Diff for /loncom/metadata_database/searchcat.pl between versions 1.61 and 1.62

version 1.61, 2005/03/09 18:22:19 version 1.62, 2005/03/11 03:25:18
Line 77  use HTML::TokeParser; Line 77  use HTML::TokeParser;
 use GDBM_File;  use GDBM_File;
 use POSIX qw(strftime mktime);  use POSIX qw(strftime mktime);
   
   use Sys::Hostname;
   
 use File::Find;  use File::Find;
   
 #  #
 # Set up configuration options  # Set up configuration options
 my ($simulate,$oneuser,$help,$verbose,$logfile,$debug);  my ($simulate,$oneuser,$help,$verbose,$logfile,$debug,$multidom);
 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 100  Options: Line 103  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 173  if ($dbh->err) { Line 177  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;
 opendir(RESOURCES,"$perlvar{'lonDocRoot'}/res/$dom");  if (defined($multidom)) {
 my @homeusers =       &log(1,'====multi domain setup====');
     grep {      # Peek into the hosts.tab and look for matches of our hostname
         &ishome("$perlvar{'lonDocRoot'}/res/$dom/$_");      my $host = hostname();
     } grep {       &log(9,'hostname = "'.$host.'"');
         !/^\.\.?$/;      open(HOSTFILE,$perlvar{'lonTabDir'}.'/hosts.tab') || 
     } readdir(RESOURCES);          die ("Unable to determine domain(s) of multi-domain server");
 closedir RESOURCES;      my %domains;
 #      while (<HOSTFILE>) {
 if ($oneuser) {          next if (/^\#/);
     @homeusers=($oneuser);          next if (!/:\Q$host\E/);
 }          &log(9,$_);
 #          $domains{(split(':',$_))[1]}++;
 # Loop through the users      }
 foreach my $user (@homeusers) {      close HOSTFILE;
     &log(0,"=== User: ".$user);      @domains = sort(keys(%domains));
     &process_dynamic_metadata($user,$dom);      &log(9,join(',',@domains));
     #      if (! scalar(@domains)) {
     # Use File::Find to get the files we need to read/modify          die ("Unable to find any domains in the hosts.tab that match ".$host);
     find(      }
          {preprocess => \&only_meta_files,  } else {
 #          wanted     => \&print_filename,      push(@domains,$perlvar{'lonDefDomain'});
 #          wanted     => \&log_metadata,  }
           wanted     => \&process_meta_file,  
           },   foreach my $dom (@domains) {
          "$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}/$user");      &log(9,'domain = '.$dom);
       opendir(RESOURCES,"$perlvar{'lonDocRoot'}/res/$dom");
       my @homeusers = 
           grep {
               &ishome("$perlvar{'lonDocRoot'}/res/$dom/$_");
           } grep { 
               !/^\.\.?$/;
           } readdir(RESOURCES);
       closedir RESOURCES;
       &log(5,'users = '.$dom.':'.join(',',@homeusers));
       #
       if ($oneuser) {
           @homeusers=($oneuser);
       }
       #
       # Loop through the users
       foreach my $user (@homeusers) {
           &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,
                }, join('/',($perlvar{'lonDocRoot'},'res',$dom,$user)) );
       }
 }  }
 #  #
 # Rename the table  # Rename the table
Line 212  if (! $simulate) { Line 243  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 504  sub process_dynamic_metadata { Line 534  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 532  sub process_dynamic_metadata { Line 564  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

Removed from v.1.61  
changed lines
  Added in v.1.62


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