[BACK]Return to searchcat.pl CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / metadata_database

Diff for /loncom/metadata_database/searchcat.pl between versions 1.32 and 1.51

version 1.32, 2003/03/26 20:15:57 version 1.51, 2003/12/26 16:27:20
Line 27 Line 27
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
 ###  ###
   
 =pod  =pod
   
 =head1 NAME  =head1 NAME
Line 55  This script also does general database m Line 56  This script also does general database m
 the C<loncapa:metadata> table if it is deprecated.  the C<loncapa:metadata> table if it is deprecated.
   
 This script evaluates dynamic metadata from the authors'  This script evaluates dynamic metadata from the authors'
 F<nohist_resevaldata.db> database file in order to store it in MySQL, as  F<nohist_resevaldata.db> database file in order to store it in MySQL.
 well as to compress the filesize (add up all "count"-type metadata).  
   
 This script is playing an increasingly important role for a loncapa  This script is playing an increasingly important role for a loncapa
 library server.  The proper operation of this script is critical for a smooth  library server.  The proper operation of this script is critical for a smooth
Line 64  and correct user experience. Line 64  and correct user experience.
   
 =cut  =cut
   
   use strict;
   
 use lib '/home/httpd/lib/perl/';  use lib '/home/httpd/lib/perl/';
 use LONCAPA::Configuration;  use LONCAPA::Configuration;
   
Line 73  use DBI; Line 75  use DBI;
 use GDBM_File;  use GDBM_File;
 use POSIX qw(strftime mktime);  use POSIX qw(strftime mktime);
   
   require "find.pl";
   
 my @metalist;  my @metalist;
   
   my $simplestatus='';
   my %countext=();
   
   # ----------------------------------------------------- write out simple status
   sub writesimple {
       open(SMP,'>/home/httpd/html/lon-status/mysql.txt');
       print SMP $simplestatus."\n";
       close(SMP);
   }
   
   sub writecount {
       open(RSMP,'>/home/httpd/html/lon-status/rescount.txt');
       foreach (keys %countext) {
    print RSMP $_.'='.$countext{$_}.'&';
       }
       print RSMP 'time='.time."\n";
       close(RSMP);
   }
   
   # -------------------------------------- counts files with different extensions
   sub count {
       my $file=shift;
       $file=~/\.(\w+)$/;
       my $ext=lc($1);
       if (defined($countext{$ext})) {
    $countext{$ext}++;
       } else {
    $countext{$ext}=1;
       }
   }
 # ----------------------------------------------------- Un-Escape Special Chars  # ----------------------------------------------------- Un-Escape Special Chars
   
 sub unescape {  sub unescape {
Line 92  sub escape { Line 125  sub escape {
     return $str;      return $str;
 }  }
   
   
 # ------------------------------------------- Code to evaluate dynamic metadata  # ------------------------------------------- Code to evaluate dynamic metadata
   
 sub dynamicmeta {  sub dynamicmeta {
   
     my $url=&declutter(shift);      my $url=&declutter(shift);
     $url=~s/\.meta$//;      $url=~s/\.meta$//;
     my %returnhash=();      my %returnhash=(
       'count' => 0,
       'course' => 0,
       'course_list' => '',
       'avetries' => 'NULL',
       'avetries_list' => '',
       'stdno' => 0,
       'stdno_list' => '',
       'usage' => 0,
       'usage_list' => '',
       'goto' => 0,
       'goto_list' => '',
       'comefrom' => 0,
       'comefrom_list' => '',
       'difficulty' => 'NULL',
       'difficulty_list' => '',
                       'clear' => 'NULL',
                       'technical' => 'NULL',
       'correct' => 'NULL',
       'helpful' => 'NULL',
       'depth' => 'NULL',
       'comments' => ''
       );
     my ($adomain,$aauthor)=($url=~/^(\w+)\/(\w+)\//);      my ($adomain,$aauthor)=($url=~/^(\w+)\/(\w+)\//);
     my $prodir=&propath($adomain,$aauthor);      my $prodir=&propath($adomain,$aauthor);
     if ((tie(%evaldata,'GDBM_File',  
             $prodir.'/nohist_resevaldata.db',&GDBM_READER(),0640)) &&  # Get metadata except counts
         (tie(%newevaldata,'GDBM_File',      if (tie(my %evaldata,'GDBM_File',
             $prodir.'/nohist_new_resevaldata.db',&GDBM_WRCREAT(),0640))) {              $prodir.'/nohist_resevaldata.db',&GDBM_READER(),0640)) {
        my %sum=();   my %sum=();
        my %cnt=();   my %cnt=();
        my %listitems=('count'        => 'add',   my %concat=();
                       'course'       => 'add',   my %listitems=(
                       'avetries'     => 'avg',         'course'       => 'add',
                       'stdno'        => 'add',         'goto'         => 'add',
                       'difficulty'   => 'avg',         'comefrom'     => 'add',
                       'clear'        => 'avg',         'avetries'     => 'avg',
                       'technical'    => 'avg',         'stdno'        => 'add',
                       'helpful'      => 'avg',         'difficulty'   => 'avg',
                       'correct'      => 'avg',         'clear'        => 'avg',
                       'depth'        => 'avg',         'technical'    => 'avg',
                       'comments'     => 'app',         'helpful'      => 'avg',
                       'usage'        => 'cnt'         'correct'      => 'avg',
                       );         'depth'        => 'avg',
        my $regexp=$url;         'comments'     => 'app',
        $regexp=~s/(\W)/\\$1/g;         'usage'        => 'cnt'
        $regexp='___'.$regexp.'___([a-z]+)$';         );
        foreach (keys %evaldata) {  
  my $key=&unescape($_);   my $regexp=$url;
  if ($key=~/$regexp/) {   $regexp=~s/(\W)/\\$1/g;
     my $ctype=$1;   $regexp='___'.$regexp.'___([a-z]+)$';
             if (defined($cnt{$ctype})) {    while (my ($esckey,$value)=each %evaldata) {
                $cnt{$ctype}++;       my $key=&unescape($esckey);
             } else {       if ($key=~/$regexp/) {
                $cnt{$ctype}=1;    my ($item,$purl,$cat)=split(/___/,$key);
             }   if (defined($cnt{$cat})) { $cnt{$cat}++; } else { $cnt{$cat}=1; }
             unless ($listitems{$ctype} eq 'app') {   unless ($listitems{$cat} eq 'app') {
                if (defined($sum{$ctype})) {      if (defined($sum{$cat})) {
                   $sum{$ctype}+=$evaldata{$_};   $sum{$cat}+=&unescape($evaldata{$esckey});
           } else {   $concat{$cat}.=','.$item;
                   $sum{$ctype}=$evaldata{$_};      } else {
        }   $sum{$cat}=&unescape($evaldata{$esckey});
             } else {   $concat{$cat}=$item;
                if (defined($sum{$ctype})) {      }
                   if ($evaldata{$_}) {   } else {
                      $sum{$ctype}.='<hr>'.$evaldata{$_};      if (defined($sum{$cat})) {
           }   if ($evaldata{$esckey}=~/\w/) {
         } else {      $sum{$cat}.='<hr />'.&unescape($evaldata{$esckey});
              $sum{$ctype}=''.$evaldata{$_};   }
        }      } else {
    $sum{$cat}=''.&unescape($evaldata{$esckey});
       }
    }
       }
    }
    untie(%evaldata);
   # transfer gathered data to returnhash, calculate averages where applicable
    while (my $cat=each(%cnt)) {
       if ($cnt{$cat} eq 'nan') { next; }
       if ($sum{$cat} eq 'nan') { next; }
       if ($listitems{$cat} eq 'avg') {
    if ($cnt{$cat}) {
       $returnhash{$cat}=int(($sum{$cat}/$cnt{$cat})*100.0+0.5)/100.0;
    } else {
       $returnhash{$cat}='NULL';
    }
       } elsif ($listitems{$cat} eq 'cnt') {
    $returnhash{$cat}=$cnt{$cat};
       } else {
    $returnhash{$cat}=$sum{$cat};
     }      }
     if ($ctype ne 'count') {      $returnhash{$cat.'_list'}=$concat{$cat};
        $newevaldata{$_}=$evaldata{$_};   }
    }      }
  }  # get count
       }      if (tie(my %evaldata,'GDBM_File',
       foreach (keys %cnt) {              $prodir.'/nohist_accesscount.db',&GDBM_READER(),0640)) {
          if ($listitems{$_} eq 'avg') {   my $escurl=&escape($url);
      $returnhash{$_}=int(($sum{$_}/$cnt{$_})*100.0+0.5)/100.0;   if (! exists($evaldata{$escurl})) {
          } elsif ($listitems{$_} eq 'cnt') {      $returnhash{'count'}=0;
              $returnhash{$_}=$cnt{$_};   } else {
          } else {      $returnhash{'count'}=$evaldata{$escurl};
              $returnhash{$_}=$sum{$_};   }
          }   untie %evaldata;
      }      }
      if ($returnhash{'count'}) {      return %returnhash;
          my $newkey=$$.'_'.time.'_searchcat___'.&escape($url).'___count';  
          $newevaldata{$newkey}=$returnhash{'count'};  
      }  
      untie(%evaldata);  
      untie(%newevaldata);  
    }  
    return %returnhash;  
 }  }
       
 # ----------------- Code to enable 'find' subroutine listing of the .meta files  
 require "find.pl";  
 sub wanted {  
     (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&  
     -f _ &&  
     /^.*\.meta$/ && !/^.+\.\d+\.[^\.]+\.meta$/ &&  
     push(@metalist,"$dir/$_");  
 }  
   
 # ---------------  Read loncapa_apache.conf and loncapa.conf and get variables  # ---------------  Read loncapa_apache.conf and loncapa.conf and get variables
 my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');  my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');
 my %perlvar=%{$perlvarref};  my %perlvar=%{$perlvarref};
 undef $perlvarref; # remove since sensitive and not needed  undef $perlvarref;
 delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed  delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed
   
 # ------------------------------------- Only run if machine is a library server  # ------------------------------------- Only run if machine is a library server
Line 194  exit unless $perlvar{'lonRole'} eq 'libr Line 251  exit unless $perlvar{'lonRole'} eq 'libr
   
 my $wwwid=getpwnam('www');  my $wwwid=getpwnam('www');
 if ($wwwid!=$<) {  if ($wwwid!=$<) {
    $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";      my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
    $subj="LON: $perlvar{'lonHostID'} User ID mismatch";      my $subj="LON: $perlvar{'lonHostID'} User ID mismatch";
    system("echo 'User ID mismatch. searchcat.pl must be run as user www.' |\      system("echo 'User ID mismatch. searchcat.pl must be run as user www.' |\
  mailto $emailto -s '$subj' > /dev/null");   mailto $emailto -s '$subj' > /dev/null");
    exit 1;      exit 1;
 }  }
   
   
Line 206  if ($wwwid!=$<) { Line 263  if ($wwwid!=$<) {
   
 open(LOG,'>'.$perlvar{'lonDaemons'}.'/logs/searchcat.log');  open(LOG,'>'.$perlvar{'lonDaemons'}.'/logs/searchcat.log');
 print LOG '==== Searchcat Run '.localtime()."====\n\n";  print LOG '==== Searchcat Run '.localtime()."====\n\n";
   $simplestatus='time='.time.'&';
 my $dbh;  my $dbh;
 # ------------------------------------- Make sure that database can be accessed  # ------------------------------------- Make sure that database can be accessed
 {  {
Line 213  my $dbh; Line 271  my $dbh;
     $dbh = DBI->connect("DBI:mysql:loncapa","www",$perlvar{'lonSqlAccess'},{ RaiseError =>0,PrintError=>0})      $dbh = DBI->connect("DBI:mysql:loncapa","www",$perlvar{'lonSqlAccess'},{ RaiseError =>0,PrintError=>0})
     ) {       ) { 
  print LOG "Cannot connect to database!\n";   print LOG "Cannot connect to database!\n";
    $simplestatus.='mysql=defunct';
    &writesimple();
  exit;   exit;
     }      }
     my $make_metadata_table = "CREATE TABLE IF NOT EXISTS metadata (".  
   # Make temporary table
       $dbh->do("DROP TABLE IF EXISTS newmetadata");
       my $make_metadata_table = "CREATE TABLE IF NOT EXISTS newmetadata (".
         "title TEXT, author TEXT, subject TEXT, url TEXT, keywords TEXT, ".          "title TEXT, author TEXT, subject TEXT, url TEXT, keywords TEXT, ".
         "version TEXT, notes TEXT, abstract TEXT, mime TEXT, language TEXT, ".          "version TEXT, notes TEXT, abstract TEXT, mime TEXT, language TEXT, ".
         "creationdate DATETIME, lastrevisiondate DATETIME, owner TEXT, ".          "creationdate DATETIME, lastrevisiondate DATETIME, owner TEXT, ".
         "copyright TEXT, FULLTEXT idx_title (title), ".          "copyright TEXT, dependencies TEXT, ".
    "modifyinguser TEXT, authorspace TEXT, ".
    "lowestgradelevel INTEGER UNSIGNED, highestgradelevel INTEGER UNSIGNED, ".
    "standards TEXT, ".
           "count INTEGER UNSIGNED, ".
           "course INTEGER UNSIGNED, course_list TEXT, ".
           "goto INTEGER UNSIGNED, goto_list TEXT, ".
           "comefrom INTEGER UNSIGNED, comefrom_list TEXT, ".
           "sequsage INTEGER UNSIGNED, sequsage_list TEXT, ".
           "stdno INTEGER UNSIGNED, stdno_list TEXT, ".
    "avetries FLOAT, avetries_list TEXT, ".
           "difficulty FLOAT, difficulty_list TEXT, ".
    "clear FLOAT, technical FLOAT, correct FLOAT, helpful FLOAT, depth FLOAT, ".
    "comments TEXT, ".
           "FULLTEXT idx_title (title), ".
         "FULLTEXT idx_author (author), FULLTEXT idx_subject (subject), ".          "FULLTEXT idx_author (author), FULLTEXT idx_subject (subject), ".
         "FULLTEXT idx_url (url), FULLTEXT idx_keywords (keywords), ".          "FULLTEXT idx_url (url), FULLTEXT idx_keywords (keywords), ".
         "FULLTEXT idx_version (version), FULLTEXT idx_notes (notes), ".          "FULLTEXT idx_version (version), FULLTEXT idx_notes (notes), ".
         "FULLTEXT idx_abstract (abstract), FULLTEXT idx_mime (mime), ".          "FULLTEXT idx_abstract (abstract), FULLTEXT idx_mime (mime), ".
         "FULLTEXT idx_language (language), FULLTEXT idx_owner (owner), ".          "FULLTEXT idx_language (language), FULLTEXT idx_owner (owner), ".
         "FULLTEXT idx_copyright (copyright)) TYPE=MYISAM";          "FULLTEXT idx_copyright (copyright)) ".
           "TYPE=MyISAM";
     # It would sure be nice to have some logging mechanism.      # It would sure be nice to have some logging mechanism.
     $dbh->do($make_metadata_table);      unless ($dbh->do($make_metadata_table)) {
    print LOG "\nMySQL Error Create: ".$dbh->errstr."\n";
    die $dbh->errstr;
       }
 }  }
   
 # ------------------------------------------------------------- get .meta files  # ------------------------------------------------------------- get .meta files
 opendir(RESOURCES,"$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}");  opendir(RESOURCES,"$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}");
 my @homeusers=grep  my @homeusers = grep {
           {&ishome("$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}/$_")}      &ishome("$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}/$_")
           grep {!/^\.\.?$/} readdir(RESOURCES);      } grep {!/^\.\.?$/} readdir(RESOURCES);
 closedir RESOURCES;  closedir RESOURCES;
   
   #
   # Create the statement handlers we need
   
   my $insert_sth = $dbh->prepare
       ("INSERT INTO newmetadata VALUES (".
        "?,".   # title
        "?,".   # author
        "?,".   # subject
        "?,".   # declutter url
        "?,".   # version
        "?,".   # current
        "?,".   # notes
        "?,".   # abstract
        "?,".   # mime
        "?,".   # language
        "?,".   # creationdate
        "?,".   # revisiondate
        "?,".   # owner
        "?,".   # copyright
        "?,".   # dependencies
        "?,".   # modifyinguser
        "?,".   # authorspace
        "?,".   # lowestgradelevel
        "?,".   # highestgradelevel
        "?,".   # standards
        "?,".   # count
        "?,".   # course
        "?,".   # course_list
        "?,".   # goto
        "?,".   # goto_list
        "?,".   # comefrom
        "?,".   # comefrom_list
        "?,".   # usage
        "?,".   # usage_list
        "?,".   # stdno
        "?,".   # stdno_list
        "?,".   # avetries
        "?,".   # avetries_list
        "?,".   # difficulty
        "?,".   # difficulty_list
        "?,".   # clear
        "?,".   # technical
        "?,".   # correct
        "?,".   # helpful
        "?,".   # depth
        "?".    # comments
        ")"
        );
   
 foreach my $user (@homeusers) {  foreach my $user (@homeusers) {
     print LOG "\n=== User: ".$user."\n\n";      print LOG "\n=== User: ".$user."\n\n";
 # Remove left-over db-files from potentially crashed searchcat run  
     my $prodir=&propath($perlvar{'lonDefDomain'},$user);      my $prodir=&propath($perlvar{'lonDefDomain'},$user);
     unlink($prodir.'/nohist_new_resevaldata.db');      # Use find.pl
 # Use find.pl  
     undef @metalist;      undef @metalist;
     @metalist=();      @metalist=();
     &find("$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}/$user");      &find("$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}/$user");
       # -- process each file to get metadata and put into search catalog SQL
 # -- process each file to get metadata and put into search catalog SQL database      # database.  Also, check to see if already there.
 # Also, check to see if already there.      # I could just delete (without searching first), but this works for now.
 # I could just delete (without searching first), but this works for now.      foreach my $m (@metalist) {
 foreach my $m (@metalist) {          print LOG "- ".$m."\n";
     print LOG "- ".$m."\n";          my $ref=&metadata($m);
     my $ref=&metadata($m);          my $m2='/res/'.&declutter($m);
     my $m2='/res/'.&declutter($m);          $m2=~s/\.meta$//;
     $m2=~s/\.meta$//;    if ($ref->{'obsolete'}) { print LOG "obsolete\n"; next; }
     &dynamicmeta($m2);   if ($ref->{'copyright'} eq 'private') { print LOG "private\n"; next; }
     my $q2="select * from metadata where url like binary '$m2'";          my %dyn=&dynamicmeta($m2);
     my $sth = $dbh->prepare($q2);   &count($m2);
     $sth->execute();          unless ($insert_sth->execute(
     my $r1=$sth->fetchall_arrayref;       $ref->{'title'},
     if (@$r1) {                               $ref->{'author'},
  $sth=$dbh->prepare("delete from metadata where url like binary '$m2'");                               $ref->{'subject'},
         $sth->execute();                               $m2,
                                $ref->{'keywords'},
                                'current',
                                $ref->{'notes'},
                                $ref->{'abstract'},
                                $ref->{'mime'},
                                $ref->{'language'},
                                sqltime($ref->{'creationdate'}),
                                sqltime($ref->{'lastrevisiondate'}),
                                $ref->{'owner'},
                                $ref->{'copyright'},
        $ref->{'dependencies'},
        $ref->{'modifyinguser'},
        $ref->{'authorspace'},
        $ref->{'lowestgradelevel'},
        $ref->{'highestgradelevel'},
        $ref->{'standards'},
        $dyn{'count'},
        $dyn{'course'},
        $dyn{'course_list'},
        $dyn{'goto'},
        $dyn{'goto_list'},
        $dyn{'comefrom'},
        $dyn{'comefrom_list'},
        $dyn{'usage'},
        $dyn{'usage_list'},
        $dyn{'stdno'},
        $dyn{'stdno_list'},
        $dyn{'avetries'},
        $dyn{'avetries_list'},
        $dyn{'difficulty'},
        $dyn{'difficulty_list'},     
        $dyn{'clear'},
        $dyn{'technical'},
        $dyn{'correct'},
        $dyn{'helpful'},
        $dyn{'depth'},
        $dyn{'comments'}     
        )) {
       print LOG "\nMySQL Error Insert: ".$dbh->errstr."\n";
       die $dbh->errstr;
    }
           $ref = undef;
     }      }
     $sth=$dbh->prepare('insert into metadata values ('.  
   '"'.delete($ref->{'title'}).'"'.','.  
   '"'.delete($ref->{'author'}).'"'.','.  
   '"'.delete($ref->{'subject'}).'"'.','.  
   '"'.$m2.'"'.','.  
   '"'.delete($ref->{'keywords'}).'"'.','.  
   '"'.'current'.'"'.','.  
   '"'.delete($ref->{'notes'}).'"'.','.  
   '"'.delete($ref->{'abstract'}).'"'.','.  
   '"'.delete($ref->{'mime'}).'"'.','.  
   '"'.delete($ref->{'language'}).'"'.','.  
   '"'.sqltime(delete($ref->{'creationdate'})).'"'.','.  
   '"'.sqltime(delete($ref->{'lastrevisiondate'})).'"'.','.  
   '"'.delete($ref->{'owner'}).'"'.','.  
   '"'.delete($ref->{'copyright'}).'"'.')');  
     $sth->execute();  
 }  
   
 # ----------------------------------------------------------- Clean up database  
 # Need to, perhaps, remove stale SQL database records.  
 # ... not yet implemented  
   
   
 # -------------------------------------------------- Copy over the new db-files  
     system('mv '.$prodir.'/nohist_new_resevaldata.db '.  
          $prodir.'/nohist_resevaldata.db');  
 }  }
 # --------------------------------------------------- Close database connection  # --------------------------------------------------- Close database connection
 $dbh->disconnect;  $dbh->do("DROP TABLE IF EXISTS metadata");
   unless ($dbh->do("RENAME TABLE newmetadata TO metadata")) {
       print LOG "\nMySQL Error Rename: ".$dbh->errstr."\n";
       die $dbh->errstr;
   }
   unless ($dbh->disconnect) {
       print LOG "\nMySQL Error Disconnect: ".$dbh->errstr."\n";
       die $dbh->errstr;
   }
 print LOG "\n==== Searchcat completed ".localtime()." ====\n";  print LOG "\n==== Searchcat completed ".localtime()." ====\n";
 close(LOG);  close(LOG);
   &writesimple();
   &writecount();
 exit 0;  exit 0;
   
   
   
 # =============================================================================  # =============================================================================
   
 # ---------------------------------------------------------------- Get metadata  # ---------------------------------------------------------------- Get metadata
 # significantly altered from subroutine present in lonnet  # significantly altered from subroutine present in lonnet
 sub metadata {  sub metadata {
     my ($uri,$what)=@_;      my ($uri,$what)=@_;
     my %metacache;      my %metacache=();
     $uri=&declutter($uri);      $uri=&declutter($uri);
     my $filename=$uri;      my $filename=$uri;
     $uri=~s/\.meta$//;      $uri=~s/\.meta$//;
Line 312  sub metadata { Line 471  sub metadata {
         my $parser=HTML::TokeParser->new(\$metastring);          my $parser=HTML::TokeParser->new(\$metastring);
         my $token;          my $token;
         while ($token=$parser->get_token) {          while ($token=$parser->get_token) {
            if ($token->[0] eq 'S') {              if ($token->[0] eq 'S') {
       my $entry=$token->[1];                  my $entry=$token->[1];
               my $unikey=$entry;                  my $unikey=$entry;
               if (defined($token->[2]->{'part'})) {                   if (defined($token->[2]->{'part'})) { 
                  $unikey.='_'.$token->[2]->{'part'};                       $unikey.='_'.$token->[2]->{'part'}; 
       }                  }
               if (defined($token->[2]->{'name'})) {                   if (defined($token->[2]->{'name'})) { 
                  $unikey.='_'.$token->[2]->{'name'};                       $unikey.='_'.$token->[2]->{'name'}; 
       }                  }
               if ($metacache{$uri.'keys'}) {                  if ($metacache{$uri.'keys'}) {
                  $metacache{$uri.'keys'}.=','.$unikey;                      $metacache{$uri.'keys'}.=','.$unikey;
               } else {                  } else {
                  $metacache{$uri.'keys'}=$unikey;                      $metacache{$uri.'keys'}=$unikey;
       }                  }
               map {                  map {
   $metacache{$uri.''.$unikey.'.'.$_}=$token->[2]->{$_};                      $metacache{$uri.''.$unikey.'.'.$_}=$token->[2]->{$_};
               } @{$token->[3]};                  } @{$token->[3]};
               unless (                  unless (
                  $metacache{$uri.''.$unikey}=$parser->get_text('/'.$entry)                          $metacache{$uri.''.$unikey}=$parser->get_text('/'.$entry)
       ) { $metacache{$uri.''.$unikey}=                          ) { $metacache{$uri.''.$unikey}=
       $metacache{$uri.''.$unikey.'.default'};                                  $metacache{$uri.''.$unikey.'.default'};
       }                          }
           }              }
        }          }
     }      }
     return \%metacache;      return \%metacache;
 }  }
Line 343  sub metadata { Line 502  sub metadata {
 # ------------------------------------------------------------ Serves up a file  # ------------------------------------------------------------ Serves up a file
 # returns either the contents of the file or a -1  # returns either the contents of the file or a -1
 sub getfile {  sub getfile {
   my $file=shift;      my $file=shift;
   if (! -e $file ) { return -1; };      if (! -e $file ) { return -1; };
   my $fh=IO::File->new($file);      my $fh=IO::File->new($file);
   my $a='';      my $a='';
   while (<$fh>) { $a .=$_; }      while (<$fh>) { $a .=$_; }
   return $a      return $a;
 }  }
   
 # ------------------------------------------------------------- Declutters URLs  # ------------------------------------------------------------- Declutters URLs
Line 396  sub sqltime { Line 555  sub sqltime {
   
 sub maketime {  sub maketime {
     my %th=@_;      my %th=@_;
     return POSIX::mktime(      return POSIX::mktime(($th{'seconds'},$th{'minutes'},$th{'hours'},
         ($th{'seconds'},$th{'minutes'},$th{'hours'},                            $th{'day'},$th{'month'}-1,
          $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,$th{'dlsav'}));                            $th{'year'}-1900,0,0,$th{'dlsav'}));
 }  }
   
   
Line 409  sub maketime { Line 568  sub maketime {
 sub unsqltime {  sub unsqltime {
     my $timestamp=shift;      my $timestamp=shift;
     if ($timestamp=~/^(\d+)\-(\d+)\-(\d+)\s+(\d+)\:(\d+)\:(\d+)$/) {      if ($timestamp=~/^(\d+)\-(\d+)\-(\d+)\s+(\d+)\:(\d+)\:(\d+)$/) {
        $timestamp=&maketime(          $timestamp=&maketime('year'=>$1,'month'=>$2,'day'=>$3,
    'year'=>$1,'month'=>$2,'day'=>$3,                               'hours'=>$4,'minutes'=>$5,'seconds'=>$6);
            'hours'=>$4,'minutes'=>$5,'seconds'=>$6);  
     }      }
     return $timestamp;      return $timestamp;
 }  }
   
   # ----------------- Code to enable 'find' subroutine listing of the .meta files
   
   no strict "vars";
   
   sub wanted {
       (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
            -f _ &&
            /^.*\.meta$/ && !/^.+\.\d+\.[^\.]+\.meta$/ &&
            push(@metalist,"$dir/$_");
   }
Removed from v.1.32  
changed lines
  Added in v.1.51

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>