[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.49 and 1.55

version 1.49, 2003/12/25 15:20:00 version 1.55, 2004/04/08 15:57:32
Line 66  and correct user experience. Line 66  and correct user experience.
   
 use strict;  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 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);
   use File::Find;
   
 require "find.pl";  ##
   ## Use variables for table names so we can test this routine a little easier
   my $oldname = 'metadata';
   my $newname = 'newmetadata';
   
 my @metalist;  #
   # Read loncapa_apache.conf and loncapa.conf
   my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');
   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');
   print LOG '==== Searchcat Run '.localtime()."====\n";
   #
   # Connect to database
   my $dbh;
   if (! ($dbh = DBI->connect("DBI:mysql:loncapa","www",$perlvar{'lonSqlAccess'},
                             { RaiseError =>0,PrintError=>0}))) {
       print LOG "Cannot connect to database!\n";
       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();
       print LOG "\nMySQL Error Create: ".$dbh->errstr."\n";
       die $dbh->errstr;
   }
   #
   # find out which users we need to examine
   opendir(RESOURCES,"$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}");
   my @homeusers = 
       grep {
           &ishome("$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}/$_");
       } grep { 
           !/^\.\.?$/;
       } readdir(RESOURCES);
   closedir RESOURCES;
   #
   # Loop through the users
   foreach my $user (@homeusers) {
       print LOG "=== User: ".$user."\n";
       my $prodir=&propath($perlvar{'lonDefDomain'},$user);
       #
       # 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
   $dbh->do('DROP TABLE IF EXISTS '.$oldname);
   if (! $dbh->do('RENAME TABLE '.$newname.' TO '.$oldname)) {
       print LOG "MySQL Error Rename: ".$dbh->errstr."\n";
       die $dbh->errstr;
   }
   if (! $dbh->disconnect) {
       print LOG "MySQL Error Disconnect: ".$dbh->errstr."\n";
       die $dbh->errstr;
   }
   ##
   ## Finished!
   print LOG "==== Searchcat completed ".localtime()." ====\n";
   close(LOG);
   
 my $simplestatus='';  &write_type_count();
 my %countext=();  &write_copyright_count();
   
 # ----------------------------------------------------- write out simple status  exit 0;
 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{$_}.'&';  ###          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);
           }
     }      }
     print RSMP 'time='.time."\n";      return @ChosenFiles;
     close(RSMP);  
 }  }
   
 # -------------------------------------- counts files with different extensions  ##
 sub count {  ##
     my $file=shift;  ## Debugging routines, use these for 'wanted' in the File::Find call
     $file=~/\.(\w+)$/;  ##
     my $ext=lc($1);  sub print_filename {
     if (defined($countext{$ext})) {      my ($file) = $_;
  $countext{$ext}++;      my $fullfilename = $File::Find::name;
       if (-d $file) {
           print LOG " Got directory ".$fullfilename."\n";
     } else {      } else {
  $countext{$ext}=1;          print LOG " Got file ".$fullfilename."\n";
     }      }
       $_=$file;
 }  }
 # ----------------------------------------------------- Un-Escape Special Chars  
   
 sub unescape {  sub log_metadata {
     my $str=shift;      my ($file) = $_;
     $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;      my $fullfilename = $File::Find::name;
     return $str;      return if (-d $fullfilename); # No need to do anything here for directories
       print LOG $fullfilename."\n";
       my $ref=&metadata($fullfilename);
       if (! defined($ref)) {
           print LOG "    No data\n";
           return;
       }
       while (my($key,$value) = each(%$ref)) {
           print LOG "    ".$key." => ".$value."\n";
       }
       &count_copyright($ref->{'copyright'});
       $_=$file;
 }  }
   
 # -------------------------------------------------------- Escape Special Chars  
   
 sub escape {  ##
     my $str=shift;  ## process_meta_file
     $str =~ s/(\W)/"%".unpack('H2',$1)/eg;  ##   Called by File::Find. 
     return $str;  ##   Only input is the filename in $_.  
   sub process_meta_file {
       my ($file) = $_;
       my $filename = $File::Find::name;
       return if (-d $filename); # No need to do anything here for directories
       #
       print LOG $filename."\n";
       #
       my $ref=&metadata($filename);
       #
       # $url is the original file url, not the metadata file
       my $url='/res/'.&declutter($filename);
       $url=~s/\.meta$//;
       print LOG "    ".$url."\n";
       #
       # Ignore some files based on their metadata
       if ($ref->{'obsolete'}) { 
           print LOG "obsolete\n"; 
           return; 
       }
       &count_copyright($ref->{'copyright'});
       if ($ref->{'copyright'} eq 'private') { 
           print LOG "private\n"; 
           return; 
       }
       #
       # Find the dynamic metadata
       my %dyn;
       if ($url=~ m:/default$:) {
           $url=~ s:/default$:/:;
       } else {
           # %dyn=&dynamicmeta($url);
           &count_type($url);
       }
       #
       $ref->{'creationdate'}     = &sqltime($ref->{'creationdate'});
       $ref->{'lastrevisiondate'} = &sqltime($ref->{'lastrevisiondate'});
       my %Data = (
                   %$ref,
                   %dyn,
                   'url'=>$url,
                   'version'=>'current');
       my ($count,$err) = &LONCAPA::lonmetadata::store_metadata($dbh,$newname,
                                                                \%Data);
       if ($err) {
           print LOG "\nMySQL Error Insert: ".$err."\n";
           die $err;
       }
       if ($count < 1) {
           print LOG "Unable to insert record into MySQL database for $url\n";
           die "Unable to insert record into MySQl database for $url";
       } else {
           print LOG "Count = ".$count."\n";
       }
       #
       # 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'}; 
               }
               if (defined($token->[2]->{'name'})) { 
                   $unikey.='_'.$token->[2]->{'name'}; 
               }
               if ($metacache{$uri.'keys'}) {
                   $metacache{$uri.'keys'}.=','.$unikey;
               } else {
                   $metacache{$uri.'keys'}=$unikey;
               }
               foreach ( @{$token->[3]}) {
                   $metacache{$uri.''.$unikey.'.'.$_}=$token->[2]->{$_};
               } 
               if (! ($metacache{$uri.''.$unikey}=$parser->get_text('/'.$entry))){
                   $metacache{$uri.''.$unikey} = 
                       $metacache{$uri.''.$unikey.'.default'};
               }
           } # End of ($token->[0] eq 'S')
       }
       return \%metacache;
 }  }
   
 # ------------------------------------------- Code to evaluate dynamic metadata  ##
   ## &getfile($filename)
   ##   Slurps up an entire file into a scalar.  
   ##   Returns undef if the file does not exist
   sub getfile {
       my $file = shift();
       if (! -e $file ) { 
           return undef; 
       }
       my $fh=IO::File->new($file);
       my $contents = '';
       while (<$fh>) { 
           $contents .= $_;
       }
       return $contents;
   }
   
   ########################################################
   ########################################################
   ###                                                  ###
   ###    Dynamic Metadata                              ###
   ###                                                  ###
   ########################################################
   ########################################################
 sub dynamicmeta {  sub dynamicmeta {
     my $url=&declutter(shift);      my $url = &declutter(shift());
     $url=~s/\.meta$//;      $url =~ s/\.meta$//;
     my %returnhash=(      my %data = ('count'         => 0,
     'count' => 0,                  'course'        => 0,
     'course' => 0,                  'course_list'   => '',
     'course_list' => '',                  'avetries'      => 'NULL',
     'avetries' => 'NULL',                  'avetries_list' => '',
     'avetries_list' => '',                  'stdno'         => 0,
     'stdno' => 0,                  'stdno_list'    => '',
     'stdno_list' => '',                  'usage'         => 0,
     'usage' => 0,                  'usage_list'    => '',
     'usage_list' => '',                  'goto'          => 0,
     'goto' => 0,                  'goto_list'     => '',
     'goto_list' => '',                  'comefrom'      => 0,
     'comefrom' => 0,                  'comefrom_list' => '',
     'comefrom_list' => '',                  'difficulty'    => 'NULL',
     'difficulty' => 'NULL',                  'difficulty_list' => '',
     'difficulty_list' => '',                  'sequsage'      => '0',
                     'clear' => 'NULL',                  'sequsage_list' => '',
                     'technical' => 'NULL',                  'clear'         => 'NULL',
     'correct' => 'NULL',                  'technical'     => 'NULL',
     'helpful' => 'NULL',                  'correct'       => 'NULL',
     'depth' => 'NULL',                  'helpful'       => 'NULL',
     'comments' => ''                  'depth'         => 'NULL',
     );                  'comments'      => '',                
     my ($adomain,$aauthor)=($url=~/^(\w+)\/(\w+)\//);                  );
     my $prodir=&propath($adomain,$aauthor);      my ($dom,$auth)=($url=~/^(\w+)\/(\w+)\//);
       my $prodir=&propath($dom,$auth);
 # Get metadata except counts      #
     if (tie(my %evaldata,'GDBM_File',      # Get metadata except counts
             $prodir.'/nohist_resevaldata.db',&GDBM_READER(),0640)) {      my %evaldata;
  my %sum=();      if (! tie(%evaldata,'GDBM_File',
  my %cnt=();                $prodir.'/nohist_resevaldata.db',&GDBM_READER(),0640)) {
  my %concat=();          return (undef);
  my %listitems=(      }
        'course'       => 'add',      my %sum=();
        'goto'         => 'add',      my %count=();
        'comefrom'     => 'add',      my %concat=();
        'avetries'     => 'avg',      my %listitems=(
        'stdno'        => 'add',                     'course'       => 'add',
        'difficulty'   => 'avg',                     'goto'         => 'add',
        'clear'        => 'avg',                     'comefrom'     => 'add',
        'technical'    => 'avg',                     'avetries'     => 'average',
        'helpful'      => 'avg',                     'stdno'        => 'add',
        'correct'      => 'avg',                     'difficulty'   => 'average',
        'depth'        => 'avg',                     'clear'        => 'average',
        'comments'     => 'app',                     'technical'    => 'average',
        'usage'        => 'cnt'                     'helpful'      => 'average',
        );                     'correct'      => 'average',
                      'depth'        => 'average',
  my $regexp=$url;                     'comments'     => 'append',
  $regexp=~s/(\W)/\\$1/g;                     'usage'        => 'count'
  $regexp='___'.$regexp.'___([a-z]+)$';                     );
  while (my ($esckey,$value)=each %evaldata) {      #
     my $key=&unescape($esckey);      my $regexp=$url;
     if ($key=~/$regexp/) {      $regexp=~s/(\W)/\\$1/g;
  my ($item,$purl,$cat)=split(/___/,$key);      $regexp='___'.$regexp.'___([a-z]+)$';
  if (defined($cnt{$cat})) { $cnt{$cat}++; } else { $cnt{$cat}=1; }      while (my ($esckey,$value)=each %evaldata) {
  unless ($listitems{$cat} eq 'app') {          my $key=&unescape($esckey);
     if (defined($sum{$cat})) {          if ($key=~/$regexp/) {
  $sum{$cat}+=$evaldata{$esckey};              my ($item,$purl,$cat)=split(/___/,$key);
  $concat{$cat}.=','.$item;              $count{$cat}++;
     } else {              if ($listitems{$cat} ne 'append') {
  $sum{$cat}=$evaldata{$esckey};                  if (defined($sum{$cat})) {
  $concat{$cat}=$item;                      $sum{$cat}+=&unescape($value);
     }                      $concat{$cat}.=','.$item;
  } else {                  } else {
     if (defined($sum{$cat})) {                      $sum{$cat}=&unescape($value);
  if ($evaldata{$esckey}=~/\w/) {                      $concat{$cat}=$item;
     $sum{$cat}.='<hr>'.$evaldata{$esckey};                  }
  }              } else {
     } else {                  if (defined($sum{$cat})) {
  $sum{$cat}=''.$evaldata{$esckey};                      if ($evaldata{$esckey}=~/\w/) {
                           $sum{$cat}.='<hr />'.&unescape($evaldata{$esckey});
                       }
                   } else {
                       $sum{$cat}=''.&unescape($evaldata{$esckey});
     }      }
  }              }
     }          }
  }      }
  untie(%evaldata);      untie(%evaldata);
 # transfer gathered data to returnhash, calculate averages where applicable      # transfer gathered data to returnhash, calculate averages where applicable
  while (my $cat=each(%cnt)) {      my %returnhash;
     if ($cnt{$cat} eq 'nan') { next; }      while (my $cat=each(%count)) {
     if ($sum{$cat} eq 'nan') { next; }          if ($count{$cat} eq 'nan') { next; }
     if ($listitems{$cat} eq 'avg') {          if ($sum{$cat} eq 'nan') { next; }
  if ($cnt{$cat}) {          if ($listitems{$cat} eq 'average') {
     $returnhash{$cat}=int(($sum{$cat}/$cnt{$cat})*100.0+0.5)/100.0;              if ($count{$cat}) {
  } else {                  $returnhash{$cat}=int(($sum{$cat}/$count{$cat})*100.0+0.5)/100.0;
     $returnhash{$cat}='NULL';              } else {
  }                  $returnhash{$cat}='NULL';
     } elsif ($listitems{$cat} eq 'cnt') {              }
  $returnhash{$cat}=$cnt{$cat};          } elsif ($listitems{$cat} eq 'count') {
     } else {              $returnhash{$cat}=$count{$cat};
  $returnhash{$cat}=$sum{$cat};          } else {
     }              $returnhash{$cat}=$sum{$cat};
     $returnhash{$cat.'_list'}=$concat{$cat};          }
  }          $returnhash{$cat.'_list'}=$concat{$cat};
     }      }
 # get count      #
       # get count
     if (tie(my %evaldata,'GDBM_File',      if (tie(my %evaldata,'GDBM_File',
             $prodir.'/nohist_accesscount.db',&GDBM_READER(),0640)) {              $prodir.'/nohist_accesscount.db',&GDBM_READER(),0640)) {
  my $escurl=&escape($url);   my $escurl=&escape($url);
Line 237  sub dynamicmeta { Line 481  sub dynamicmeta {
     }      }
     return %returnhash;      return %returnhash;
 }  }
     
 # ---------------  Read loncapa_apache.conf and loncapa.conf and get variables  
 my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');  
 my %perlvar=%{$perlvarref};  
 undef $perlvarref; # remove since sensitive and not needed  
 delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed  
   
 # ------------------------------------- Only run if machine is a library server  ########################################################
 exit unless $perlvar{'lonRole'} eq 'library';  ########################################################
   ###                                                  ###
   ###   Counts                                         ###
   ###                                                  ###
   ########################################################
   ########################################################
   {
   
 # ----------------------------- Make sure this process is running from user=www  my %countext;
   
 my $wwwid=getpwnam('www');  sub count_type {
 if ($wwwid!=$<) {      my $file=shift;
     my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";      $file=~/\.(\w+)$/;
     my $subj="LON: $perlvar{'lonHostID'} User ID mismatch";      my $ext=lc($1);
     system("echo 'User ID mismatch. searchcat.pl must be run as user www.' |\      $countext{$ext}++;
  mailto $emailto -s '$subj' > /dev/null");  
     exit 1;  
 }  }
   
   sub write_type_count {
 # ---------------------------------------------------------- We are in business      open(RESCOUNT,'>/home/httpd/html/lon-status/rescount.txt');
       while (my ($extension,$count) = each(%countext)) {
 open(LOG,'>'.$perlvar{'lonDaemons'}.'/logs/searchcat.log');   print RESCOUNT $extension.'='.$count.'&';
 print LOG '==== Searchcat Run '.localtime()."====\n\n";  
 $simplestatus='time='.time.'&';  
 my $dbh;  
 # ------------------------------------- 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;  
     }  
   
 # 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, ".  
         "version TEXT, notes TEXT, abstract TEXT, mime TEXT, language TEXT, ".  
         "creationdate DATETIME, lastrevisiondate DATETIME, owner TEXT, ".  
         "copyright 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_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.  
     unless ($dbh->do($make_metadata_table)) {  
  print LOG "\nMySQL Error Create: ".$dbh->errstr."\n";  
  die $dbh->errstr;  
     }      }
       print RESCOUNT 'time='.time."\n";
       close(RESCOUNT);
 }  }
   
 # ------------------------------------------------------------- get .meta files  } # end of scope for %countext
 opendir(RESOURCES,"$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}");  
 my @homeusers = grep {  
     &ishome("$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}/$_")  
     } grep {!/^\.\.?$/} readdir(RESOURCES);  
 closedir RESOURCES;  
   
 #  {
 # Create the statement handlers we need  
   
 my $insert_sth = $dbh->prepare  my %copyrights;
     ("INSERT INTO newmetadata VALUES (".  
      "?,".   # title  
      "?,".   # author  
      "?,".   # subject  
      "?,".   # declutter url  
      "?,".   # version  
      "?,".   # current  
      "?,".   # notes  
      "?,".   # abstract  
      "?,".   # mime  
      "?,".   # language  
      "?,".   # creationdate  
      "?,".   # revisiondate  
      "?,".   # owner  
      "?,".   # copyright  
      "?,".   # 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) {  sub count_copyright {
     print LOG "\n=== User: ".$user."\n\n";      $copyrights{@_[0]}++;
   
     my $prodir=&propath($perlvar{'lonDefDomain'},$user);  
     # 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$//;  
   if ($ref->{'obsolete'}) { print LOG "obsolete\n"; next; }  
  if ($ref->{'copyright'} eq 'private') { print LOG "private\n"; next; }  
         my %dyn=&dynamicmeta($m2);  
  &count($m2);  
         unless ($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'},  
      $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;  
     }  
 }  
 # --------------------------------------------------- Close database connection  
 $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";  
 close(LOG);  
 &writesimple();  
 &writecount();  
 exit 0;  
   
   
   sub write_copyright_count {
 # =============================================================================      open(COPYCOUNT,'>/home/httpd/html/lon-status/copyrightcount.txt');
       while (my ($copyright,$count) = each(%copyrights)) {
 # ---------------------------------------------------------------- Get metadata   print COPYCOUNT $copyright.'='.$count.'&';
 # 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;      print COPYCOUNT 'time='.time."\n";
 }      close(COPYCOUNT);
   
 # ------------------------------------------------------------ Serves up a file  
 # returns either the contents of the file or a -1  
 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  } # end of scope for %copyrights
 sub declutter {  
     my $thisfn=shift;  
     $thisfn=~s/^$perlvar{'lonDocRoot'}//;  
     $thisfn=~s/^\///;  
     $thisfn=~s/^res\///;  
     return $thisfn;  
 }  
   
 # --------------------------------------- Is this the home server of an author?  ########################################################
 # (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 518  sub ishome { Line 553  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 530  sub propath { Line 567  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]);
       } else {
           print LOG "    Unable to decode time ".$time."\n";
           $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;  
 }  }
   
 # ----------------- Code to enable 'find' subroutine listing of the .meta files  sub escape {
       my $str=shift;
 no strict "vars";      $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
       return $str;
 sub wanted {  
     (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&  
          -f _ &&  
          /^.*\.meta$/ && !/^.+\.\d+\.[^\.]+\.meta$/ &&  
          push(@metalist,"$dir/$_");  
 }  }
Removed from v.1.49  
changed lines
  Added in v.1.55

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