[BACK]Return to searchcat.pl CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / metadata_database

Diff for /loncom/metadata_database/searchcat.pl between versions 1.55 and 1.72

version 1.55, 2004/04/08 15:57:32 version 1.72, 2007/01/01 21:23:10
Line 65  and correct user experience. Line 65  and correct user experience.
 =cut  =cut
   
 use strict;  use strict;
   
 use DBI;  use DBI;
 use lib '/home/httpd/lib/perl/';  use lib '/home/httpd/lib/perl/';
 use LONCAPA::Configuration;  
 use LONCAPA::lonmetadata;  use LONCAPA::lonmetadata;
   
   use Getopt::Long;
 use IO::File;  use IO::File;
 use HTML::TokeParser;  use HTML::TokeParser;
 use GDBM_File;  use GDBM_File;
 use POSIX qw(strftime mktime);  use POSIX qw(strftime mktime);
   
   use Apache::lonnet();
   
 use File::Find;  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  ## Use variables for table names so we can test this routine a little easier
 my $oldname = 'metadata';  my %oldnames = (
 my $newname = 'newmetadata';                   'metadata'    => 'metadata',
                    'portfolio'   => 'portfolio_metadata',
                    'access'      => 'portfolio_access',
                    'addedfields' => 'portfolio_addedfields',
                  );
   
   my %newnames;
   # new table names -  append pid to have unique temporary tables
   foreach my $key (keys(%oldnames)) {
       $newnames{$key} = 'new'.$oldnames{$key}.$$;
   }
   
 #  #
 # Read loncapa_apache.conf and loncapa.conf  
 my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');  
 my %perlvar=%{$perlvarref};  
 undef $perlvarref;  
 delete $perlvar{'lonReceipt'}; # remove since sensitive (really?) & not needed  
 #  
 # Only run if machine is a library server  # Only run if machine is a library server
 exit if ($perlvar{'lonRole'} ne 'library');  exit if ($Apache::lonnet::perlvar{'lonRole'} ne 'library');
 #  #
 #  Make sure this process is running from user=www  #  Make sure this process is running from user=www
 my $wwwid=getpwnam('www');  my $wwwid=getpwnam('www');
 if ($wwwid!=$<) {  if ($wwwid!=$<) {
     my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";      my $emailto="$Apache::lonnet::perlvar{'lonAdmEMail'},$Apache::lonnet::perlvar{'lonSysEMail'}";
     my $subj="LON: $perlvar{'lonHostID'} User ID mismatch";      my $subj="LON: $Apache::lonnet::perlvar{'lonHostID'} User ID mismatch";
     system("echo 'User ID mismatch. searchcat.pl must be run as user www.' |\      system("echo 'User ID mismatch. searchcat.pl must be run as user www.' |\
  mailto $emailto -s '$subj' > /dev/null");   mail -s '$subj' $emailto > /dev/null");
     exit 1;      exit 1;
 }  }
 #  #
 # Let people know we are running  # Let people know we are running
 open(LOG,'>'.$perlvar{'lonDaemons'}.'/logs/searchcat.log');  open(LOG,'>>'.$Apache::lonnet::perlvar{'lonDaemons'}.'/logs/searchcat.log');
 print LOG '==== Searchcat Run '.localtime()."====\n";  &log(0,'==== Searchcat Run '.localtime()."====");
   
   
   if ($debug) {
       &log(0,'simulating') if ($simulate);
       &log(0,'only processing user '.$oneuser) if ($oneuser);
       &log(0,'verbosity level = '.$verbose);
   }
 #  #
 # Connect to database  # Connect to database
 my $dbh;  my $dbh;
 if (! ($dbh = DBI->connect("DBI:mysql:loncapa","www",$perlvar{'lonSqlAccess'},  if (! ($dbh = DBI->connect("DBI:mysql:loncapa","www",$Apache::lonnet::perlvar{'lonSqlAccess'},
                           { RaiseError =>0,PrintError=>0}))) {                            { RaiseError =>0,PrintError=>0}))) {
     print LOG "Cannot connect to database!\n";      &log(0,"Cannot connect to database!");
     die "MySQL Error: Cannot connect to database!\n";      die "MySQL Error: Cannot connect to database!\n";
 }  }
 # This can return an error and still be okay, so we do not bother checking.  # 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)  # (perhaps it should be more robust and check for specific errors)
 $dbh->do('DROP TABLE IF EXISTS '.$newname);  foreach my $key (keys(%newnames)) {
       if ($newnames{$key} ne '') {
           $dbh->do('DROP TABLE IF EXISTS '.$newnames{$key});
       }
   }
   
 #  #
 # Create the new table  # Create the new metadata and portfolio tables
 my $request = &LONCAPA::lonmetadata::create_metadata_storage($newname);  foreach my $key (keys(%newnames)) {
 $dbh->do($request);      if ($newnames{$key} ne '') { 
 if ($dbh->err) {          my $request =
     $dbh->disconnect();               &LONCAPA::lonmetadata::create_metadata_storage($newnames{$key},$oldnames{$key});
     print LOG "\nMySQL Error Create: ".$dbh->errstr."\n";          $dbh->do($request);
     die $dbh->errstr;          if ($dbh->err) {
               $dbh->disconnect();
               &log(0,"MySQL Error Create: ".$dbh->errstr);
               die $dbh->errstr;
           }
       }
 }  }
   
 #  #
 # find out which users we need to examine  # find out which users we need to examine
 opendir(RESOURCES,"$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}");  my @domains = sort(&Apache::lonnet::current_machine_domains());
 my @homeusers =   &log(9,'domains ="'.join('","',@domains).'"');
     grep {  
         &ishome("$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}/$_");  foreach my $dom (@domains) {
     } grep {       &log(9,'domain = '.$dom);
         !/^\.\.?$/;      opendir(RESOURCES,"$Apache::lonnet::perlvar{'lonDocRoot'}/res/$dom");
     } readdir(RESOURCES);      my @homeusers = 
 closedir RESOURCES;          grep {
 #              &ishome("$Apache::lonnet::perlvar{'lonDocRoot'}/res/$dom/$_");
 # Loop through the users          } grep { 
 foreach my $user (@homeusers) {              !/^\.\.?$/;
     print LOG "=== User: ".$user."\n";          } readdir(RESOURCES);
     my $prodir=&propath($perlvar{'lonDefDomain'},$user);      closedir RESOURCES;
     #      &log(5,'users = '.$dom.':'.join(',',@homeusers));
     # Use File::Find to get the files we need to read/modify      #
     find(      if ($oneuser) {
          {preprocess => \&only_meta_files,          @homeusers=($oneuser);
 #          wanted     => \&print_filename,      }
 #          wanted     => \&log_metadata,      #
           wanted     => \&process_meta_file,      # Loop through the users
           },       foreach my $user (@homeusers) {
          "$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}/$user");          &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,
                 no_chdir   => 1,
                }, join('/',($Apache::lonnet::perlvar{'lonDocRoot'},'res',$dom,$user)) );
       }
       # Search for public portfolio files
       my %portusers;
       if ($oneuser) {
           %portusers = (
                           $oneuser => '',
                          );
       } else {
           my $dir = $Apache::lonnet::perlvar{lonUsersDir}.'/'.$dom;
           &descend_tree($dir,0,\%portusers);
       }
       foreach my $uname (keys(%portusers)) {
           my $urlstart = '/uploaded/'.$dom.'/'.$uname;
           my $pathstart = &propath($dom,$uname).'/userfiles';
           my $is_course = &Apache::lonnet::is_course($dom,$uname);
           my $curr_perm = &Apache::lonnet::get_portfile_permissions($dom,$uname);
           my %access = &Apache::lonnet::get_access_controls($curr_perm);
           foreach my $file (keys(%access)) { 
               my ($group,$url,$fullpath);
               if ($is_course) {
                   ($group, my ($path)) = ($file =~ /^(\w+)(\/.+)$/);
                   $fullpath = $pathstart.'/groups/'.$group.'/portfolio'.$path;
                   $url = $urlstart.'/groups/'.$group.'/portfolio'.$path;
               } else {
                   $fullpath = $pathstart.'/portfolio'.$file;
                   $url = $urlstart.'/portfolio'.$file;
               }
               if (ref($access{$file}) eq 'HASH') {
                   &process_portfolio_access_data($url,$access{$file});
               }
               &process_portfolio_metadata($url,$fullpath,$is_course,$dom,
                                           $uname,$group);
           }
       }
 }  }
   
 #  #
 # Rename the table  # Rename the tables
 $dbh->do('DROP TABLE IF EXISTS '.$oldname);  if (! $simulate) {
 if (! $dbh->do('RENAME TABLE '.$newname.' TO '.$oldname)) {      foreach my $key (keys(%oldnames)) {
     print LOG "MySQL Error Rename: ".$dbh->errstr."\n";          if (($oldnames{$key} ne '') && ($newnames{$key} ne '')) {
     die $dbh->errstr;              $dbh->do('DROP TABLE IF EXISTS '.$oldnames{$key});
               if (! $dbh->do('RENAME TABLE '.$newnames{$key}.' TO '.$oldnames{$key})) {
                   &log(0,"MySQL Error Rename: ".$dbh->errstr);
                   die $dbh->errstr;
               } else {
                   &log(1,"MySQL table rename successful for $key.");
               }
           }
       }
 }  }
 if (! $dbh->disconnect) {  if (! $dbh->disconnect) {
     print LOG "MySQL Error Disconnect: ".$dbh->errstr."\n";      &log(0,"MySQL Error Disconnect: ".$dbh->errstr);
     die $dbh->errstr;      die $dbh->errstr;
 }  }
 ##  ##
 ## Finished!  ## Finished!
 print LOG "==== Searchcat completed ".localtime()." ====\n";  &log(0,"==== Searchcat completed ".localtime()." ====");
 close(LOG);  close(LOG);
   
 &write_type_count();  &write_type_count();
Line 171  close(LOG); Line 285  close(LOG);
   
 exit 0;  exit 0;
   
   ##
   ## 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.$/;
       }
   }
   
   sub descend_tree {
       my ($dir,$depth,$alldomusers) = @_;
       if (-d $dir) {
           opendir(DIR,$dir);
           my @contents = grep(!/^\./,readdir(DIR));
           closedir(DIR);
           $depth ++;
           foreach my $item (@contents) {
               if ($depth < 4) {
                   &descend_tree($dir.'/'.$item,$depth,$alldomusers);
               } else {
                   if (-e $dir.'/'.$item.'/file_permissions.db') {
                    
                       $$alldomusers{$item} = '';
                   }
               }       
           }
       } 
   }
   
   sub process_portfolio_access_data {
       my ($url,$access_hash) = @_;
       foreach my $key (keys(%{$access_hash})) {
           my $acc_data;
           $acc_data->{url} = $url;
           $acc_data->{keynum} = $key;
           my ($num,$scope,$end,$start) =
                           ($key =~ /^([^:]+):([a-z]+)_(\d*)_?(\d*)$/);
           $acc_data->{scope} = $scope;
           if ($end != 0) {
               $acc_data->{end} = &LONCAPA::lonmetadata::sqltime($end);
           }
           $acc_data->{start} = &LONCAPA::lonmetadata::sqltime($start);
           if (! $simulate) {
               my ($count,$err) =
                 &LONCAPA::lonmetadata::store_metadata($dbh,
                                                   $newnames{'access'},
                                                   'portfolio_access',$acc_data);
               if ($err) {
                   &log(0,"MySQL Error Insert: ".$err);
               }
               if ($count < 1) {
                   &log(0,"Unable to insert record into MySQL database for $url");
               }
           }
       }
   }
   
   sub process_portfolio_metadata {
       my ($url,$fullpath,$is_course,$dom,$uname,$group) = @_;
       my ($ref,$crs,$addedfields) = &portfolio_metadata($fullpath,$dom,$uname,
                                                         $group);
       &getfiledates($ref,$fullpath);
       if ($is_course) {
           $ref->{'groupname'} = $group;
       }
       my %Data;
       if (ref($ref) eq 'HASH') {
           %Data = %{$ref};
       }
       %Data = (
                %Data,
                'url'=>$url,
                'version'=>'current',
       );
       if (! $simulate) {
           my ($count,$err) =
            &LONCAPA::lonmetadata::store_metadata($dbh,
                                                  $newnames{'portfolio'},
                                                  'portfolio_metadata',\%Data);
           if ($err) {
               &log(0,"MySQL Error Insert: ".$err);
           }
           if ($count < 1) {
               &log(0,"Unable to insert record into MySQL portfolio_metadata database table for $url");
           }
           if (ref($addedfields) eq 'HASH') {
               if (keys(%{$addedfields}) > 0) {
                   foreach my $key (keys(%{$addedfields})) {
                       my $added_data = {
                                   'url'   => $url,
                                   'field' => $key,
                                   'value' => $addedfields->{$key},
                                   'courserestricted' => $crs,
                       };
                       ($count,$err) = &LONCAPA::lonmetadata::store_metadata($dbh,
                                               $newnames{'addedfields'},
                                               'portfolio_addedfields',
                                               $added_data);
                       if ($err) {
                           &log(0,"MySQL Error Insert: ".$err);
                       }
                       if ($count < 1) {
                           &log(0,"Unable to insert record into MySQL portfolio_addedfields database table for url = $url and field = $key");
                       }
                   }
               }
           }
       }
       return;
   }
   
 ########################################################  ########################################################
 ########################################################  ########################################################
 ###                                                  ###  ###                                                  ###
Line 190  sub only_meta_files { Line 423  sub only_meta_files {
     foreach my $file (@PossibleFiles) {      foreach my $file (@PossibleFiles) {
         if ( ($file =~ /\.meta$/ &&            # Ends in meta          if ( ($file =~ /\.meta$/ &&            # Ends in meta
               $file !~ /\.\d+\.[^\.]+\.meta$/  # is not for a prior version                $file !~ /\.\d+\.[^\.]+\.meta$/  # is not for a prior version
              ) || (-d $file )) { # directories are okay               ) || (-d $File::Find::dir."/".$file )) { # directories are okay
                  # but we do not want /. or /..                   # but we do not want /. or /..
             push(@ChosenFiles,$file);              push(@ChosenFiles,$file);
         }          }
Line 205  sub only_meta_files { Line 438  sub only_meta_files {
 sub print_filename {  sub print_filename {
     my ($file) = $_;      my ($file) = $_;
     my $fullfilename = $File::Find::name;      my $fullfilename = $File::Find::name;
     if (-d $file) {      if ($debug) {
         print LOG " Got directory ".$fullfilename."\n";          if (-d $file) {
     } else {              &log(5," Got directory ".$fullfilename);
         print LOG " Got file ".$fullfilename."\n";          } else {
               &log(5," Got file ".$fullfilename);
           }
     }      }
     $_=$file;      $_=$file;
 }  }
Line 217  sub log_metadata { Line 452  sub log_metadata {
     my ($file) = $_;      my ($file) = $_;
     my $fullfilename = $File::Find::name;      my $fullfilename = $File::Find::name;
     return if (-d $fullfilename); # No need to do anything here for directories      return if (-d $fullfilename); # No need to do anything here for directories
     print LOG $fullfilename."\n";      if ($debug) {
     my $ref=&metadata($fullfilename);          &log(6,$fullfilename);
     if (! defined($ref)) {          my $ref = &metadata($fullfilename);
         print LOG "    No data\n";          if (! defined($ref)) {
         return;              &log(6,"    No data");
     }              return;
     while (my($key,$value) = each(%$ref)) {          }
         print LOG "    ".$key." => ".$value."\n";          while (my($key,$value) = each(%$ref)) {
               &log(6,"    ".$key." => ".$value);
           }
           &count_copyright($ref->{'copyright'});
     }      }
     &count_copyright($ref->{'copyright'});  
     $_=$file;      $_=$file;
 }  }
   
   
 ##  ##
 ## process_meta_file  ## process_meta_file
 ##   Called by File::Find.   ##   Called by File::Find. 
 ##   Only input is the filename in $_.    ##   Only input is the filename in $_.  
 sub process_meta_file {  sub process_meta_file {
     my ($file) = $_;      my ($file) = $_;
     my $filename = $File::Find::name;      my $filename = $File::Find::name; # full filename
     return if (-d $filename); # No need to do anything here for directories      return if (-d $filename); # No need to do anything here for directories
     #      #
     print LOG $filename."\n";      &log(3,$filename) if ($debug);
     #      #
     my $ref=&metadata($filename);      my $ref = &metadata($filename);
     #      #
     # $url is the original file url, not the metadata file      # $url is the original file url, not the metadata file
     my $url='/res/'.&declutter($filename);      my $target = $filename;
     $url=~s/\.meta$//;      $target =~ s/\.meta$//;
     print LOG "    ".$url."\n";      my $url='/res/'.&declutter($target);
       &log(3,"    ".$url) if ($debug);
     #      #
     # Ignore some files based on their metadata      # Ignore some files based on their metadata
     if ($ref->{'obsolete'}) {       if ($ref->{'obsolete'}) { 
         print LOG "obsolete\n";           &log(3,"obsolete") if ($debug);
         return;           return; 
     }      }
     &count_copyright($ref->{'copyright'});      &count_copyright($ref->{'copyright'});
     if ($ref->{'copyright'} eq 'private') {       if ($ref->{'copyright'} eq 'private') { 
         print LOG "private\n";           &log(3,"private") if ($debug);
         return;           return; 
     }      }
     #      #
Line 264  sub process_meta_file { Line 501  sub process_meta_file {
     my %dyn;      my %dyn;
     if ($url=~ m:/default$:) {      if ($url=~ m:/default$:) {
         $url=~ s:/default$:/:;          $url=~ s:/default$:/:;
           &log(3,"Skipping dynamic data") if ($debug);
     } else {      } else {
         # %dyn=&dynamicmeta($url);          &log(3,"Retrieving dynamic data") if ($debug);
           %dyn=&get_dynamic_metadata($url);
         &count_type($url);          &count_type($url);
     }      }
       &getfiledates($ref,$target);
     #      #
     $ref->{'creationdate'}     = &sqltime($ref->{'creationdate'});  
     $ref->{'lastrevisiondate'} = &sqltime($ref->{'lastrevisiondate'});  
     my %Data = (      my %Data = (
                 %$ref,                  %$ref,
                 %dyn,                  %dyn,
                 'url'=>$url,                  'url'=>$url,
                 'version'=>'current');                  'version'=>'current');
     my ($count,$err) = &LONCAPA::lonmetadata::store_metadata($dbh,$newname,      if (! $simulate) {
                                                              \%Data);          my ($count,$err) = 
     if ($err) {            &LONCAPA::lonmetadata::store_metadata($dbh,$newnames{'metadata'},
         print LOG "\nMySQL Error Insert: ".$err."\n";                                                  'metadata',\%Data);
         die $err;          if ($err) {
     }              &log(0,"MySQL Error Insert: ".$err);
     if ($count < 1) {          }
         print LOG "Unable to insert record into MySQL database for $url\n";          if ($count < 1) {
         die "Unable to insert record into MySQl database for $url";              &log(0,"Unable to insert record into MySQL database for $url");
     } else {          }
         print LOG "Count = ".$count."\n";  
     }      }
     #      #
     # Reset $_ before leaving      # Reset $_ before leaving
Line 302  sub process_meta_file { Line 539  sub process_meta_file {
 ########################################################  ########################################################
 ########################################################  ########################################################
 sub metadata {  sub metadata {
     my ($uri)=@_;      my ($uri) = @_;
     my %metacache=();      my %metacache=();
     $uri=&declutter($uri);      $uri=&declutter($uri);
     my $filename=$uri;      my $filename=$uri;
Line 311  sub metadata { Line 548  sub metadata {
     if ($filename !~ /\.meta$/) {       if ($filename !~ /\.meta$/) { 
         $filename.='.meta';          $filename.='.meta';
     }      }
     my $metastring=&getfile($perlvar{'lonDocRoot'}.'/res/'.$filename);      my $metastring=&getfile($Apache::lonnet::perlvar{'lonDocRoot'}.'/res/'.$filename);
     return undef if (! defined($metastring));      return undef if (! defined($metastring));
     my $parser=HTML::TokeParser->new(\$metastring);      my $parser=HTML::TokeParser->new(\$metastring);
     my $token;      my $token;
Line 332  sub metadata { Line 569  sub metadata {
             }              }
             foreach ( @{$token->[3]}) {              foreach ( @{$token->[3]}) {
                 $metacache{$uri.''.$unikey.'.'.$_}=$token->[2]->{$_};                  $metacache{$uri.''.$unikey.'.'.$_}=$token->[2]->{$_};
             }               }
             if (! ($metacache{$uri.''.$unikey}=$parser->get_text('/'.$entry))){              if (! ($metacache{$uri.''.$unikey}=$parser->get_text('/'.$entry))){
                 $metacache{$uri.''.$unikey} =                   $metacache{$uri.''.$unikey} = 
                     $metacache{$uri.''.$unikey.'.default'};                      $metacache{$uri.''.$unikey.'.default'};
Line 342  sub metadata { Line 579  sub metadata {
     return \%metacache;      return \%metacache;
 }  }
   
   ###############################################################
   ###############################################################
   ###                                                         ###
   ###  &portfolio_metadata($filepath,$dom,$uname,$group) ###
   ###   Retrieve metadata for the given file                  ###
   ###   Returns array -                                       ###
   ###      contains reference to metadatahash and             ###
   ###         optional reference to addedfields hash          ###
   ###                                                         ###
   ###############################################################
   ###############################################################
   sub portfolio_metadata {
       my ($fullpath,$dom,$uname,$group)=@_;
       my ($mime) = ( $fullpath=~/\.(\w+)$/ );
       my %metacache=();
       if ($fullpath !~ /\.meta$/) {
           $fullpath .= '.meta';
       }
       my (@standard_fields,%addedfields);
       my $colsref = 
          $LONCAPA::lonmetadata::Portfolio_metadata_table_description;
       if (ref($colsref) eq 'ARRAY') {
           my @columns = @{$colsref};
           foreach my $coldata (@columns) {
               push(@standard_fields,$coldata->{'name'});
           }
       }
       my $metastring=&getfile($fullpath);
       if (! defined($metastring)) {
           $metacache{'keys'}= 'owner,domain,mime';
           $metacache{'owner'} = $uname.':'.$dom;
           $metacache{'domain'} = $dom;
           $metacache{'mime'} = $mime;
           if (defined($group)) {
               $metacache{'keys'} .= ',courserestricted';
               $metacache{'courserestricted'} = 'course.'.$dom.'_'.$uname;
           } 
       } else {
           my $parser=HTML::TokeParser->new(\$metastring);
           my $token;
           while ($token=$parser->get_token) {
               if ($token->[0] eq 'S') {
                   my $entry=$token->[1];
                   if ($metacache{'keys'}) {
                       $metacache{'keys'}.=','.$entry;
                   } else {
                       $metacache{'keys'}=$entry;
                   }
                   my $value = $parser->get_text('/'.$entry);
                   if (!grep(/^\Q$entry\E$/,@standard_fields)) {
                       my $clean_value = lc($value);
                       $clean_value =~ s/\s/_/g;
                       if ($clean_value ne $entry) {
                           if (defined($addedfields{$entry})) {
                               $addedfields{$entry} .=','.$value;
                           } else {
                               $addedfields{$entry} = $value;
                           }
                       }
                   } else {
                       $metacache{$entry} = $value;
                   }
               }
           } # End of ($token->[0] eq 'S')
       }
       if (keys(%addedfields) > 0) {
           foreach my $key (sort keys(%addedfields)) {
               $metacache{'addedfieldnames'} .= $key.',';
               $metacache{'addedfieldvalues'} .= $addedfields{$key}.'&&&';
           }
           $metacache{'addedfieldnames'} =~ s/,$//;
           $metacache{'addedfieldvalues'} =~ s/\&\&\&$//;
           if ($metacache{'keys'}) {
               $metacache{'keys'}.=',addedfieldnames';
           } else {
               $metacache{'keys'}='addedfieldnames';
           }
           $metacache{'keys'}.=',addedfieldvalues';
       }
       return (\%metacache,$metacache{'courserestricted'},\%addedfields);
   }
   
 ##  ##
 ## &getfile($filename)  ## &getfile($filename)
 ##   Slurps up an entire file into a scalar.    ##   Slurps up an entire file into a scalar.  
Line 359  sub getfile { Line 678  sub getfile {
     return $contents;      return $contents;
 }  }
   
   ##
   ## &getfiledates() 
   ## Converts creationdate and modifieddates to SQL format 
   ## Applies stat() to file to retrieve dates if missing
   sub getfiledates {
       my ($ref,$target) = @_;
       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'}     = 
           &LONCAPA::lonmetadata::sqltime($ref->{'creationdate'});
       $ref->{'lastrevisiondate'} = 
           &LONCAPA::lonmetadata::sqltime($ref->{'lastrevisiondate'});
   }
   
 ########################################################  ########################################################
 ########################################################  ########################################################
 ###                                                  ###  ###                                                  ###
Line 366  sub getfile { Line 705  sub getfile {
 ###                                                  ###  ###                                                  ###
 ########################################################  ########################################################
 ########################################################  ########################################################
 sub dynamicmeta {  ##
     my $url = &declutter(shift());  ## Dynamic metadata description (incomplete)
     $url =~ s/\.meta$//;  ##
     my %data = ('count'         => 0,  ## For a full description of all fields,
                 'course'        => 0,  ## see LONCAPA::lonmetadata
                 'course_list'   => '',  ##
                 'avetries'      => 'NULL',  ##   Field             Type
                 'avetries_list' => '',  ##-----------------------------------------------------------
                 'stdno'         => 0,  ##   count             integer
                 'stdno_list'    => '',  ##   course            integer
                 'usage'         => 0,  ##   course_list       comma separated list of course ids
                 'usage_list'    => '',  ##   avetries          real                                
                 'goto'          => 0,  ##   avetries_list     comma separated list of real numbers
                 'goto_list'     => '',  ##   stdno             real
                 'comefrom'      => 0,  ##   stdno_list        comma separated list of real numbers
                 'comefrom_list' => '',  ##   usage             integer   
                 'difficulty'    => 'NULL',  ##   usage_list        comma separated list of resources
                 'difficulty_list' => '',  ##   goto              scalar
                 'sequsage'      => '0',  ##   goto_list         comma separated list of resources
                 'sequsage_list' => '',  ##   comefrom          scalar
                 'clear'         => 'NULL',  ##   comefrom_list     comma separated list of resources
                 'technical'     => 'NULL',  ##   difficulty        real
                 'correct'       => 'NULL',  ##   difficulty_list   comma separated list of real numbers
                 'helpful'       => 'NULL',  ##   sequsage          scalar
                 'depth'         => 'NULL',  ##   sequsage_list     comma separated list of resources
                 'comments'      => '',                  ##   clear             real
                 );  ##   technical         real
     my ($dom,$auth)=($url=~/^(\w+)\/(\w+)\//);  ##   correct           real
     my $prodir=&propath($dom,$auth);  ##   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);
     #      #
     # Get metadata except counts      # Read in the dynamic metadata
     my %evaldata;      my %evaldata;
     if (! tie(%evaldata,'GDBM_File',      if (! tie(%evaldata,'GDBM_File',
               $prodir.'/nohist_resevaldata.db',&GDBM_READER(),0640)) {                $prodir.'/nohist_resevaldata.db',&GDBM_READER(),0640)) {
         return (undef);          return 0;
     }  
     my %sum=();  
     my %count=();  
     my %concat=();  
     my %listitems=(  
                    'course'       => 'add',  
                    'goto'         => 'add',  
                    'comefrom'     => 'add',  
                    'avetries'     => 'average',  
                    'stdno'        => 'add',  
                    'difficulty'   => 'average',  
                    'clear'        => 'average',  
                    'technical'    => 'average',  
                    'helpful'      => 'average',  
                    'correct'      => 'average',  
                    'depth'        => 'average',  
                    'comments'     => 'append',  
                    'usage'        => 'count'  
                    );  
     #  
     my $regexp=$url;  
     $regexp=~s/(\W)/\\$1/g;  
     $regexp='___'.$regexp.'___([a-z]+)$';  
     while (my ($esckey,$value)=each %evaldata) {  
         my $key=&unescape($esckey);  
         if ($key=~/$regexp/) {  
             my ($item,$purl,$cat)=split(/___/,$key);  
             $count{$cat}++;  
             if ($listitems{$cat} ne 'append') {  
                 if (defined($sum{$cat})) {  
                     $sum{$cat}+=&unescape($value);  
                     $concat{$cat}.=','.$item;  
                 } else {  
                     $sum{$cat}=&unescape($value);  
                     $concat{$cat}=$item;  
                 }  
             } else {  
                 if (defined($sum{$cat})) {  
                     if ($evaldata{$esckey}=~/\w/) {  
                         $sum{$cat}.='<hr />'.&unescape($evaldata{$esckey});  
                     }  
                 } else {  
                     $sum{$cat}=''.&unescape($evaldata{$esckey});  
     }  
             }  
         }  
     }      }
       #
       %DynamicData = &LONCAPA::lonmetadata::process_reseval_data(\%evaldata);
     untie(%evaldata);      untie(%evaldata);
     # transfer gathered data to returnhash, calculate averages where applicable      $DynamicData{'domain'} = $dom;
     my %returnhash;      #print('user = '.$user.' domain = '.$dom.$/);
     while (my $cat=each(%count)) {  
         if ($count{$cat} eq 'nan') { next; }  
         if ($sum{$cat} eq 'nan') { next; }  
         if ($listitems{$cat} eq 'average') {  
             if ($count{$cat}) {  
                 $returnhash{$cat}=int(($sum{$cat}/$count{$cat})*100.0+0.5)/100.0;  
             } else {  
                 $returnhash{$cat}='NULL';  
             }  
         } elsif ($listitems{$cat} eq 'count') {  
             $returnhash{$cat}=$count{$cat};  
         } else {  
             $returnhash{$cat}=$sum{$cat};  
         }  
         $returnhash{$cat.'_list'}=$concat{$cat};  
     }  
     #      #
     # get count      # Read in the access count data
     if (tie(my %evaldata,'GDBM_File',      &log(7,'Reading access count data') if ($debug);
             $prodir.'/nohist_accesscount.db',&GDBM_READER(),0640)) {      my %countdata;
  my $escurl=&escape($url);      if (! tie(%countdata,'GDBM_File',
  if (! exists($evaldata{$escurl})) {                $prodir.'/nohist_accesscount.db',&GDBM_READER(),0640)) {
     $returnhash{'count'}=0;          return 0;
  } else {      }
     $returnhash{'count'}=$evaldata{$escurl};      while (my ($key,$count) = each(%countdata)) {
  }          next if ($key !~ /^$dom/);
  untie %evaldata;          $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 %returnhash;      return %data;
 }  }
   
   } # End of %DynamicData and %Counts scope
   
 ########################################################  ########################################################
 ########################################################  ########################################################
 ###                                                  ###  ###                                                  ###
Line 563  sub propath { Line 885  sub propath {
     $uname=~s/\W//g;      $uname=~s/\W//g;
     my $subdir=$uname.'__';      my $subdir=$uname.'__';
     $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;      $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
     my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname";      my $proname="$Apache::lonnet::perlvar{'lonUsersDir'}/$udom/$subdir/$uname";
     return $proname;      return $proname;
 }   } 
   
 ##  ##
 ## &sqltime($timestamp)  
 ##  
 ## Convert perl $timestamp to MySQL time.  MySQL expects YYYY-MM-DD HH:MM:SS  
 ##  
 sub sqltime {  
     my ($time) = @_;  
     my $mysqltime;  
     if ($time =~   
         /(\d+)-(\d+)-(\d+) # YYYY-MM-DD  
         \s                 # a space  
         (\d+):(\d+):(\d+)  # HH:MM::SS  
         /x ) {   
         # Some of the .meta files have the time in mysql  
         # format already, so just make sure they are 0 padded and  
         # pass them back.  
         $mysqltime = sprintf('%04d-%02d-%02d %02d:%02d:%02d',  
                              $1,$2,$3,$4,$5,$6);  
     } elsif ($time =~ /^\d+$/) {  
         my @TimeData = gmtime($time);  
         # Alter the month to be 1-12 instead of 0-11  
         $TimeData[4]++;  
         # Alter the year to be from 0 instead of from 1900  
         $TimeData[5]+=1900;  
         $mysqltime = sprintf('%04d-%02d-%02d %02d:%02d:%02d',  
                              @TimeData[5,4,3,2,1,0]);  
     } else {  
         print LOG "    Unable to decode time ".$time."\n";  
         $mysqltime = 0;  
     }  
     return $mysqltime;  
 }  
   
 ##  
 ## &declutter($filename)  ## &declutter($filename)
 ##   Given a filename, returns a url for the filename.  ##   Given a filename, returns a url for the filename.
 sub declutter {  sub declutter {
     my $thisfn=shift;      my $thisfn=shift;
     $thisfn=~s/^$perlvar{'lonDocRoot'}//;      $thisfn=~s/^$Apache::lonnet::perlvar{'lonDocRoot'}//;
     $thisfn=~s/^\///;      $thisfn=~s/^\///;
     $thisfn=~s/^res\///;      $thisfn=~s/^res\///;
     return $thisfn;      return $thisfn;
Removed from v.1.55  
changed lines
  Added in v.1.72

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
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.