--- loncom/metadata_database/searchcat.pl 2003/06/19 19:34:27 1.33 +++ loncom/metadata_database/searchcat.pl 2003/08/08 12:38:00 1.37 @@ -2,7 +2,7 @@ # The LearningOnline Network # searchcat.pl "Search Catalog" batch script # -# $Id: searchcat.pl,v 1.33 2003/06/19 19:34:27 matthew Exp $ +# $Id: searchcat.pl,v 1.37 2003/08/08 12:38:00 matthew Exp $ # # Copyright Michigan State University Board of Trustees # @@ -76,6 +76,13 @@ use POSIX qw(strftime mktime); my @metalist; +$simplestatus=''; + +sub writesimple { + open(SMP,'>/home/httpd/html/lon-status/mysql.txt'); + print SMP $simplestatus."\n"; + close(SMP); +} # ----------------------------------------------------- Un-Escape Special Chars @@ -104,75 +111,75 @@ sub dynamicmeta { my ($adomain,$aauthor)=($url=~/^(\w+)\/(\w+)\//); my $prodir=&propath($adomain,$aauthor); if ((tie(%evaldata,'GDBM_File', - $prodir.'/nohist_resevaldata.db',&GDBM_READER(),0640)) && + $prodir.'/nohist_resevaldata.db',&GDBM_READER(),0640)) && (tie(%newevaldata,'GDBM_File', - $prodir.'/nohist_new_resevaldata.db',&GDBM_WRCREAT(),0640))) { - my %sum=(); - my %cnt=(); - my %listitems=('count' => 'add', - 'course' => '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]+)$'; - foreach (keys %evaldata) { - my $key=&unescape($_); - if ($key=~/$regexp/) { - my $ctype=$1; - if (defined($cnt{$ctype})) { - $cnt{$ctype}++; - } else { - $cnt{$ctype}=1; - } - unless ($listitems{$ctype} eq 'app') { - if (defined($sum{$ctype})) { - $sum{$ctype}+=$evaldata{$_}; - } else { - $sum{$ctype}=$evaldata{$_}; - } - } else { - if (defined($sum{$ctype})) { - if ($evaldata{$_}) { - $sum{$ctype}.='
'.$evaldata{$_}; - } - } else { - $sum{$ctype}=''.$evaldata{$_}; - } - } - if ($ctype ne 'count') { - $newevaldata{$_}=$evaldata{$_}; - } + $prodir.'/nohist_new_resevaldata.db',&GDBM_WRCREAT(),0640))) { + my %sum=(); + my %cnt=(); + my %listitems=('count' => 'add', + 'course' => '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]+)$'; + foreach (keys %evaldata) { + my $key=&unescape($_); + if ($key=~/$regexp/) { + my $ctype=$1; + if (defined($cnt{$ctype})) { + $cnt{$ctype}++; + } else { + $cnt{$ctype}=1; } - } - foreach (keys %cnt) { - if ($listitems{$_} eq 'avg') { - $returnhash{$_}=int(($sum{$_}/$cnt{$_})*100.0+0.5)/100.0; - } elsif ($listitems{$_} eq 'cnt') { - $returnhash{$_}=$cnt{$_}; + unless ($listitems{$ctype} eq 'app') { + if (defined($sum{$ctype})) { + $sum{$ctype}+=$evaldata{$_}; + } else { + $sum{$ctype}=$evaldata{$_}; + } } else { - $returnhash{$_}=$sum{$_}; - } - } - if ($returnhash{'count'}) { - my $newkey=$$.'_'.time.'_searchcat___'.&escape($url).'___count'; - $newevaldata{$newkey}=$returnhash{'count'}; - } - untie(%evaldata); - untie(%newevaldata); - } - return %returnhash; + if (defined($sum{$ctype})) { + if ($evaldata{$_}) { + $sum{$ctype}.='
'.$evaldata{$_}; + } + } else { + $sum{$ctype}=''.$evaldata{$_}; + } + } + if ($ctype ne 'count') { + $newevaldata{$_}=$evaldata{$_}; + } + } + } + foreach (keys %cnt) { + if ($listitems{$_} eq 'avg') { + $returnhash{$_}=int(($sum{$_}/$cnt{$_})*100.0+0.5)/100.0; + } elsif ($listitems{$_} eq 'cnt') { + $returnhash{$_}=$cnt{$_}; + } else { + $returnhash{$_}=$sum{$_}; + } + } + if ($returnhash{'count'}) { + my $newkey=$$.'_'.time.'_searchcat___'.&escape($url).'___count'; + $newevaldata{$newkey}=$returnhash{'count'}; + } + untie(%evaldata); + untie(%newevaldata); + } + return %returnhash; } - + # ----------------- Code to enable 'find' subroutine listing of the .meta files require "find.pl"; sub wanted { @@ -207,6 +214,7 @@ if ($wwwid!=$<) { open(LOG,'>'.$perlvar{'lonDaemons'}.'/logs/searchcat.log'); print LOG '==== Searchcat Run '.localtime()."====\n\n"; +$simplestatus='time='.time.'&'; my $dbh; # ------------------------------------- Make sure that database can be accessed { @@ -214,8 +222,11 @@ my $dbh; $dbh = DBI->connect("DBI:mysql:loncapa","www",$perlvar{'lonSqlAccess'},{ RaiseError =>0,PrintError=>0}) ) { print LOG "Cannot connect to database!\n"; + $simplestatus.='mysql=defunct'; + &writesimple(); exit; } + my $make_metadata_table = "CREATE TABLE IF NOT EXISTS metadata (". "title TEXT, author TEXT, subject TEXT, url TEXT, keywords TEXT, ". "version TEXT, notes TEXT, abstract TEXT, mime TEXT, language TEXT, ". @@ -237,6 +248,30 @@ my @homeusers = grep { &ishome("$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}/$_") } grep {!/^\.\.?$/} readdir(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) { print LOG "\n=== User: ".$user."\n\n"; # Remove left-over db-files from potentially crashed searchcat run @@ -255,30 +290,25 @@ foreach my $user (@homeusers) { my $m2='/res/'.&declutter($m); $m2=~s/\.meta$//; &dynamicmeta($m2); - my $q2="select * from metadata where url like binary '$m2'"; - my $sth = $dbh->prepare($q2); - $sth->execute(); - my $r1=$sth->fetchall_arrayref; - if (@$r1) { - $sth=$dbh->prepare("delete from metadata where url like binary '$m2'"); - $sth->execute(); - } - $sth=$dbh->prepare('insert into metadata values ('. - '"'.delete($ref->{'title'}).'"'.','. - '"'.delete($ref->{'author'}).'"'.','. - '"'.delete($ref->{'subject'}).'"'.','. - '"'.$m2.'"'.','. - '"'.delete($ref->{'keywords'}).'"'.','. - '"'.'current'.'"'.','. - '"'.delete($ref->{'notes'}).'"'.','. - '"'.delete($ref->{'abstract'}).'"'.','. - '"'.delete($ref->{'mime'}).'"'.','. - '"'.delete($ref->{'language'}).'"'.','. - '"'.sqltime(delete($ref->{'creationdate'})).'"'.','. - '"'.sqltime(delete($ref->{'lastrevisiondate'})).'"'.','. - '"'.delete($ref->{'owner'}).'"'.','. - '"'.delete($ref->{'copyright'}).'"'.')'); - $sth->execute(); + $delete_sth->execute($m2); + $insert_sth->execute($ref->{'title'}, + $ref->{'author'}, + $ref->{'subject'}, + $m2, + $ref->{'keywords'}, + 'current', + $ref->{'notes'}, + $ref->{'abstract'}, + $ref->{'mime'}, + $ref->{'language'}, + sqltime($ref->{'creationdate'}), + sqltime($ref->{'lastrevisiondate'}), + $ref->{'owner'}, + $ref->{'copyright'}); +# if ($dbh->err()) { +# print STDERR "Error:".$dbh->errstr()."\n"; +# } + $ref = undef; } # --------------------------------------------------- Clean up database @@ -286,13 +316,33 @@ foreach my $user (@homeusers) { # ... not yet implemented # ------------------------------------------- Copy over the new db-files - system('mv '.$prodir.'/nohist_new_resevaldata.db '. - $prodir.'/nohist_resevaldata.db'); + # + # Check the size of nohist_new_resevaldata.db compared to + # nohist_resevaldata.db + my @stat_result = stat($prodir.'/nohist_new_resevaldata.db'); + my $new_size = $stat_result[7]; + @stat_result = stat($prodir.'/nohist_resevaldata.db'); + my $old_size = $stat_result[7]; + if ($new_size/$old_size > 0.15 ) { + system('mv '.$prodir.'/nohist_new_resevaldata.db '. + $prodir.'/nohist_resevaldata.db'); + } else { + print LOG "Size of '$user' old nohist_reseval: $old_size ". + "Size of new: $new_size. Not overwriting.\n"; + my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}"; + my $subj="LON: $perlvar{'lonHostID'} searchcat.pl $user reseval ". + "modification error."; + system("echo ". + "'See /home/httpd/perl/logs/searchcat.txt for information.' ". + "| mailto $emailto -s '$subj' > /dev/null"); + } + } # --------------------------------------------------- Close database connection $dbh->disconnect; print LOG "\n==== Searchcat completed ".localtime()." ====\n"; close(LOG); +&writesimple(); exit 0;