Return to searchcat.pl CVS log

Up to [LON-CAPA] / loncom / metadata_database

- removing use Apache2::Compat that never really worked

    1: #!/usr/bin/perl
    2: # The LearningOnline Network
    3: # searchcat.pl "Search Catalog" batch script
    4: #
    5: # $Id: searchcat.pl,v 1.68 2006/04/08 07:07:15 albertel Exp $
    6: #
    7: # Copyright Michigan State University Board of Trustees
    8: #
    9: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
   10: #
   11: # LON-CAPA is free software; you can redistribute it and/or modify
   12: # it under the terms of the GNU General Public License as published by
   13: # the Free Software Foundation; either version 2 of the License, or
   14: # (at your option) any later version.
   15: #
   16: # LON-CAPA is distributed in the hope that it will be useful,
   17: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   18: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   19: # GNU General Public License for more details.
   20: #
   21: # You should have received a copy of the GNU General Public License
   22: # along with LON-CAPA; if not, write to the Free Software
   23: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   24: #
   25: # /home/httpd/html/adm/gpl.txt
   26: #
   27: # http://www.lon-capa.org/
   28: #
   29: ###
   30: 
   31: =pod
   32: 
   33: =head1 NAME
   34: 
   35: B<searchcat.pl> - put authoritative filesystem data into sql database.
   36: 
   37: =head1 SYNOPSIS
   38: 
   39: Ordinarily this script is to be called from a loncapa cron job
   40: (CVS source location: F<loncapa/loncom/cron/loncapa>; typical
   41: filesystem installation location: F</etc/cron.d/loncapa>).
   42: 
   43: Here is the cron job entry.
   44: 
   45: C<# Repopulate and refresh the metadata database used for the search catalog.>
   46: C<10 1 * * 7    www    /home/httpd/perl/searchcat.pl>
   47: 
   48: This script only allows itself to be run as the user C<www>.
   49: 
   50: =head1 DESCRIPTION
   51: 
   52: This script goes through a loncapa resource directory and gathers metadata.
   53: The metadata is entered into a SQL database.
   54: 
   55: This script also does general database maintenance such as reformatting
   56: the C<loncapa:metadata> table if it is deprecated.
   57: 
   58: This script evaluates dynamic metadata from the authors'
   59: F<nohist_resevaldata.db> database file in order to store it in MySQL.
   60: 
   61: This script is playing an increasingly important role for a loncapa
   62: library server.  The proper operation of this script is critical for a smooth
   63: and correct user experience.
   64: 
   65: =cut
   66: 
   67: use strict;
   68: use DBI;
   69: use lib '/home/httpd/lib/perl/';
   70: use LONCAPA::lonmetadata;
   71: 
   72: use Getopt::Long;
   73: use IO::File;
   74: use HTML::TokeParser;
   75: use GDBM_File;
   76: use POSIX qw(strftime mktime);
   77: 
   78: use Apache::lonnet();
   79: 
   80: use File::Find;
   81: 
   82: #
   83: # Set up configuration options
   84: my ($simulate,$oneuser,$help,$verbose,$logfile,$debug);
   85: GetOptions (
   86:             'help'     => \$help,
   87:             'simulate' => \$simulate,
   88:             'only=s'   => \$oneuser,
   89:             'verbose=s'  => \$verbose,
   90:             'debug' => \$debug,
   91:             );
   92: 
   93: if ($help) {
   94:     print <<"ENDHELP";
   95: $0
   96: Rebuild and update the LON-CAPA metadata database. 
   97: Options:
   98:     -help          Print this help
   99:     -simulate      Do not modify the database.
  100:     -only=user     Only compute for the given user.  Implies -simulate   
  101:     -verbose=val   Sets logging level, val must be a number
  102:     -debug         Turns on debugging output
  103: ENDHELP
  104:     exit 0;
  105: }
  106: 
  107: if (! defined($debug)) {
  108:     $debug = 0;
  109: }
  110: 
  111: if (! defined($verbose)) {
  112:     $verbose = 0;
  113: }
  114: 
  115: if (defined($oneuser)) {
  116:     $simulate=1;
  117: }
  118: 
  119: ##
  120: ## Use variables for table names so we can test this routine a little easier
  121: my $oldname = 'metadata';
  122: my $newname = 'newmetadata'.$$; # append pid to have unique temporary table
  123: 
  124: #
  125: # Only run if machine is a library server
  126: exit if ($Apache::lonnet::perlvar{'lonRole'} ne 'library');
  127: #
  128: #  Make sure this process is running from user=www
  129: my $wwwid=getpwnam('www');
  130: if ($wwwid!=$<) {
  131:     my $emailto="$Apache::lonnet::perlvar{'lonAdmEMail'},$Apache::lonnet::perlvar{'lonSysEMail'}";
  132:     my $subj="LON: $Apache::lonnet::perlvar{'lonHostID'} User ID mismatch";
  133:     system("echo 'User ID mismatch. searchcat.pl must be run as user www.' |\
  134:  mail -s '$subj' $emailto > /dev/null");
  135:     exit 1;
  136: }
  137: #
  138: # Let people know we are running
  139: open(LOG,'>>'.$Apache::lonnet::perlvar{'lonDaemons'}.'/logs/searchcat.log');
  140: &log(0,'==== Searchcat Run '.localtime()."====");
  141: 
  142: 
  143: if ($debug) {
  144:     &log(0,'simulating') if ($simulate);
  145:     &log(0,'only processing user '.$oneuser) if ($oneuser);
  146:     &log(0,'verbosity level = '.$verbose);
  147: }
  148: #
  149: # Connect to database
  150: my $dbh;
  151: if (! ($dbh = DBI->connect("DBI:mysql:loncapa","www",$Apache::lonnet::perlvar{'lonSqlAccess'},
  152:                           { RaiseError =>0,PrintError=>0}))) {
  153:     &log(0,"Cannot connect to database!");
  154:     die "MySQL Error: Cannot connect to database!\n";
  155: }
  156: # This can return an error and still be okay, so we do not bother checking.
  157: # (perhaps it should be more robust and check for specific errors)
  158: $dbh->do('DROP TABLE IF EXISTS '.$newname);
  159: #
  160: # Create the new table
  161: my $request = &LONCAPA::lonmetadata::create_metadata_storage($newname);
  162: $dbh->do($request);
  163: if ($dbh->err) {
  164:     $dbh->disconnect();
  165:     &log(0,"MySQL Error Create: ".$dbh->errstr);
  166:     die $dbh->errstr;
  167: }
  168: #
  169: # find out which users we need to examine
  170: my @domains = sort(&Apache::lonnet::current_machine_domains());
  171: &log(9,'domains ="'.join('","',@domains).'"');
  172: 
  173: foreach my $dom (@domains) {
  174:     &log(9,'domain = '.$dom);
  175:     opendir(RESOURCES,"$Apache::lonnet::perlvar{'lonDocRoot'}/res/$dom");
  176:     my @homeusers = 
  177:         grep {
  178:             &ishome("$Apache::lonnet::perlvar{'lonDocRoot'}/res/$dom/$_");
  179:         } grep { 
  180:             !/^\.\.?$/;
  181:         } readdir(RESOURCES);
  182:     closedir RESOURCES;
  183:     &log(5,'users = '.$dom.':'.join(',',@homeusers));
  184:     #
  185:     if ($oneuser) {
  186:         @homeusers=($oneuser);
  187:     }
  188:     #
  189:     # Loop through the users
  190:     foreach my $user (@homeusers) {
  191:         &log(0,"=== User: ".$user);
  192:         &process_dynamic_metadata($user,$dom);
  193:         #
  194:         # Use File::Find to get the files we need to read/modify
  195:         find(
  196:              {preprocess => \&only_meta_files,
  197:               #wanted     => \&print_filename,
  198:               #wanted     => \&log_metadata,
  199:               wanted     => \&process_meta_file,
  200:               no_chdir   => 1,
  201:              }, join('/',($Apache::lonnet::perlvar{'lonDocRoot'},'res',$dom,$user)) );
  202:     }
  203: }
  204: #
  205: # Rename the table
  206: if (! $simulate) {
  207:     $dbh->do('DROP TABLE IF EXISTS '.$oldname);
  208:     if (! $dbh->do('RENAME TABLE '.$newname.' TO '.$oldname)) {
  209:         &log(0,"MySQL Error Rename: ".$dbh->errstr);
  210:         die $dbh->errstr;
  211:     } else {
  212:         &log(1,"MySQL table rename successful.");
  213:     }
  214: }
  215: if (! $dbh->disconnect) {
  216:     &log(0,"MySQL Error Disconnect: ".$dbh->errstr);
  217:     die $dbh->errstr;
  218: }
  219: ##
  220: ## Finished!
  221: &log(0,"==== Searchcat completed ".localtime()." ====");
  222: close(LOG);
  223: 
  224: &write_type_count();
  225: &write_copyright_count();
  226: 
  227: exit 0;
  228: 
  229: ##
  230: ## Status logging routine.  Inputs: $level, $message
  231: ## 
  232: ## $level 0 should be used for normal output and error messages
  233: ##
  234: ## $message does not need to end with \n.  In the case of errors
  235: ## the message should contain as much information as possible to
  236: ## help in diagnosing the problem.
  237: ##
  238: sub log {
  239:     my ($level,$message)=@_;
  240:     $level = 0 if (! defined($level));
  241:     if ($verbose >= $level) {
  242:         print LOG $message.$/;
  243:     }
  244: }
  245: 
  246: ########################################################
  247: ########################################################
  248: ###                                                  ###
  249: ###          File::Find support routines             ###
  250: ###                                                  ###
  251: ########################################################
  252: ########################################################
  253: ##
  254: ## &only_meta_files
  255: ##
  256: ## Called by File::Find.
  257: ## Takes a list of files/directories in and returns a list of files/directories
  258: ## to search.
  259: sub only_meta_files {
  260:     my @PossibleFiles = @_;
  261:     my @ChosenFiles;
  262:     foreach my $file (@PossibleFiles) {
  263:         if ( ($file =~ /\.meta$/ &&            # Ends in meta
  264:               $file !~ /\.\d+\.[^\.]+\.meta$/  # is not for a prior version
  265:              ) || (-d $File::Find::dir."/".$file )) { # directories are okay
  266:                  # but we do not want /. or /..
  267:             push(@ChosenFiles,$file);
  268:         }
  269:     }
  270:     return @ChosenFiles;
  271: }
  272: 
  273: ##
  274: ##
  275: ## Debugging routines, use these for 'wanted' in the File::Find call
  276: ##
  277: sub print_filename {
  278:     my ($file) = $_;
  279:     my $fullfilename = $File::Find::name;
  280:     if ($debug) {
  281:         if (-d $file) {
  282:             &log(5," Got directory ".$fullfilename);
  283:         } else {
  284:             &log(5," Got file ".$fullfilename);
  285:         }
  286:     }
  287:     $_=$file;
  288: }
  289: 
  290: sub log_metadata {
  291:     my ($file) = $_;
  292:     my $fullfilename = $File::Find::name;
  293:     return if (-d $fullfilename); # No need to do anything here for directories
  294:     if ($debug) {
  295:         &log(6,$fullfilename);
  296:         my $ref=&metadata($fullfilename);
  297:         if (! defined($ref)) {
  298:             &log(6,"    No data");
  299:             return;
  300:         }
  301:         while (my($key,$value) = each(%$ref)) {
  302:             &log(6,"    ".$key." => ".$value);
  303:         }
  304:         &count_copyright($ref->{'copyright'});
  305:     }
  306:     $_=$file;
  307: }
  308: 
  309: ##
  310: ## process_meta_file
  311: ##   Called by File::Find. 
  312: ##   Only input is the filename in $_.  
  313: sub process_meta_file {
  314:     my ($file) = $_;
  315:     my $filename = $File::Find::name; # full filename
  316:     return if (-d $filename); # No need to do anything here for directories
  317:     #
  318:     &log(3,$filename) if ($debug);
  319:     #
  320:     my $ref=&metadata($filename);
  321:     #
  322:     # $url is the original file url, not the metadata file
  323:     my $target = $filename;
  324:     $target =~ s/\.meta$//;
  325:     my $url='/res/'.&declutter($target);
  326:     &log(3,"    ".$url) if ($debug);
  327:     #
  328:     # Ignore some files based on their metadata
  329:     if ($ref->{'obsolete'}) { 
  330:         &log(3,"obsolete") if ($debug);
  331:         return; 
  332:     }
  333:     &count_copyright($ref->{'copyright'});
  334:     if ($ref->{'copyright'} eq 'private') { 
  335:         &log(3,"private") if ($debug);
  336:         return; 
  337:     }
  338:     #
  339:     # Find the dynamic metadata
  340:     my %dyn;
  341:     if ($url=~ m:/default$:) {
  342:         $url=~ s:/default$:/:;
  343:         &log(3,"Skipping dynamic data") if ($debug);
  344:     } else {
  345:         &log(3,"Retrieving dynamic data") if ($debug);
  346:         %dyn=&get_dynamic_metadata($url);
  347:         &count_type($url);
  348:     }
  349:     #
  350:     if (! defined($ref->{'creationdate'}) ||
  351:         $ref->{'creationdate'} =~ /^\s*$/) {
  352:         $ref->{'creationdate'} = (stat($target))[9];
  353:     }
  354:     if (! defined($ref->{'lastrevisiondate'}) ||
  355:         $ref->{'lastrevisiondate'} =~ /^\s*$/) {
  356:         $ref->{'lastrevisiondate'} = (stat($target))[9];
  357:     }
  358:     $ref->{'creationdate'}     = &sqltime($ref->{'creationdate'});
  359:     $ref->{'lastrevisiondate'} = &sqltime($ref->{'lastrevisiondate'});
  360:     my %Data = (
  361:                 %$ref,
  362:                 %dyn,
  363:                 'url'=>$url,
  364:                 'version'=>'current');
  365:     if (! $simulate) {
  366:         my ($count,$err) = &LONCAPA::lonmetadata::store_metadata($dbh,$newname,
  367:                                                                  \%Data);
  368:         if ($err) {
  369:             &log(0,"MySQL Error Insert: ".$err);
  370:         }
  371:         if ($count < 1) {
  372:             &log(0,"Unable to insert record into MySQL database for $url");
  373:         }
  374:     }
  375:     #
  376:     # Reset $_ before leaving
  377:     $_ = $file;
  378: }
  379: 
  380: ########################################################
  381: ########################################################
  382: ###                                                  ###
  383: ###  &metadata($uri)                                 ###
  384: ###   Retrieve metadata for the given file           ###
  385: ###                                                  ###
  386: ########################################################
  387: ########################################################
  388: sub metadata {
  389:     my ($uri)=@_;
  390:     my %metacache=();
  391:     $uri=&declutter($uri);
  392:     my $filename=$uri;
  393:     $uri=~s/\.meta$//;
  394:     $uri='';
  395:     if ($filename !~ /\.meta$/) { 
  396:         $filename.='.meta';
  397:     }
  398:     my $metastring=&getfile($Apache::lonnet::perlvar{'lonDocRoot'}.'/res/'.$filename);
  399:     return undef if (! defined($metastring));
  400:     my $parser=HTML::TokeParser->new(\$metastring);
  401:     my $token;
  402:     while ($token=$parser->get_token) {
  403:         if ($token->[0] eq 'S') {
  404:             my $entry=$token->[1];
  405:             my $unikey=$entry;
  406:             if (defined($token->[2]->{'part'})) { 
  407:                 $unikey.='_'.$token->[2]->{'part'}; 
  408:             }
  409:             if (defined($token->[2]->{'name'})) { 
  410:                 $unikey.='_'.$token->[2]->{'name'}; 
  411:             }
  412:             if ($metacache{$uri.'keys'}) {
  413:                 $metacache{$uri.'keys'}.=','.$unikey;
  414:             } else {
  415:                 $metacache{$uri.'keys'}=$unikey;
  416:             }
  417:             foreach ( @{$token->[3]}) {
  418:                 $metacache{$uri.''.$unikey.'.'.$_}=$token->[2]->{$_};
  419:             } 
  420:             if (! ($metacache{$uri.''.$unikey}=$parser->get_text('/'.$entry))){
  421:                 $metacache{$uri.''.$unikey} = 
  422:                     $metacache{$uri.''.$unikey.'.default'};
  423:             }
  424:         } # End of ($token->[0] eq 'S')
  425:     }
  426:     return \%metacache;
  427: }
  428: 
  429: ##
  430: ## &getfile($filename)
  431: ##   Slurps up an entire file into a scalar.  
  432: ##   Returns undef if the file does not exist
  433: sub getfile {
  434:     my $file = shift();
  435:     if (! -e $file ) { 
  436:         return undef; 
  437:     }
  438:     my $fh=IO::File->new($file);
  439:     my $contents = '';
  440:     while (<$fh>) { 
  441:         $contents .= $_;
  442:     }
  443:     return $contents;
  444: }
  445: 
  446: ########################################################
  447: ########################################################
  448: ###                                                  ###
  449: ###    Dynamic Metadata                              ###
  450: ###                                                  ###
  451: ########################################################
  452: ########################################################
  453: ##
  454: ## Dynamic metadata description (incomplete)
  455: ##
  456: ## For a full description of all fields,
  457: ## see LONCAPA::lonmetadata
  458: ##
  459: ##   Field             Type
  460: ##-----------------------------------------------------------
  461: ##   count             integer
  462: ##   course            integer
  463: ##   course_list       comma separated list of course ids
  464: ##   avetries          real                                
  465: ##   avetries_list     comma separated list of real numbers
  466: ##   stdno             real
  467: ##   stdno_list        comma separated list of real numbers
  468: ##   usage             integer   
  469: ##   usage_list        comma separated list of resources
  470: ##   goto              scalar
  471: ##   goto_list         comma separated list of resources
  472: ##   comefrom          scalar
  473: ##   comefrom_list     comma separated list of resources
  474: ##   difficulty        real
  475: ##   difficulty_list   comma separated list of real numbers
  476: ##   sequsage          scalar
  477: ##   sequsage_list     comma separated list of resources
  478: ##   clear             real
  479: ##   technical         real
  480: ##   correct           real
  481: ##   helpful           real
  482: ##   depth             real
  483: ##   comments          html of all the comments made
  484: ##
  485: {
  486: 
  487: my %DynamicData;
  488: my %Counts;
  489: 
  490: sub process_dynamic_metadata {
  491:     my ($user,$dom) = @_;
  492:     undef(%DynamicData);
  493:     undef(%Counts);
  494:     #
  495:     my $prodir = &propath($dom,$user);
  496:     #
  497:     # Read in the dynamic metadata
  498:     my %evaldata;
  499:     if (! tie(%evaldata,'GDBM_File',
  500:               $prodir.'/nohist_resevaldata.db',&GDBM_READER(),0640)) {
  501:         return 0;
  502:     }
  503:     #
  504:     %DynamicData = &LONCAPA::lonmetadata::process_reseval_data(\%evaldata);
  505:     untie(%evaldata);
  506:     $DynamicData{'domain'} = $dom;
  507:     #print('user = '.$user.' domain = '.$dom.$/);
  508:     #
  509:     # Read in the access count data
  510:     &log(7,'Reading access count data') if ($debug);
  511:     my %countdata;
  512:     if (! tie(%countdata,'GDBM_File',
  513:               $prodir.'/nohist_accesscount.db',&GDBM_READER(),0640)) {
  514:         return 0;
  515:     }
  516:     while (my ($key,$count) = each(%countdata)) {
  517:         next if ($key !~ /^$dom/);
  518:         $key = &unescape($key);
  519:         &log(8,'    Count '.$key.' = '.$count) if ($debug);
  520:         $Counts{$key}=$count;
  521:     }
  522:     untie(%countdata);
  523:     if ($debug) {
  524:         &log(7,scalar(keys(%Counts)).
  525:              " Counts read for ".$user."@".$dom);
  526:         &log(7,scalar(keys(%DynamicData)).
  527:              " Dynamic metadata read for ".$user."@".$dom);
  528:     }
  529:     #
  530:     return 1;
  531: }
  532: 
  533: sub get_dynamic_metadata {
  534:     my ($url) = @_;
  535:     $url =~ s:^/res/::;
  536:     my %data = &LONCAPA::lonmetadata::process_dynamic_metadata($url,
  537:                                                                \%DynamicData);
  538:     # find the count
  539:     $data{'count'} = $Counts{$url};
  540:     #
  541:     # Log the dynamic metadata
  542:     if ($debug) {
  543:         while (my($k,$v)=each(%data)) {
  544:             &log(8,"    ".$k." => ".$v);
  545:         }
  546:     }
  547:     return %data;
  548: }
  549: 
  550: } # End of %DynamicData and %Counts scope
  551: 
  552: ########################################################
  553: ########################################################
  554: ###                                                  ###
  555: ###   Counts                                         ###
  556: ###                                                  ###
  557: ########################################################
  558: ########################################################
  559: {
  560: 
  561: my %countext;
  562: 
  563: sub count_type {
  564:     my $file=shift;
  565:     $file=~/\.(\w+)$/;
  566:     my $ext=lc($1);
  567:     $countext{$ext}++;
  568: }
  569: 
  570: sub write_type_count {
  571:     open(RESCOUNT,'>/home/httpd/html/lon-status/rescount.txt');
  572:     while (my ($extension,$count) = each(%countext)) {
  573: 	print RESCOUNT $extension.'='.$count.'&';
  574:     }
  575:     print RESCOUNT 'time='.time."\n";
  576:     close(RESCOUNT);
  577: }
  578: 
  579: } # end of scope for %countext
  580: 
  581: {
  582: 
  583: my %copyrights;
  584: 
  585: sub count_copyright {
  586:     $copyrights{@_[0]}++;
  587: }
  588: 
  589: sub write_copyright_count {
  590:     open(COPYCOUNT,'>/home/httpd/html/lon-status/copyrightcount.txt');
  591:     while (my ($copyright,$count) = each(%copyrights)) {
  592: 	print COPYCOUNT $copyright.'='.$count.'&';
  593:     }
  594:     print COPYCOUNT 'time='.time."\n";
  595:     close(COPYCOUNT);
  596: }
  597: 
  598: } # end of scope for %copyrights
  599: 
  600: ########################################################
  601: ########################################################
  602: ###                                                  ###
  603: ###   Miscellanous Utility Routines                  ###
  604: ###                                                  ###
  605: ########################################################
  606: ########################################################
  607: ##
  608: ## &ishome($username)
  609: ##   Returns 1 if $username is a LON-CAPA author, 0 otherwise
  610: ##   (copied from lond, modification of the return value)
  611: sub ishome {
  612:     my $author=shift;
  613:     $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
  614:     my ($udom,$uname)=split(/\//,$author);
  615:     my $proname=propath($udom,$uname);
  616:     if (-e $proname) {
  617: 	return 1;
  618:     } else {
  619:         return 0;
  620:     }
  621: }
  622: 
  623: ##
  624: ## &propath($udom,$uname)
  625: ##   Returns the path to the users LON-CAPA directory
  626: ##   (copied from lond)
  627: sub propath {
  628:     my ($udom,$uname)=@_;
  629:     $udom=~s/\W//g;
  630:     $uname=~s/\W//g;
  631:     my $subdir=$uname.'__';
  632:     $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
  633:     my $proname="$Apache::lonnet::perlvar{'lonUsersDir'}/$udom/$subdir/$uname";
  634:     return $proname;
  635: } 
  636: 
  637: ##
  638: ## &sqltime($timestamp)
  639: ##
  640: ## Convert perl $timestamp to MySQL time.  MySQL expects YYYY-MM-DD HH:MM:SS
  641: ##
  642: sub sqltime {
  643:     my ($time) = @_;
  644:     my $mysqltime;
  645:     if ($time =~ 
  646:         /(\d+)-(\d+)-(\d+) # YYYY-MM-DD
  647:         \s                 # a space
  648:         (\d+):(\d+):(\d+)  # HH:MM::SS
  649:         /x ) { 
  650:         # Some of the .meta files have the time in mysql
  651:         # format already, so just make sure they are 0 padded and
  652:         # pass them back.
  653:         $mysqltime = sprintf('%04d-%02d-%02d %02d:%02d:%02d',
  654:                              $1,$2,$3,$4,$5,$6);
  655:     } elsif ($time =~ /^\d+$/) {
  656:         my @TimeData = gmtime($time);
  657:         # Alter the month to be 1-12 instead of 0-11
  658:         $TimeData[4]++;
  659:         # Alter the year to be from 0 instead of from 1900
  660:         $TimeData[5]+=1900;
  661:         $mysqltime = sprintf('%04d-%02d-%02d %02d:%02d:%02d',
  662:                              @TimeData[5,4,3,2,1,0]);
  663:     } elsif (! defined($time) || $time == 0) {
  664:         $mysqltime = 0;
  665:     } else {
  666:         &log(0,"    sqltime:Unable to decode time ".$time);
  667:         $mysqltime = 0;
  668:     }
  669:     return $mysqltime;
  670: }
  671: 
  672: ##
  673: ## &declutter($filename)
  674: ##   Given a filename, returns a url for the filename.
  675: sub declutter {
  676:     my $thisfn=shift;
  677:     $thisfn=~s/^$Apache::lonnet::perlvar{'lonDocRoot'}//;
  678:     $thisfn=~s/^\///;
  679:     $thisfn=~s/^res\///;
  680:     return $thisfn;
  681: }
  682: 
  683: ##
  684: ## Escape / Unescape special characters
  685: sub unescape {
  686:     my $str=shift;
  687:     $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
  688:     return $str;
  689: }
  690: 
  691: sub escape {
  692:     my $str=shift;
  693:     $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
  694:     return $str;
  695: }