Diff for /loncom/metadata_database/searchcat.pl between versions 1.52 and 1.84

version 1.52, 2003/12/27 01:52:04 version 1.84, 2016/01/31 21:25:49
Line 65  and correct user experience. Line 65  and correct user experience.
 =cut  =cut
   
 use strict;  use strict;
   use DBI;
 use lib '/home/httpd/lib/perl/';  use lib '/home/httpd/lib/perl/';
 use LONCAPA::Configuration;  use LONCAPA::lonmetadata;
   use LONCAPA;
   use Getopt::Long;
 use IO::File;  use IO::File;
 use HTML::TokeParser;  use HTML::TokeParser;
 use DBI;  
 use GDBM_File;  use GDBM_File;
 use POSIX qw(strftime mktime);  use POSIX qw(strftime mktime);
   use Mail::Send;
   use Apache::loncommon();
   
 require "find.pl";  use Apache::lonnet();
   
 my @metalist;  
   
 my $simplestatus='';  use File::Find;
 my %countext=();  
   
 # ----------------------------------------------------- write out simple status  #
 sub writesimple {  # Set up configuration options
     open(SMP,'>/home/httpd/html/lon-status/mysql.txt');  my ($simulate,$oneuser,$help,$verbose,$logfile,$debug);
     print SMP $simplestatus."\n";  GetOptions (
     close(SMP);              'help'     => \$help,
 }              'simulate' => \$simulate,
               'only=s'   => \$oneuser,
 sub writecount {              'verbose=s'  => \$verbose,
     open(RSMP,'>/home/httpd/html/lon-status/rescount.txt');              'debug' => \$debug,
     foreach (keys %countext) {              );
  print RSMP $_.'='.$countext{$_}.'&';  
     }  if ($help) {
     print RSMP 'time='.time."\n";      print <<"ENDHELP";
     close(RSMP);  $0
 }  Rebuild and update the LON-CAPA metadata database. 
   Options:
 # -------------------------------------- counts files with different extensions      -help          Print this help
 sub count {      -simulate      Do not modify the database.
     my $file=shift;      -only=user     Only compute for the given user.  Implies -simulate   
     $file=~/\.(\w+)$/;      -verbose=val   Sets logging level, val must be a number
     my $ext=lc($1);      -debug         Turns on debugging output
     if (defined($countext{$ext})) {  ENDHELP
  $countext{$ext}++;      exit 0;
     } else {  }
  $countext{$ext}=1;  
     }  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
   my %oldnames = (
                    'metadata'    => 'metadata',
                    'portfolio'   => 'portfolio_metadata',
                    'access'      => 'portfolio_access',
                    'addedfields' => 'portfolio_addedfields',
                    'allusers'    => 'allusers',
                  );
   
   my %newnames;
   # new table names -  append pid to have unique temporary tables
   foreach my $key (keys(%oldnames)) {
       $newnames{$key} = 'new'.$oldnames{$key}.$$;
 }  }
 # ----------------------------------------------------- Un-Escape Special Chars  
   
 sub unescape {  
     my $str=shift;  
     $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;  
     return $str;  
 }  
   
 # -------------------------------------------------------- Escape Special Chars  
   
 sub escape {  
     my $str=shift;  
     $str =~ s/(\W)/"%".unpack('H2',$1)/eg;  
     return $str;  
 }  
   
 # ------------------------------------------- Code to evaluate dynamic metadata  
   
 sub dynamicmeta {  
     my $url=&declutter(shift);  
     $url=~s/\.meta$//;  
     my %returnhash=(  
     'count' => 0,  
     'course' => 0,  
     'course_list' => '',  
     'avetries' => 'NULL',  
     'avetries_list' => '',  
     'stdno' => 0,  
     'stdno_list' => '',  
     'usage' => 0,  
     'usage_list' => '',  
     'goto' => 0,  
     'goto_list' => '',  
     'comefrom' => 0,  
     'comefrom_list' => '',  
     'difficulty' => 'NULL',  
     'difficulty_list' => '',  
                     'clear' => 'NULL',  
                     'technical' => 'NULL',  
     'correct' => 'NULL',  
     'helpful' => 'NULL',  
     'depth' => 'NULL',  
     'comments' => ''  
     );  
     my ($adomain,$aauthor)=($url=~/^(\w+)\/(\w+)\//);  
     my $prodir=&propath($adomain,$aauthor);  
   
 # Get metadata except counts  
     if (tie(my %evaldata,'GDBM_File',  
             $prodir.'/nohist_resevaldata.db',&GDBM_READER(),0640)) {  
  my %sum=();  
  my %cnt=();  
  my %concat=();  
  my %listitems=(  
        'course'       => 'add',  
        'goto'         => 'add',  
        'comefrom'     => 'add',  
        'avetries'     => 'avg',  
        'stdno'        => 'add',  
        'difficulty'   => 'avg',  
        'clear'        => 'avg',  
        'technical'    => 'avg',  
        'helpful'      => 'avg',  
        'correct'      => 'avg',  
        'depth'        => 'avg',  
        'comments'     => 'app',  
        'usage'        => 'cnt'  
        );  
   
  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);  
  if (defined($cnt{$cat})) { $cnt{$cat}++; } else { $cnt{$cat}=1; }  
  unless ($listitems{$cat} eq 'app') {  
     if (defined($sum{$cat})) {  
  $sum{$cat}+=&unescape($evaldata{$esckey});  
  $concat{$cat}.=','.$item;  
     } else {  
  $sum{$cat}=&unescape($evaldata{$esckey});  
  $concat{$cat}=$item;  
     }  
  } else {  
     if (defined($sum{$cat})) {  
  if ($evaldata{$esckey}=~/\w/) {  
     $sum{$cat}.='<hr />'.&unescape($evaldata{$esckey});  
  }  
     } else {  
  $sum{$cat}=''.&unescape($evaldata{$esckey});  
     }  
  }  
     }  
  }  
  untie(%evaldata);  
 # transfer gathered data to returnhash, calculate averages where applicable  
  while (my $cat=each(%cnt)) {  
     if ($cnt{$cat} eq 'nan') { next; }  
     if ($sum{$cat} eq 'nan') { next; }  
     if ($listitems{$cat} eq 'avg') {  
  if ($cnt{$cat}) {  
     $returnhash{$cat}=int(($sum{$cat}/$cnt{$cat})*100.0+0.5)/100.0;  
  } else {  
     $returnhash{$cat}='NULL';  
  }  
     } elsif ($listitems{$cat} eq 'cnt') {  
  $returnhash{$cat}=$cnt{$cat};  
     } else {  
  $returnhash{$cat}=$sum{$cat};  
     }  
     $returnhash{$cat.'_list'}=$concat{$cat};  
  }  
     }  
 # get count  
     if (tie(my %evaldata,'GDBM_File',  
             $prodir.'/nohist_accesscount.db',&GDBM_READER(),0640)) {  
  my $escurl=&escape($url);  
  if (! exists($evaldata{$escurl})) {  
     $returnhash{'count'}=0;  
  } else {  
     $returnhash{'count'}=$evaldata{$escurl};  
  }  
  untie %evaldata;  
     }  
     return %returnhash;  
 }  
     
 # ---------------  Read loncapa_apache.conf and loncapa.conf and get variables  
 my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');  
 my %perlvar=%{$perlvarref};  
 undef $perlvarref;  
 delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed  
   
 # ------------------------------------- Only run if machine is a library server  #
 exit unless $perlvar{'lonRole'} eq 'library';  # Only run if machine is a library server
   exit if ($Apache::lonnet::perlvar{'lonRole'} ne 'library');
 # ----------------------------- Make sure this process is running from user=www  my $hostid = $Apache::lonnet::perlvar{'lonHostID'};
   
   #
   #  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
   open(LOG,'>>'.$Apache::lonnet::perlvar{'lonDaemons'}.'/logs/searchcat.log');
   &log(0,'==== Searchcat Run '.localtime()."====");
   
   
 # ---------------------------------------------------------- We are in business  if ($debug) {
       &log(0,'simulating') if ($simulate);
 open(LOG,'>'.$perlvar{'lonDaemons'}.'/logs/searchcat.log');      &log(0,'only processing user '.$oneuser) if ($oneuser);
 print LOG '==== Searchcat Run '.localtime()."====\n\n";      &log(0,'verbosity level = '.$verbose);
 $simplestatus='time='.time.'&';  }
   #
   # Connect to database
 my $dbh;  my $dbh;
 # ------------------------------------- Make sure that database can be accessed  if (! ($dbh = DBI->connect("DBI:mysql:loncapa","www",$Apache::lonnet::perlvar{'lonSqlAccess'},
 {                            { RaiseError =>0,PrintError=>0}))) {
     unless (      &log(0,"Cannot connect to database!");
     $dbh = DBI->connect("DBI:mysql:loncapa","www",$perlvar{'lonSqlAccess'},{ RaiseError =>0,PrintError=>0})      die "MySQL Error: Cannot connect to database!\n";
     ) {   }
  print LOG "Cannot connect to database!\n";  # This can return an error and still be okay, so we do not bother checking.
  $simplestatus.='mysql=defunct';  # (perhaps it should be more robust and check for specific errors)
  &writesimple();  foreach my $key (keys(%newnames)) {
  exit;      if ($newnames{$key} ne '') {
     }          $dbh->do('DROP TABLE IF EXISTS '.$newnames{$key});
   
 # Make temporary table  
     $dbh->do("DROP TABLE IF EXISTS newmetadata");  
     my $make_metadata_table = "CREATE TABLE IF NOT EXISTS newmetadata (".  
         "title TEXT, author TEXT, subject TEXT, url TEXT, keywords TEXT, ".  
         "version TEXT, notes TEXT, abstract TEXT, mime TEXT, language TEXT, ".  
         "creationdate DATETIME, lastrevisiondate DATETIME, owner TEXT, ".  
         "copyright TEXT, dependencies TEXT, ".  
  "modifyinguser TEXT, authorspace TEXT, ".  
  "lowestgradelevel INTEGER UNSIGNED, highestgradelevel INTEGER UNSIGNED, ".  
  "standards TEXT, ".  
         "count INTEGER UNSIGNED, ".  
         "course INTEGER UNSIGNED, course_list TEXT, ".  
         "goto INTEGER UNSIGNED, goto_list TEXT, ".  
         "comefrom INTEGER UNSIGNED, comefrom_list TEXT, ".  
         "sequsage INTEGER UNSIGNED, sequsage_list TEXT, ".  
         "stdno INTEGER UNSIGNED, stdno_list TEXT, ".  
  "avetries FLOAT, avetries_list TEXT, ".  
         "difficulty FLOAT, difficulty_list TEXT, ".  
  "clear FLOAT, technical FLOAT, correct FLOAT, helpful FLOAT, depth FLOAT, ".  
  "comments TEXT, ".  
   
         "FULLTEXT idx_title (title), ".  
         "FULLTEXT idx_author (author), FULLTEXT idx_subject (subject), ".  
         "FULLTEXT idx_url (url), FULLTEXT idx_keywords (keywords), ".  
         "FULLTEXT idx_notes (notes), ".  
         "FULLTEXT idx_abstract (abstract), FULLTEXT idx_mime (mime), ".  
         "FULLTEXT idx_owner (owner), ".  
  "FULLTEXT idx_standards (standards))".  
         "TYPE=MyISAM";  
     # It would sure be nice to have some logging mechanism.  
     unless ($dbh->do($make_metadata_table)) {  
  print LOG "\nMySQL Error Create: ".$dbh->errstr."\n";  
  die $dbh->errstr;  
     }      }
 }  }
   
 # ------------------------------------------------------------- get .meta files  #
 opendir(RESOURCES,"$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}");  # Create the new metadata, portfolio and allusers tables
 my @homeusers = grep {  foreach my $key (keys(%newnames)) {
     &ishome("$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}/$_")      if ($newnames{$key} ne '') { 
     } grep {!/^\.\.?$/} readdir(RESOURCES);          my $request =
 closedir RESOURCES;               &LONCAPA::lonmetadata::create_metadata_storage($newnames{$key},$oldnames{$key});
           $dbh->do($request);
           if ($dbh->err) {
               $dbh->disconnect();
               &log(0,"MySQL Error Create: ".$dbh->errstr);
               die $dbh->errstr;
           }
       }
   }
   
 #  #
 # Create the statement handlers we need  # find out which users we need to examine
   my @domains = sort(&Apache::lonnet::current_machine_domains());
   &log(9,'domains ="'.join('","',@domains).'"');
   
   foreach my $dom (@domains) {
       &log(9,'domain = '.$dom);
       opendir(RESOURCES,"$Apache::lonnet::perlvar{'lonDocRoot'}/res/$dom");
       my @homeusers = 
           grep {
               &ishome("$Apache::lonnet::perlvar{'lonDocRoot'}/res/$dom/$_");
           } grep { 
               !/^\.\.?$/;
           } readdir(RESOURCES);
       closedir RESOURCES;
       &log(5,'users = '.$dom.':'.join(',',@homeusers));
       #
       if ($oneuser) {
           @homeusers=($oneuser);
       }
   
 my $insert_sth = $dbh->prepare      #
     ("INSERT INTO newmetadata VALUES (".      # Loop through the users
      "?,".   # title      foreach my $user (@homeusers) {
      "?,".   # author          &log(0,"=== User: ".$user);
      "?,".   # subject          &process_dynamic_metadata($user,$dom);
      "?,".   # declutter url          #
      "?,".   # version          # Use File::Find to get the files we need to read/modify
      "?,".   # current          find(
      "?,".   # notes               {preprocess => \&only_meta_files,
      "?,".   # abstract                #wanted     => \&print_filename,
      "?,".   # mime                #wanted     => \&log_metadata,
      "?,".   # language                wanted     => \&process_meta_file,
      "?,".   # creationdate                no_chdir   => 1,
      "?,".   # revisiondate               }, join('/',($Apache::lonnet::perlvar{'lonDocRoot'},'res',$dom,$user)) );
      "?,".   # owner      }
      "?,".   # copyright      # Search for all users and public portfolio files
      "?,".   # dependencies      my (%allusers,%portusers,%courses);
      "?,".   # modifyinguser      if ($oneuser) {
      "?,".   # authorspace          %portusers = (
      "?,".   # lowestgradelevel                          $oneuser => '',
      "?,".   # highestgradelevel                         );
      "?,".   # standards          %allusers = (
      "?,".   # count                          $oneuser => '',
      "?,".   # course                         );
      "?,".   # course_list          %courses = &courseiddump($dom,'.',1,'.','.',$oneuser,undef,
      "?,".   # goto                                   undef,'.');
      "?,".   # goto_list      } else {
      "?,".   # comefrom          # get courseIDs for domain on current machine
      "?,".   # comefrom_list          %courses=&Apache::lonnet::courseiddump($dom,'.',1,'.','.','.',1,[$hostid],'.');
      "?,".   # usage          my $dir = $Apache::lonnet::perlvar{lonUsersDir}.'/'.$dom;
      "?,".   # usage_list          &descend_tree($dom,$dir,0,\%portusers,\%allusers);
      "?,".   # stdno      }
      "?,".   # stdno_list      foreach my $uname (keys(%portusers)) {
      "?,".   # avetries          my $urlstart = '/uploaded/'.$dom.'/'.$uname;
      "?,".   # avetries_list          my $pathstart = &propath($dom,$uname).'/userfiles';
      "?,".   # difficulty          my $is_course = '';
      "?,".   # difficulty_list          if (exists($courses{$dom.'_'.$uname})) {
      "?,".   # clear              $is_course = 1;
      "?,".   # technical          }
      "?,".   # correct          my $curr_perm = &Apache::lonnet::get_portfile_permissions($dom,$uname);
      "?,".   # helpful          my %access = &Apache::lonnet::get_access_controls($curr_perm);
      "?,".   # depth          foreach my $file (keys(%access)) {
      "?".    # comments              my ($group,$url,$fullpath);
      ")"              if ($is_course) {
      );                  ($group, my ($path)) = ($file =~ /^(\w+)(\/.+)$/);
                   $fullpath = $pathstart.'/groups/'.$group.'/portfolio'.$path;
 foreach my $user (@homeusers) {                  $url = $urlstart.'/groups/'.$group.'/portfolio'.$path;
     print LOG "\n=== User: ".$user."\n\n";              } else {
                   $fullpath = $pathstart.'/portfolio'.$file;
     my $prodir=&propath($perlvar{'lonDefDomain'},$user);                  $url = $urlstart.'/portfolio'.$file;
     # Use find.pl              }
     undef @metalist;              if (ref($access{$file}) eq 'HASH') {
     @metalist=();                  my %portaccesslog = 
     &find("$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}/$user");                      &LONCAPA::lonmetadata::process_portfolio_access_data($dbh,
     # -- process each file to get metadata and put into search catalog SQL                             $simulate,\%newnames,$url,$fullpath,$access{$file});
     # database.  Also, check to see if already there.                  &portfolio_logging(%portaccesslog);
     # I could just delete (without searching first), but this works for now.              }
     foreach my $m (@metalist) {              my %portmetalog = &LONCAPA::lonmetadata::process_portfolio_metadata($dbh,$simulate,\%newnames,$url,$fullpath,$is_course,$dom,$uname,$group);
         print LOG "- ".$m."\n";              &portfolio_logging(%portmetalog);
         my $ref=&metadata($m);          }
         my $m2='/res/'.&declutter($m);      }
         $m2=~s/\.meta$//;      my %duplicates;
   if ($ref->{'obsolete'}) { print LOG "obsolete\n"; next; }      my %names_by_id = (
  if ($ref->{'copyright'} eq 'private') { print LOG "private\n"; next; }                            id       => {},
         my %dyn=&dynamicmeta($m2);                            clickers => {},
  &count($m2);                        );
         unless ($insert_sth->execute(      my %ids_by_name = (
      $ref->{'title'},                            id       => {},
                              $ref->{'author'},                            clickers => {},
                              $ref->{'subject'},                        );
                              $m2,      my %idstodelete = (
                              $ref->{'keywords'},                            id       => {},
                              'current',                            clickers => {}, 
                              $ref->{'notes'},                        );
                              $ref->{'abstract'},      my %idstoadd    = (
                              $ref->{'mime'},                            id       => {},
                              $ref->{'language'},                            clickers => {},
                              sqltime($ref->{'creationdate'}),                        );
                              sqltime($ref->{'lastrevisiondate'}),      my %namespace  = (
                              $ref->{'owner'},                           id       => 'ids',
                              $ref->{'copyright'},                           clickers => 'clickers',
      $ref->{'dependencies'},                       );
      $ref->{'modifyinguser'},      my %idtext = (
      $ref->{'authorspace'},                       id       => 'employee/student IDs',
      $ref->{'lowestgradelevel'},                       clickers => 'clicker IDs',
      $ref->{'highestgradelevel'},                   );
      $ref->{'standards'},      unless ($simulate || $oneuser) {
      $dyn{'count'},          foreach my $key ('id','clickers') {
      $dyn{'course'},              my $hashref = &tie_domain_hash($dom,$namespace{$key},&GDBM_WRCREAT());
      $dyn{'course_list'},              if (ref($hashref) eq 'HASH') {
      $dyn{'goto'},                  while (my ($id,$unamestr) = each(%{$hashref}) ) {
      $dyn{'goto_list'},                      $id = &unescape($id);
      $dyn{'comefrom'},                      $unamestr = &unescape($unamestr);
      $dyn{'comefrom_list'},                      if ($key eq 'clickers') {
      $dyn{'usage'},                          my @unames = split(/,/,$unamestr);
      $dyn{'usage_list'},                          foreach my $uname (@unames) {
      $dyn{'stdno'},                              push(@{$ids_by_name{$key}{$uname}},$id);
      $dyn{'stdno_list'},                          }
      $dyn{'avetries'},                          $names_by_id{$key}{$id} = $unamestr;
      $dyn{'avetries_list'},                      } else {
      $dyn{'difficulty'},                          $names_by_id{$key}{$id} = $unamestr;
      $dyn{'difficulty_list'},                               push(@{$ids_by_name{$key}{$unamestr}},$id);
      $dyn{'clear'},                      }
      $dyn{'technical'},                  }
      $dyn{'correct'},                  &untie_domain_hash($hashref);
      $dyn{'helpful'},              }
      $dyn{'depth'},          }
      $dyn{'comments'}           }
      )) {      # Update allusers
     print LOG "\nMySQL Error Insert: ".$dbh->errstr."\n";      foreach my $uname (keys(%allusers)) {
     die $dbh->errstr;          next if (exists($courses{$dom.'_'.$uname}));
  }          my %userdata = 
         $ref = undef;              &Apache::lonnet::get('environment',['firstname','lastname',
     }                  'middlename','generation','id','permanentemail','clickers'],
 }                                   $dom,$uname);
 # --------------------------------------------------- Close database connection          unless ($simulate || $oneuser) {
 $dbh->do("DROP TABLE IF EXISTS metadata");              foreach my $key ('id','clickers') {
 unless ($dbh->do("RENAME TABLE newmetadata TO metadata")) {                  my %addid = ();
     print LOG "\nMySQL Error Rename: ".$dbh->errstr."\n";                  if ($userdata{$key} ne '') {
     die $dbh->errstr;                      my $idfromenv = $userdata{$key};
                       if ($key eq 'id') {
                           $idfromenv=~tr/A-Z/a-z/;
                           $addid{$idfromenv} = 1;
                       } else {
                           $idfromenv =~ s/^\s+//;
                           $idfromenv =~ s/\s+$//;
                           map { $addid{$_} = 1; } split(/,/,$idfromenv);
                       }
                   }
                   if (ref($ids_by_name{$key}{$uname}) eq 'ARRAY') {
                       if (scalar(@{$ids_by_name{$key}{$uname}}) > 1) {
                           &log(0,"Multiple $idtext{$key} found in $namespace{$key}.db for $uname:$dom -- ".
                                join(', ',@{$ids_by_name{$key}{$uname}}));
                       }
                       foreach my $id (@{$ids_by_name{$key}{$uname}}) {
                            if ($addid{$id}) {
                               delete($addid{$id});
                            } else {
                               if ($key eq 'id') {
                                   $idstodelete{$key}{$id} = $uname;
                               } else {
                                   $idstodelete{$key}{$id} .= $uname.',';
                               }
                           }
                       }
                   }
                   if (keys(%addid)) {
                       foreach my $id (keys(%addid)) {
                           if ($key eq 'id') {
                               if (exists($idstoadd{$key}{$id})) {
                                   push(@{$duplicates{$id}},$uname);
                               } else {
                                   $idstoadd{$key}{$id} = $uname;
                               }
                           } else {
                               $idstoadd{$key}{$id} .= $uname.',';
                           }
                       }
                   }
               }
           }
   
           $userdata{'username'} = $uname;
           $userdata{'domain'} = $dom;
           my %alluserslog = 
               &LONCAPA::lonmetadata::process_allusers_data($dbh,$simulate,
                   \%newnames,$uname,$dom,\%userdata);
           foreach my $item (keys(%alluserslog)) {
               &log(0,$alluserslog{$item});
           }
       }
       unless ($simulate || $oneuser) {
           foreach my $key ('id','clickers') { 
               if (keys(%{$idstodelete{$key}}) > 0) {
                   my %resulthash;
                   if ($key eq 'id') {
                       %resulthash = &Apache::lonnet::iddel($dom,$idstodelete{$key},$hostid,$namespace{$key});
                   } else {
                       foreach my $delid (sort(keys(%{$idstodelete{$key}}))) {
                           $idstodelete{$key}{$delid} =~ s/,$//;
                       }
                       %resulthash = &Apache::lonnet::iddel($dom,$idstodelete{$key},$hostid,$namespace{$key});
                   }
                   if ($resulthash{$hostid} eq 'ok') {
                       foreach my $id (sort(keys(%{$idstodelete{$key}}))) {
                           &log(0,"Record deleted from $namespace{$key}.db for $dom -- $id => ".$idstodelete{$key}{$id});
                       }
                   } else {
                       &log(0,"Error: '$resulthash{$hostid}' occurred when attempting to delete records from $namespace{$key}.db for $dom");
                   }
               }
               if (keys(%{$idstoadd{$key}}) > 0) {
                   my $idmessage = '';
                   my %newids;
                   if ($key eq 'id') {
                       foreach my $addid (sort(keys(%{$idstoadd{$key}}))) {
                           if ((exists($names_by_id{$key}{$addid})) && ($names_by_id{$key}{$addid} ne $idstoadd{$key}{$addid})  && !($idstodelete{$key}{$addid})) {
                               &log(0,"Two usernames associated with a single ID $addid in domain: $dom: $names_by_id{$key}{$addid} (current) and $idstoadd{$key}{$addid}\n");
                               $idmessage .= "$addid,$names_by_id{$key}{$addid},$idstoadd{$key}{$addid}\n";
                           } else {
                               $newids{$addid} = $idstoadd{$key}{$addid};
                           }
                       }
                   } else {
                       foreach my $addid (sort(keys(%{$idstoadd{$key}}))) {
                           $idstoadd{$key}{$addid} =~ s/,$//;
                           $newids{$addid} = $idstoadd{$key}{$addid};
                       }
                   }
                   if (keys(%newids) > 0) {
                       my $putresult;
                       if ($key eq 'clickers') {
                           $putresult = &Apache::lonnet::updateclickers($dom,'add',\%newids,$hostid); 
                       } else {
                           $putresult = &Apache::lonnet::put_dom($namespace{$key},\%newids,$dom,$hostid);
                       } 
                       if ($putresult eq 'ok') {
                           foreach my $id (sort(keys(%newids))) {
                               &log(0,"Record added to $namespace{$key}.db for $dom -- $id => ".$newids{$id});
                           }
                       } else {
                           &log(0,"Error: '$putresult' occurred when attempting to add records to $namespace{$key}.db for $dom"); 
                       }
                   }
                   if ($idmessage) {
                       my $to = &Apache::loncommon::build_recipient_list(undef,'idconflictsmail',$dom);
                       if ($to ne '') {
                           my $msg = new Mail::Send;
                           $msg->to($to);
                           $msg->subject('LON-CAPA studentIDs conflict');
                           my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
                           my $hostname = &Apache::lonnet::hostname($lonhost);
                           my $replytoaddress = 'do-not-reply@'.$hostname;
                           $msg->add('Reply-to',$replytoaddress);
                           $msg->add('From','www@'.$hostname);
                           $msg->add('Content-type','text/plain; charset=UTF-8');
                           if (my $fh = $msg->open()) {
                               print $fh 
                                   'The following IDs are used for more than one user in your domain:'."\n".
                                   'Each row contains: Student/Employee ID, Current username in ids.db file, '.
                                   'Additional username'."\n\n".
                                   $idmessage;
                               $fh->close;
                           }
                       }
                   }
               }
           }
           if (keys(%duplicates) > 0) {
               foreach my $id (sort(keys(%duplicates))) {
                   if (ref($duplicates{$id}) eq 'ARRAY') {
                       &log(0,"Duplicate IDs found for entries to add to ids.db in $dom -- $id => ".join(',',@{$duplicates{$id}}));
                   }
               }
           }
       }
 }  }
 unless ($dbh->disconnect) {  
     print LOG "\nMySQL Error Disconnect: ".$dbh->errstr."\n";  #
   # Rename the tables
   if (! $simulate) {
       foreach my $key (keys(%oldnames)) {
           if (($oldnames{$key} ne '') && ($newnames{$key} ne '')) {
               $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) {
       &log(0,"MySQL Error Disconnect: ".$dbh->errstr);
     die $dbh->errstr;      die $dbh->errstr;
 }  }
 print LOG "\n==== Searchcat completed ".localtime()." ====\n";  ##
   ## Finished!
   &log(0,"==== Searchcat completed ".localtime()." ====");
 close(LOG);  close(LOG);
 &writesimple();  
 &writecount();  &write_type_count();
   &write_copyright_count();
   
 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 portfolio_logging {
       my (%portlog) = @_;
       foreach my $key (keys(%portlog)) {
           if (ref($portlog{$key}) eq 'HASH') {
               foreach my $item (keys(%{$portlog{$key}})) {
                   &log(0,$portlog{$key}{$item});
               }
           }
       }
   }
   
   sub descend_tree {
       my ($dom,$dir,$depth,$allportusers,$alldomusers) = @_;
       if (-d $dir) {
           opendir(DIR,$dir);
           my @contents = grep(!/^\./,readdir(DIR));
           closedir(DIR);
           $depth ++;
           foreach my $item (@contents) {
               if (($depth < 4) && (length($item) == 1)) {
                   &descend_tree($dom,$dir.'/'.$item,$depth,$allportusers,$alldomusers);
               } else {
                   if (-e $dir.'/'.$item.'/file_permissions.db') {
                       $$allportusers{$item} = '';
                   }
                   if (-e $dir.'/'.$item.'/passwd') {
                       $$alldomusers{$item} = '';
                   }
               }       
           }
       } 
   }
   
   ########################################################
   ########################################################
   ###                                                  ###
   ###          File::Find support routines             ###
   ###                                                  ###
   ########################################################
   ########################################################
   ##
   ## &only_meta_files
   ##
   ## Called by File::Find.
   ## Takes a list of files/directories in and returns a list of files/directories
   ## to search.
   sub only_meta_files {
       my @PossibleFiles = @_;
       my @ChosenFiles;
       foreach my $file (@PossibleFiles) {
           if ( ($file =~ /\.meta$/ &&            # Ends in meta
                 $file !~ /\.\d+\.[^\.]+\.meta$/  # is not for a prior version
                ) || (-d $File::Find::dir."/".$file )) { # directories are okay
                    # but we do not want /. or /..
               push(@ChosenFiles,$file);
           }
       }
       return @ChosenFiles;
   }
   
   ##
   ##
   ## Debugging routines, use these for 'wanted' in the File::Find call
   ##
   sub print_filename {
       my ($file) = $_;
       my $fullfilename = $File::Find::name;
       if ($debug) {
           if (-d $file) {
               &log(5," Got directory ".$fullfilename);
           } else {
               &log(5," Got file ".$fullfilename);
           }
       }
       $_=$file;
   }
   
   sub log_metadata {
       my ($file) = $_;
       my $fullfilename = $File::Find::name;
       return if (-d $fullfilename); # No need to do anything here for directories
       if ($debug) {
           &log(6,$fullfilename);
           my $ref = &metadata($fullfilename);
           if (! defined($ref)) {
               &log(6,"    No data");
               return;
           }
           while (my($key,$value) = each(%$ref)) {
               &log(6,"    ".$key." => ".$value);
           }
           &count_copyright($ref->{'copyright'});
       }
       $_=$file;
   }
   
 # =============================================================================  ##
   ## process_meta_file
   ##   Called by File::Find. 
   ##   Only input is the filename in $_.  
   sub process_meta_file {
       my ($file) = $_;
       my $filename = $File::Find::name; # full filename
       return if (-d $filename); # No need to do anything here for directories
       #
       &log(3,$filename) if ($debug);
       #
       my $ref = &metadata($filename);
       #
       # $url is the original file url, not the metadata file
       my $target = $filename;
       $target =~ s/\.meta$//;
       my $url='/res/'.&declutter($target);
       &log(3,"    ".$url) if ($debug);
       #
       # Ignore some files based on their metadata
       if ($ref->{'obsolete'}) { 
           &log(3,"obsolete") if ($debug);
           return; 
       }
       &count_copyright($ref->{'copyright'});
       if ($ref->{'copyright'} eq 'private') { 
           &log(3,"private") if ($debug);
           return; 
       }
       #
       # Find the dynamic metadata
       my %dyn;
       if ($url=~ m:/default$:) {
           $url=~ s:/default$:/:;
           &log(3,"Skipping dynamic data") if ($debug);
       } else {
           &log(3,"Retrieving dynamic data") if ($debug);
           %dyn=&get_dynamic_metadata($url);
           &count_type($url);
       }
       &LONCAPA::lonmetadata::getfiledates($ref,$target);
       #
       my %Data = (
                   %$ref,
                   %dyn,
                   'url'=>$url,
                   'version'=>'current');
       if (! $simulate) {
           my ($count,$err) = 
             &LONCAPA::lonmetadata::store_metadata($dbh,$newnames{'metadata'},
                                                   'metadata',\%Data);
           if ($err) {
               &log(0,"MySQL Error Insert: ".$err);
           }
           if ($count < 1) {
               &log(0,"Unable to insert record into MySQL database for $url");
           }
       }
       #
       # Reset $_ before leaving
       $_ = $file;
   }
   
 # ---------------------------------------------------------------- Get metadata  ########################################################
 # significantly altered from subroutine present in lonnet  ########################################################
   ###                                                  ###
   ###  &metadata($uri)                                 ###
   ###   Retrieve metadata for the given file           ###
   ###                                                  ###
   ########################################################
   ########################################################
 sub metadata {  sub metadata {
     my ($uri,$what)=@_;      my ($uri) = @_;
     my %metacache=();      my %metacache=();
     $uri=&declutter($uri);      $uri=&declutter($uri);
     my $filename=$uri;      my $filename=$uri;
     $uri=~s/\.meta$//;      $uri=~s/\.meta$//;
     $uri='';      $uri='';
     unless ($metacache{$uri.'keys'}) {      if ($filename !~ /\.meta$/) { 
         unless ($filename=~/\.meta$/) { $filename.='.meta'; }          $filename.='.meta';
  my $metastring=&getfile($perlvar{'lonDocRoot'}.'/res/'.$filename);      }
         my $parser=HTML::TokeParser->new(\$metastring);      my $metastring = 
         my $token;          &LONCAPA::lonmetadata::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.'/res/'.$filename);
         while ($token=$parser->get_token) {      return undef if (! defined($metastring));
             if ($token->[0] eq 'S') {      my $parser=HTML::TokeParser->new(\$metastring);
                 my $entry=$token->[1];      my $token;
                 my $unikey=$entry;      while ($token=$parser->get_token) {
                 if (defined($token->[2]->{'part'})) {           if ($token->[0] eq 'S') {
                     $unikey.='_'.$token->[2]->{'part'};               my $entry=$token->[1];
                 }              my $unikey=$entry;
                 if (defined($token->[2]->{'name'})) {               if (defined($token->[2]->{'part'})) { 
                     $unikey.='_'.$token->[2]->{'name'};                   $unikey.='_'.$token->[2]->{'part'}; 
                 }  
                 if ($metacache{$uri.'keys'}) {  
                     $metacache{$uri.'keys'}.=','.$unikey;  
                 } else {  
                     $metacache{$uri.'keys'}=$unikey;  
                 }  
                 map {  
                     $metacache{$uri.''.$unikey.'.'.$_}=$token->[2]->{$_};  
                 } @{$token->[3]};  
                 unless (  
                         $metacache{$uri.''.$unikey}=$parser->get_text('/'.$entry)  
                         ) { $metacache{$uri.''.$unikey}=  
                                 $metacache{$uri.''.$unikey.'.default'};  
                         }  
             }              }
         }              if (defined($token->[2]->{'name'})) { 
                   $unikey.='_'.$token->[2]->{'name'}; 
               }
               if ($metacache{$uri.'keys'}) {
                   $metacache{$uri.'keys'}.=','.$unikey;
               } else {
                   $metacache{$uri.'keys'}=$unikey;
               }
               foreach ( @{$token->[3]}) {
                   $metacache{$uri.''.$unikey.'.'.$_}=$token->[2]->{$_};
               }
               if (! ($metacache{$uri.''.$unikey}=$parser->get_text('/'.$entry))){
                   $metacache{$uri.''.$unikey} = 
                       $metacache{$uri.''.$unikey.'.default'};
               }
           } # End of ($token->[0] eq 'S')
     }      }
     return \%metacache;      return \%metacache;
 }  }
   
 # ------------------------------------------------------------ Serves up a file  ########################################################
 # returns either the contents of the file or a -1  ########################################################
 sub getfile {  ###                                                  ###
   ###    Dynamic Metadata                              ###
   ###                                                  ###
   ########################################################
   ########################################################
   ##
   ## Dynamic metadata description (incomplete)
   ##
   ## For a full description of all fields,
   ## see LONCAPA::lonmetadata
   ##
   ##   Field             Type
   ##-----------------------------------------------------------
   ##   count             integer
   ##   course            integer
   ##   course_list       comma separated list of course ids
   ##   avetries          real                                
   ##   avetries_list     comma separated list of real numbers
   ##   stdno             real
   ##   stdno_list        comma separated list of real numbers
   ##   usage             integer   
   ##   usage_list        comma separated list of resources
   ##   goto              scalar
   ##   goto_list         comma separated list of resources
   ##   comefrom          scalar
   ##   comefrom_list     comma separated list of resources
   ##   difficulty        real
   ##   difficulty_list   comma separated list of real numbers
   ##   sequsage          scalar
   ##   sequsage_list     comma separated list of resources
   ##   clear             real
   ##   technical         real
   ##   correct           real
   ##   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);
       #
       # Read in the dynamic metadata
       my %evaldata;
       if (! tie(%evaldata,'GDBM_File',
                 $prodir.'/nohist_resevaldata.db',&GDBM_READER(),0640)) {
           return 0;
       }
       #
       %DynamicData = &LONCAPA::lonmetadata::process_reseval_data(\%evaldata);
       untie(%evaldata);
       $DynamicData{'domain'} = $dom;
       #print('user = '.$user.' domain = '.$dom.$/);
       #
       # Read in the access count data
       &log(7,'Reading access count data') if ($debug);
       my %countdata;
       if (! tie(%countdata,'GDBM_File',
                 $prodir.'/nohist_accesscount.db',&GDBM_READER(),0640)) {
           return 0;
       }
       while (my ($key,$count) = each(%countdata)) {
           next if ($key !~ /^$dom/);
           $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 %data;
   }
   
   } # End of %DynamicData and %Counts scope
   
   ########################################################
   ########################################################
   ###                                                  ###
   ###   Counts                                         ###
   ###                                                  ###
   ########################################################
   ########################################################
   {
   
   my %countext;
   
   sub count_type {
     my $file=shift;      my $file=shift;
     if (! -e $file ) { return -1; };      $file=~/\.(\w+)$/;
     my $fh=IO::File->new($file);      my $ext=lc($1);
     my $a='';      $countext{$ext}++;
     while (<$fh>) { $a .=$_; }  
     return $a;  
 }  }
   
 # ------------------------------------------------------------- Declutters URLs  sub write_type_count {
 sub declutter {      open(RESCOUNT,'>/home/httpd/html/lon-status/rescount.txt');
     my $thisfn=shift;      while (my ($extension,$count) = each(%countext)) {
     $thisfn=~s/^$perlvar{'lonDocRoot'}//;   print RESCOUNT $extension.'='.$count.'&';
     $thisfn=~s/^\///;      }
     $thisfn=~s/^res\///;      print RESCOUNT 'time='.time."\n";
     return $thisfn;      close(RESCOUNT);
 }  }
   
 # --------------------------------------- Is this the home server of an author?  } # end of scope for %countext
 # (copied from lond, modification of the return value)  
   {
   
   my %copyrights;
   
   sub count_copyright {
       $copyrights{@_[0]}++;
   }
   
   sub write_copyright_count {
       open(COPYCOUNT,'>/home/httpd/html/lon-status/copyrightcount.txt');
       while (my ($copyright,$count) = each(%copyrights)) {
    print COPYCOUNT $copyright.'='.$count.'&';
       }
       print COPYCOUNT 'time='.time."\n";
       close(COPYCOUNT);
   }
   
   } # end of scope for %copyrights
   
   ########################################################
   ########################################################
   ###                                                  ###
   ###   Miscellanous Utility Routines                  ###
   ###                                                  ###
   ########################################################
   ########################################################
   ##
   ## &ishome($username)
   ##   Returns 1 if $username is a LON-CAPA author, 0 otherwise
   ##   (copied from lond, modification of the return value)
 sub ishome {  sub ishome {
     my $author=shift;      my $author=shift;
     $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;      $author=~s{/home/httpd/html/res/([^/]*)/([^/]*).*}{$1/$2};
     my ($udom,$uname)=split(/\//,$author);      my ($udom,$uname)=split(/\//,$author);
     my $proname=propath($udom,$uname);      my $proname=propath($udom,$uname);
     if (-e $proname) {      if (-e $proname) {
Line 534  sub ishome { Line 902  sub ishome {
     }      }
 }  }
   
 # -------------------------------------------- Return path to profile directory  ##
 # (copied from lond)  ## &declutter($filename)
 sub propath {  ##   Given a filename, returns a url for the filename.
     my ($udom,$uname)=@_;  sub declutter {
     $udom=~s/\W//g;      my $thisfn=shift;
     $uname=~s/\W//g;      $thisfn=~s/^$Apache::lonnet::perlvar{'lonDocRoot'}//;
     my $subdir=$uname.'__';      $thisfn=~s/^\///;
     $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;      $thisfn=~s/^res\///;
     my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname";      return $thisfn;
     return $proname;  
 }   
   
 # ---------------------------- convert 'time' format into a datetime sql format  
 sub sqltime {  
     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =  
  localtime(&unsqltime(@_[0]));  
     $mon++; $year+=1900;  
     return "$year-$mon-$mday $hour:$min:$sec";  
 }  
   
 sub maketime {  
     my %th=@_;  
     return POSIX::mktime(($th{'seconds'},$th{'minutes'},$th{'hours'},  
                           $th{'day'},$th{'month'}-1,  
                           $th{'year'}-1900,0,0,$th{'dlsav'}));  
 }  
   
   
 #########################################  
 #  
 # Retro-fixing of un-backward-compatible time format  
   
 sub unsqltime {  
     my $timestamp=shift;  
     if ($timestamp=~/^(\d+)\-(\d+)\-(\d+)\s+(\d+)\:(\d+)\:(\d+)$/) {  
         $timestamp=&maketime('year'=>$1,'month'=>$2,'day'=>$3,  
                              'hours'=>$4,'minutes'=>$5,'seconds'=>$6);  
     }  
     return $timestamp;  
 }  }
   
 # ----------------- Code to enable 'find' subroutine listing of the .meta files  
   
 no strict "vars";  
   
 sub wanted {  
     (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&  
          -f _ &&  
          /^.*\.meta$/ && !/^.+\.\d+\.[^\.]+\.meta$/ &&  
          push(@metalist,"$dir/$_");  
 }  

Removed from v.1.52  
changed lines
  Added in v.1.84


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