Annotation of loncom/metadata_database/searchcat.pl, revision 1.66

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

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