[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.62 and 1.63

version 1.62, 2005/03/11 03:25:18 version 1.63, 2005/03/21 20:36:11
Line 68  use strict; Line 68  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 Getopt::Long;
Line 77  use HTML::TokeParser; Line 76  use HTML::TokeParser;
 use GDBM_File;  use GDBM_File;
 use POSIX qw(strftime mktime);  use POSIX qw(strftime mktime);
   
 use Sys::Hostname;  use Apache::lonnet();
   
 use File::Find;  use File::Find;
   
 #  #
 # Set up configuration options  # Set up configuration options
 my ($simulate,$oneuser,$help,$verbose,$logfile,$debug,$multidom);  my ($simulate,$oneuser,$help,$verbose,$logfile,$debug);
 GetOptions (  GetOptions (
             'help'     => \$help,              'help'     => \$help,
             'simulate' => \$simulate,              'simulate' => \$simulate,
             'only=s'   => \$oneuser,              'only=s'   => \$oneuser,
             'verbose=s'  => \$verbose,              'verbose=s'  => \$verbose,
             'debug' => \$debug,              'debug' => \$debug,
             'multi_domain'  => \$multidom,  
             );              );
   
 if ($help) {  if ($help) {
Line 103  Options: Line 101  Options:
     -only=user     Only compute for the given user.  Implies -simulate         -only=user     Only compute for the given user.  Implies -simulate   
     -verbose=val   Sets logging level, val must be a number      -verbose=val   Sets logging level, val must be a number
     -debug         Turns on debugging output      -debug         Turns on debugging output
     -multi_domain  Parse the hosts.tab file domain(s) to use.  
 ENDHELP  ENDHELP
     exit 0;      exit 0;
 }  }
Line 126  my $oldname = 'metadata'; Line 123  my $oldname = 'metadata';
 my $newname = 'newmetadata'.$$; # append pid to have unique temporary table  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 158  if ($debug) { Line 149  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 177  if ($dbh->err) { Line 168  if ($dbh->err) {
 }  }
 #  #
 # find out which users we need to examine  # find out which users we need to examine
 my @domains;  my @domains = sort(&Apache::lonnet::current_machine_domains());
 if (defined($multidom)) {  &log(9,'domains ="'.join('","',@domains).'"');
     &log(1,'====multi domain setup====');  
     # Peek into the hosts.tab and look for matches of our hostname  
     my $host = hostname();  
     &log(9,'hostname = "'.$host.'"');  
     open(HOSTFILE,$perlvar{'lonTabDir'}.'/hosts.tab') ||   
         die ("Unable to determine domain(s) of multi-domain server");  
     my %domains;  
     while (<HOSTFILE>) {  
         next if (/^\#/);  
         next if (!/:\Q$host\E/);  
         &log(9,$_);  
         $domains{(split(':',$_))[1]}++;  
     }  
     close HOSTFILE;  
     @domains = sort(keys(%domains));  
     &log(9,join(',',@domains));  
     if (! scalar(@domains)) {  
         die ("Unable to find any domains in the hosts.tab that match ".$host);  
     }  
 } else {  
     push(@domains,$perlvar{'lonDefDomain'});  
 }  
   
 foreach my $dom (@domains) {  foreach my $dom (@domains) {
     &log(9,'domain = '.$dom);      &log(9,'domain = '.$dom);
     opendir(RESOURCES,"$perlvar{'lonDocRoot'}/res/$dom");      opendir(RESOURCES,"$Apache::lonnet::perlvar{'lonDocRoot'}/res/$dom");
     my @homeusers =       my @homeusers = 
         grep {          grep {
             &ishome("$perlvar{'lonDocRoot'}/res/$dom/$_");              &ishome("$Apache::lonnet::perlvar{'lonDocRoot'}/res/$dom/$_");
         } grep {           } grep { 
             !/^\.\.?$/;              !/^\.\.?$/;
         } readdir(RESOURCES);          } readdir(RESOURCES);
Line 229  foreach my $dom (@domains) { Line 198  foreach my $dom (@domains) {
               #wanted     => \&print_filename,                #wanted     => \&print_filename,
               #wanted     => \&log_metadata,                #wanted     => \&log_metadata,
               wanted     => \&process_meta_file,                wanted     => \&process_meta_file,
              }, join('/',($perlvar{'lonDocRoot'},'res',$dom,$user)) );               }, join('/',($Apache::lonnet::perlvar{'lonDocRoot'},'res',$dom,$user)) );
     }      }
 }  }
 #  #
Line 426  sub metadata { Line 395  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 661  sub propath { Line 630  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 705  sub sqltime { Line 674  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.62  
changed lines
  Added in v.1.63

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