--- loncom/metadata_database/searchcat.pl	2003/12/25 04:06:52	1.47
+++ loncom/metadata_database/searchcat.pl	2004/04/08 15:57:32	1.55
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # searchcat.pl "Search Catalog" batch script
 #
-# $Id: searchcat.pl,v 1.47 2003/12/25 04:06:52 www Exp $
+# $Id: searchcat.pl,v 1.55 2004/04/08 15:57:32 matthew Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -56,8 +56,7 @@ This script also does general database m
 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).
+F<nohist_resevaldata.db> database file in order to store it in MySQL.
 
 This script is playing an increasingly important role for a loncapa
 library server.  The proper operation of this script is critical for a smooth
@@ -67,137 +66,409 @@ and correct user experience.
 
 use strict;
 
+use DBI;
 use lib '/home/httpd/lib/perl/';
 use LONCAPA::Configuration;
+use LONCAPA::lonmetadata;
 
 use IO::File;
 use HTML::TokeParser;
-use DBI;
 use GDBM_File;
 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='';
-my %countext=();
+&write_type_count();
+&write_copyright_count();
 
-# ----------------------------------------------------- write out simple status
-sub writesimple {
-    open(SMP,'>/home/httpd/html/lon-status/mysql.txt');
-    print SMP $simplestatus."\n";
-    close(SMP);
-}
+exit 0;
 
-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";
-    close(RSMP);
+    return @ChosenFiles;
 }
 
-# -------------------------------------- counts files with different extensions
-sub count {
-    my $file=shift;
-    $file=~/\.(\w+)$/;
-    my $ext=lc($1);
-    if (defined($countext{$ext})) {
-	$countext{$ext}++;
+##
+##
+## Debugging routines, use these for 'wanted' in the File::Find call
+##
+sub print_filename {
+    my ($file) = $_;
+    my $fullfilename = $File::Find::name;
+    if (-d $file) {
+        print LOG " Got directory ".$fullfilename."\n";
     } else {
-	$countext{$ext}=1;
+        print LOG " Got file ".$fullfilename."\n";
     }
+    $_=$file;
 }
-# ----------------------------------------------------- Un-Escape Special Chars
 
-sub unescape {
-    my $str=shift;
-    $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
-    return $str;
+sub log_metadata {
+    my ($file) = $_;
+    my $fullfilename = $File::Find::name;
+    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;
-    $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
-    return $str;
+##
+## process_meta_file
+##   Called by File::Find. 
+##   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 {
-    my $url=&declutter(shift);
-    $url=~s/\.meta$//;
-    my %returnhash=();
-    my ($adomain,$aauthor)=($url=~/^(\w+)\/(\w+)\//);
-    my $prodir=&propath($adomain,$aauthor);
-
-# Get metadata except counts
-    if (tie(my %evaldata,'GDBM_File',
-            $prodir.'/nohist_resevaldata.db',&GDBM_READER(),0640)) {
-	my %sum=();
-	my %cnt=();
-	my %concat=();
-	my %listitems=(
-		       'course'       => 'add',
-		       'goto'         => 'add',
-		       'comefrom'     => 'add',
-		       'avetries'     => 'avg',
-		       'stdno'        => 'add',
-		       'difficulty'   => 'avg',
-		       'clear'        => 'avg',
-		       'technical'    => 'avg',
-		       'helpful'      => 'avg',
-		       'correct'      => 'avg',
-		       'depth'        => 'avg',
-		       'comments'     => 'app',
-		       'usage'        => 'cnt'
-		       );
-	
-	my $regexp=$url;
-	$regexp=~s/(\W)/\\$1/g;
-	$regexp='___'.$regexp.'___([a-z]+)$';
-	while (my ($esckey,$value)=each %evaldata) {
-	    my $key=&unescape($esckey);
-	    if ($key=~/$regexp/) {
-		my ($item,$purl,$cat)=split(/___/,$key);
-		if (defined($cnt{$cat})) { $cnt{$cat}++; } else { $cnt{$cat}=1; }
-		unless ($listitems{$cat} eq 'app') {
-		    if (defined($sum{$cat})) {
-			$sum{$cat}+=$evaldata{$esckey};
-			$concat{$cat}.=','.$item;
-		    } else {
-			$sum{$cat}=$evaldata{$esckey};
-			$concat{$cat}=$item;
-		    }
-		} else {
-		    if (defined($sum{$cat})) {
-			if ($evaldata{$esckey}=~/\w/) {
-			    $sum{$cat}.='<hr>'.$evaldata{$esckey};
-			}
-		    } else {
-			$sum{$cat}=''.$evaldata{$esckey};
+    my $url = &declutter(shift());
+    $url =~ s/\.meta$//;
+    my %data = ('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' => '',
+                'sequsage'      => '0',
+                'sequsage_list' => '',
+                'clear'         => 'NULL',
+                'technical'     => 'NULL',
+                'correct'       => 'NULL',
+                'helpful'       => 'NULL',
+                'depth'         => 'NULL',
+                'comments'      => '',                
+                );
+    my ($dom,$auth)=($url=~/^(\w+)\/(\w+)\//);
+    my $prodir=&propath($dom,$auth);
+    #
+    # Get metadata except counts
+    my %evaldata;
+    if (! tie(%evaldata,'GDBM_File',
+              $prodir.'/nohist_resevaldata.db',&GDBM_READER(),0640)) {
+        return (undef);
+    }
+    my %sum=();
+    my %count=();
+    my %concat=();
+    my %listitems=(
+                   'course'       => 'add',
+                   'goto'         => 'add',
+                   'comefrom'     => 'add',
+                   'avetries'     => 'average',
+                   'stdno'        => 'add',
+                   'difficulty'   => 'average',
+                   'clear'        => 'average',
+                   'technical'    => 'average',
+                   'helpful'      => 'average',
+                   'correct'      => 'average',
+                   'depth'        => 'average',
+                   'comments'     => 'append',
+                   'usage'        => 'count'
+                   );
+    #
+    my $regexp=$url;
+    $regexp=~s/(\W)/\\$1/g;
+    $regexp='___'.$regexp.'___([a-z]+)$';
+    while (my ($esckey,$value)=each %evaldata) {
+        my $key=&unescape($esckey);
+        if ($key=~/$regexp/) {
+            my ($item,$purl,$cat)=split(/___/,$key);
+            $count{$cat}++;
+            if ($listitems{$cat} ne 'append') {
+                if (defined($sum{$cat})) {
+                    $sum{$cat}+=&unescape($value);
+                    $concat{$cat}.=','.$item;
+                } else {
+                    $sum{$cat}=&unescape($value);
+                    $concat{$cat}=$item;
+                }
+            } else {
+                if (defined($sum{$cat})) {
+                    if ($evaldata{$esckey}=~/\w/) {
+                        $sum{$cat}.='<hr />'.&unescape($evaldata{$esckey});
+                    }
+                } else {
+                    $sum{$cat}=''.&unescape($evaldata{$esckey});
 		    }
-		}
-	    }
-	}
-	untie(%evaldata);
-# transfer gathered data to returnhash, calculate averages where applicable
-	while (my $cat=each(%cnt)) {
-	    if ($listitems{$cat} eq 'avg') {
-		$returnhash{$cat}=int(($sum{$cat}/$cnt{$cat})*100.0+0.5)/100.0;
-	    } elsif ($listitems{$cat} eq 'cnt') {
-		$returnhash{$cat}=$cnt{$cat};
-	    } else {
-		$returnhash{$cat}=$sum{$cat};
-	    }
-	    $returnhash{$cat.'_list'}=$concat{$cat};
-	}
+            }
+        }
+    }
+    untie(%evaldata);
+    # transfer gathered data to returnhash, calculate averages where applicable
+    my %returnhash;
+    while (my $cat=each(%count)) {
+        if ($count{$cat} eq 'nan') { next; }
+        if ($sum{$cat} eq 'nan') { next; }
+        if ($listitems{$cat} eq 'average') {
+            if ($count{$cat}) {
+                $returnhash{$cat}=int(($sum{$cat}/$count{$cat})*100.0+0.5)/100.0;
+            } else {
+                $returnhash{$cat}='NULL';
+            }
+        } elsif ($listitems{$cat} eq 'count') {
+            $returnhash{$cat}=$count{$cat};
+        } else {
+            $returnhash{$cat}=$sum{$cat};
+        }
+        $returnhash{$cat.'_list'}=$concat{$cat};
     }
-# get count
+    #
+    # get count
     if (tie(my %evaldata,'GDBM_File',
             $prodir.'/nohist_accesscount.db',&GDBM_READER(),0640)) {
 	my $escurl=&escape($url);
@@ -210,260 +481,66 @@ sub dynamicmeta {
     }
     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');
-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;
+sub count_type {
+    my $file=shift;
+    $file=~/\.(\w+)$/;
+    my $ext=lc($1);
+    $countext{$ext}++;
 }
 
-
-# ---------------------------------------------------------- We are in business
-
-open(LOG,'>'.$perlvar{'lonDaemons'}.'/logs/searchcat.log');
-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, ".
-        "fusage INTEGER UNSIGNED, fusage_list TEXT, ".
-        "stdno INTEGER UNSIGNED, stdno_list TEXT, ".
-	"avetries FLOAT, avetries_list TEXT, ".
-        "difficulty FLOAT, difficulty_list 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;
+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);
 }
 
-# ------------------------------------------------------------- get .meta files
-opendir(RESOURCES,"$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}");
-my @homeusers = grep {
-    &ishome("$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}/$_")
-    } grep {!/^\.\.?$/} readdir(RESOURCES);
-closedir RESOURCES;
+} # end of scope for %countext
 
-#
-# 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
-     "?,".   # count
-     "?,".   # course
-     "?,".   # course_list
-     "?,".   # goto
-     "?,".   # goto_list
-     "?,".   # comefrom
-     "?,".   # comefrom_list
-     "?,".   # usage
-     "?,".   # usage_list
-     "?,".   # stdno
-     "?,".   # stdno_list
-     "?,".   # avetries
-     "?,".   # avetries_list
-     "?,".   # difficulty
-     "?,"    # difficulty_list
-     );
+my %copyrights;
 
-foreach my $user (@homeusers) {
-    print LOG "\n=== User: ".$user."\n\n";
-
-    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'}			     
-			     )) {
-	    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;
+sub count_copyright {
+    $copyrights{@_[0]}++;
 }
-print LOG "\n==== Searchcat completed ".localtime()." ====\n";
-close(LOG);
-&writesimple();
-&writecount();
-exit 0;
-
 
-
-# =============================================================================
-
-# ---------------------------------------------------------------- Get metadata
-# 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'};
-                        }
-            }
-        }
+sub write_copyright_count {
+    open(COPYCOUNT,'>/home/httpd/html/lon-status/copyrightcount.txt');
+    while (my ($copyright,$count) = each(%copyrights)) {
+	print COPYCOUNT $copyright.'='.$count.'&';
     }
-    return \%metacache;
-}
-
-# ------------------------------------------------------------ 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;
+    print COPYCOUNT 'time='.time."\n";
+    close(COPYCOUNT);
 }
 
-# ------------------------------------------------------------- Declutters URLs
-sub declutter {
-    my $thisfn=shift;
-    $thisfn=~s/^$perlvar{'lonDocRoot'}//;
-    $thisfn=~s/^\///;
-    $thisfn=~s/^res\///;
-    return $thisfn;
-}
+} # end of scope for %copyrights
 
-# --------------------------------------- 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 {
     my $author=shift;
     $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
@@ -476,8 +553,10 @@ 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 {
     my ($udom,$uname)=@_;
     $udom=~s/\W//g;
@@ -488,42 +567,60 @@ sub propath {
     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 {
-    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
-	localtime(&unsqltime(@_[0]));
-    $mon++; $year+=1900;
-    return "$year-$mon-$mday $hour:$min:$sec";
+    my ($time) = @_;
+    my $mysqltime;
+    if ($time =~ 
+        /(\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=@_;
-    return POSIX::mktime(($th{'seconds'},$th{'minutes'},$th{'hours'},
-                          $th{'day'},$th{'month'}-1,
-                          $th{'year'}-1900,0,0,$th{'dlsav'}));
+##
+## &declutter($filename)
+##   Given a filename, returns a url for the filename.
+sub declutter {
+    my $thisfn=shift;
+    $thisfn=~s/^$perlvar{'lonDocRoot'}//;
+    $thisfn=~s/^\///;
+    $thisfn=~s/^res\///;
+    return $thisfn;
 }
 
-
-#########################################
-#
-# Retro-fixing of un-backward-compatible time format
-
-sub unsqltime {
-    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;
+##
+## Escape / Unescape special characters
+sub unescape {
+    my $str=shift;
+    $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
+    return $str;
 }
 
-# ----------------- 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/$_");
+sub escape {
+    my $str=shift;
+    $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
+    return $str;
 }