[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.31 and 1.42

version 1.31, 2003/02/03 18:03:53 version 1.42, 2003/10/08 14:15:03
Line 28 Line 28
 #  #
 ###  ###
   
 # This script goes through a LON-CAPA resource  =pod
 # directory and gathers metadata.  
 # The metadata is entered into a SQL database.  =head1 NAME
   
   B<searchcat.pl> - put authoritative filesystem data into sql database.
   
   =head1 SYNOPSIS
   
   Ordinarily this script is to be called from a loncapa cron job
   (CVS source location: F<loncapa/loncom/cron/loncapa>; typical
   filesystem installation location: F</etc/cron.d/loncapa>).
   
   Here is the cron job entry.
   
   C<# Repopulate and refresh the metadata database used for the search catalog.>
   C<10 1 * * 7    www    /home/httpd/perl/searchcat.pl>
   
   This script only allows itself to be run as the user C<www>.
   
   =head1 DESCRIPTION
   
   This script goes through a loncapa resource directory and gathers metadata.
   The metadata is entered into a SQL database.
   
   This script also does general database maintenance such as reformatting
   the C<loncapa:metadata> table if it is deprecated.
   
   This script evaluates dynamic metadata from the authors'
   F<nohist_resevaldata.db> database file in order to store it in MySQL, as
   well as to compress the filesize (add up all "count"-type metadata).
   
   This script is playing an increasingly important role for a loncapa
   library server.  The proper operation of this script is critical for a smooth
   and correct user experience.
   
   =cut
   
 use lib '/home/httpd/lib/perl/';  use lib '/home/httpd/lib/perl/';
 use LONCAPA::Configuration;  use LONCAPA::Configuration;
Line 43  use POSIX qw(strftime mktime); Line 76  use POSIX qw(strftime mktime);
   
 my @metalist;  my @metalist;
   
   $simplestatus='';
   my %countext=();
   
   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);
   }
   
   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 78  sub dynamicmeta { Line 138  sub dynamicmeta {
        my %cnt=();         my %cnt=();
        my %listitems=('count'        => 'add',         my %listitems=('count'        => 'add',
                       'course'       => 'add',                        'course'       => 'add',
         'goto'         => 'add',
         'comefrom'     => 'add',
                       'avetries'     => 'avg',                        'avetries'     => 'avg',
                       'stdno'        => 'add',                        'stdno'        => 'add',
                       'difficulty'   => 'avg',                        'difficulty'   => 'avg',
Line 92  sub dynamicmeta { Line 154  sub dynamicmeta {
        my $regexp=$url;         my $regexp=$url;
        $regexp=~s/(\W)/\\$1/g;         $regexp=~s/(\W)/\\$1/g;
        $regexp='___'.$regexp.'___([a-z]+)$';         $regexp='___'.$regexp.'___([a-z]+)$';
        foreach (keys %evaldata) {         while (my ($key,$value)=each %evaldata) {
  my $key=&unescape($_);   $key=&unescape($key);
  if ($key=~/$regexp/) {   if ($key=~/$regexp/) {
     my $ctype=$1;      my $ctype=$1;
             if (defined($cnt{$ctype})) {               if (defined($cnt{$ctype})) { 
Line 103  sub dynamicmeta { Line 165  sub dynamicmeta {
             }              }
             unless ($listitems{$ctype} eq 'app') {              unless ($listitems{$ctype} eq 'app') {
                if (defined($sum{$ctype})) {                 if (defined($sum{$ctype})) {
                   $sum{$ctype}+=$evaldata{$_};                    $sum{$ctype}+=$value;
           } else {            } else {
                   $sum{$ctype}=$evaldata{$_};                    $sum{$ctype}=$value;
        }         }
             } else {              } else {
                if (defined($sum{$ctype})) {                 if (defined($sum{$ctype})) {
                   if ($evaldata{$_}) {                    if ($value) {
                      $sum{$ctype}.='<hr>'.$evaldata{$_};                       $sum{$ctype}.='<hr>'.$value;
           }            }
         } else {          } else {
              $sum{$ctype}=''.$evaldata{$_};               $sum{$ctype}=''.$value;
        }         }
     }      }
     if ($ctype ne 'count') {      if ($ctype ne 'count') {
        $newevaldata{$_}=$evaldata{$_};         $newevaldata{$_}=$value;
    }     }
  }   }
       }        }
Line 144  sub dynamicmeta { Line 206  sub dynamicmeta {
 require "find.pl";  require "find.pl";
 sub wanted {  sub wanted {
     (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&      (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
     -f _ &&          -f _ &&
     /^.*\.meta$/ && !/^.+\.\d+\.[^\.]+\.meta$/ &&          /^.*\.meta$/ && !/^.+\.\d+\.[^\.]+\.meta$/ &&
     push(@metalist,"$dir/$_");          push(@metalist,"$dir/$_");
 }  }
   
 # ---------------  Read loncapa_apache.conf and loncapa.conf and get variables  # ---------------  Read loncapa_apache.conf and loncapa.conf and get variables
Line 162  exit unless $perlvar{'lonRole'} eq 'libr Line 224  exit unless $perlvar{'lonRole'} eq 'libr
   
 my $wwwid=getpwnam('www');  my $wwwid=getpwnam('www');
 if ($wwwid!=$<) {  if ($wwwid!=$<) {
    $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";      $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
    $subj="LON: $perlvar{'lonHostID'} User ID mismatch";      $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 174  if ($wwwid!=$<) { Line 236  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 181  my $dbh; Line 244  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 (".      my $make_metadata_table = "CREATE TABLE IF NOT EXISTS metadata (".
         "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, ".
Line 200  my $dbh; Line 266  my $dbh;
   
 # ------------------------------------------------------------- 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 $delete_sth = $dbh->prepare
       ("DELETE FROM metadata WHERE url LIKE BINARY ?");
   
   my $insert_sth = $dbh->prepare
       ("INSERT INTO metadata VALUES (".
        "?,".   # title
        "?,".   # author
        "?,".   # subject
        "?,".   # m2???
        "?,".   # version
        "?,".   # current
        "?,".   # notes
        "?,".   # abstract
        "?,".   # mime
        "?,".   # language
        "?,".   # creationdate
        "?,".   # revisiondate
        "?,".   # owner
        "?)"    # copyright
        );
   
 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      # 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');      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$//;          &dynamicmeta($m2);
     &dynamicmeta($m2);    if ($ref->{'obsolete'}) { print LOG "obsolete\n"; next; }
     my $q2="select * from metadata where url like binary '$m2'";   if ($ref->{'copyright'} eq 'private') { print LOG "private\n"; next; }
     my $sth = $dbh->prepare($q2);   &count($m2);
     $sth->execute();          $delete_sth->execute($m2);
     my $r1=$sth->fetchall_arrayref;          $insert_sth->execute($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'});
   #        if ($dbh->err()) {
   #            print STDERR "Error:".$dbh->errstr()."\n";
   #        }
           $ref = undef;
     }      }
     $sth=$dbh->prepare('insert into metadata values ('.      
   '"'.delete($ref->{'title'}).'"'.','.      # --------------------------------------------------- Clean up database
   '"'.delete($ref->{'author'}).'"'.','.      # Need to, perhaps, remove stale SQL database records.
   '"'.delete($ref->{'subject'}).'"'.','.      # ... not yet implemented
   '"'.$m2.'"'.','.          
   '"'.delete($ref->{'keywords'}).'"'.','.      # ------------------------------------------- Copy over the new db-files
   '"'.'current'.'"'.','.      #
   '"'.delete($ref->{'notes'}).'"'.','.  
   '"'.delete($ref->{'abstract'}).'"'.','.      system('mv '.$prodir.'/nohist_new_resevaldata.db '.
   '"'.delete($ref->{'mime'}).'"'.','.     $prodir.'/nohist_resevaldata.db');
   '"'.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->disconnect;
 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
Line 280  sub metadata { Line 374  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 311  sub metadata { Line 405  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 364  sub sqltime { Line 458  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 377  sub maketime { Line 471  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;
 }  }
Removed from v.1.31  
changed lines
  Added in v.1.42

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