--- 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 table if it is deprecated. This script evaluates dynamic metadata from the authors' -F database file in order to store it in MySQL, as -well as to compress the filesize (add up all "count"-type metadata). +F 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}.='
'.$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}.='
'.&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; }