diff --git a/textarchive/lib/TA/Hasher.pm b/textarchive/lib/TA/Hasher.pm index 83bdbde6e88653869c9dd588619045d667a12cd7..ca09cfe3f18ff5c0de4d505ad4c76bdcbad973e7 100644 --- a/textarchive/lib/TA/Hasher.pm +++ b/textarchive/lib/TA/Hasher.pm @@ -74,7 +74,7 @@ sub check_file my @dir_path= @{$mkpo->{'L'}}; unshift (@dir_path, $obj->{'pfx'}) if (exists ($obj->{'pfx'})); - push (@dir_path, $fnm) if ($obj->{'name'} == 'dir'); + push (@dir_path, $fnm) if ($obj->{'name'} eq 'dir'); my $dir_path= join ('/', @dir_path); my $existed= (-d $dir_path) ? 1 : 0; diff --git a/textarchive/lib/TA/ObjReg.pm b/textarchive/lib/TA/ObjReg.pm index 7189420930df6ee891bc310b3a8d241aa490bda5..98a2813fcc46b69fba8071a7716877c03882f0c3 100644 --- a/textarchive/lib/TA/ObjReg.pm +++ b/textarchive/lib/TA/ObjReg.pm @@ -4,7 +4,9 @@ package TA::ObjReg; use strict; use JSON; + use TA::Util; +use TA::Hasher; sub new { @@ -30,7 +32,11 @@ sub new $obj->{$par}= $par{$par}; } - $par; + my $cfg= $obj->get_project (); + return undef unless (defined ($cfg)); + $obj->{cfg}= $cfg; + + $obj; } sub get_project @@ -38,20 +44,65 @@ sub get_project my $obj= shift; my $proj_name= $obj->{'project'}; - my $proj_cfg_fnm= join ('/', $ENV{'TABASE'}, 'projects', $proj_name, 'config.json'); + $obj->{'proj_cfg_dir'}= my $proj_cfg_dir= join ('/', $ENV{'TABASE'}, 'projects', $proj_name); + $obj->{'proj_cfg_fnm'}= my $proj_cfg_fnm= join ('/', $proj_cfg_dir, 'config.json'); my $proj_cfg; unless ($proj_cfg= TA::Util::slurp_file ($proj_cfg_fnm, 'json')) { - print STDERR "project '$proj_name' at 'proj_cfg_fnm'\n"; + print STDERR "no project '$proj_name' at '$proj_cfg_fnm'\n"; return undef; } + # print "proj_cfg: ", main::Dumper ($proj_cfg); + # TODO: check authorization (no need, if local, but for client-server, we need something1 + + my $base_dir= $obj->{'proj_cfg_dir'}; + $obj->{'proj_cat'}= my $proj_cat= join ('/', $base_dir, 'cat'); + $obj->{'hasher'}= my $hasher= new TA::Hasher ('algorithm' => $proj_cfg->{'algorithm'}, 'pfx' => $proj_cat, 'name' => 'file'); + + $proj_cfg; } sub add { + my $obj= shift; + my $id_str= shift; + my $max_age= shift; # TODO: add code to skip processing if registry data was not updated; but this is tricky because it really depends on the subproject... + my $new_reg= shift; + + my @r= $obj->{'hasher'}->check_file ($id_str, 1); + + print "id_str=[$id_str] r=", main::Dumper (\@r); + my ($rc, $path)= @r; + + my $fnm= $path . '/' . $id_str . '.json'; + print "description: [$fnm]\n"; + + my $reg; + my $upd= 0; + + my @st= stat ($fnm); + + if (@st) + { + $reg= TA::Util::slurp_file ($fnm, 'json'); + print "json read: ", main::Dumper ($reg); + } + else + { + $reg= $new_reg; + $upd= 1; + } + + if ($upd) + { + print "reg: ", main::Dumper ($reg); + my $j= encode_json ($reg); + print "generated json: [$j]\n"; + open (J, '>:utf8', $fnm); print J $j; close (J); + } } # =head1 INTERNAL FUNCTIONS @@ -61,7 +112,6 @@ __END__ =head1 ENVIRONMENT - =head1 TODOs * this is a stub for storage in a local filesystem diff --git a/textarchive/lib/TA/Util.pm b/textarchive/lib/TA/Util.pm index e9dff194e7796538c45bca208696431fd7ff8f15..820cbb44472e94c20d772126f5be7905f9c1db7c 100644 --- a/textarchive/lib/TA/Util.pm +++ b/textarchive/lib/TA/Util.pm @@ -3,6 +3,8 @@ package TA::Util; use strict; +use JSON; + =head2 _file_slurp ($filename, $format) read contents of that file and diff --git a/textarchive/vlib001.pl b/textarchive/vlib001.pl new file mode 100755 index 0000000000000000000000000000000000000000..4558af61fc1a8b5c0a9d5abea5698d976e077606 --- /dev/null +++ b/textarchive/vlib001.pl @@ -0,0 +1,89 @@ +#!/usr/bin/perl + +use strict; + +use Data::Dumper; +$Data::Dumper::Indent= 1; + +use TA::ObjReg; +use TA::Hasher; +use TA::Util; + +my @PAR= (); +my $project; +my $subproject; + +while (my $arg= shift (@ARGV)) +{ + if ($arg eq '--') { push (@PAR, @ARGV); @ARGV= (); } + elsif ($arg =~ /^--/) + { + if ($arg eq '--project') { $project= shift (@ARGV); } + elsif ($arg eq '--subproject') { $subproject= shift (@ARGV); } + } + elsif ($arg =~ /^-/) + { + my @a= split ('|', $arg); + foreach my $a (@a) + { + if ($a eq 'p') { $project= shift (@ARGV); } + elsif ($a eq 's') { $subproject= shift (@ARGV); } + } + } + else { push (@PAR, $arg); } +} + +unless (defined ($project)) +{ + &usage ('no project specified'); +} + +my $objreg= new TA::ObjReg ('project' => $project, 'subproject' => $subproject); +print "objreg: ", Dumper ($objreg); + +my $catalog= $objreg->{'cfg'}->{'catalog'}; +unless (defined ($catalog)) +{ + &usage ('no catalog specified'); +} + +if ($catalog->{'format'} eq 'md5cat') +{ + refresh_md5cat ($objreg, 'subproject' => $subproject); +} + +print "objreg: (after refresh)", Dumper ($objreg); + +exit (0); + +sub refresh_md5cat +{ + my $objreg= shift; + my %extra= @_; + + # my $catalog= $objreg->{'cfg'}->{'catalog'}; + system ('/usr/local/bin/chkmd5.pl'); + + # my $hasher= $objreg->{'hasher'}; + + open (CAT, '_catalog') or die "cant read catalog"; + while (<CAT>) + { + chop; + my ($md5, $xf, $size, $path)= split (' ', $_, 4); + $path=~ s#^\.\/##; + print "md5=[$md5] size=[$size] path=[$path]\n"; + $objreg->add ($md5, 0, { 'md5' => $md5, 'size' => $size, 'path' => $path, %extra } ); + } + close (CAT); +} + + +sub usage +{ + my $msg= shift; + print $msg, "\n"; + system ("perldoc $0"); + exit -1; +} +