[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.44 and 1.46

version 1.44, 2003/12/23 15:47:26 version 1.46, 2003/12/24 20:41:32
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;
   
 $simplestatus='';  my $simplestatus='';
 my %countext=();  my %countext=();
   
   # ----------------------------------------------------- write out simple status
 sub writesimple {  sub writesimple {
     open(SMP,'>/home/httpd/html/lon-status/mysql.txt');      open(SMP,'>/home/httpd/html/lon-status/mysql.txt');
     print SMP $simplestatus."\n";      print SMP $simplestatus."\n";
Line 94  sub writecount { Line 99  sub writecount {
     close(RSMP);      close(RSMP);
 }  }
   
   # -------------------------------------- counts files with different extensions
 sub count {  sub count {
     my $file=shift;      my $file=shift;
     $file=~/\.(\w+)$/;      $file=~/\.(\w+)$/;
Line 120  sub escape { Line 126  sub escape {
     return $str;      return $str;
 }  }
   
   
 # ------------------------------------------- Code to evaluate dynamic metadata  # ------------------------------------------- Code to evaluate dynamic metadata
   
 sub dynamicmeta {  sub dynamicmeta {
Line 129  sub dynamicmeta { Line 134  sub dynamicmeta {
     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);
   
 # Get metadata except counts  # Get metadata except counts
     if (tie(%evaldata,'GDBM_File',      if (tie(my %evaldata,'GDBM_File',
             $prodir.'/nohist_resevaldata.db',&GDBM_READER(),0640)) {              $prodir.'/nohist_resevaldata.db',&GDBM_READER(),0640)) {
  my %sum=();   my %sum=();
  my %cnt=();   my %cnt=();
Line 155  sub dynamicmeta { Line 161  sub dynamicmeta {
  $regexp=~s/(\W)/\\$1/g;   $regexp=~s/(\W)/\\$1/g;
  $regexp='___'.$regexp.'___([a-z]+)$';   $regexp='___'.$regexp.'___([a-z]+)$';
  while (my ($esckey,$value)=each %evaldata) {   while (my ($esckey,$value)=each %evaldata) {
     $key=&unescape($esckey);      my $key=&unescape($esckey);
     if ($key=~/$regexp/) {      if ($key=~/$regexp/) {
  my ($item,$purl,$cat)=split(/___/,$_);   my ($item,$purl,$cat)=split(/___/,$key);
  if (defined($cnt{$cat})) { $cnt{$cat}++; } else { $cnt{$cat}=1; }   if (defined($cnt{$cat})) { $cnt{$cat}++; } else { $cnt{$cat}=1; }
  unless ($listitems{$cat} eq 'app') {   unless ($listitems{$cat} eq 'app') {
     if (defined($sum{$cat})) {      if (defined($sum{$cat})) {
  $sum{$cat}+=$evaldata{$_};   $sum{$cat}+=$evaldata{$esckey};
  $concat{$cat}.=','.$item;   $concat{$cat}.=','.$item;
     } else {      } else {
  $sum{$cat}=$evaldata{$_};   $sum{$cat}=$evaldata{$esckey};
  $concat{$cat}=$item;   $concat{$cat}=$item;
     }      }
  } else {   } else {
     if (defined($sum{$cat})) {      if (defined($sum{$cat})) {
  if ($evaldata{$_}) {   if ($evaldata{$esckey}=~/\w/) {
     $sum{$cat}.='<hr>'.$evaldata{$_};      $sum{$cat}.='<hr>'.$evaldata{$esckey};
  }   }
     } else {      } else {
  $sum{$cat}=''.$evaldata{$_};   $sum{$cat}=''.$evaldata{$esckey};
     }      }
  }   }
     }      }
  }   }
  untie(%evaldata);   untie(%evaldata);
     }  # transfer gathered data to returnhash, calculate averages where applicable
 # construct the return hash for non-count data   while (my $cat=each(%cnt)) {
     my %returnhash=();      if ($listitems{$cat} eq 'avg') {
     while ($_=each(%cnt)) {   $returnhash{$cat}=int(($sum{$cat}/$cnt{$cat})*100.0+0.5)/100.0;
  if ($listitems{$_} eq 'avg') {      } elsif ($listitems{$cat} eq 'cnt') {
     $returnhash{$_}=int(($sum{$_}/$cnt{$_})*100.0+0.5)/100.0;   $returnhash{$cat}=$cnt{$cat};
  } elsif ($listitems{$_} eq 'cnt') {      } else {
     $returnhash{$_}=$cnt{$_};   $returnhash{$cat}=$sum{$cat};
  } else {      }
     $returnhash{$_}=$sum{$_};      $returnhash{$cat.'_list'}=$concat{$cat};
  }   }
  $returnhash{$_.'_list'}=$concat{$_};  
     }      }
 # get count  # get count
     if (tie(%evaldata,'GDBM_File',      if (tie(my %evaldata,'GDBM_File',
             $prodir.'/nohist_accesscount.db',&GDBM_READER(),0640)) {              $prodir.'/nohist_accesscount.db',&GDBM_READER(),0640)) {
  if (! exists($evaldata{$uri})) {   my $escurl=&escape($url);
     $returnhash{'count'}='Not Available';   if (! exists($evaldata{$escurl})) {
       $returnhash{'count'}=0;
  } else {   } else {
     $returnhash{'count'}=$evaldata{$uri};      $returnhash{'count'}=$evaldata{$escurl};
  }   }
  untie %evaldata;   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 227  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 252  my $dbh; Line 249  my $dbh;
  exit;   exit;
     }      }
   
   # Create table for static metadata, unless exists
     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 265  my $dbh; Line 263  my $dbh;
         "FULLTEXT idx_copyright (copyright)) TYPE=MYISAM";          "FULLTEXT idx_copyright (copyright)) TYPE=MYISAM";
     # It would sure be nice to have some logging mechanism.      # It would sure be nice to have some logging mechanism.
     $dbh->do($make_metadata_table);      $dbh->do($make_metadata_table);
   
   # Create table for dynamic metadata, unless exists
       my $make_dynmetadata_table = "CREATE TABLE IF NOT EXISTS dynmetadata (".
           "url TEXT, count INTEGER UNSIGNED, ".
           "course INTEGER UNSIGNED, course_list TEXT, ".
           "goto INTEGER UNSIGNED, goto_list TEXT, ".
           "comefrom INTEGER UNSIGNED, comefrom_list TEXT, ".
           "usage INTEGER UNSIGNED, usage_list TEXT, ".
           "stdno INTEGER UNSIGNED, stdno_list TEXT, ".
    "avetries FLOAT, avetries_list TEXT, ".
           "difficulty FLOAT, difficulty_list TEXT ".
           "TYPE=MYISAM";
       # It would sure be nice to have some logging mechanism.
   ####    $dbh->do($make_dynmetadata_table);
   
 }  }
   
 # ------------------------------------------------------------- get .meta files  # ------------------------------------------------------------- get .meta files
Line 313  foreach my $user (@homeusers) { Line 326  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$//;
         &dynamicmeta($m2);  
   if ($ref->{'obsolete'}) { print LOG "obsolete\n"; next; }    if ($ref->{'obsolete'}) { print LOG "obsolete\n"; next; }
  if ($ref->{'copyright'} eq 'private') { print LOG "private\n"; next; }   if ($ref->{'copyright'} eq 'private') { print LOG "private\n"; next; }
           &dynamicmeta($m2);
  &count($m2);   &count($m2);
         $delete_sth->execute($m2);          $delete_sth->execute($m2);
         $insert_sth->execute($ref->{'title'},          $insert_sth->execute($ref->{'title'},
Line 473  sub unsqltime { Line 486  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.44  
changed lines
  Added in v.1.46

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