--- loncom/metadata_database/searchcat.pl 2003/02/03 18:03:53 1.31 +++ loncom/metadata_database/searchcat.pl 2005/08/11 18:19:41 1.64 @@ -2,7 +2,7 @@ # The LearningOnline Network # searchcat.pl "Search Catalog" batch script # -# $Id: searchcat.pl,v 1.31 2003/02/03 18:03:53 harris41 Exp $ +# $Id: searchcat.pl,v 1.64 2005/08/11 18:19:41 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -28,308 +28,586 @@ # ### -# This script goes through a LON-CAPA resource -# directory and gathers metadata. -# The metadata is entered into a SQL database. +=pod -use lib '/home/httpd/lib/perl/'; -use LONCAPA::Configuration; +=head1 NAME -use IO::File; -use HTML::TokeParser; -use DBI; -use GDBM_File; -use POSIX qw(strftime mktime); +B - put authoritative filesystem data into sql database. -my @metalist; +=head1 SYNOPSIS +Ordinarily this script is to be called from a loncapa cron job +(CVS source location: F; typical +filesystem installation location: F). -# ----------------------------------------------------- Un-Escape Special Chars +Here is the cron job entry. -sub unescape { - my $str=shift; - $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; - return $str; -} +C<# Repopulate and refresh the metadata database used for the search catalog.> +C<10 1 * * 7 www /home/httpd/perl/searchcat.pl> -# -------------------------------------------------------- Escape Special Chars +This script only allows itself to be run as the user C. -sub escape { - my $str=shift; - $str =~ s/(\W)/"%".unpack('H2',$1)/eg; - return $str; -} +=head1 DESCRIPTION +This script goes through a loncapa resource directory and gathers metadata. +The metadata is entered into a SQL database. -# ------------------------------------------- Code to evaluate dynamic metadata +This script also does general database maintenance such as reformatting +the C table if it is deprecated. -sub dynamicmeta { +This script evaluates dynamic metadata from the authors' +F database file in order to store it in MySQL. - my $url=&declutter(shift); - $url=~s/\.meta$//; - my %returnhash=(); - my ($adomain,$aauthor)=($url=~/^(\w+)\/(\w+)\//); - my $prodir=&propath($adomain,$aauthor); - if ((tie(%evaldata,'GDBM_File', - $prodir.'/nohist_resevaldata.db',&GDBM_READER(),0640)) && - (tie(%newevaldata,'GDBM_File', - $prodir.'/nohist_new_resevaldata.db',&GDBM_WRCREAT(),0640))) { - my %sum=(); - my %cnt=(); - my %listitems=('count' => 'add', - 'course' => '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]+)$'; - foreach (keys %evaldata) { - my $key=&unescape($_); - if ($key=~/$regexp/) { - my $ctype=$1; - if (defined($cnt{$ctype})) { - $cnt{$ctype}++; - } else { - $cnt{$ctype}=1; - } - unless ($listitems{$ctype} eq 'app') { - if (defined($sum{$ctype})) { - $sum{$ctype}+=$evaldata{$_}; - } else { - $sum{$ctype}=$evaldata{$_}; - } - } else { - if (defined($sum{$ctype})) { - if ($evaldata{$_}) { - $sum{$ctype}.='
'.$evaldata{$_}; - } - } else { - $sum{$ctype}=''.$evaldata{$_}; - } - } - if ($ctype ne 'count') { - $newevaldata{$_}=$evaldata{$_}; - } - } - } - foreach (keys %cnt) { - if ($listitems{$_} eq 'avg') { - $returnhash{$_}=int(($sum{$_}/$cnt{$_})*100.0+0.5)/100.0; - } elsif ($listitems{$_} eq 'cnt') { - $returnhash{$_}=$cnt{$_}; - } else { - $returnhash{$_}=$sum{$_}; - } - } - if ($returnhash{'count'}) { - my $newkey=$$.'_'.time.'_searchcat___'.&escape($url).'___count'; - $newevaldata{$newkey}=$returnhash{'count'}; - } - untie(%evaldata); - untie(%newevaldata); - } - return %returnhash; -} - -# ----------------- Code to enable 'find' subroutine listing of the .meta files -require "find.pl"; -sub wanted { - (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) && - -f _ && - /^.*\.meta$/ && !/^.+\.\d+\.[^\.]+\.meta$/ && - push(@metalist,"$dir/$_"); -} - -# --------------- Read loncapa_apache.conf and loncapa.conf and get variables -my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf'); -my %perlvar=%{$perlvarref}; -undef $perlvarref; # remove since sensitive and not needed -delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed +This script is playing an increasingly important role for a loncapa +library server. The proper operation of this script is critical for a smooth +and correct user experience. + +=cut + +use strict; -# ------------------------------------- Only run if machine is a library server -exit unless $perlvar{'lonRole'} eq 'library'; +use DBI; +use lib '/home/httpd/lib/perl/'; +use LONCAPA::lonmetadata; -# ----------------------------- Make sure this process is running from user=www +use Getopt::Long; +use IO::File; +use HTML::TokeParser; +use GDBM_File; +use POSIX qw(strftime mktime); +use Apache::lonnet(); + +use File::Find; + +# +# Set up configuration options +my ($simulate,$oneuser,$help,$verbose,$logfile,$debug); +GetOptions ( + 'help' => \$help, + 'simulate' => \$simulate, + 'only=s' => \$oneuser, + 'verbose=s' => \$verbose, + 'debug' => \$debug, + ); + +if ($help) { + print <<"ENDHELP"; +$0 +Rebuild and update the LON-CAPA metadata database. +Options: + -help Print this help + -simulate Do not modify the database. + -only=user Only compute for the given user. Implies -simulate + -verbose=val Sets logging level, val must be a number + -debug Turns on debugging output +ENDHELP + exit 0; +} + +if (! defined($debug)) { + $debug = 0; +} + +if (! defined($verbose)) { + $verbose = 0; +} + +if (defined($oneuser)) { + $simulate=1; +} + +## +## Use variables for table names so we can test this routine a little easier +my $oldname = 'metadata'; +my $newname = 'newmetadata'.$$; # append pid to have unique temporary table + +# +# Only run if machine is a library server +exit if ($Apache::lonnet::perlvar{'lonRole'} ne 'library'); +# +# Make sure this process is running from user=www my $wwwid=getpwnam('www'); if ($wwwid!=$<) { - $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}"; - $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; + my $emailto="$Apache::lonnet::perlvar{'lonAdmEMail'},$Apache::lonnet::perlvar{'lonSysEMail'}"; + my $subj="LON: $Apache::lonnet::perlvar{'lonHostID'} User ID mismatch"; + system("echo 'User ID mismatch. searchcat.pl must be run as user www.' |\ + mail -s '$subj' $emailto > /dev/null"); + exit 1; } +# +# Let people know we are running +open(LOG,'>>'.$Apache::lonnet::perlvar{'lonDaemons'}.'/logs/searchcat.log'); +&log(0,'==== Searchcat Run '.localtime()."===="); -# ---------------------------------------------------------- We are in business - -open(LOG,'>'.$perlvar{'lonDaemons'}.'/logs/searchcat.log'); -print LOG '==== Searchcat Run '.localtime()."====\n\n"; +if ($debug) { + &log(0,'simulating') if ($simulate); + &log(0,'only processing user '.$oneuser) if ($oneuser); + &log(0,'verbosity level = '.$verbose); +} +# +# Connect to database 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"; - exit; - } - my $make_metadata_table = "CREATE TABLE IF NOT EXISTS metadata (". - "title TEXT, author TEXT, subject TEXT, url TEXT, keywords TEXT, ". - "version TEXT, notes TEXT, abstract TEXT, mime TEXT, language TEXT, ". - "creationdate DATETIME, lastrevisiondate DATETIME, owner TEXT, ". - "copyright TEXT, FULLTEXT idx_title (title), ". - "FULLTEXT idx_author (author), FULLTEXT idx_subject (subject), ". - "FULLTEXT idx_url (url), FULLTEXT idx_keywords (keywords), ". - "FULLTEXT idx_version (version), FULLTEXT idx_notes (notes), ". - "FULLTEXT idx_abstract (abstract), FULLTEXT idx_mime (mime), ". - "FULLTEXT idx_language (language), FULLTEXT idx_owner (owner), ". - "FULLTEXT idx_copyright (copyright)) TYPE=MYISAM"; - # It would sure be nice to have some logging mechanism. - $dbh->do($make_metadata_table); -} - -# ------------------------------------------------------------- get .meta files -opendir(RESOURCES,"$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}"); -my @homeusers=grep - {&ishome("$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}/$_")} - grep {!/^\.\.?$/} readdir(RESOURCES); -closedir RESOURCES; -foreach my $user (@homeusers) { - print LOG "\n=== User: ".$user."\n\n"; -# Remove left-over db-files from potentially crashed searchcat run - my $prodir=&propath($perlvar{'lonDefDomain'},$user); - unlink($prodir.'/nohist_new_resevaldata.db'); -# Use find.pl - undef @metalist; - @metalist=(); - &find("$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}/$user"); - -# -- process each file to get metadata and put into search catalog SQL database -# Also, check to see if already there. -# I could just delete (without searching first), but this works for now. -foreach my $m (@metalist) { - print LOG "- ".$m."\n"; - my $ref=&metadata($m); - my $m2='/res/'.&declutter($m); - $m2=~s/\.meta$//; - &dynamicmeta($m2); - my $q2="select * from metadata where url like binary '$m2'"; - my $sth = $dbh->prepare($q2); - $sth->execute(); - my $r1=$sth->fetchall_arrayref; - if (@$r1) { - $sth=$dbh->prepare("delete from metadata where url like binary '$m2'"); - $sth->execute(); - } - $sth=$dbh->prepare('insert into metadata values ('. - '"'.delete($ref->{'title'}).'"'.','. - '"'.delete($ref->{'author'}).'"'.','. - '"'.delete($ref->{'subject'}).'"'.','. - '"'.$m2.'"'.','. - '"'.delete($ref->{'keywords'}).'"'.','. - '"'.'current'.'"'.','. - '"'.delete($ref->{'notes'}).'"'.','. - '"'.delete($ref->{'abstract'}).'"'.','. - '"'.delete($ref->{'mime'}).'"'.','. - '"'.delete($ref->{'language'}).'"'.','. - '"'.sqltime(delete($ref->{'creationdate'})).'"'.','. - '"'.sqltime(delete($ref->{'lastrevisiondate'})).'"'.','. - '"'.delete($ref->{'owner'}).'"'.','. - '"'.delete($ref->{'copyright'}).'"'.')'); - $sth->execute(); -} - -# ----------------------------------------------------------- Clean up database -# Need to, perhaps, remove stale SQL database records. -# ... not yet implemented - - -# -------------------------------------------------- Copy over the new db-files - system('mv '.$prodir.'/nohist_new_resevaldata.db '. - $prodir.'/nohist_resevaldata.db'); -} -# --------------------------------------------------- Close database connection -$dbh->disconnect; -print LOG "\n==== Searchcat completed ".localtime()." ====\n"; +if (! ($dbh = DBI->connect("DBI:mysql:loncapa","www",$Apache::lonnet::perlvar{'lonSqlAccess'}, + { RaiseError =>0,PrintError=>0}))) { + &log(0,"Cannot connect to database!"); + die "MySQL Error: Cannot connect to database!\n"; +} +# This can return an error and still be okay, so we do not bother checking. +# (perhaps it should be more robust and check for specific errors) +$dbh->do('DROP TABLE IF EXISTS '.$newname); +# +# Create the new table +my $request = &LONCAPA::lonmetadata::create_metadata_storage($newname); +$dbh->do($request); +if ($dbh->err) { + $dbh->disconnect(); + &log(0,"MySQL Error Create: ".$dbh->errstr); + die $dbh->errstr; +} +# +# find out which users we need to examine +my @domains = sort(&Apache::lonnet::current_machine_domains()); +&log(9,'domains ="'.join('","',@domains).'"'); + +foreach my $dom (@domains) { + &log(9,'domain = '.$dom); + opendir(RESOURCES,"$Apache::lonnet::perlvar{'lonDocRoot'}/res/$dom"); + my @homeusers = + grep { + &ishome("$Apache::lonnet::perlvar{'lonDocRoot'}/res/$dom/$_"); + } grep { + !/^\.\.?$/; + } readdir(RESOURCES); + closedir RESOURCES; + &log(5,'users = '.$dom.':'.join(',',@homeusers)); + # + if ($oneuser) { + @homeusers=($oneuser); + } + # + # Loop through the users + foreach my $user (@homeusers) { + &log(0,"=== User: ".$user); + &process_dynamic_metadata($user,$dom); + # + # Use File::Find to get the files we need to read/modify + find( + {preprocess => \&only_meta_files, + #wanted => \&print_filename, + #wanted => \&log_metadata, + wanted => \&process_meta_file, + }, join('/',($Apache::lonnet::perlvar{'lonDocRoot'},'res',$dom,$user)) ); + } +} +# +# Rename the table +if (! $simulate) { + $dbh->do('DROP TABLE IF EXISTS '.$oldname); + if (! $dbh->do('RENAME TABLE '.$newname.' TO '.$oldname)) { + &log(0,"MySQL Error Rename: ".$dbh->errstr); + die $dbh->errstr; + } else { + &log(1,"MySQL table rename successful."); + } +} +if (! $dbh->disconnect) { + &log(0,"MySQL Error Disconnect: ".$dbh->errstr); + die $dbh->errstr; +} +## +## Finished! +&log(0,"==== Searchcat completed ".localtime()." ===="); close(LOG); + +&write_type_count(); +&write_copyright_count(); + exit 0; -# ============================================================================= -# ---------------------------------------------------------------- Get metadata -# significantly altered from subroutine present in lonnet +## +## Status logging routine. Inputs: $level, $message +## +## $level 0 should be used for normal output and error messages +## +## $message does not need to end with \n. In the case of errors +## the message should contain as much information as possible to +## help in diagnosing the problem. +## +sub log { + my ($level,$message)=@_; + $level = 0 if (! defined($level)); + if ($verbose >= $level) { + print LOG $message.$/; + } +} + +######################################################## +######################################################## +### ### +### File::Find support routines ### +### ### +######################################################## +######################################################## +## +## &only_meta_files +## +## Called by File::Find. +## Takes a list of files/directories in and returns a list of files/directories +## to search. +sub only_meta_files { + my @PossibleFiles = @_; + my @ChosenFiles; + foreach my $file (@PossibleFiles) { + if ( ($file =~ /\.meta$/ && # Ends in meta + $file !~ /\.\d+\.[^\.]+\.meta$/ # is not for a prior version + ) || (-d $file )) { # directories are okay + # but we do not want /. or /.. + push(@ChosenFiles,$file); + } + } + return @ChosenFiles; +} + +## +## +## Debugging routines, use these for 'wanted' in the File::Find call +## +sub print_filename { + my ($file) = $_; + my $fullfilename = $File::Find::name; + if ($debug) { + if (-d $file) { + &log(5," Got directory ".$fullfilename); + } else { + &log(5," Got file ".$fullfilename); + } + } + $_=$file; +} + +sub log_metadata { + my ($file) = $_; + my $fullfilename = $File::Find::name; + return if (-d $fullfilename); # No need to do anything here for directories + if ($debug) { + &log(6,$fullfilename); + my $ref=&metadata($fullfilename); + if (! defined($ref)) { + &log(6," No data"); + return; + } + while (my($key,$value) = each(%$ref)) { + &log(6," ".$key." => ".$value); + } + &count_copyright($ref->{'copyright'}); + } + $_=$file; +} + +## +## process_meta_file +## Called by File::Find. +## Only input is the filename in $_. +sub process_meta_file { + my ($file) = $_; + my $filename = $File::Find::name; # full filename + return if (-d $filename); # No need to do anything here for directories + # + &log(3,$filename) if ($debug); + # + my $ref=&metadata($filename); + # + # $url is the original file url, not the metadata file + my $target = $filename; + $target =~ s/\.meta$//; + my $url='/res/'.&declutter($target); + &log(3," ".$url) if ($debug); + # + # Ignore some files based on their metadata + if ($ref->{'obsolete'}) { + &log(3,"obsolete") if ($debug); + return; + } + &count_copyright($ref->{'copyright'}); + if ($ref->{'copyright'} eq 'private') { + &log(3,"private") if ($debug); + return; + } + # + # Find the dynamic metadata + my %dyn; + if ($url=~ m:/default$:) { + $url=~ s:/default$:/:; + &log(3,"Skipping dynamic data") if ($debug); + } else { + &log(3,"Retrieving dynamic data") if ($debug); + %dyn=&get_dynamic_metadata($url); + &count_type($url); + } + # + if (! defined($ref->{'creationdate'}) || + $ref->{'creationdate'} =~ /^\s*$/) { + $ref->{'creationdate'} = (stat($target))[9]; + } + if (! defined($ref->{'lastrevisiondate'}) || + $ref->{'lastrevisiondate'} =~ /^\s*$/) { + $ref->{'lastrevisiondate'} = (stat($target))[9]; + } + $ref->{'creationdate'} = &sqltime($ref->{'creationdate'}); + $ref->{'lastrevisiondate'} = &sqltime($ref->{'lastrevisiondate'}); + my %Data = ( + %$ref, + %dyn, + 'url'=>$url, + 'version'=>'current'); + if (! $simulate) { + my ($count,$err) = &LONCAPA::lonmetadata::store_metadata($dbh,$newname, + \%Data); + if ($err) { + &log(0,"MySQL Error Insert: ".$err); + } + if ($count < 1) { + &log(0,"Unable to insert record into MySQL database for $url"); + } + } + # + # Reset $_ before leaving + $_ = $file; +} + +######################################################## +######################################################## +### ### +### &metadata($uri) ### +### Retrieve metadata for the given file ### +### ### +######################################################## +######################################################## sub metadata { - my ($uri,$what)=@_; - my %metacache; + my ($uri)=@_; + 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'}; - } - } - } + if ($filename !~ /\.meta$/) { + $filename.='.meta'; + } + my $metastring=&getfile($Apache::lonnet::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; } -# ------------------------------------------------------------ Serves up a file -# returns either the contents of the file or a -1 +## +## &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 -1; }; - my $fh=IO::File->new($file); - my $a=''; - while (<$fh>) { $a .=$_; } - return $a + my $file = shift(); + if (! -e $file ) { + return undef; + } + my $fh=IO::File->new($file); + my $contents = ''; + while (<$fh>) { + $contents .= $_; + } + return $contents; } -# ------------------------------------------------------------- Declutters URLs -sub declutter { - my $thisfn=shift; - $thisfn=~s/^$perlvar{'lonDocRoot'}//; - $thisfn=~s/^\///; - $thisfn=~s/^res\///; - return $thisfn; +######################################################## +######################################################## +### ### +### Dynamic Metadata ### +### ### +######################################################## +######################################################## +## +## Dynamic metadata description (incomplete) +## +## For a full description of all fields, +## see LONCAPA::lonmetadata +## +## Field Type +##----------------------------------------------------------- +## count integer +## course integer +## course_list comma separated list of course ids +## avetries real +## avetries_list comma separated list of real numbers +## stdno real +## stdno_list comma separated list of real numbers +## usage integer +## usage_list comma separated list of resources +## goto scalar +## goto_list comma separated list of resources +## comefrom scalar +## comefrom_list comma separated list of resources +## difficulty real +## difficulty_list comma separated list of real numbers +## sequsage scalar +## sequsage_list comma separated list of resources +## clear real +## technical real +## correct real +## helpful real +## depth real +## comments html of all the comments made +## +{ + +my %DynamicData; +my %Counts; + +sub process_dynamic_metadata { + my ($user,$dom) = @_; + undef(%DynamicData); + undef(%Counts); + # + my $prodir = &propath($dom,$user); + # + # Read in the dynamic metadata + my %evaldata; + if (! tie(%evaldata,'GDBM_File', + $prodir.'/nohist_resevaldata.db',&GDBM_READER(),0640)) { + return 0; + } + # + %DynamicData = &LONCAPA::lonmetadata::process_reseval_data(\%evaldata); + untie(%evaldata); + $DynamicData{'domain'} = $dom; + #print('user = '.$user.' domain = '.$dom.$/); + # + # Read in the access count data + &log(7,'Reading access count data') if ($debug); + my %countdata; + if (! tie(%countdata,'GDBM_File', + $prodir.'/nohist_accesscount.db',&GDBM_READER(),0640)) { + return 0; + } + while (my ($key,$count) = each(%countdata)) { + next if ($key !~ /^$dom/); + $key = &unescape($key); + &log(8,' Count '.$key.' = '.$count) if ($debug); + $Counts{$key}=$count; + } + untie(%countdata); + if ($debug) { + &log(7,scalar(keys(%Counts)). + " Counts read for ".$user."@".$dom); + &log(7,scalar(keys(%DynamicData)). + " Dynamic metadata read for ".$user."@".$dom); + } + # + return 1; +} + +sub get_dynamic_metadata { + my ($url) = @_; + $url =~ s:^/res/::; + my %data = &LONCAPA::lonmetadata::process_dynamic_metadata($url, + \%DynamicData); + # find the count + $data{'count'} = $Counts{$url}; + # + # Log the dynamic metadata + if ($debug) { + while (my($k,$v)=each(%data)) { + &log(8," ".$k." => ".$v); + } + } + return %data; +} + +} # End of %DynamicData and %Counts scope + +######################################################## +######################################################## +### ### +### Counts ### +### ### +######################################################## +######################################################## +{ + +my %countext; + +sub count_type { + my $file=shift; + $file=~/\.(\w+)$/; + my $ext=lc($1); + $countext{$ext}++; } -# --------------------------------------- Is this the home server of an author? -# (copied from lond, modification of the return value) +sub write_type_count { + open(RESCOUNT,'>/home/httpd/html/lon-status/rescount.txt'); + while (my ($extension,$count) = each(%countext)) { + print RESCOUNT $extension.'='.$count.'&'; + } + print RESCOUNT 'time='.time."\n"; + close(RESCOUNT); +} + +} # end of scope for %countext + +{ + +my %copyrights; + +sub count_copyright { + $copyrights{@_[0]}++; +} + +sub write_copyright_count { + open(COPYCOUNT,'>/home/httpd/html/lon-status/copyrightcount.txt'); + while (my ($copyright,$count) = each(%copyrights)) { + print COPYCOUNT $copyright.'='.$count.'&'; + } + print COPYCOUNT 'time='.time."\n"; + close(COPYCOUNT); +} + +} # end of scope for %copyrights + +######################################################## +######################################################## +### ### +### 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/; @@ -342,45 +620,76 @@ 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; $uname=~s/\W//g; my $subdir=$uname.'__'; $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/; - my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname"; + my $proname="$Apache::lonnet::perlvar{'lonUsersDir'}/$udom/$subdir/$uname"; 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]); + } elsif (! defined($time) || $time == 0) { + $mysqltime = 0; + } else { + &log(0," sqltime:Unable to decode time ".$time); + $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/^$Apache::lonnet::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; } +sub escape { + my $str=shift; + $str =~ s/(\W)/"%".unpack('H2',$1)/eg; + return $str; +} 500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.