added vlib processing

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;

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

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 

textarchive/vlib001.pl

+#!/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;
+}
+