Return to searchcat.pl CVS log

Up to [LON-CAPA] / loncom / metadata_database

searchcat.pl
- Additional MySQL table to build: allusers
- &descend_tree() arguments changed. $dom added as first arg, and reference to %allusers hash added as last arg.
- %allusers keys are usernames for all users in the domain which are not courses.
- user information put into allusers MySQL table.

LONCAPA/lonmetadata.pm
- description of allusers table
- &update_metadata(), &lookup_metadata() and &delete_metadata() modified to allow more flexibility in the WHERE condition in the SQL query (no longer forced to be url = ).
- &process_allusers_data() added to add/modify the contents of the allusers table.

    1: #!/usr/bin/perl
    2: # The LearningOnline Network
    3: # searchcat.pl "Search Catalog" batch script
    4: #
    5: # $Id: searchcat.pl,v 1.77 2007/07/25 23:17:43 raeburn 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: use LONCAPA;
   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 %oldnames = (
  122:                  'metadata'    => 'metadata',
  123:                  'portfolio'   => 'portfolio_metadata',
  124:                  'access'      => 'portfolio_access',
  125:                  'addedfields' => 'portfolio_addedfields',
  126:                  'allusers'     => 'allusers',
  127:                );
  128: 
  129: my %newnames;
  130: # new table names -  append pid to have unique temporary tables
  131: foreach my $key (keys(%oldnames)) {
  132:     $newnames{$key} = 'new'.$oldnames{$key}.$$;
  133: }
  134: 
  135: #
  136: # Only run if machine is a library server
  137: exit if ($Apache::lonnet::perlvar{'lonRole'} ne 'library');
  138: #
  139: #  Make sure this process is running from user=www
  140: my $wwwid=getpwnam('www');
  141: if ($wwwid!=$<) {
  142:     my $emailto="$Apache::lonnet::perlvar{'lonAdmEMail'},$Apache::lonnet::perlvar{'lonSysEMail'}";
  143:     my $subj="LON: $Apache::lonnet::perlvar{'lonHostID'} User ID mismatch";
  144:     system("echo 'User ID mismatch. searchcat.pl must be run as user www.' |\
  145:  mail -s '$subj' $emailto > /dev/null");
  146:     exit 1;
  147: }
  148: #
  149: # Let people know we are running
  150: open(LOG,'>>'.$Apache::lonnet::perlvar{'lonDaemons'}.'/logs/searchcat.log');
  151: &log(0,'==== Searchcat Run '.localtime()."====");
  152: 
  153: 
  154: if ($debug) {
  155:     &log(0,'simulating') if ($simulate);
  156:     &log(0,'only processing user '.$oneuser) if ($oneuser);
  157:     &log(0,'verbosity level = '.$verbose);
  158: }
  159: #
  160: # Connect to database
  161: my $dbh;
  162: if (! ($dbh = DBI->connect("DBI:mysql:loncapa","www",$Apache::lonnet::perlvar{'lonSqlAccess'},
  163:                           { RaiseError =>0,PrintError=>0}))) {
  164:     &log(0,"Cannot connect to database!");
  165:     die "MySQL Error: Cannot connect to database!\n";
  166: }
  167: # This can return an error and still be okay, so we do not bother checking.
  168: # (perhaps it should be more robust and check for specific errors)
  169: foreach my $key (keys(%newnames)) {
  170:     if ($newnames{$key} ne '') {
  171:         $dbh->do('DROP TABLE IF EXISTS '.$newnames{$key});
  172:     }
  173: }
  174: 
  175: #
  176: # Create the new metadata, portfolio and allusers tables
  177: foreach my $key (keys(%newnames)) {
  178:     if ($newnames{$key} ne '') { 
  179:         my $request =
  180:              &LONCAPA::lonmetadata::create_metadata_storage($newnames{$key},$oldnames{$key});
  181:         $dbh->do($request);
  182:         if ($dbh->err) {
  183:             $dbh->disconnect();
  184:             &log(0,"MySQL Error Create: ".$dbh->errstr);
  185:             die $dbh->errstr;
  186:         }
  187:     }
  188: }
  189: 
  190: #
  191: # find out which users we need to examine
  192: my @domains = sort(&Apache::lonnet::current_machine_domains());
  193: &log(9,'domains ="'.join('","',@domains).'"');
  194: 
  195: foreach my $dom (@domains) {
  196:     &log(9,'domain = '.$dom);
  197:     opendir(RESOURCES,"$Apache::lonnet::perlvar{'lonDocRoot'}/res/$dom");
  198:     my @homeusers = 
  199:         grep {
  200:             &ishome("$Apache::lonnet::perlvar{'lonDocRoot'}/res/$dom/$_");
  201:         } grep { 
  202:             !/^\.\.?$/;
  203:         } readdir(RESOURCES);
  204:     closedir RESOURCES;
  205:     &log(5,'users = '.$dom.':'.join(',',@homeusers));
  206:     #
  207:     if ($oneuser) {
  208:         @homeusers=($oneuser);
  209:     }
  210:     #
  211:     # Loop through the users
  212:     foreach my $user (@homeusers) {
  213:         &log(0,"=== User: ".$user);
  214:         &process_dynamic_metadata($user,$dom);
  215:         #
  216:         # Use File::Find to get the files we need to read/modify
  217:         find(
  218:              {preprocess => \&only_meta_files,
  219:               #wanted     => \&print_filename,
  220:               #wanted     => \&log_metadata,
  221:               wanted     => \&process_meta_file,
  222:               no_chdir   => 1,
  223:              }, join('/',($Apache::lonnet::perlvar{'lonDocRoot'},'res',$dom,$user)) );
  224:     }
  225:     # Search for all users and public portfolio files
  226:     my (%allusers,%portusers);
  227:     if ($oneuser) {
  228:         %portusers = (
  229:                         $oneuser => '',
  230:                        );
  231:         %allusers = (
  232:                         $oneuser => '',
  233:                        );
  234:     } else {
  235:         my $dir = $Apache::lonnet::perlvar{lonUsersDir}.'/'.$dom;
  236:         &descend_tree($dom,$dir,0,\%portusers,\%allusers);
  237:     }
  238:     foreach my $uname (keys(%portusers)) {
  239:         my $urlstart = '/uploaded/'.$dom.'/'.$uname;
  240:         my $pathstart = &propath($dom,$uname).'/userfiles';
  241:         my $is_course = &Apache::lonnet::is_course($dom,$uname);
  242:         my $curr_perm = &Apache::lonnet::get_portfile_permissions($dom,$uname);
  243:         my %access = &Apache::lonnet::get_access_controls($curr_perm);
  244:         foreach my $file (keys(%access)) {
  245:             my ($group,$url,$fullpath);
  246:             if ($is_course) {
  247:                 ($group, my ($path)) = ($file =~ /^(\w+)(\/.+)$/);
  248:                 $fullpath = $pathstart.'/groups/'.$group.'/portfolio'.$path;
  249:                 $url = $urlstart.'/groups/'.$group.'/portfolio'.$path;
  250:             } else {
  251:                 $fullpath = $pathstart.'/portfolio'.$file;
  252:                 $url = $urlstart.'/portfolio'.$file;
  253:             }
  254:             if (ref($access{$file}) eq 'HASH') {
  255:                 my %portaccesslog = 
  256:                     &LONCAPA::lonmetadata::process_portfolio_access_data($dbh,
  257:                            $simulate,\%newnames,$url,$fullpath,$access{$file});
  258:                 &portfolio_logging(%portaccesslog);
  259:             }
  260:             my %portmetalog = &LONCAPA::lonmetadata::process_portfolio_metadata($dbh,$simulate,\%newnames,$url,$fullpath,$is_course,$dom,$uname,$group);
  261:             &portfolio_logging(%portmetalog);
  262:         }
  263:     }
  264:     # Update allusers
  265:     foreach my $uname (keys(%allusers)) {
  266:         my %userdata = 
  267:             &Apache::lonnet::get('environment',['firstname','lastname',
  268:                 'middlename','generation','id','permanentemail'],$dom,$uname);
  269:         $userdata{'username'} = $uname;
  270:         $userdata{'domain'} = $dom;
  271:         my %alluserslog = 
  272:             &LONCAPA::lonmetadata::process_allusers_data($dbh,$simulate,
  273:                 \%newnames,$uname,$dom,\%userdata);
  274:         foreach my $item (keys(%alluserslog)) {
  275:             &log(0,$alluserslog{$item});
  276:         }
  277:     }
  278: }
  279: 
  280: #
  281: # Rename the tables
  282: if (! $simulate) {
  283:     foreach my $key (keys(%oldnames)) {
  284:         if (($oldnames{$key} ne '') && ($newnames{$key} ne '')) {
  285:             $dbh->do('DROP TABLE IF EXISTS '.$oldnames{$key});
  286:             if (! $dbh->do('RENAME TABLE '.$newnames{$key}.' TO '.$oldnames{$key})) {
  287:                 &log(0,"MySQL Error Rename: ".$dbh->errstr);
  288:                 die $dbh->errstr;
  289:             } else {
  290:                 &log(1,"MySQL table rename successful for $key.");
  291:             }
  292:         }
  293:     }
  294: }
  295: if (! $dbh->disconnect) {
  296:     &log(0,"MySQL Error Disconnect: ".$dbh->errstr);
  297:     die $dbh->errstr;
  298: }
  299: ##
  300: ## Finished!
  301: &log(0,"==== Searchcat completed ".localtime()." ====");
  302: close(LOG);
  303: 
  304: &write_type_count();
  305: &write_copyright_count();
  306: 
  307: exit 0;
  308: 
  309: ##
  310: ## Status logging routine.  Inputs: $level, $message
  311: ## 
  312: ## $level 0 should be used for normal output and error messages
  313: ##
  314: ## $message does not need to end with \n.  In the case of errors
  315: ## the message should contain as much information as possible to
  316: ## help in diagnosing the problem.
  317: ##
  318: sub log {
  319:     my ($level,$message)=@_;
  320:     $level = 0 if (! defined($level));
  321:     if ($verbose >= $level) {
  322:         print LOG $message.$/;
  323:     }
  324: }
  325: 
  326: sub portfolio_logging {
  327:     my (%portlog) = @_;
  328:     foreach my $key (keys(%portlog)) {
  329:         if (ref($portlog{$key}) eq 'HASH') {
  330:             foreach my $item (keys(%{$portlog{$key}})) {
  331:                 &log(0,$portlog{$key}{$item});
  332:             }
  333:         }
  334:     }
  335: }
  336: 
  337: sub descend_tree {
  338:     my ($dom,$dir,$depth,$allportusers,$alldomusers) = @_;
  339:     if (-d $dir) {
  340:         opendir(DIR,$dir);
  341:         my @contents = grep(!/^\./,readdir(DIR));
  342:         closedir(DIR);
  343:         $depth ++;
  344:         foreach my $item (@contents) {
  345:             if ($depth < 4) {
  346:                 &descend_tree($dom,$dir.'/'.$item,$depth,$allportusers,$alldomusers);
  347:             } else {
  348:                 if (-e $dir.'/'.$item.'/file_permissions.db') {
  349:                      $$allportusers{$item} = '';
  350:                 }
  351:                 if (!&Apache::lonnet::is_course($dom,$item)) { 
  352:                     $$alldomusers{$item} = '';
  353:                 }
  354:             }       
  355:         }
  356:     } 
  357: }
  358: 
  359: ########################################################
  360: ########################################################
  361: ###                                                  ###
  362: ###          File::Find support routines             ###
  363: ###                                                  ###
  364: ########################################################
  365: ########################################################
  366: ##
  367: ## &only_meta_files
  368: ##
  369: ## Called by File::Find.
  370: ## Takes a list of files/directories in and returns a list of files/directories
  371: ## to search.
  372: sub only_meta_files {
  373:     my @PossibleFiles = @_;
  374:     my @ChosenFiles;
  375:     foreach my $file (@PossibleFiles) {
  376:         if ( ($file =~ /\.meta$/ &&            # Ends in meta
  377:               $file !~ /\.\d+\.[^\.]+\.meta$/  # is not for a prior version
  378:              ) || (-d $File::Find::dir."/".$file )) { # directories are okay
  379:                  # but we do not want /. or /..
  380:             push(@ChosenFiles,$file);
  381:         }
  382:     }
  383:     return @ChosenFiles;
  384: }
  385: 
  386: ##
  387: ##
  388: ## Debugging routines, use these for 'wanted' in the File::Find call
  389: ##
  390: sub print_filename {
  391:     my ($file) = $_;
  392:     my $fullfilename = $File::Find::name;
  393:     if ($debug) {
  394:         if (-d $file) {
  395:             &log(5," Got directory ".$fullfilename);
  396:         } else {
  397:             &log(5," Got file ".$fullfilename);
  398:         }
  399:     }
  400:     $_=$file;
  401: }
  402: 
  403: sub log_metadata {
  404:     my ($file) = $_;
  405:     my $fullfilename = $File::Find::name;
  406:     return if (-d $fullfilename); # No need to do anything here for directories
  407:     if ($debug) {
  408:         &log(6,$fullfilename);
  409:         my $ref = &metadata($fullfilename);
  410:         if (! defined($ref)) {
  411:             &log(6,"    No data");
  412:             return;
  413:         }
  414:         while (my($key,$value) = each(%$ref)) {
  415:             &log(6,"    ".$key." => ".$value);
  416:         }
  417:         &count_copyright($ref->{'copyright'});
  418:     }
  419:     $_=$file;
  420: }
  421: 
  422: ##
  423: ## process_meta_file
  424: ##   Called by File::Find. 
  425: ##   Only input is the filename in $_.  
  426: sub process_meta_file {
  427:     my ($file) = $_;
  428:     my $filename = $File::Find::name; # full filename
  429:     return if (-d $filename); # No need to do anything here for directories
  430:     #
  431:     &log(3,$filename) if ($debug);
  432:     #
  433:     my $ref = &metadata($filename);
  434:     #
  435:     # $url is the original file url, not the metadata file
  436:     my $target = $filename;
  437:     $target =~ s/\.meta$//;
  438:     my $url='/res/'.&declutter($target);
  439:     &log(3,"    ".$url) if ($debug);
  440:     #
  441:     # Ignore some files based on their metadata
  442:     if ($ref->{'obsolete'}) { 
  443:         &log(3,"obsolete") if ($debug);
  444:         return; 
  445:     }
  446:     &count_copyright($ref->{'copyright'});
  447:     if ($ref->{'copyright'} eq 'private') { 
  448:         &log(3,"private") if ($debug);
  449:         return; 
  450:     }
  451:     #
  452:     # Find the dynamic metadata
  453:     my %dyn;
  454:     if ($url=~ m:/default$:) {
  455:         $url=~ s:/default$:/:;
  456:         &log(3,"Skipping dynamic data") if ($debug);
  457:     } else {
  458:         &log(3,"Retrieving dynamic data") if ($debug);
  459:         %dyn=&get_dynamic_metadata($url);
  460:         &count_type($url);
  461:     }
  462:     &LONCAPA::lonmetadata::getfiledates($ref,$target);
  463:     #
  464:     my %Data = (
  465:                 %$ref,
  466:                 %dyn,
  467:                 'url'=>$url,
  468:                 'version'=>'current');
  469:     if (! $simulate) {
  470:         my ($count,$err) = 
  471:           &LONCAPA::lonmetadata::store_metadata($dbh,$newnames{'metadata'},
  472:                                                 'metadata',\%Data);
  473:         if ($err) {
  474:             &log(0,"MySQL Error Insert: ".$err);
  475:         }
  476:         if ($count < 1) {
  477:             &log(0,"Unable to insert record into MySQL database for $url");
  478:         }
  479:     }
  480:     #
  481:     # Reset $_ before leaving
  482:     $_ = $file;
  483: }
  484: 
  485: ########################################################
  486: ########################################################
  487: ###                                                  ###
  488: ###  &metadata($uri)                                 ###
  489: ###   Retrieve metadata for the given file           ###
  490: ###                                                  ###
  491: ########################################################
  492: ########################################################
  493: sub metadata {
  494:     my ($uri) = @_;
  495:     my %metacache=();
  496:     $uri=&declutter($uri);
  497:     my $filename=$uri;
  498:     $uri=~s/\.meta$//;
  499:     $uri='';
  500:     if ($filename !~ /\.meta$/) { 
  501:         $filename.='.meta';
  502:     }
  503:     my $metastring = 
  504:         &LONCAPA::lonmetadata::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.'/res/'.$filename);
  505:     return undef if (! defined($metastring));
  506:     my $parser=HTML::TokeParser->new(\$metastring);
  507:     my $token;
  508:     while ($token=$parser->get_token) {
  509:         if ($token->[0] eq 'S') {
  510:             my $entry=$token->[1];
  511:             my $unikey=$entry;
  512:             if (defined($token->[2]->{'part'})) { 
  513:                 $unikey.='_'.$token->[2]->{'part'}; 
  514:             }
  515:             if (defined($token->[2]->{'name'})) { 
  516:                 $unikey.='_'.$token->[2]->{'name'}; 
  517:             }
  518:             if ($metacache{$uri.'keys'}) {
  519:                 $metacache{$uri.'keys'}.=','.$unikey;
  520:             } else {
  521:                 $metacache{$uri.'keys'}=$unikey;
  522:             }
  523:             foreach ( @{$token->[3]}) {
  524:                 $metacache{$uri.''.$unikey.'.'.$_}=$token->[2]->{$_};
  525:             }
  526:             if (! ($metacache{$uri.''.$unikey}=$parser->get_text('/'.$entry))){
  527:                 $metacache{$uri.''.$unikey} = 
  528:                     $metacache{$uri.''.$unikey.'.default'};
  529:             }
  530:         } # End of ($token->[0] eq 'S')
  531:     }
  532:     return \%metacache;
  533: }
  534: 
  535: ########################################################
  536: ########################################################
  537: ###                                                  ###
  538: ###    Dynamic Metadata                              ###
  539: ###                                                  ###
  540: ########################################################
  541: ########################################################
  542: ##
  543: ## Dynamic metadata description (incomplete)
  544: ##
  545: ## For a full description of all fields,
  546: ## see LONCAPA::lonmetadata
  547: ##
  548: ##   Field             Type
  549: ##-----------------------------------------------------------
  550: ##   count             integer
  551: ##   course            integer
  552: ##   course_list       comma separated list of course ids
  553: ##   avetries          real                                
  554: ##   avetries_list     comma separated list of real numbers
  555: ##   stdno             real
  556: ##   stdno_list        comma separated list of real numbers
  557: ##   usage             integer   
  558: ##   usage_list        comma separated list of resources
  559: ##   goto              scalar
  560: ##   goto_list         comma separated list of resources
  561: ##   comefrom          scalar
  562: ##   comefrom_list     comma separated list of resources
  563: ##   difficulty        real
  564: ##   difficulty_list   comma separated list of real numbers
  565: ##   sequsage          scalar
  566: ##   sequsage_list     comma separated list of resources
  567: ##   clear             real
  568: ##   technical         real
  569: ##   correct           real
  570: ##   helpful           real
  571: ##   depth             real
  572: ##   comments          html of all the comments made
  573: ##
  574: {
  575: 
  576: my %DynamicData;
  577: my %Counts;
  578: 
  579: sub process_dynamic_metadata {
  580:     my ($user,$dom) = @_;
  581:     undef(%DynamicData);
  582:     undef(%Counts);
  583:     #
  584:     my $prodir = &propath($dom,$user);
  585:     #
  586:     # Read in the dynamic metadata
  587:     my %evaldata;
  588:     if (! tie(%evaldata,'GDBM_File',
  589:               $prodir.'/nohist_resevaldata.db',&GDBM_READER(),0640)) {
  590:         return 0;
  591:     }
  592:     #
  593:     %DynamicData = &LONCAPA::lonmetadata::process_reseval_data(\%evaldata);
  594:     untie(%evaldata);
  595:     $DynamicData{'domain'} = $dom;
  596:     #print('user = '.$user.' domain = '.$dom.$/);
  597:     #
  598:     # Read in the access count data
  599:     &log(7,'Reading access count data') if ($debug);
  600:     my %countdata;
  601:     if (! tie(%countdata,'GDBM_File',
  602:               $prodir.'/nohist_accesscount.db',&GDBM_READER(),0640)) {
  603:         return 0;
  604:     }
  605:     while (my ($key,$count) = each(%countdata)) {
  606:         next if ($key !~ /^$dom/);
  607:         $key = &unescape($key);
  608:         &log(8,'    Count '.$key.' = '.$count) if ($debug);
  609:         $Counts{$key}=$count;
  610:     }
  611:     untie(%countdata);
  612:     if ($debug) {
  613:         &log(7,scalar(keys(%Counts)).
  614:              " Counts read for ".$user."@".$dom);
  615:         &log(7,scalar(keys(%DynamicData)).
  616:              " Dynamic metadata read for ".$user."@".$dom);
  617:     }
  618:     #
  619:     return 1;
  620: }
  621: 
  622: sub get_dynamic_metadata {
  623:     my ($url) = @_;
  624:     $url =~ s:^/res/::;
  625:     my %data = &LONCAPA::lonmetadata::process_dynamic_metadata($url,
  626:                                                                \%DynamicData);
  627:     # find the count
  628:     $data{'count'} = $Counts{$url};
  629:     #
  630:     # Log the dynamic metadata
  631:     if ($debug) {
  632:         while (my($k,$v)=each(%data)) {
  633:             &log(8,"    ".$k." => ".$v);
  634:         }
  635:     }
  636:     return %data;
  637: }
  638: 
  639: } # End of %DynamicData and %Counts scope
  640: 
  641: ########################################################
  642: ########################################################
  643: ###                                                  ###
  644: ###   Counts                                         ###
  645: ###                                                  ###
  646: ########################################################
  647: ########################################################
  648: {
  649: 
  650: my %countext;
  651: 
  652: sub count_type {
  653:     my $file=shift;
  654:     $file=~/\.(\w+)$/;
  655:     my $ext=lc($1);
  656:     $countext{$ext}++;
  657: }
  658: 
  659: sub write_type_count {
  660:     open(RESCOUNT,'>/home/httpd/html/lon-status/rescount.txt');
  661:     while (my ($extension,$count) = each(%countext)) {
  662: 	print RESCOUNT $extension.'='.$count.'&';
  663:     }
  664:     print RESCOUNT 'time='.time."\n";
  665:     close(RESCOUNT);
  666: }
  667: 
  668: } # end of scope for %countext
  669: 
  670: {
  671: 
  672: my %copyrights;
  673: 
  674: sub count_copyright {
  675:     $copyrights{@_[0]}++;
  676: }
  677: 
  678: sub write_copyright_count {
  679:     open(COPYCOUNT,'>/home/httpd/html/lon-status/copyrightcount.txt');
  680:     while (my ($copyright,$count) = each(%copyrights)) {
  681: 	print COPYCOUNT $copyright.'='.$count.'&';
  682:     }
  683:     print COPYCOUNT 'time='.time."\n";
  684:     close(COPYCOUNT);
  685: }
  686: 
  687: } # end of scope for %copyrights
  688: 
  689: ########################################################
  690: ########################################################
  691: ###                                                  ###
  692: ###   Miscellanous Utility Routines                  ###
  693: ###                                                  ###
  694: ########################################################
  695: ########################################################
  696: ##
  697: ## &ishome($username)
  698: ##   Returns 1 if $username is a LON-CAPA author, 0 otherwise
  699: ##   (copied from lond, modification of the return value)
  700: sub ishome {
  701:     my $author=shift;
  702:     $author=~s{/home/httpd/html/res/([^/]*)/([^/]*).*}{$1/$2};
  703:     my ($udom,$uname)=split(/\//,$author);
  704:     my $proname=propath($udom,$uname);
  705:     if (-e $proname) {
  706: 	return 1;
  707:     } else {
  708:         return 0;
  709:     }
  710: }
  711: 
  712: ##
  713: ## &declutter($filename)
  714: ##   Given a filename, returns a url for the filename.
  715: sub declutter {
  716:     my $thisfn=shift;
  717:     $thisfn=~s/^$Apache::lonnet::perlvar{'lonDocRoot'}//;
  718:     $thisfn=~s/^\///;
  719:     $thisfn=~s/^res\///;
  720:     return $thisfn;
  721: }
  722: