#!/usr/bin/perl
#
# Created by Zachary
# Updated by Brandon to include both split and join
# Updated by Brandon for Perl5 and the new database format
#
## require perl 5 or better, sorry guys, upgrade time.
if ($] < 5) {
die("This program requires perl 5.002 or greater.\n");
}
require 5.002;
$parents = "";
$buffer = "";
select(STDOUT); $| = 1;
sub frobfile {
local($file) = @_;
if ($file =~ /[^a-z0-9_]/) {
print "\nInvalid object name \"\$$file\"";
$file =~ s/[^a-z0-9_]//g;
print ", stripping to \"\$$file\".\n";
}
return $file;
}
sub saveobj {
local($object) = @_;
local($objname);
($object =~ /^new object [\$#]([^:; ]+)/) ||
($object =~ /^object [\$#]([^:; ]+)/);
$objname = $1;
local($file) = &frobfile($objname);
local($tmp) = "$file.cdc";
local($i) = 0;
while (-e $tmp) {
print "\nFile \"$tmp\" exists, renaming to ";
$i++;
$tmp = "$file-${i}.cdc";
print "\"$tmp\".\n";
}
$file = $tmp;
print ".";
open(FILE, ">$srcdir/$file") || die("\nUnable to write to \"$srcdir\".\n");
print INDEX "$file\n";
print FILE $object;
print FILE $buffer;
$buffer = "";
$parents = "";
close(FILE);
}
sub split {
$reading_obj = 0;
while (<DUMP>) {
if (/^new object / || /^object /) {
($reading_obj) && &saveobj($reading_obj);
$reading_obj = $_;
} else {
$buffer .= "$_";
}
}
&saveobj($reading_obj);
}
sub unsplit {
local($name);
while (<INDEX>) {
chomp;
print STDERR ".";
$file = "$srcdir/$_";
if (-e $file) {
open(FILE, $file);
while (<FILE>) {
print DUMP;
}
close(FILE);
} else {
print STDERR "\nAck, unable to find file \"$file\".\n";
}
}
}
$USAGE = <<END;
Usage: dumpsplit <option> [<dump> <srcdir>]
dump defaults to "textdump"
srcdir defaults to "src"
Options:
-s -- split
-j -- join db (unsplit)
END
$_ = $ARGV[0];
shift;
if ($ARGV[0]) { $textdump = $ARGV[0]; } else { $textdump = "textdump"; }
if ($ARGV[1]) { $srcdir = $ARGV[1]; } else { $srcdir = "src"; }
$index = "$srcdir/INDEX";
if (!(-d $srcdir)) {
mkdir($srcdir, 0755) ||
(print "Unable to make directory \"$srcdir\"." && exit);
}
if (/^-s/) {
open(DUMP, "$textdump") ||
(print "${USAGE}Unable to open textdump \"$textdump\".\n" && exit);
open(INDEX, ">$index") ||
(print "${USAGE}Unable to open name file \"$index\".\n" && exit);
print "Splitting db";
&split();
} elsif (/^-[uj]/) {
open(DUMP, ">$textdump") ||
(print "${USAGE}Unable to open textdump \"$textdump\".\n" && exit);
open(INDEX, "$index") ||
(print "${USAGE}Unable to open name file \"$index\".\n" && exit);
print "Joining db";
&unsplit();
} else {
print $USAGE;
exit(0);
}
print "\n";
close(DUMP);
close(INDEX);