[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.42 and 1.57

version 1.42, 2003/10/08 14:15:03 version 1.57, 2004/04/12 21:11:45
Line 56  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 65  and correct user experience. Line 64  and correct user experience.
   
 =cut  =cut
   
   use strict;
   
   use DBI;
 use lib '/home/httpd/lib/perl/';  use lib '/home/httpd/lib/perl/';
 use LONCAPA::Configuration;  use LONCAPA::Configuration;
   use LONCAPA::lonmetadata;
   
   use Getopt::Long;
 use IO::File;  use IO::File;
 use HTML::TokeParser;  use HTML::TokeParser;
 use DBI;  
 use GDBM_File;  use GDBM_File;
 use POSIX qw(strftime mktime);  use POSIX qw(strftime mktime);
   
 my @metalist;  use File::Find;
   
 $simplestatus='';  #
 my %countext=();  # Set up configuration options
   my ($simulate,$oneuser,$help,$verbose,$logfile,$debug);
   GetOptions (
               'help'     => \$help,
               'simulate' => \$simulate,
               'only=s'   => \$oneuser,
               'verbose=s'  => \$verbose,
               'debug' => \$debug,
               );
   
   if ($help) {
       print <<"ENDHELP";
   $0
   Rebuild and update the LON-CAPA metadata database. 
   Options:
       -help          Print this help
       -simulate      Do not modify the database.
       -only=user     Only compute for the given user.  Implies -simulate   
       -verbose=val   Sets logging level, val must be a number
       -debug         Turns on debugging output
   ENDHELP
       exit 0;
   }
   
   if (! defined($debug)) {
       $debug = 0;
   }
   
   if (! defined($verbose)) {
       $verbose = 0;
   }
   
   if (defined($oneuser)) {
       $simulate=1;
   }
   
   ##
   ## Use variables for table names so we can test this routine a little easier
   my $oldname = 'metadata';
   my $newname = 'newmetadata';
   
 sub writesimple {  #
     open(SMP,'>/home/httpd/html/lon-status/mysql.txt');  # Read loncapa_apache.conf and loncapa.conf
     print SMP $simplestatus."\n";  my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');
     close(SMP);  my %perlvar=%{$perlvarref};
   undef $perlvarref;
   delete $perlvar{'lonReceipt'}; # remove since sensitive (really?) & not needed
   #
   # Only run if machine is a library server
   exit if ($perlvar{'lonRole'} ne 'library');
   #
   #  Make sure this process is running from user=www
   my $wwwid=getpwnam('www');
   if ($wwwid!=$<) {
       my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
       my $subj="LON: $perlvar{'lonHostID'} User ID mismatch";
       system("echo 'User ID mismatch. searchcat.pl must be run as user www.' |\
    mailto $emailto -s '$subj' > /dev/null");
       exit 1;
 }  }
   #
   # Let people know we are running
   open(LOG,'>'.$perlvar{'lonDaemons'}.'/logs/searchcat.log');
   &log(0,'==== Searchcat Run '.localtime()."====");
   
 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 {  if ($debug) {
     my $file=shift;      &log(0,'simulating') if ($simulate);
     $file=~/\.(\w+)$/;      &log(0,'only processing user '.$oneuser) if ($oneuser);
     my $ext=lc($1);      &log(0,'verbosity level = '.$verbose);
     if (defined($countext{$ext})) {  }
  $countext{$ext}++;  #
   # Connect to database
   my $dbh;
   if (! ($dbh = DBI->connect("DBI:mysql:loncapa","www",$perlvar{'lonSqlAccess'},
                             { RaiseError =>0,PrintError=>0}))) {
       &log(0,"Cannot connect to database!");
       die "MySQL Error: Cannot connect to database!\n";
   }
   # This can return an error and still be okay, so we do not bother checking.
   # (perhaps it should be more robust and check for specific errors)
   $dbh->do('DROP TABLE IF EXISTS '.$newname);
   #
   # Create the new table
   my $request = &LONCAPA::lonmetadata::create_metadata_storage($newname);
   $dbh->do($request);
   if ($dbh->err) {
       $dbh->disconnect();
       &log(0,"MySQL Error Create: ".$dbh->errstr);
       die $dbh->errstr;
   }
   #
   # find out which users we need to examine
   my $dom = $perlvar{'lonDefDomain'};
   opendir(RESOURCES,"$perlvar{'lonDocRoot'}/res/$dom");
   my @homeusers = 
       grep {
           &ishome("$perlvar{'lonDocRoot'}/res/$dom/$_");
       } grep { 
           !/^\.\.?$/;
       } readdir(RESOURCES);
   closedir RESOURCES;
   #
   if ($oneuser) {
       @homeusers=($oneuser);
   }
   #
   # Loop through the users
   foreach my $user (@homeusers) {
       &log(0,"=== User: ".$user);
       &process_dynamic_metadata($user,$dom);
       #
       # Use File::Find to get the files we need to read/modify
       find(
            {preprocess => \&only_meta_files,
   #          wanted     => \&print_filename,
   #          wanted     => \&log_metadata,
             wanted     => \&process_meta_file,
             }, 
            "$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}/$user");
   }
   #
   # Rename the table
   if (! $simulate) {
       $dbh->do('DROP TABLE IF EXISTS '.$oldname);
       if (! $dbh->do('RENAME TABLE '.$newname.' TO '.$oldname)) {
           &log(0,"MySQL Error Rename: ".$dbh->errstr);
           die $dbh->errstr;
     } else {      } else {
  $countext{$ext}=1;          &log(1,"MySQL table rename successful.");
     }      }
 }  }
 # ----------------------------------------------------- Un-Escape Special Chars  
   
 sub unescape {  if (! $dbh->disconnect) {
     my $str=shift;      &log(0,"MySQL Error Disconnect: ".$dbh->errstr);
     $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;      die $dbh->errstr;
     return $str;  }
 }  ##
   ## Finished!
   &log(0,"==== Searchcat completed ".localtime()." ====");
   close(LOG);
   
 # -------------------------------------------------------- Escape Special Chars  &write_type_count();
   &write_copyright_count();
   
 sub escape {  exit 0;
     my $str=shift;  
     $str =~ s/(\W)/"%".unpack('H2',$1)/eg;  ##
     return $str;  ## Status logging routine.  Inputs: $level, $message
   ## 
   ## $level 0 should be used for normal output and error messages
   ##
   ## $message does not need to end with \n.  In the case of errors
   ## the message should contain as much information as possible to
   ## help in diagnosing the problem.
   ##
   sub log {
       my ($level,$message)=@_;
       $level = 0 if (! defined($level));
       if ($verbose >= $level) {
           print LOG $message.$/;
       }
 }  }
   
   ########################################################
   ########################################################
   ###                                                  ###
   ###          File::Find support routines             ###
   ###                                                  ###
   ########################################################
   ########################################################
   ##
   ## &only_meta_files
   ##
   ## Called by File::Find.
   ## Takes a list of files/directories in and returns a list of files/directories
   ## to search.
   sub only_meta_files {
       my @PossibleFiles = @_;
       my @ChosenFiles;
       foreach my $file (@PossibleFiles) {
           if ( ($file =~ /\.meta$/ &&            # Ends in meta
                 $file !~ /\.\d+\.[^\.]+\.meta$/  # is not for a prior version
                ) || (-d $file )) { # directories are okay
                    # but we do not want /. or /..
               push(@ChosenFiles,$file);
           }
       }
       return @ChosenFiles;
   }
   
 # ------------------------------------------- Code to evaluate dynamic metadata  ##
   ##
   ## Debugging routines, use these for 'wanted' in the File::Find call
   ##
   sub print_filename {
       my ($file) = $_;
       my $fullfilename = $File::Find::name;
       if ($debug) {
           if (-d $file) {
               &log(5," Got directory ".$fullfilename);
           } else {
               &log(5," Got file ".$fullfilename);
           }
       }
       $_=$file;
   }
   
 sub dynamicmeta {  sub log_metadata {
       my ($file) = $_;
       my $fullfilename = $File::Find::name;
       return if (-d $fullfilename); # No need to do anything here for directories
       if ($debug) {
           &log(6,$fullfilename);
           my $ref=&metadata($fullfilename);
           if (! defined($ref)) {
               &log(6,"    No data");
               return;
           }
           while (my($key,$value) = each(%$ref)) {
               &log(6,"    ".$key." => ".$value);
           }
           &count_copyright($ref->{'copyright'});
       }
       $_=$file;
   }
   
     my $url=&declutter(shift);  ##
   ## process_meta_file
   ##   Called by File::Find. 
   ##   Only input is the filename in $_.  
   sub process_meta_file {
       my ($file) = $_;
       my $filename = $File::Find::name; # full filename
       return if (-d $filename); # No need to do anything here for directories
       #
       &log(3,$filename) if ($debug);
       #
       my $ref=&metadata($filename);
       #
       # $url is the original file url, not the metadata file
       my $url='/res/'.&declutter($filename);
     $url=~s/\.meta$//;      $url=~s/\.meta$//;
     my %returnhash=();      &log(3,"    ".$url) if ($debug);
     my ($adomain,$aauthor)=($url=~/^(\w+)\/(\w+)\//);      #
     my $prodir=&propath($adomain,$aauthor);      # Ignore some files based on their metadata
     if ((tie(%evaldata,'GDBM_File',      if ($ref->{'obsolete'}) { 
             $prodir.'/nohist_resevaldata.db',&GDBM_READER(),0640)) &&          &log(3,"obsolete") if ($debug);
         (tie(%newevaldata,'GDBM_File',          return; 
             $prodir.'/nohist_new_resevaldata.db',&GDBM_WRCREAT(),0640))) {      }
        my %sum=();      &count_copyright($ref->{'copyright'});
        my %cnt=();      if ($ref->{'copyright'} eq 'private') { 
        my %listitems=('count'        => 'add',          &log(3,"private") if ($debug);
                       'course'       => 'add',          return; 
       'goto'         => 'add',      }
       'comefrom'     => 'add',      #
                       'avetries'     => 'avg',      # Find the dynamic metadata
                       'stdno'        => 'add',      my %dyn;
                       'difficulty'   => 'avg',      if ($url=~ m:/default$:) {
                       'clear'        => 'avg',          $url=~ s:/default$:/:;
                       'technical'    => 'avg',          &log(3,"Skipping dynamic data") if ($debug);
                       'helpful'      => 'avg',      } else {
                       'correct'      => 'avg',          &log(3,"Retrieving dynamic data") if ($debug);
                       'depth'        => 'avg',          %dyn=&get_dynamic_metadata($url);
                       'comments'     => 'app',          &count_type($url);
                       'usage'        => 'cnt'      }
                       );      #
        my $regexp=$url;      $ref->{'creationdate'}     = &sqltime($ref->{'creationdate'});
        $regexp=~s/(\W)/\\$1/g;      $ref->{'lastrevisiondate'} = &sqltime($ref->{'lastrevisiondate'});
        $regexp='___'.$regexp.'___([a-z]+)$';      my %Data = (
        while (my ($key,$value)=each %evaldata) {                  %$ref,
  $key=&unescape($key);                  %dyn,
  if ($key=~/$regexp/) {                  'url'=>$url,
     my $ctype=$1;                  'version'=>'current');
             if (defined($cnt{$ctype})) {       if (! $simulate) {
                $cnt{$ctype}++;           my ($count,$err) = &LONCAPA::lonmetadata::store_metadata($dbh,$newname,
             } else {                                                                    \%Data);
                $cnt{$ctype}=1;           if ($err) {
               &log(0,"MySQL Error Insert: ".$err);
           }
           if ($count < 1) {
               &log(0,"Unable to insert record into MySQL database for $url");
           }
       }
       #
       # Reset $_ before leaving
       $_ = $file;
   }
   
   ########################################################
   ########################################################
   ###                                                  ###
   ###  &metadata($uri)                                 ###
   ###   Retrieve metadata for the given file           ###
   ###                                                  ###
   ########################################################
   ########################################################
   sub metadata {
       my ($uri)=@_;
       my %metacache=();
       $uri=&declutter($uri);
       my $filename=$uri;
       $uri=~s/\.meta$//;
       $uri='';
       if ($filename !~ /\.meta$/) { 
           $filename.='.meta';
       }
       my $metastring=&getfile($perlvar{'lonDocRoot'}.'/res/'.$filename);
       return undef if (! defined($metastring));
       my $parser=HTML::TokeParser->new(\$metastring);
       my $token;
       while ($token=$parser->get_token) {
           if ($token->[0] eq 'S') {
               my $entry=$token->[1];
               my $unikey=$entry;
               if (defined($token->[2]->{'part'})) { 
                   $unikey.='_'.$token->[2]->{'part'}; 
             }              }
             unless ($listitems{$ctype} eq 'app') {              if (defined($token->[2]->{'name'})) { 
                if (defined($sum{$ctype})) {                  $unikey.='_'.$token->[2]->{'name'}; 
                   $sum{$ctype}+=$value;              }
           } else {              if ($metacache{$uri.'keys'}) {
                   $sum{$ctype}=$value;                  $metacache{$uri.'keys'}.=','.$unikey;
        }  
             } else {              } else {
                if (defined($sum{$ctype})) {                  $metacache{$uri.'keys'}=$unikey;
                   if ($value) {              }
                      $sum{$ctype}.='<hr>'.$value;              foreach ( @{$token->[3]}) {
           }                  $metacache{$uri.''.$unikey.'.'.$_}=$token->[2]->{$_};
         } else {              } 
              $sum{$ctype}=''.$value;              if (! ($metacache{$uri.''.$unikey}=$parser->get_text('/'.$entry))){
        }                  $metacache{$uri.''.$unikey} = 
     }                      $metacache{$uri.''.$unikey.'.default'};
     if ($ctype ne 'count') {              }
        $newevaldata{$_}=$value;          } # End of ($token->[0] eq 'S')
    }      }
  }      return \%metacache;
       }  
       foreach (keys %cnt) {  
          if ($listitems{$_} eq 'avg') {  
      $returnhash{$_}=int(($sum{$_}/$cnt{$_})*100.0+0.5)/100.0;  
          } elsif ($listitems{$_} eq 'cnt') {  
              $returnhash{$_}=$cnt{$_};  
          } else {  
              $returnhash{$_}=$sum{$_};  
          }  
      }  
      if ($returnhash{'count'}) {  
          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  ##
 my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');  ## &getfile($filename)
 my %perlvar=%{$perlvarref};  ##   Slurps up an entire file into a scalar.  
 undef $perlvarref; # remove since sensitive and not needed  ##   Returns undef if the file does not exist
 delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed  sub getfile {
       my $file = shift();
       if (! -e $file ) { 
           return undef; 
       }
       my $fh=IO::File->new($file);
       my $contents = '';
       while (<$fh>) { 
           $contents .= $_;
       }
       return $contents;
   }
   
 # ------------------------------------- Only run if machine is a library server  ########################################################
 exit unless $perlvar{'lonRole'} eq 'library';  ########################################################
   ###                                                  ###
   ###    Dynamic Metadata                              ###
   ###                                                  ###
   ########################################################
   ########################################################
   ##
   ## Dynamic metadata description
   ##
   ##   Field             Type
   ##-----------------------------------------------------------
   ##   count             integer
   ##   course            integer
   ##   course_list       comma seperated list of course ids
   ##   avetries          real                                
   ##   avetries_list     comma seperated list of real numbers
   ##   stdno             real
   ##   stdno_list        comma seperated list of real numbers
   ##   usage             integer   
   ##   usage_list        comma seperated list of resources
   ##   goto              scalar
   ##   goto_list         comma seperated list of resources
   ##   comefrom          scalar
   ##   comefrom_list     comma seperated list of resources
   ##   difficulty        real
   ##   difficulty_list   comma seperated list of real numbers
   ##   sequsage          scalar
   ##   sequsage_list     comma seperated list of resources
   ##   clear             real
   ##   technical         real
   ##   correct           real
   ##   helpful           real
   ##   depth             real
   ##   comments          html of all the comments made
   ##
   {
   
 # ----------------------------- Make sure this process is running from user=www  my %DynamicData;
   my %Counts;
   
 my $wwwid=getpwnam('www');  sub process_dynamic_metadata {
 if ($wwwid!=$<) {      my ($user,$dom) = @_;
     $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";      undef(%DynamicData);
     $subj="LON: $perlvar{'lonHostID'} User ID mismatch";      undef(%Counts);
     system("echo 'User ID mismatch. searchcat.pl must be run as user www.' |\      #
  mailto $emailto -s '$subj' > /dev/null");      my $prodir = &propath($dom,$user);
     exit 1;      #
       # Read in the dynamic metadata
       my %evaldata;
       if (! tie(%evaldata,'GDBM_File',
                 $prodir.'/nohist_resevaldata.db',&GDBM_READER(),0640)) {
           return 0;
       }
       #
       %DynamicData = &LONCAPA::lonmetadata::process_reseval_data(\%evaldata);
       untie(%evaldata);
       #
       # Read in the access count data
       &log(7,'Reading access count data') if ($debug);
       my %countdata;
       if (! tie(%countdata,'GDBM_File',
                 $prodir.'/nohist_accesscount.db',&GDBM_READER(),0640)) {
           return 0;
       }
       while (my ($key,$count) = each(%countdata)) {
           next if ($key !~ /^$dom/);
           $key = &unescape($key);
           &log(8,'    Count '.$key.' = '.$count) if ($debug);
           $Counts{$key}=$count;
       }
       untie(%countdata);
       if ($debug) {
           &log(7,scalar(keys(%Counts)).
                " Counts read for ".$user."@".$dom);
           &log(7,scalar(keys(%DynamicData)).
                " Dynamic metadata read for ".$user."@".$dom);
       }
       #
       return 1;
 }  }
   
   sub get_dynamic_metadata {
       my ($url) = @_;
       $url =~ s:^/res/::;
       if (! exists($DynamicData{$url})) {
           &log(7,'    No dynamic data for '.$url) if ($debug);
           return ();
       }
       my %data = &LONCAPA::lonmetadata::process_dynamic_metadata($url,
                                                                  \%DynamicData);
       # find the count
       $data{'count'} = $Counts{$url};
       #
       # Log the dynamic metadata
       if ($debug) {
           while (my($k,$v)=each(%data)) {
               &log(8,"    ".$k." => ".$v);
           }
       }
       return %data;
   }
   
 # ---------------------------------------------------------- We are in business  } # End of %DynamicData and %Counts scope
   
 open(LOG,'>'.$perlvar{'lonDaemons'}.'/logs/searchcat.log');  ########################################################
 print LOG '==== Searchcat Run '.localtime()."====\n\n";  ########################################################
 $simplestatus='time='.time.'&';  ###                                                  ###
 my $dbh;  ###   Counts                                         ###
 # ------------------------------------- Make sure that database can be accessed  ###                                                  ###
   ########################################################
   ########################################################
 {  {
     unless (  
     $dbh = DBI->connect("DBI:mysql:loncapa","www",$perlvar{'lonSqlAccess'},{ RaiseError =>0,PrintError=>0})  
     ) {   
  print LOG "Cannot connect to database!\n";  
  $simplestatus.='mysql=defunct';  
  &writesimple();  
  exit;  
     }  
   
     my $make_metadata_table = "CREATE TABLE IF NOT EXISTS metadata (".  
         "title TEXT, author TEXT, subject TEXT, url TEXT, keywords TEXT, ".  
         "version TEXT, notes TEXT, abstract TEXT, mime TEXT, language TEXT, ".  
         "creationdate DATETIME, lastrevisiondate DATETIME, owner TEXT, ".  
         "copyright TEXT, FULLTEXT idx_title (title), ".  
         "FULLTEXT idx_author (author), FULLTEXT idx_subject (subject), ".  
         "FULLTEXT idx_url (url), FULLTEXT idx_keywords (keywords), ".  
         "FULLTEXT idx_version (version), FULLTEXT idx_notes (notes), ".  
         "FULLTEXT idx_abstract (abstract), FULLTEXT idx_mime (mime), ".  
         "FULLTEXT idx_language (language), FULLTEXT idx_owner (owner), ".  
         "FULLTEXT idx_copyright (copyright)) TYPE=MYISAM";  
     # It would sure be nice to have some logging mechanism.  
     $dbh->do($make_metadata_table);  
 }  
   
 # ------------------------------------------------------------- get .meta files  
 opendir(RESOURCES,"$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}");  
 my @homeusers = grep {  
     &ishome("$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}/$_")  
     } grep {!/^\.\.?$/} readdir(RESOURCES);  
 closedir RESOURCES;  
   
 #  my %countext;
 # 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) {  sub count_type {
     print LOG "\n=== User: ".$user."\n\n";      my $file=shift;
     # Remove left-over db-files from potentially crashed searchcat run      $file=~/\.(\w+)$/;
     my $prodir=&propath($perlvar{'lonDefDomain'},$user);      my $ext=lc($1);
     unlink($prodir.'/nohist_new_resevaldata.db');      $countext{$ext}++;
     # Use find.pl  }
     undef @metalist;  
     @metalist=();  
     &find("$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}/$user");  
     # -- process each file to get metadata and put into search catalog SQL  
     # database.  Also, check to see if already there.  
     # I could just delete (without searching first), but this works for now.  
     foreach my $m (@metalist) {  
         print LOG "- ".$m."\n";  
         my $ref=&metadata($m);  
         my $m2='/res/'.&declutter($m);  
         $m2=~s/\.meta$//;  
         &dynamicmeta($m2);  
   if ($ref->{'obsolete'}) { print LOG "obsolete\n"; next; }  
  if ($ref->{'copyright'} eq 'private') { print LOG "private\n"; next; }  
  &count($m2);  
         $delete_sth->execute($m2);  
         $insert_sth->execute($ref->{'title'},  
                              $ref->{'author'},  
                              $ref->{'subject'},  
                              $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;  
     }  
       
     # --------------------------------------------------- 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  
 $dbh->disconnect;  
 print LOG "\n==== Searchcat completed ".localtime()." ====\n";  
 close(LOG);  
 &writesimple();  
 &writecount();  
 exit 0;  
   
   sub write_type_count {
       open(RESCOUNT,'>/home/httpd/html/lon-status/rescount.txt');
       while (my ($extension,$count) = each(%countext)) {
    print RESCOUNT $extension.'='.$count.'&';
       }
       print RESCOUNT 'time='.time."\n";
       close(RESCOUNT);
   }
   
   } # end of scope for %countext
   
 # =============================================================================  {
   
 # ---------------------------------------------------------------- Get metadata  my %copyrights;
 # significantly altered from subroutine present in lonnet  
 sub metadata {  
     my ($uri,$what)=@_;  
     my %metacache;  
     $uri=&declutter($uri);  
     my $filename=$uri;  
     $uri=~s/\.meta$//;  
     $uri='';  
     unless ($metacache{$uri.'keys'}) {  
         unless ($filename=~/\.meta$/) { $filename.='.meta'; }  
  my $metastring=&getfile($perlvar{'lonDocRoot'}.'/res/'.$filename);  
         my $parser=HTML::TokeParser->new(\$metastring);  
         my $token;  
         while ($token=$parser->get_token) {  
             if ($token->[0] eq 'S') {  
                 my $entry=$token->[1];  
                 my $unikey=$entry;  
                 if (defined($token->[2]->{'part'})) {   
                     $unikey.='_'.$token->[2]->{'part'};   
                 }  
                 if (defined($token->[2]->{'name'})) {   
                     $unikey.='_'.$token->[2]->{'name'};   
                 }  
                 if ($metacache{$uri.'keys'}) {  
                     $metacache{$uri.'keys'}.=','.$unikey;  
                 } else {  
                     $metacache{$uri.'keys'}=$unikey;  
                 }  
                 map {  
                     $metacache{$uri.''.$unikey.'.'.$_}=$token->[2]->{$_};  
                 } @{$token->[3]};  
                 unless (  
                         $metacache{$uri.''.$unikey}=$parser->get_text('/'.$entry)  
                         ) { $metacache{$uri.''.$unikey}=  
                                 $metacache{$uri.''.$unikey.'.default'};  
                         }  
             }  
         }  
     }  
     return \%metacache;  
 }  
   
 # ------------------------------------------------------------ Serves up a file  sub count_copyright {
 # returns either the contents of the file or a -1      $copyrights{@_[0]}++;
 sub getfile {  
     my $file=shift;  
     if (! -e $file ) { return -1; };  
     my $fh=IO::File->new($file);  
     my $a='';  
     while (<$fh>) { $a .=$_; }  
     return $a;  
 }  }
   
 # ------------------------------------------------------------- Declutters URLs  sub write_copyright_count {
 sub declutter {      open(COPYCOUNT,'>/home/httpd/html/lon-status/copyrightcount.txt');
     my $thisfn=shift;      while (my ($copyright,$count) = each(%copyrights)) {
     $thisfn=~s/^$perlvar{'lonDocRoot'}//;   print COPYCOUNT $copyright.'='.$count.'&';
     $thisfn=~s/^\///;      }
     $thisfn=~s/^res\///;      print COPYCOUNT 'time='.time."\n";
     return $thisfn;      close(COPYCOUNT);
 }  }
   
 # --------------------------------------- Is this the home server of an author?  } # end of scope for %copyrights
 # (copied from lond, modification of the return value)  
   ########################################################
   ########################################################
   ###                                                  ###
   ###   Miscellanous Utility Routines                  ###
   ###                                                  ###
   ########################################################
   ########################################################
   ##
   ## &ishome($username)
   ##   Returns 1 if $username is a LON-CAPA author, 0 otherwise
   ##   (copied from lond, modification of the return value)
 sub ishome {  sub ishome {
     my $author=shift;      my $author=shift;
     $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;      $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
Line 436  sub ishome { Line 611  sub ishome {
     }      }
 }  }
   
 # -------------------------------------------- Return path to profile directory  ##
 # (copied from lond)  ## &propath($udom,$uname)
   ##   Returns the path to the users LON-CAPA directory
   ##   (copied from lond)
 sub propath {  sub propath {
     my ($udom,$uname)=@_;      my ($udom,$uname)=@_;
     $udom=~s/\W//g;      $udom=~s/\W//g;
Line 448  sub propath { Line 625  sub propath {
     return $proname;      return $proname;
 }   } 
   
 # ---------------------------- convert 'time' format into a datetime sql format  ##
   ## &sqltime($timestamp)
   ##
   ## Convert perl $timestamp to MySQL time.  MySQL expects YYYY-MM-DD HH:MM:SS
   ##
 sub sqltime {  sub sqltime {
     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =      my ($time) = @_;
  localtime(&unsqltime(@_[0]));      my $mysqltime;
     $mon++; $year+=1900;      if ($time =~ 
     return "$year-$mon-$mday $hour:$min:$sec";          /(\d+)-(\d+)-(\d+) # YYYY-MM-DD
           \s                 # a space
           (\d+):(\d+):(\d+)  # HH:MM::SS
           /x ) { 
           # Some of the .meta files have the time in mysql
           # format already, so just make sure they are 0 padded and
           # pass them back.
           $mysqltime = sprintf('%04d-%02d-%02d %02d:%02d:%02d',
                                $1,$2,$3,$4,$5,$6);
       } elsif ($time =~ /^\d+$/) {
           my @TimeData = gmtime($time);
           # Alter the month to be 1-12 instead of 0-11
           $TimeData[4]++;
           # Alter the year to be from 0 instead of from 1900
           $TimeData[5]+=1900;
           $mysqltime = sprintf('%04d-%02d-%02d %02d:%02d:%02d',
                                @TimeData[5,4,3,2,1,0]);
       } elsif (! defined($time) || $time == 0) {
           $mysqltime = 0;
       } else {
           &log(0,"    sqltime:Unable to decode time ".$time);
           $mysqltime = 0;
       }
       return $mysqltime;
 }  }
   
 sub maketime {  ##
     my %th=@_;  ## &declutter($filename)
     return POSIX::mktime(($th{'seconds'},$th{'minutes'},$th{'hours'},  ##   Given a filename, returns a url for the filename.
                           $th{'day'},$th{'month'}-1,  sub declutter {
                           $th{'year'}-1900,0,0,$th{'dlsav'}));      my $thisfn=shift;
       $thisfn=~s/^$perlvar{'lonDocRoot'}//;
       $thisfn=~s/^\///;
       $thisfn=~s/^res\///;
       return $thisfn;
 }  }
   
   ##
 #########################################  ## Escape / Unescape special characters
 #  sub unescape {
 # Retro-fixing of un-backward-compatible time format      my $str=shift;
       $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
 sub unsqltime {      return $str;
     my $timestamp=shift;  
     if ($timestamp=~/^(\d+)\-(\d+)\-(\d+)\s+(\d+)\:(\d+)\:(\d+)$/) {  
         $timestamp=&maketime('year'=>$1,'month'=>$2,'day'=>$3,  
                              'hours'=>$4,'minutes'=>$5,'seconds'=>$6);  
     }  
     return $timestamp;  
 }  }
   
   sub escape {
       my $str=shift;
       $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
       return $str;
   }
Removed from v.1.42  
changed lines
  Added in v.1.57

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