loncom/metadata_database/searchcat.pl - diff

Return to searchcat.pl CVS log

Up to [LON-CAPA] / loncom / metadata_database

Diff for /loncom/metadata_database/searchcat.pl between versions 1.42 and 1.46

version 1.42, 2003/10/08 14:15:03	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 {

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=(
'goto' => 'add',	'course' => 'add',
'comefrom' => 'add',	'goto' => 'add',
'avetries' => 'avg',	'comefrom' => 'add',
'stdno' => 'add',	'avetries' => 'avg',
'difficulty' => 'avg',	'stdno' => 'add',
'clear' => 'avg',	'difficulty' => 'avg',
'technical' => 'avg',	'clear' => 'avg',
'helpful' => 'avg',	'technical' => 'avg',
'correct' => 'avg',	'helpful' => 'avg',
'depth' => 'avg',	'correct' => 'avg',
'comments' => 'app',	'depth' => 'avg',
'usage' => 'cnt'	'comments' => 'app',
);	'usage' => 'cnt'
my $regexp=$url;	);
$regexp=~s/(\W)/\\$1/g;
$regexp='___'.$regexp.'___([a-z]+)$';	my $regexp=$url;
while (my ($key,$value)=each %evaldata) {	$regexp=~s/(\W)/\\$1/g;
$key=&unescape($key);	$regexp='___'.$regexp.'___([a-z]+)$';
if ($key=~/$regexp/) {	while (my ($esckey,$value)=each %evaldata) {
my $ctype=$1;	my $key=&unescape($esckey);
if (defined($cnt{$ctype})) {	if ($key=~/$regexp/) {
$cnt{$ctype}++;	my ($item,$purl,$cat)=split(/___/,$key);
} else {	if (defined($cnt{$cat})) { $cnt{$cat}++; } else { $cnt{$cat}=1; }
$cnt{$ctype}=1;	unless ($listitems{$cat} eq 'app') {
}	if (defined($sum{$cat})) {
unless ($listitems{$ctype} eq 'app') {	$sum{$cat}+=$evaldata{$esckey};
if (defined($sum{$ctype})) {	$concat{$cat}.=','.$item;
$sum{$ctype}+=$value;	} else {
} else {	$sum{$cat}=$evaldata{$esckey};
$sum{$ctype}=$value;	$concat{$cat}=$item;
}	}
} else {	} else {
if (defined($sum{$ctype})) {	if (defined($sum{$cat})) {
if ($value) {	if ($evaldata{$esckey}=~/\w/) {
$sum{$ctype}.='<hr>'.$value;	$sum{$cat}.='<hr>'.$evaldata{$esckey};
}	}
} else {	} else {
$sum{$ctype}=''.$value;	$sum{$cat}=''.$evaldata{$esckey};
}	}
	}
	}
	}
	untie(%evaldata);
	# transfer gathered data to returnhash, calculate averages where applicable
	while (my $cat=each(%cnt)) {
	if ($listitems{$cat} eq 'avg') {
	$returnhash{$cat}=int(($sum{$cat}/$cnt{$cat})*100.0+0.5)/100.0;
	} elsif ($listitems{$cat} eq 'cnt') {
	$returnhash{$cat}=$cnt{$cat};
	} else {
	$returnhash{$cat}=$sum{$cat};
}	}
if ($ctype ne 'count') {	$returnhash{$cat.'_list'}=$concat{$cat};
$newevaldata{$_}=$value;	}
}	}
}	# get count
}	if (tie(my %evaldata,'GDBM_File',
foreach (keys %cnt) {	$prodir.'/nohist_accesscount.db',&GDBM_READER(),0640)) {
if ($listitems{$_} eq 'avg') {	my $escurl=&escape($url);
$returnhash{$_}=int(($sum{$_}/$cnt{$_})*100.0+0.5)/100.0;	if (! exists($evaldata{$escurl})) {
} elsif ($listitems{$_} eq 'cnt') {	$returnhash{'count'}=0;
$returnhash{$_}=$cnt{$_};	} else {
} else {	$returnhash{'count'}=$evaldata{$escurl};
$returnhash{$_}=$sum{$_};	}
}	untie %evaldata;
}	}
if ($returnhash{'count'}) {	return %returnhash;
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 {
(($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 224 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 249 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 262 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 296 my $insert_sth = $dbh->prepare	Line 312 my $insert_sth = $dbh->prepare

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 311 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 340 foreach my $user (@homeusers) {	Line 355 foreach my $user (@homeusers) {
# 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;
Line 477 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/$_");
	}

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

Removed from v.1.42
changed lines
	Added in v.1.46