[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.33 and 1.45

version 1.33, 2003/06/19 19:34:27 version 1.45, 2003/12/24 19:58:37
Line 65  and correct user experience. Line 65  and correct user experience.
   
 =cut  =cut
   
   use strict;
   
 use lib '/home/httpd/lib/perl/';  use lib '/home/httpd/lib/perl/';
 use LONCAPA::Configuration;  use LONCAPA::Configuration;
   
Line 74  use DBI; Line 76  use DBI;
 use GDBM_File;  use GDBM_File;
 use POSIX qw(strftime mktime);  use POSIX qw(strftime mktime);
   
   require "find.pl";
   
 my @metalist;  my @metalist;
   
   my $simplestatus='';
   my %countext=();
   
   # ----------------------------------------------------- write out simple status
   sub writesimple {
       open(SMP,'>/home/httpd/html/lon-status/mysql.txt');
       print SMP $simplestatus."\n";
       close(SMP);
   }
   
   sub writecount {
       open(RSMP,'>/home/httpd/html/lon-status/rescount.txt');
       foreach (keys %countext) {
    print RSMP $_.'='.$countext{$_}.'&';
       }
       print RSMP 'time='.time."\n";
       close(RSMP);
   }
   
   # -------------------------------------- counts files with different extensions
   sub count {
       my $file=shift;
       $file=~/\.(\w+)$/;
       my $ext=lc($1);
       if (defined($countext{$ext})) {
    $countext{$ext}++;
       } else {
    $countext{$ext}=1;
       }
   }
 # ----------------------------------------------------- Un-Escape Special Chars  # ----------------------------------------------------- Un-Escape Special Chars
   
 sub unescape {  sub unescape {
Line 93  sub escape { Line 126  sub escape {
     return $str;      return $str;
 }  }
   
   
 # ------------------------------------------- Code to evaluate dynamic metadata  # ------------------------------------------- Code to evaluate dynamic metadata
   
 sub dynamicmeta {  sub dynamicmeta {
   
     my $url=&declutter(shift);      my $url=&declutter(shift);
     $url=~s/\.meta$//;      $url=~s/\.meta$//;
     my %returnhash=();      my %returnhash=();
     my ($adomain,$aauthor)=($url=~/^(\w+)\/(\w+)\//);      my ($adomain,$aauthor)=($url=~/^(\w+)\/(\w+)\//);
     my $prodir=&propath($adomain,$aauthor);      my $prodir=&propath($adomain,$aauthor);
     if ((tie(%evaldata,'GDBM_File',  
              $prodir.'/nohist_resevaldata.db',&GDBM_READER(),0640)) &&  # Get metadata except counts
         (tie(%newevaldata,'GDBM_File',      if (tie(my %evaldata,'GDBM_File',
              $prodir.'/nohist_new_resevaldata.db',&GDBM_WRCREAT(),0640))) {              $prodir.'/nohist_resevaldata.db',&GDBM_READER(),0640)) {
         my %sum=();   my %sum=();
         my %cnt=();   my %cnt=();
         my %listitems=('count'        => 'add',   my %concat=();
                        'course'       => 'add',   my %listitems=(
                        'avetries'     => 'avg',         'course'       => 'add',
                        'stdno'        => 'add',         'goto'         => 'add',
                        'difficulty'   => 'avg',         'comefrom'     => 'add',
                        'clear'        => 'avg',         'avetries'     => 'avg',
                        'technical'    => 'avg',         'stdno'        => 'add',
                        'helpful'      => 'avg',         'difficulty'   => 'avg',
                        'correct'      => 'avg',         'clear'        => 'avg',
                        'depth'        => 'avg',         'technical'    => 'avg',
                        'comments'     => 'app',         'helpful'      => 'avg',
                        'usage'        => 'cnt'         'correct'      => 'avg',
                        );         'depth'        => 'avg',
         my $regexp=$url;         'comments'     => 'app',
         $regexp=~s/(\W)/\\$1/g;         'usage'        => 'cnt'
         $regexp='___'.$regexp.'___([a-z]+)$';         );
         foreach (keys %evaldata) {  
             my $key=&unescape($_);   my $regexp=$url;
             if ($key=~/$regexp/) {   $regexp=~s/(\W)/\\$1/g;
                 my $ctype=$1;   $regexp='___'.$regexp.'___([a-z]+)$';
                 if (defined($cnt{$ctype})) {    while (my ($esckey,$value)=each %evaldata) {
                     $cnt{$ctype}++;       my $key=&unescape($esckey);
                 } else {       if ($key=~/$regexp/) {
                     $cnt{$ctype}=1;    my ($item,$purl,$cat)=split(/___/,$key);
                 }   if (defined($cnt{$cat})) { $cnt{$cat}++; } else { $cnt{$cat}=1; }
                 unless ($listitems{$ctype} eq 'app') {   unless ($listitems{$cat} eq 'app') {
                     if (defined($sum{$ctype})) {      if (defined($sum{$cat})) {
                         $sum{$ctype}+=$evaldata{$_};   $sum{$cat}+=$evaldata{$esckey};
                     } else {   $concat{$cat}.=','.$item;
                         $sum{$ctype}=$evaldata{$_};      } else {
                     }   $sum{$cat}=$evaldata{$esckey};
                 } else {   $concat{$cat}=$item;
                     if (defined($sum{$ctype})) {      }
                         if ($evaldata{$_}) {   } else {
                             $sum{$ctype}.='<hr>'.$evaldata{$_};      if (defined($sum{$cat})) {
                         }   if ($evaldata{$esckey}=~/\w/) {
                     } else {      $sum{$cat}.='<hr>'.$evaldata{$esckey};
                         $sum{$ctype}=''.$evaldata{$_};   }
                     }      } else {
                 }   $sum{$cat}=''.$evaldata{$esckey};
                 if ($ctype ne 'count') {      }
                     $newevaldata{$_}=$evaldata{$_};   }
                 }      }
             }   }
         }   untie(%evaldata);
         foreach (keys %cnt) {  # transfer gathered data to returnhash, calculate averages where applicable
             if ($listitems{$_} eq 'avg') {   while (my $cat=each(%cnt)) {
                 $returnhash{$_}=int(($sum{$_}/$cnt{$_})*100.0+0.5)/100.0;      if ($listitems{$cat} eq 'avg') {
             } elsif ($listitems{$_} eq 'cnt') {   $returnhash{$cat}=int(($sum{$cat}/$cnt{$cat})*100.0+0.5)/100.0;
                 $returnhash{$_}=$cnt{$_};      } elsif ($listitems{$cat} eq 'cnt') {
             } else {   $returnhash{$cat}=$cnt{$cat};
                 $returnhash{$_}=$sum{$_};      } else {
             }   $returnhash{$cat}=$sum{$cat};
         }      }
         if ($returnhash{'count'}) {      $returnhash{$cat.'_list'}=$concat{$cat};
             my $newkey=$$.'_'.time.'_searchcat___'.&escape($url).'___count';   }
             $newevaldata{$newkey}=$returnhash{'count'};      }
         }  # get count
         untie(%evaldata);      if (tie(my %evaldata,'GDBM_File',
         untie(%newevaldata);              $prodir.'/nohist_accesscount.db',&GDBM_READER(),0640)) {
    my $escurl=&escape($url);
    if (! exists($evaldata{$escurl})) {
       $returnhash{'count'}='Not Available';
    } else {
       $returnhash{'count'}=$evaldata{$escurl};
    }
    untie %evaldata;
     }      }
     return %returnhash;      return %returnhash;
 }  }
     
 # ----------------- Code to enable 'find' subroutine listing of the .meta files  
 require "find.pl";  
 sub wanted {  
     (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&  
         -f _ &&  
         /^.*\.meta$/ && !/^.+\.\d+\.[^\.]+\.meta$/ &&  
         push(@metalist,"$dir/$_");  
 }  
   
 # ---------------  Read loncapa_apache.conf and loncapa.conf and get variables  # ---------------  Read loncapa_apache.conf and loncapa.conf and get variables
 my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');  my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');
 my %perlvar=%{$perlvarref};  my %perlvar=%{$perlvarref};
Line 195  exit unless $perlvar{'lonRole'} eq 'libr Line 224  exit unless $perlvar{'lonRole'} eq 'libr
   
 my $wwwid=getpwnam('www');  my $wwwid=getpwnam('www');
 if ($wwwid!=$<) {  if ($wwwid!=$<) {
     $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";      my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
     $subj="LON: $perlvar{'lonHostID'} User ID mismatch";      my $subj="LON: $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");   mailto $emailto -s '$subj' > /dev/null");
     exit 1;      exit 1;
Line 207  if ($wwwid!=$<) { Line 236  if ($wwwid!=$<) {
   
 open(LOG,'>'.$perlvar{'lonDaemons'}.'/logs/searchcat.log');  open(LOG,'>'.$perlvar{'lonDaemons'}.'/logs/searchcat.log');
 print LOG '==== Searchcat Run '.localtime()."====\n\n";  print LOG '==== Searchcat Run '.localtime()."====\n\n";
   $simplestatus='time='.time.'&';
 my $dbh;  my $dbh;
 # ------------------------------------- Make sure that database can be accessed  # ------------------------------------- Make sure that database can be accessed
 {  {
Line 214  my $dbh; Line 244  my $dbh;
     $dbh = DBI->connect("DBI:mysql:loncapa","www",$perlvar{'lonSqlAccess'},{ RaiseError =>0,PrintError=>0})      $dbh = DBI->connect("DBI:mysql:loncapa","www",$perlvar{'lonSqlAccess'},{ RaiseError =>0,PrintError=>0})
     ) {       ) { 
  print LOG "Cannot connect to database!\n";   print LOG "Cannot connect to database!\n";
    $simplestatus.='mysql=defunct';
    &writesimple();
  exit;   exit;
     }      }
   
     my $make_metadata_table = "CREATE TABLE IF NOT EXISTS metadata (".      my $make_metadata_table = "CREATE TABLE IF NOT EXISTS metadata (".
         "title TEXT, author TEXT, subject TEXT, url TEXT, keywords TEXT, ".          "title TEXT, author TEXT, subject TEXT, url TEXT, keywords TEXT, ".
         "version TEXT, notes TEXT, abstract TEXT, mime TEXT, language TEXT, ".          "version TEXT, notes TEXT, abstract TEXT, mime TEXT, language TEXT, ".
Line 237  my @homeusers = grep { Line 270  my @homeusers = grep {
     &ishome("$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}/$_")      &ishome("$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}/$_")
     } grep {!/^\.\.?$/} readdir(RESOURCES);      } grep {!/^\.\.?$/} readdir(RESOURCES);
 closedir RESOURCES;  closedir RESOURCES;
   
   #
   # Create the statement handlers we need
   my $delete_sth = $dbh->prepare
       ("DELETE FROM metadata WHERE url LIKE BINARY ?");
   
   my $insert_sth = $dbh->prepare
       ("INSERT INTO metadata VALUES (".
        "?,".   # title
        "?,".   # author
        "?,".   # subject
        "?,".   # m2???
        "?,".   # version
        "?,".   # current
        "?,".   # notes
        "?,".   # abstract
        "?,".   # mime
        "?,".   # language
        "?,".   # creationdate
        "?,".   # revisiondate
        "?,".   # owner
        "?)"    # copyright
        );
   
 foreach my $user (@homeusers) {  foreach my $user (@homeusers) {
     print LOG "\n=== User: ".$user."\n\n";      print LOG "\n=== User: ".$user."\n\n";
     # Remove left-over db-files from potentially crashed searchcat run  
     my $prodir=&propath($perlvar{'lonDefDomain'},$user);      my $prodir=&propath($perlvar{'lonDefDomain'},$user);
     unlink($prodir.'/nohist_new_resevaldata.db');  
     # Use find.pl      # Use find.pl
     undef @metalist;      undef @metalist;
     @metalist=();      @metalist=();
Line 254  foreach my $user (@homeusers) { Line 310  foreach my $user (@homeusers) {
         my $ref=&metadata($m);          my $ref=&metadata($m);
         my $m2='/res/'.&declutter($m);          my $m2='/res/'.&declutter($m);
         $m2=~s/\.meta$//;          $m2=~s/\.meta$//;
     if ($ref->{'obsolete'}) { print LOG "obsolete\n"; next; }
    if ($ref->{'copyright'} eq 'private') { print LOG "private\n"; next; }
         &dynamicmeta($m2);          &dynamicmeta($m2);
         my $q2="select * from metadata where url like binary '$m2'";   &count($m2);
         my $sth = $dbh->prepare($q2);          $delete_sth->execute($m2);
         $sth->execute();          $insert_sth->execute($ref->{'title'},
         my $r1=$sth->fetchall_arrayref;                               $ref->{'author'},
         if (@$r1) {                               $ref->{'subject'},
             $sth=$dbh->prepare("delete from metadata where url like binary '$m2'");                               $m2,
             $sth->execute();                               $ref->{'keywords'},
         }                               'current',
         $sth=$dbh->prepare('insert into metadata values ('.                               $ref->{'notes'},
                            '"'.delete($ref->{'title'}).'"'.','.                               $ref->{'abstract'},
                            '"'.delete($ref->{'author'}).'"'.','.                               $ref->{'mime'},
                            '"'.delete($ref->{'subject'}).'"'.','.                               $ref->{'language'},
                            '"'.$m2.'"'.','.                               sqltime($ref->{'creationdate'}),
                            '"'.delete($ref->{'keywords'}).'"'.','.                               sqltime($ref->{'lastrevisiondate'}),
                            '"'.'current'.'"'.','.                               $ref->{'owner'},
                            '"'.delete($ref->{'notes'}).'"'.','.                               $ref->{'copyright'});
                            '"'.delete($ref->{'abstract'}).'"'.','.  #        if ($dbh->err()) {
                            '"'.delete($ref->{'mime'}).'"'.','.  #            print STDERR "Error:".$dbh->errstr()."\n";
                            '"'.delete($ref->{'language'}).'"'.','.  #        }
                            '"'.sqltime(delete($ref->{'creationdate'})).'"'.','.          $ref = undef;
                            '"'.sqltime(delete($ref->{'lastrevisiondate'})).'"'.','.  
                            '"'.delete($ref->{'owner'}).'"'.','.  
                            '"'.delete($ref->{'copyright'}).'"'.')');  
         $sth->execute();  
     }      }
           
     # --------------------------------------------------- Clean up database      # --------------------------------------------------- Clean up database
     # Need to, perhaps, remove stale SQL database records.      # Need to, perhaps, remove stale SQL database records.
     # ... not yet implemented      # ... not yet implemented
                   
     # ------------------------------------------- Copy over the new db-files  
     system('mv '.$prodir.'/nohist_new_resevaldata.db '.  
            $prodir.'/nohist_resevaldata.db');  
 }  }
 # --------------------------------------------------- Close database connection  # --------------------------------------------------- Close database connection
 $dbh->disconnect;  $dbh->disconnect;
 print LOG "\n==== Searchcat completed ".localtime()." ====\n";  print LOG "\n==== Searchcat completed ".localtime()." ====\n";
 close(LOG);  close(LOG);
   &writesimple();
   &writecount();
 exit 0;  exit 0;
   
   
Line 417  sub unsqltime { Line 470  sub unsqltime {
     return $timestamp;      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.33  
changed lines
  Added in v.1.45

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