version 1.44, 2003/12/23 15:47:26
|
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; |
|
|
$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); |
|
if (! exists($evaldata{$escurl})) { |
$returnhash{'count'}='Not Available'; |
$returnhash{'count'}='Not Available'; |
} 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 313 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$//; |
&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 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/$_"); |
|
} |