diff --git a/textarchive/lib/TA/ObjReg.pm b/textarchive/lib/TA/ObjReg.pm
index e0f867f460c7ed6ef39633ac54b4d5d2914d82f3..b74c4b5ea2be5b09f60cd7ee902bf24c811a0d75 100644
--- a/textarchive/lib/TA/ObjReg.pm
+++ b/textarchive/lib/TA/ObjReg.pm
@@ -97,7 +97,11 @@ sub get_project
{
if ($be eq 'TA::Hasher') { require TA::Hasher; }
elsif ($be eq 'TA::UrxnBla') { require TA::UrxnBla; }
- elsif ($be eq 'MongoDB') { require MongoDB; }
+ elsif ($be eq 'MongoDB')
+ {
+ require MongoDB;
+ require MongoDB::MongoClient;
+ }
else
{
print "ATTN: unknown backend '$be'\n";
@@ -728,14 +732,16 @@ sub connect_MongoDB
my $cfg= shift;
my $cmm= $cfg->{'MongoDB'};
- # print "cmm: ", main::Dumper ($cmm);
+ my %cmm_c= map { $_ => $cmm->{$_} } qw(host username password db_name);
+ # print "cmm_c: ", main::Dumper (\%cmm_c);
my ($db, $col0, $col1, $col2);
eval
{
- my $connection= MongoDB::Connection->new(host => $cmm->{'host'});
- $connection->authenticate($cmm->{'db'}, $cmm->{'user'}, $cmm->{'pass'});
- $db= $connection->get_database($cmm->{'db'});
+ my $connection= new MongoDB::MongoClient( %cmm_c );
+ print "connection=[$connection]\n";
+ # $connection->authenticate($cmm->{'db'}, $cmm->{'user'}, $cmm->{'pass'});
+ $db= $connection->get_database($cmm->{'db_name'});
$col0= $db->get_collection($cmm->{'maint'});
$col1= $db->get_collection($cmm->{'catalog'});
diff --git a/textarchive/lib/md5cat.pm b/textarchive/lib/md5cat.pm
new file mode 100644
index 0000000000000000000000000000000000000000..dd9de03873ab70b8238ab35c3167663513487c64
--- /dev/null
+++ b/textarchive/lib/md5cat.pm
@@ -0,0 +1,594 @@
+#
+# $Id: md5cat.pm,v 1.7 2015/10/15 04:48:14 gonter Exp $
+#
+
+=head1 NAME
+
+ md5cat
+
+=head1 DESCRIPTION
+
+=head1 SYNOPSIS
+
+ my $md5cat= new md5cat (%parameters);
+
+=head1 REQUIREMENTS
+
+ Digest::MD5::File
+ sudo apt-get install libdigest-md5-file-perl
+
+=cut
+
+package md5cat;
+
+use strict;
+
+use Digest::MD5::File;
+
+sub new
+{
+ my $class= shift;
+ my %par= @_;
+
+ my $md5cat=
+ {
+ 'catalog' => '_catalog',
+ 'format' => 'md5cat', # standard catalog format; alternative: md5sum
+ 'chksum_pgm' => 'Digest::MD5::File',
+ };
+ bless $md5cat, $class;
+ foreach my $par (keys %par)
+ {
+ $md5cat->{$par}= $par{$par};
+ }
+ $md5cat->{'FLIST'}= {};
+ $md5cat->{'INO'}= {};
+
+ $md5cat->set_catalog ();
+
+ $md5cat;
+}
+
+sub set_catalog
+{
+ my $obj= shift;
+ my $catalog= shift || $obj->{'catalog'};
+
+ $obj->{'cat_backup'}= $catalog . '.bup';
+ $obj->{'inocat_file'}= $catalog . '.inodes';
+ $obj->{'inocat_backup'}= $catalog . '.inodes.bup';
+}
+
+sub set_tmpdir
+{
+ my $obj= shift;
+ my $tmp_dir= shift;
+
+ $obj->{'tmp_out'}= $tmp_dir . '@@@md5.tmp';
+}
+
+# ----------------------------------------------------------------------------
+sub save_catalog
+{
+ my $md5cat= shift;
+ my $cat= shift || $md5cat->{'catalog'};
+
+ my $bup= $cat . '.bup';
+
+ rename $cat, $bup if (-r $cat);
+ unless (open (CAT, ">$cat"))
+ {
+ print "can't write to [$cat]\n";
+ return -1;
+ }
+ print "writing new catalog '$cat'\n";
+
+ my $xFLIST= $md5cat->{'FLIST'};
+ foreach my $xf (sort keys %$xFLIST)
+ {
+ my $xfo= $xFLIST->{$xf};
+ printf CAT ("%s file %9d %s\n", $xfo->{'md5'}, $xfo->{'fs_size'}, $xf);
+ # print CAT $CAT{$entry}, "\n";
+ }
+ close (CAT);
+}
+
+# ----------------------------------------------------------------------------
+sub save_inode_catalog
+{
+ my $md5cat= shift;
+ my $cat= shift || $md5cat->{'inocat_file'};
+
+ my $bup= $cat . '.bup';
+
+ rename $cat, $bup if (-r $cat);
+ unless (open (CAT, ">$cat"))
+ {
+ print "cant write to $cat\n";
+ return -1;
+ }
+ print "writing new catalog '$cat'\n";
+
+ my $INO= $md5cat->{'INO'};
+ my $entry;
+ foreach $entry (sort { $a <=> $b } keys %$INO)
+ {
+ print CAT join ('|', $entry, @{$INO->{$entry}}), "\n";
+ }
+ close (CAT);
+}
+
+# ----------------------------------------------------------------------------
+sub read_flist
+{
+ my $md5cat= shift;
+ my $fnm= shift;
+
+ my $xFLIST= $md5cat->{'FLIST'};
+ my $INO= $md5cat->{'INO'};
+
+ print "reading reference list: [$fnm]\n";
+ unless (open (FI, $fnm))
+ {
+ print __LINE__, " could not open '$fnm'!\n";
+ return -1;
+ }
+
+ my $ref_cnt= 0;
+ while (<FI>)
+ {
+ s/\015//g;
+ chop;
+ next if (/^#/);
+ tr/A-Z/a-z/ if ($md5cat->{'to_lower'});
+ s#^\.\/##;
+
+ # print __LINE__, " >>> $_\n" if (/Hafo/i);
+ # print ">>> $_\n";
+
+# TODO: refactor into separate check
+ next if ($_ eq $md5cat->{'catalog'}
+ || $_ eq $md5cat->{'cat_backup'}
+ || $_ eq $md5cat->{'inocat_file'}
+ || $_ eq $md5cat->{'inocat_backup'}
+ );
+ next if ($md5cat->{'skip_vcs'} && $_ =~ m#(^|/)(CVS|\.git|\.svn|.bzr|RCS)/#);
+
+ my @st= stat ($_);
+ my $ino= $st[1];
+
+ $xFLIST->{$_}= { 'state' => 'exists', 'fs_size' => $st[7], 'mtime' => $st [9], 'ino' => $ino };
+ $ref_cnt++;
+
+ push (@{$INO->{$ino}}, $_);
+ }
+ close (FI);
+ $ref_cnt;
+}
+
+# ----------------------------------------------------------------------------
+sub read_dir_listing
+{
+ my $md5cat= shift;
+ my $fnm_i= shift;
+ my $is_top;
+ my $dir= '';
+ my ($perms, $lnk, $owner, $group, $size, $mon, $day, $time_year, $nm);
+
+ my $xFLIST= $md5cat->{'FLIST'};
+
+ print "reading dir listing: '$fnm_i'\n";
+ unless (open (FI, $fnm_i))
+ {
+ print __LINE__, " could not open '$fnm_i'!\n";
+ return -1;
+ }
+
+ my $ref_cnt= 0;
+ while (<FI>)
+ {
+ s/\015//g;
+ chop;
+
+ if (/^[ \t]*$/)
+ {
+ $is_top= 1;
+ next;
+ }
+
+ next if (/^total /);
+
+ if ($is_top && /\.\/pub\/(.+):/)
+ {
+ $dir= $1;
+ $is_top= 0;
+ next;
+ }
+
+ ($perms, $lnk, $owner, $group, $size, $mon, $day, $time_year, $nm)=
+ split (' ', $_, 9);
+
+ if ($perms =~ /^\-r..r..r../)
+ {
+ $size= 1 if ($size == 0); # 0 is a flag !
+ $xFLIST->{"$dir/$nm"}= { 'fs_size' => $size, 'state' => 'exists' };
+ $ref_cnt++;
+ }
+ }
+ close (FI);
+ $ref_cnt;
+}
+
+# ----------------------------------------------------------------------------
+# cleanup
+sub check_new_files
+{
+ my $md5cat= shift;
+ my $limit= shift;
+
+ my %QUEUE_openssl= ();
+ my $QUEUE_openssl= 0;
+
+ my $xFLIST= $md5cat->{'FLIST'};
+ my @tmp_2chk= ();
+ my @res= ();
+ my $cnt= 0;
+ FILE: foreach my $fnm (sort keys %$xFLIST)
+ {
+ last FILE if (defined ($limit) && @tmp_2chk >= $limit);
+
+ printf ("%9d items processed\n", $cnt) if ((++$cnt % 1000) == 0);
+ my $F= $xFLIST->{$fnm};
+ my $x= $F->{'state'};
+ next if ($x eq 'nocheck');
+
+ if ($x eq 'toobig')
+ {
+ print "ATTN: skipping '$fnm': '$x'\n";
+ next;
+ }
+
+ # print "to be checked: fnm='$fnm'\n" if ($md5cat->{'verbose_level'} > 2);
+
+ if (0 && $F->{'fs_size'} >= $md5cat->{'MAX_CSIZE'})
+ {
+ print "file to big for checksum!\n";
+ print 'F: ', main::Dumper ($F), "\n";
+ $QUEUE_openssl{$fnm}= $F;
+ $QUEUE_openssl++;
+ }
+ else
+ {
+ push (@tmp_2chk, $fnm);
+ }
+ }
+ printf ("%9d files to be checked\n", scalar (@tmp_2chk));
+
+ if (@tmp_2chk)
+ {
+ print "to be checked with $md5cat->{'chksum_pgm'}: ", scalar @tmp_2chk, "\n" if ($md5cat->{'verbose_level'} > 2);
+ # print __LINE__, " files:\n--- 8< ---\n", join ("\n", @tmp_2chk), "\n--- >8 ---\n";
+
+ if ($md5cat->{'chksum_pgm'} eq 'Digest::MD5::File')
+ {
+ @res= digest_md5_list (@tmp_2chk);
+ # print "res: ", main::Dumper (\@res);
+ }
+
+=begin comment
+
+... maybe we should drop that sometime ...
+ else
+ {
+ my $cmd;
+ if ($md5cat->{'chksum_pgm'} eq 'checksum')
+ {
+ $cmd= "$md5cat->{'checksum'} -e -f$tmp_2chk >$md5cat->{'tmp_out'}";
+ }
+ elsif ($md5cat->{'chksum_pgm'} eq 'CRC32')
+ {
+ $cmd= "CRC32 -checksum -f$tmp_2chk >$md5cat->{'tmp_out'}";
+ }
+ elsif ($md5cat->{'chksum_pgm'} eq 'md5sum')
+ {
+ $cmd= "xargs <$tmp_2chk $md5cat->{'checksum'} >$md5cat->{'tmp_out'}";
+ }
+ if ($md5cat->{'chksum_pgm'} eq 'Digest::MD5::File')
+ {
+ digest_md5_file ($tmp_2chk, $md5cat->{'tmp_out'});
+ }
+
+ print "chksum_pgm=[$md5cat->{'chksum_pgm'}]\n";
+ print "checksum=[$md5cat->{'checksum'}]\n";
+ system ($cmd);
+ # exit (0);
+ }
+
+=end comment
+=cut
+
+ }
+
+ if ($QUEUE_openssl)
+ {
+ print "to be checked with openssl: $QUEUE_openssl\n" if ($md5cat->{'verbose_level'} > 2);
+ open (FO, ">>$md5cat->{'tmp_out'}") or die "cant append to $md5cat->{'tmp_out'}";
+
+ print "to be checked with openssl: $QUEUE_openssl\n";
+ foreach my $fnm (keys %QUEUE_openssl)
+ {
+ my $F= $QUEUE_openssl{$fnm};
+ my $cmd2= "openssl md5 '$fnm'";
+ my $res= `$cmd2`;
+ chop ($res);
+
+ print __LINE__, " >> res='$res'\n";
+ if ($res =~ /^MD5\((.+)\)= ([a-fA-F0-9]{32,})$/)
+ {
+ my ($x_fnm, $x_md5)= ($1, $2);
+ print __LINE__, " >>> x_fnm='$x_fnm' x_md5='$x_md5'\n";
+ print FO "$x_md5 file $F->{'fs_size'} $x_fnm\n";
+ }
+ }
+ close (FO);
+ }
+
+ push (@main::REPORT, sprintf ("checked %s: %8d (%s)", $md5cat->{'chksum_pgm'}, scalar (@tmp_2chk)));
+ push (@main::REPORT, sprintf ("checked openssl: %8d (%s)", $QUEUE_openssl));
+
+ (wantarray) ? @res : \@res;
+}
+
+sub update_catalog
+{
+ my $md5cat= shift;
+
+ # Step 2: read catalog of known files
+ my $to_save= $md5cat->check_md5_entries ($md5cat->{'catalog'}, 0);
+ # print __LINE__, " diag: catalog processed\n"; $md5cat->diag ();
+ # print __LINE__, " md5cat: ", main::Dumper ($md5cat);
+
+ my $new_files= $md5cat->check_new_files ();
+ if (@$new_files)
+ {
+ # $md5cat->check_md5_entries ($md5cat->{'tmp_out'}, 1);
+ # unlink $md5cat->{'tmp_out'} if ($md5cat->{'do_unlink'});
+ print __LINE__, " integrate new files: ", main::Dumper ($new_files);
+ $md5cat->integrate_md5_sums ($new_files);
+
+ $to_save= 1;
+ }
+
+ if ($to_save)
+ {
+ $md5cat->save_catalog ();
+ $md5cat->save_inode_catalog ();
+ }
+
+ $to_save;
+}
+
+sub integrate_md5_sums
+{
+ my $md5cat= shift;
+ my $result_list= shift;
+
+ my $fl= $md5cat->{'FLIST'};
+ foreach my $e (@$result_list)
+ {
+ my ($md5, $path, $size, $mtime)= @$e;
+ my $f;
+ $f= $fl->{$path}= {} unless (defined ($f= $fl->{$path}));
+ $f->{'md5'}= $md5;
+ $f->{'fs_size'}= $size if (defined ($size));
+ $f->{'mtime'}= $mtime if (defined ($mtime));
+ }
+}
+
+# ----------------------------------------------------------------------------
+# read MD5 catalog
+#
+# this function is called to read the existing catalog as well to read
+# output from checksum command
+#
+sub check_md5_entries
+{
+ my $md5cat= shift;
+ my $list= shift;
+ my $added= shift;
+ my $format= $md5cat->{'format'} || 'md5cat';
+
+ my $xFLIST= $md5cat->{'FLIST'};
+
+ my $rc= 0;
+ my ($cnt_dropped, $cnt_retained, $fnm1, $fnm2, $fnm3, @fnm);
+ my @st= stat ($list);
+ my $mtime= $st[9];
+
+ unless (open (FI, $list))
+ {
+ print __LINE__, " could not open $list!\n";
+ return 0;
+ }
+
+ my $line= 0;
+ while (<FI>)
+ {
+ $line++;
+ s/\015//g;
+ chop;
+ next if (/^\s*$/ || /^#/);
+
+ my ($md5, $x_file, $size, $fnm)= split (' ', $_, 4);
+
+ if ($x_file eq 'file') {} # standard format
+ elsif ($fnm eq 'file')
+ {
+ print STDERR "ATTN: non standard format in file $list at line $line: [$_]\n";
+ }
+ elsif ($format eq 'md5sum')
+ {
+ # Uh, this needs to be redesigned soon!
+ my @stf= stat ($fnm);
+ $size= $stf[7];
+ # $_= sprintf ("%s file %9d %s", $f[0], $size, $fnm);
+ }
+ else
+ {
+ next;
+ }
+
+=begin comment
+
+this may be obsolete and shold be removed
+ if (0 && $xsep) # redesign!
+ {
+ @fnm= split ('/', $fnm);
+ $fnm3= pop (@fnm);
+ $fnm2= pop (@fnm);
+ $fnm1= substr ($fnm3, 0, 1);
+ # print ">> $fnm, $fnm2, $fnm1, $fnm3 ->";
+
+ if ($fnm1 =~ /\d/) { $fnm1= '0'; }
+ elsif (!($fnm1 =~ /\w/)) { $fnm1= '_'; }
+
+ if ($fnm2 eq '.xvpics') { push (@fnm, $fnm1, $fnm2, $fnm3); }
+ else { push (@fnm, $fnm2, $fnm1, $fnm3); }
+ $fnm= join ('/', @fnm);
+ # print " $fnm\n";
+ }
+
+=end comment
+=cut
+
+ my $FL;
+ if (# -r $fnm
+ defined ($FL= $xFLIST->{$fnm})
+ && $FL->{'state'} eq 'exists'
+ && !($fnm eq $md5cat->{'catalog'} || $fnm eq $md5cat->{'cat_backup'})
+ )
+ {
+ my $fs_size= $FL->{'fs_size'};
+ $FL->{'md5'}= $md5;
+
+ # print "size=$size fs_size=$fs_size\n";
+ if (($fs_size == 1 || $size == $fs_size)
+ && $mtime > $FL->{'mtime'}
+ )
+ {
+ $cnt_retained++;
+ # $FL->{'skip'}= 1;
+ $FL->{'state'}= ($added) ? 'added' : 'nocheck';
+ # $xFLIST->{$fnm}= 0 if (defined ($xFLIST->{$fnm}) && $xFLIST->{$fnm});
+ # $CAT{$fnm}= $_;
+ }
+ elsif ($fs_size < 0) #### || $fs_size > $md5cat->{'MAX_CSIZE'})
+ { # checksum can't handle files larger than 2 GB yet, it will check such files everytime again
+ print ">>> skipping fnm='$fnm' fs_size='$fs_size'\n";
+ $FL->{'state'}= 'toobig';
+ }
+ else
+ {
+ $FL->{'state'}= ($added) ? 'added' : 'recheck';
+ }
+ # print "$_\n";
+ }
+ else
+ {
+ print "dropped: $_\n";
+ $cnt_dropped++;
+ $rc= 1;
+ $FL->{'state'} => 'dropped';
+ }
+ }
+
+ close (FI);
+ push (@main::REPORT, sprintf ("retained: %8d (%s)", $cnt_retained, $list));
+ push (@main::REPORT, sprintf ("dropped: %8d (%s)", $cnt_dropped, $list));
+
+ return $rc;
+}
+
+# =head1 INTERNAL METHODS
+
+sub diag
+{
+ my $md5cat= shift;
+
+ my $xF= $md5cat->{'FLIST'} or die;
+
+ foreach my $xf (keys %$xF)
+ {
+ my $xfo= $xF->{$xf};
+ next if ($xfo->{'state'} eq 'nocheck');
+ print "xf=[$xf] ", main::Dumper ($xfo);
+ }
+}
+
+# =head1 INTERNAL FUNCTIONS
+
+sub digest_md5_list
+{
+ my @res= ();
+
+ my $cnt= 0;
+ while (my $f= shift (@_))
+ {
+ printf ("%9d items processed\n", $cnt) if ((++$cnt % 1000) == 0);
+ my @st= stat ($f);
+ unless (@st)
+ {
+ print STDERR "can't stat file '$f'\n";
+ next;
+ }
+
+ my $md5= Digest::MD5::File::file_md5_hex ($f);
+printf ("%9d %s %s\n", $st[7], $md5, $f);
+ push (@res, [ $md5, $f, $st[7], $st[9] ]);
+ }
+
+ (wantarray) ? @res : \@res;
+}
+
+sub digest_md5_file
+{
+ my $fnm_in= shift;
+ my $fnm_out= shift;
+
+ open (FI, '<:utf8', $fnm_in) or die "can't read $fnm_in";
+ open (FO, '>:utf8', $fnm_out) or die "can't write $fnm_out";
+ while (my $f= <FI>)
+ {
+ chop ($f);
+
+ my @st= stat ($f);
+ unless (@st)
+ {
+ print STDERR "can't stat file '$f'\n";
+ next;
+ }
+
+ my $md5= Digest::MD5::File::file_md5_hex ($f);
+ printf FO ("%s file %9d %s\n", $md5, $st[7], $f);
+ }
+ close (FI);
+ close (FO);
+}
+
+1;
+
+__END__
+
+=head1 INTERNALS
+
+=head2 file items:
+
+state:
+ exists .. file is present in reference list
+ nocheck .. no checking necessary (md5 present, mtime ok, size ok)
+ recheck .. perform a new check
+ toobig .. file is too big to be handled by normal checking code
+ dropped .. item will be removed from the catalog
+ added .. file is added to the catalog
+
+
diff --git a/textarchive/mp3tags.pl b/textarchive/mp3tags.pl
index b413c436b4076f420eba524a7261763a4cd72eb6..d7ba1dfacd029ae62d5339a5cc269e5a1facb435 100755
--- a/textarchive/mp3tags.pl
+++ b/textarchive/mp3tags.pl
@@ -6,12 +6,20 @@ use MP3::Info;
use Data::Dumper;
$Data::Dumper::Indent= 1;
+my $op_mode;
+my $do_move= 0;
+
my @PAR;
while (my $arg= shift (@ARGV))
{
if ($arg =~ /^-/)
{
- &usage;
+ if ($arg eq '--album') { $op_mode= 'album'; }
+ elsif ($arg eq '--move') { $do_move= 1; }
+ else
+ {
+ &usage;
+ }
}
else
{
@@ -19,14 +27,36 @@ while (my $arg= shift (@ARGV))
}
}
+my %albums;
foreach my $file (@PAR)
{
my $tag= get_mp3tag ($file);
- print "file: [$file]\n";
- print "tag: ", Dumper ($tag);
+ if ($op_mode eq 'album')
+ {
+ my $album= $tag->{'ALBUM'} || 'unknown album';
+ push (@{$albums{$album}}, $file);
+ }
+ else
+ {
+ print "file: [$file]\n";
+ print "tag: ", Dumper ($tag);
+ }
}
+ if ($op_mode eq 'album')
+ {
+ foreach my $album (sort keys %albums)
+ {
+ print "album=[$album]\n";
+ system ('mkdir', $album) if ($do_move);
+ foreach my $file (@{$albums{$album}})
+ {
+ print "file=[$file]\n";
+ system ('mv', '-i', $file, $album) if ($do_move);
+ }
+ }
+ }
__END__
diff --git a/textarchive/vlib001.pl b/textarchive/vlib001.pl
index 644a7727e02ccbe14f6621fe8e3ff7e9ab637bcc..286d4459ad298e3790a40e1ce300a19ff0076629 100755
--- a/textarchive/vlib001.pl
+++ b/textarchive/vlib001.pl
@@ -4,6 +4,11 @@
vlib001.pl
+=head1 VERSION
+
+ Version: 0.50
+ Date: Fri Oct 16 13:09:17 CEST 2015
+
=head1 USAGE
vlib001.pl -p project-name [-s store-name] [parameters]*
@@ -64,6 +69,7 @@ my $DEBUG= 0;
my $STOP= 0;
my $op_mode= 'refresh';
my $limit= undef;
+my $show_every= 1000;
my $cat_file= '_catalog';
my $ino_file= '_catalog.inodes';
my $check_inode= 1;
@@ -93,7 +99,7 @@ while (my $arg= shift (@ARGV))
elsif ($arg eq '--subdir') { push (@subdirs, shift (@ARGV)); }
elsif ($arg eq '--cd') { $cd_mode= 1; }
elsif ($arg =~ /^--(refresh|verify|lookup|edit|maint|next-seq|get-cat)$/) { $op_mode= $1; }
- else { &usage ("unknown option '$arg'"); }
+ else { &usage ("unknown option '--$arg'"); }
}
elsif ($arg =~ /^-/)
{
@@ -159,6 +165,9 @@ $DEBUG= 1;
print "path=[$path]\n";
my $res= chdir ($path) or event_die ("can not change to $path");;
print "res=[$res]\n";
+
+ # verify if the chdir really lead to the expected place
+ # TODO: there might be symlinked paths or something like that, so this should pssibly not always fail
my $pwd= `pwd`; chop($pwd);
print "pwd=[$pwd]\n";
event_die ("chdir failed strangely path=[$path] pwd=[$pwd]") unless ($pwd eq $path);
@@ -231,7 +240,11 @@ exit (0);
sub usage
{
my $msg= shift;
- print $msg, "\n" if ($msg);
+ if ($msg)
+ {
+ print $msg, "\n";
+ sleep (10);
+ }
system ('perldoc', $0);
exit -1;
}