[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.58 and 1.65

version 1.58, 2004/06/17 19:37:08 version 1.65, 2006/01/27 15:25:05
Line 65  and correct user experience. Line 65  and correct user experience.
 =cut  =cut
   
 use strict;  use strict;
   BEGIN {
       eval "use Apache2::compat();";
   };
 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 Getopt::Long;
Line 77  use HTML::TokeParser; Line 78  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;
   
 #  #
Line 119  if (defined($oneuser)) { Line 122  if (defined($oneuser)) {
 ##  ##
 ## 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 $oldname = 'metadata';
 my $newname = 'newmetadata';  my $newname = 'newmetadata'.$$; # append pid to have unique temporary table
   
 #  #
 # 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');
 &log(0,'==== Searchcat Run '.localtime()."====");  &log(0,'==== Searchcat Run '.localtime()."====");
   
   
Line 154  if ($debug) { Line 151  if ($debug) {
 #  #
 # 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}))) {
     &log(0,"Cannot connect to database!");      &log(0,"Cannot connect to database!");
     die "MySQL Error: Cannot connect to database!\n";      die "MySQL Error: Cannot connect to database!\n";
Line 173  if ($dbh->err) { Line 170  if ($dbh->err) {
 }  }
 #  #
 # find out which users we need to examine  # find out which users we need to examine
 my $dom = $perlvar{'lonDefDomain'};  my @domains = sort(&Apache::lonnet::current_machine_domains());
 opendir(RESOURCES,"$perlvar{'lonDocRoot'}/res/$dom");  &log(9,'domains ="'.join('","',@domains).'"');
 my @homeusers =   
     grep {  foreach my $dom (@domains) {
         &ishome("$perlvar{'lonDocRoot'}/res/$dom/$_");      &log(9,'domain = '.$dom);
     } grep {       opendir(RESOURCES,"$Apache::lonnet::perlvar{'lonDocRoot'}/res/$dom");
         !/^\.\.?$/;      my @homeusers = 
     } readdir(RESOURCES);          grep {
 closedir RESOURCES;              &ishome("$Apache::lonnet::perlvar{'lonDocRoot'}/res/$dom/$_");
 #          } grep { 
 if ($oneuser) {              !/^\.\.?$/;
     @homeusers=($oneuser);          } readdir(RESOURCES);
 }      closedir RESOURCES;
 #      &log(5,'users = '.$dom.':'.join(',',@homeusers));
 # Loop through the users      #
 foreach my $user (@homeusers) {      if ($oneuser) {
     &log(0,"=== User: ".$user);          @homeusers=($oneuser);
     &process_dynamic_metadata($user,$dom);      }
     #      #
     # Use File::Find to get the files we need to read/modify      # Loop through the users
     find(      foreach my $user (@homeusers) {
          {preprocess => \&only_meta_files,          &log(0,"=== User: ".$user);
 #          wanted     => \&print_filename,          &process_dynamic_metadata($user,$dom);
 #          wanted     => \&log_metadata,          #
           wanted     => \&process_meta_file,          # Use File::Find to get the files we need to read/modify
           },           find(
          "$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}/$user");               {preprocess => \&only_meta_files,
                 #wanted     => \&print_filename,
                 #wanted     => \&log_metadata,
                 wanted     => \&process_meta_file,
                }, join('/',($Apache::lonnet::perlvar{'lonDocRoot'},'res',$dom,$user)) );
       }
 }  }
 #  #
 # Rename the table  # Rename the table
Line 212  if (! $simulate) { Line 214  if (! $simulate) {
         &log(1,"MySQL table rename successful.");          &log(1,"MySQL table rename successful.");
     }      }
 }  }
   
 if (! $dbh->disconnect) {  if (! $dbh->disconnect) {
     &log(0,"MySQL Error Disconnect: ".$dbh->errstr);      &log(0,"MySQL Error Disconnect: ".$dbh->errstr);
     die $dbh->errstr;      die $dbh->errstr;
Line 321  sub process_meta_file { Line 322  sub process_meta_file {
     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$//;
       my $url='/res/'.&declutter($target);
     &log(3,"    ".$url) if ($debug);      &log(3,"    ".$url) if ($debug);
     #      #
     # Ignore some files based on their metadata      # Ignore some files based on their metadata
Line 347  sub process_meta_file { Line 349  sub process_meta_file {
         &count_type($url);          &count_type($url);
     }      }
     #      #
       if (! defined($ref->{'creationdate'}) ||
           $ref->{'creationdate'} =~ /^\s*$/) {
           $ref->{'creationdate'} = (stat($target))[9];
       }
       if (! defined($ref->{'lastrevisiondate'}) ||
           $ref->{'lastrevisiondate'} =~ /^\s*$/) {
           $ref->{'lastrevisiondate'} = (stat($target))[9];
       }
     $ref->{'creationdate'}     = &sqltime($ref->{'creationdate'});      $ref->{'creationdate'}     = &sqltime($ref->{'creationdate'});
     $ref->{'lastrevisiondate'} = &sqltime($ref->{'lastrevisiondate'});      $ref->{'lastrevisiondate'} = &sqltime($ref->{'lastrevisiondate'});
     my %Data = (      my %Data = (
Line 387  sub metadata { Line 397  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 495  sub process_dynamic_metadata { Line 505  sub process_dynamic_metadata {
     #      #
     %DynamicData = &LONCAPA::lonmetadata::process_reseval_data(\%evaldata);      %DynamicData = &LONCAPA::lonmetadata::process_reseval_data(\%evaldata);
     untie(%evaldata);      untie(%evaldata);
       $DynamicData{'domain'} = $dom;
       #print('user = '.$user.' domain = '.$dom.$/);
     #      #
     # Read in the access count data      # Read in the access count data
     &log(7,'Reading access count data') if ($debug);      &log(7,'Reading access count data') if ($debug);
Line 523  sub process_dynamic_metadata { Line 535  sub process_dynamic_metadata {
 sub get_dynamic_metadata {  sub get_dynamic_metadata {
     my ($url) = @_;      my ($url) = @_;
     $url =~ s:^/res/::;      $url =~ s:^/res/::;
     if (! exists($DynamicData{$url})) {  
         &log(7,'    No dynamic data for '.$url) if ($debug);  
         return ();  
     }  
     my %data = &LONCAPA::lonmetadata::process_dynamic_metadata($url,      my %data = &LONCAPA::lonmetadata::process_dynamic_metadata($url,
                                                                \%DynamicData);                                                                 \%DynamicData);
     # find the count      # find the count
Line 624  sub propath { Line 632  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;
 }   } 
   
Line 668  sub sqltime { Line 676  sub sqltime {
 ##   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.58  
changed lines
  Added in v.1.65

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