Annotation of loncom/metadata_database/searchcat.pl, revision 1.69
1.1 harris41 1: #!/usr/bin/perl
2: # The LearningOnline Network
3: # searchcat.pl "Search Catalog" batch script
1.16 harris41 4: #
1.69 ! raeburn 5: # $Id: searchcat.pl,v 1.68 2006/04/08 07:07:15 albertel Exp $
1.16 harris41 6: #
7: # Copyright Michigan State University Board of Trustees
8: #
1.29 albertel 9: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
1.16 harris41 10: #
1.29 albertel 11: # LON-CAPA is free software; you can redistribute it and/or modify
1.16 harris41 12: # it under the terms of the GNU General Public License as published by
13: # the Free Software Foundation; either version 2 of the License, or
14: # (at your option) any later version.
15: #
1.29 albertel 16: # LON-CAPA is distributed in the hope that it will be useful,
1.16 harris41 17: # but WITHOUT ANY WARRANTY; without even the implied warranty of
18: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19: # GNU General Public License for more details.
20: #
21: # You should have received a copy of the GNU General Public License
1.29 albertel 22: # along with LON-CAPA; if not, write to the Free Software
1.16 harris41 23: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
24: #
25: # /home/httpd/html/adm/gpl.txt
26: #
1.29 albertel 27: # http://www.lon-capa.org/
1.16 harris41 28: #
29: ###
1.33 matthew 30:
1.32 www 31: =pod
1.1 harris41 32:
1.32 www 33: =head1 NAME
34:
35: B<searchcat.pl> - put authoritative filesystem data into sql database.
36:
37: =head1 SYNOPSIS
38:
39: Ordinarily this script is to be called from a loncapa cron job
40: (CVS source location: F<loncapa/loncom/cron/loncapa>; typical
41: filesystem installation location: F</etc/cron.d/loncapa>).
42:
43: Here is the cron job entry.
44:
45: C<# Repopulate and refresh the metadata database used for the search catalog.>
46: C<10 1 * * 7 www /home/httpd/perl/searchcat.pl>
47:
48: This script only allows itself to be run as the user C<www>.
49:
50: =head1 DESCRIPTION
51:
52: This script goes through a loncapa resource directory and gathers metadata.
53: The metadata is entered into a SQL database.
54:
55: This script also does general database maintenance such as reformatting
56: the C<loncapa:metadata> table if it is deprecated.
57:
58: This script evaluates dynamic metadata from the authors'
1.48 www 59: F<nohist_resevaldata.db> database file in order to store it in MySQL.
1.32 www 60:
61: This script is playing an increasingly important role for a loncapa
62: library server. The proper operation of this script is critical for a smooth
63: and correct user experience.
64:
65: =cut
1.1 harris41 66:
1.45 www 67: use strict;
1.55 matthew 68: use DBI;
1.17 harris41 69: use lib '/home/httpd/lib/perl/';
1.55 matthew 70: use LONCAPA::lonmetadata;
1.17 harris41 71:
1.56 matthew 72: use Getopt::Long;
1.1 harris41 73: use IO::File;
74: use HTML::TokeParser;
1.21 www 75: use GDBM_File;
1.24 www 76: use POSIX qw(strftime mktime);
1.56 matthew 77:
1.63 matthew 78: use Apache::lonnet();
1.62 matthew 79:
1.55 matthew 80: use File::Find;
1.1 harris41 81:
1.56 matthew 82: #
83: # Set up configuration options
1.63 matthew 84: my ($simulate,$oneuser,$help,$verbose,$logfile,$debug);
1.56 matthew 85: GetOptions (
86: 'help' => \$help,
87: 'simulate' => \$simulate,
88: 'only=s' => \$oneuser,
89: 'verbose=s' => \$verbose,
90: 'debug' => \$debug,
91: );
92:
93: if ($help) {
94: print <<"ENDHELP";
95: $0
96: Rebuild and update the LON-CAPA metadata database.
97: Options:
98: -help Print this help
99: -simulate Do not modify the database.
100: -only=user Only compute for the given user. Implies -simulate
101: -verbose=val Sets logging level, val must be a number
102: -debug Turns on debugging output
103: ENDHELP
104: exit 0;
105: }
106:
107: if (! defined($debug)) {
108: $debug = 0;
109: }
110:
111: if (! defined($verbose)) {
112: $verbose = 0;
113: }
114:
115: if (defined($oneuser)) {
116: $simulate=1;
117: }
118:
1.55 matthew 119: ##
120: ## Use variables for table names so we can test this routine a little easier
1.69 ! raeburn 121: my %oldnames = (
! 122: 'metadata' => 'metadata',
! 123: 'portfolio' => 'portfolio_metadata',
! 124: 'access' => 'portfolio_access',
! 125: 'addedfields' => 'portfolio_addedfields',
! 126: );
! 127:
! 128: my %newnames;
! 129: # new table names - append pid to have unique temporary tables
! 130: foreach my $key (keys(%oldnames)) {
! 131: $newnames{$key} = 'new'.$oldnames{$key}.$$;
! 132: }
1.45 www 133:
1.55 matthew 134: #
135: # Only run if machine is a library server
1.63 matthew 136: exit if ($Apache::lonnet::perlvar{'lonRole'} ne 'library');
1.55 matthew 137: #
138: # Make sure this process is running from user=www
139: my $wwwid=getpwnam('www');
140: if ($wwwid!=$<) {
1.63 matthew 141: my $emailto="$Apache::lonnet::perlvar{'lonAdmEMail'},$Apache::lonnet::perlvar{'lonSysEMail'}";
142: my $subj="LON: $Apache::lonnet::perlvar{'lonHostID'} User ID mismatch";
1.55 matthew 143: system("echo 'User ID mismatch. searchcat.pl must be run as user www.' |\
1.63 matthew 144: mail -s '$subj' $emailto > /dev/null");
1.55 matthew 145: exit 1;
146: }
147: #
148: # Let people know we are running
1.63 matthew 149: open(LOG,'>>'.$Apache::lonnet::perlvar{'lonDaemons'}.'/logs/searchcat.log');
1.56 matthew 150: &log(0,'==== Searchcat Run '.localtime()."====");
1.57 matthew 151:
152:
1.56 matthew 153: if ($debug) {
154: &log(0,'simulating') if ($simulate);
155: &log(0,'only processing user '.$oneuser) if ($oneuser);
156: &log(0,'verbosity level = '.$verbose);
157: }
1.55 matthew 158: #
159: # Connect to database
160: my $dbh;
1.63 matthew 161: if (! ($dbh = DBI->connect("DBI:mysql:loncapa","www",$Apache::lonnet::perlvar{'lonSqlAccess'},
1.55 matthew 162: { RaiseError =>0,PrintError=>0}))) {
1.56 matthew 163: &log(0,"Cannot connect to database!");
1.55 matthew 164: die "MySQL Error: Cannot connect to database!\n";
165: }
166: # This can return an error and still be okay, so we do not bother checking.
167: # (perhaps it should be more robust and check for specific errors)
1.69 ! raeburn 168: foreach my $key (keys(%newnames)) {
! 169: if ($newnames{$key} ne '') {
! 170: $dbh->do('DROP TABLE IF EXISTS '.$newnames{$key});
! 171: }
! 172: }
! 173:
1.55 matthew 174: #
1.69 ! raeburn 175: # Create the new metadata and portfolio tables
! 176: foreach my $key (keys(%newnames)) {
! 177: if ($newnames{$key} ne '') {
! 178: my $request =
! 179: &LONCAPA::lonmetadata::create_metadata_storage($newnames{$key},$oldnames{$key});
! 180: $dbh->do($request);
! 181: if ($dbh->err) {
! 182: $dbh->disconnect();
! 183: &log(0,"MySQL Error Create: ".$dbh->errstr);
! 184: die $dbh->errstr;
! 185: }
! 186: }
1.55 matthew 187: }
1.69 ! raeburn 188:
1.55 matthew 189: #
190: # find out which users we need to examine
1.63 matthew 191: my @domains = sort(&Apache::lonnet::current_machine_domains());
192: &log(9,'domains ="'.join('","',@domains).'"');
1.62 matthew 193:
194: foreach my $dom (@domains) {
195: &log(9,'domain = '.$dom);
1.63 matthew 196: opendir(RESOURCES,"$Apache::lonnet::perlvar{'lonDocRoot'}/res/$dom");
1.62 matthew 197: my @homeusers =
198: grep {
1.63 matthew 199: &ishome("$Apache::lonnet::perlvar{'lonDocRoot'}/res/$dom/$_");
1.62 matthew 200: } grep {
201: !/^\.\.?$/;
202: } readdir(RESOURCES);
203: closedir RESOURCES;
204: &log(5,'users = '.$dom.':'.join(',',@homeusers));
205: #
206: if ($oneuser) {
207: @homeusers=($oneuser);
208: }
209: #
210: # Loop through the users
211: foreach my $user (@homeusers) {
212: &log(0,"=== User: ".$user);
213: &process_dynamic_metadata($user,$dom);
214: #
215: # Use File::Find to get the files we need to read/modify
216: find(
217: {preprocess => \&only_meta_files,
218: #wanted => \&print_filename,
219: #wanted => \&log_metadata,
220: wanted => \&process_meta_file,
1.66 albertel 221: no_chdir => 1,
1.63 matthew 222: }, join('/',($Apache::lonnet::perlvar{'lonDocRoot'},'res',$dom,$user)) );
1.62 matthew 223: }
1.69 ! raeburn 224: # Search for public portfolio files
! 225: my %portusers;
! 226: if ($oneuser) {
! 227: %portusers = (
! 228: $oneuser => '',
! 229: );
! 230: } else {
! 231: my $dir = $Apache::lonnet::perlvar{lonUsersDir}.'/'.$dom;
! 232: &descend_tree($dir,0,\%portusers);
! 233: }
! 234: foreach my $uname (keys(%portusers)) {
! 235: my $urlstart = '/uploaded/'.$dom.'/'.$uname;
! 236: my $pathstart = &propath($dom,$uname).'/userfiles';
! 237: my $is_course = &check_for_course($dom,$uname);
! 238: my $curr_perm = &Apache::lonnet::get_portfile_permissions($dom,$uname);
! 239: my %access = &Apache::lonnet::get_access_controls($curr_perm);
! 240: foreach my $file (keys(%access)) {
! 241: my ($group,$url,$fullpath);
! 242: if ($is_course) {
! 243: ($group, my ($path)) = ($file =~ /^(\w+)(\/.+)$/);
! 244: $fullpath = $pathstart.'/groups/'.$group.'/portfolio/'.$path;
! 245: $url = $urlstart.'/groups/'.$group.'/portfolio'.$path;
! 246: } else {
! 247: $fullpath = $pathstart.'/portfolio'.$file;
! 248: $url .= $urlstart.'/portfolio'.$file;
! 249: }
! 250: if (ref($access{$file}) eq 'HASH') {
! 251: &process_portfolio_access_data($url,$access{$file});
! 252: }
! 253: &process_portfolio_metadata($url,$fullpath,$is_course,$dom,
! 254: $uname,$group);
! 255: }
! 256: }
1.55 matthew 257: }
1.69 ! raeburn 258:
1.55 matthew 259: #
1.69 ! raeburn 260: # Rename the tables
1.56 matthew 261: if (! $simulate) {
1.69 ! raeburn 262: foreach my $key (keys(%oldnames)) {
! 263: if (($oldnames{$key} ne '') && ($newnames{$key} ne '')) {
! 264: $dbh->do('DROP TABLE IF EXISTS '.$oldnames{$key});
! 265: if (! $dbh->do('RENAME TABLE '.$newnames{$key}.' TO '.$oldnames{$key})) {
! 266: &log(0,"MySQL Error Rename: ".$dbh->errstr);
! 267: die $dbh->errstr;
! 268: } else {
! 269: &log(1,"MySQL table rename successful for $key.");
! 270: }
! 271: }
1.56 matthew 272: }
1.55 matthew 273: }
274: if (! $dbh->disconnect) {
1.56 matthew 275: &log(0,"MySQL Error Disconnect: ".$dbh->errstr);
1.55 matthew 276: die $dbh->errstr;
277: }
278: ##
279: ## Finished!
1.56 matthew 280: &log(0,"==== Searchcat completed ".localtime()." ====");
1.55 matthew 281: close(LOG);
1.21 www 282:
1.55 matthew 283: &write_type_count();
284: &write_copyright_count();
1.36 www 285:
1.55 matthew 286: exit 0;
1.28 harris41 287:
1.56 matthew 288: ##
289: ## Status logging routine. Inputs: $level, $message
290: ##
291: ## $level 0 should be used for normal output and error messages
292: ##
293: ## $message does not need to end with \n. In the case of errors
294: ## the message should contain as much information as possible to
295: ## help in diagnosing the problem.
296: ##
297: sub log {
298: my ($level,$message)=@_;
299: $level = 0 if (! defined($level));
300: if ($verbose >= $level) {
301: print LOG $message.$/;
302: }
303: }
304:
1.69 ! raeburn 305: sub descend_tree {
! 306: my ($dir,$depth,$alldomusers) = @_;
! 307: if (-d $dir) {
! 308: opendir(DIR,$dir);
! 309: my @contents = grep(!/^\./,readdir(DIR));
! 310: closedir(DIR);
! 311: $depth ++;
! 312: foreach my $item (@contents) {
! 313: if ($depth < 4) {
! 314: &descend_tree($dir.'/'.$item,$depth,$alldomusers);
! 315: } else {
! 316: if (-e $dir.'/'.$item.'/file_permissions.db') {
! 317:
! 318: $$alldomusers{$item} = '';
! 319: }
! 320: }
! 321: }
! 322: }
! 323: }
! 324:
! 325: sub check_for_course {
! 326: my ($cdom,$cnum) = @_;
! 327: my %courses = &Apache::lonnet::courseiddump($cdom,'.',1,'.','.',$cnum,undef,
! 328: undef,'.');
! 329: if (exists($courses{$cdom.'_'.$cnum})) {
! 330: return 1;
! 331: }
! 332: return 0;
! 333: }
! 334:
! 335:
! 336: sub process_portfolio_access_data {
! 337: my ($url,$access_hash) = @_;
! 338: foreach my $key (keys(%{$access_hash})) {
! 339: my $acc_data;
! 340: $acc_data->{url} = $url;
! 341: $acc_data->{keynum} = $key;
! 342: my ($num,$scope,$end,$start) =
! 343: ($key =~ /^([^:]+):([a-z]+)_(\d*)_?(\d*)$/);
! 344: $acc_data->{scope} = $scope;
! 345: if ($end != 0) {
! 346: $acc_data->{end} = &sqltime($end);
! 347: }
! 348: $acc_data->{start} = &sqltime($start);
! 349: if (! $simulate) {
! 350: my ($count,$err) =
! 351: &LONCAPA::lonmetadata::store_metadata($dbh,
! 352: $newnames{'access'},
! 353: 'portfolio_access',$acc_data);
! 354: if ($err) {
! 355: &log(0,"MySQL Error Insert: ".$err);
! 356: }
! 357: if ($count < 1) {
! 358: &log(0,"Unable to insert record into MySQL database for $url");
! 359: }
! 360: }
! 361: }
! 362: }
! 363:
! 364: sub process_portfolio_metadata {
! 365: my ($url,$fullpath,$is_course,$dom,$uname,$group) = @_;
! 366: my ($ref,$crs,$addedfields) = &portfolio_metadata($fullpath,$dom,$uname,
! 367: $group);
! 368: &getfiledates($ref,$fullpath);
! 369: if ($is_course) {
! 370: $ref->{'groupname'} = $group;
! 371: }
! 372: my %Data;
! 373: if (ref($ref) eq 'HASH') {
! 374: %Data = %{$ref};
! 375: }
! 376: %Data = (
! 377: %Data,
! 378: 'url'=>$url,
! 379: 'version'=>'current',
! 380: );
! 381: if (! $simulate) {
! 382: my ($count,$err) =
! 383: &LONCAPA::lonmetadata::store_metadata($dbh,
! 384: $newnames{'portfolio'},
! 385: 'portfolio_metadata',\%Data);
! 386: if ($err) {
! 387: &log(0,"MySQL Error Insert: ".$err);
! 388: }
! 389: if ($count < 1) {
! 390: &log(0,"Unable to insert record into MySQL portfolio_metadata database table for $url");
! 391: }
! 392: if (ref($addedfields) eq 'HASH') {
! 393: if (keys(%{$addedfields}) > 0) {
! 394: foreach my $key (keys(%{$addedfields})) {
! 395: my $added_data = {
! 396: 'url' => $url,
! 397: 'field' => $key,
! 398: 'value' => $addedfields->{$key},
! 399: 'courserestricted' => $crs,
! 400: };
! 401: ($count,$err) = &LONCAPA::lonmetadata::store_metadata($dbh,
! 402: $newnames{'addedfields'},
! 403: 'portfolio_addedfields',
! 404: $added_data);
! 405: if ($err) {
! 406: &log(0,"MySQL Error Insert: ".$err);
! 407: }
! 408: if ($count < 1) {
! 409: &log(0,"Unable to insert record into MySQL portfolio_addedfields database table for url = $url and field = $key");
! 410: }
! 411: }
! 412: }
! 413: }
! 414: }
! 415: return;
! 416: }
! 417:
1.55 matthew 418: ########################################################
419: ########################################################
420: ### ###
421: ### File::Find support routines ###
422: ### ###
423: ########################################################
424: ########################################################
425: ##
426: ## &only_meta_files
427: ##
428: ## Called by File::Find.
429: ## Takes a list of files/directories in and returns a list of files/directories
430: ## to search.
431: sub only_meta_files {
432: my @PossibleFiles = @_;
433: my @ChosenFiles;
434: foreach my $file (@PossibleFiles) {
435: if ( ($file =~ /\.meta$/ && # Ends in meta
436: $file !~ /\.\d+\.[^\.]+\.meta$/ # is not for a prior version
1.67 albertel 437: ) || (-d $File::Find::dir."/".$file )) { # directories are okay
1.55 matthew 438: # but we do not want /. or /..
439: push(@ChosenFiles,$file);
440: }
1.38 www 441: }
1.55 matthew 442: return @ChosenFiles;
1.38 www 443: }
444:
1.55 matthew 445: ##
446: ##
447: ## Debugging routines, use these for 'wanted' in the File::Find call
448: ##
449: sub print_filename {
450: my ($file) = $_;
451: my $fullfilename = $File::Find::name;
1.56 matthew 452: if ($debug) {
453: if (-d $file) {
454: &log(5," Got directory ".$fullfilename);
455: } else {
456: &log(5," Got file ".$fullfilename);
457: }
1.38 www 458: }
1.55 matthew 459: $_=$file;
1.38 www 460: }
1.28 harris41 461:
1.55 matthew 462: sub log_metadata {
463: my ($file) = $_;
464: my $fullfilename = $File::Find::name;
465: return if (-d $fullfilename); # No need to do anything here for directories
1.56 matthew 466: if ($debug) {
467: &log(6,$fullfilename);
1.69 ! raeburn 468: my $ref = &metadata($fullfilename);
1.56 matthew 469: if (! defined($ref)) {
470: &log(6," No data");
471: return;
472: }
473: while (my($key,$value) = each(%$ref)) {
474: &log(6," ".$key." => ".$value);
475: }
476: &count_copyright($ref->{'copyright'});
1.55 matthew 477: }
478: $_=$file;
1.31 harris41 479: }
1.21 www 480:
1.55 matthew 481: ##
482: ## process_meta_file
483: ## Called by File::Find.
484: ## Only input is the filename in $_.
485: sub process_meta_file {
486: my ($file) = $_;
1.56 matthew 487: my $filename = $File::Find::name; # full filename
1.55 matthew 488: return if (-d $filename); # No need to do anything here for directories
489: #
1.56 matthew 490: &log(3,$filename) if ($debug);
1.55 matthew 491: #
1.69 ! raeburn 492: my $ref = &metadata($filename);
1.55 matthew 493: #
494: # $url is the original file url, not the metadata file
1.61 matthew 495: my $target = $filename;
496: $target =~ s/\.meta$//;
497: my $url='/res/'.&declutter($target);
1.56 matthew 498: &log(3," ".$url) if ($debug);
1.55 matthew 499: #
500: # Ignore some files based on their metadata
501: if ($ref->{'obsolete'}) {
1.56 matthew 502: &log(3,"obsolete") if ($debug);
1.55 matthew 503: return;
504: }
505: &count_copyright($ref->{'copyright'});
506: if ($ref->{'copyright'} eq 'private') {
1.56 matthew 507: &log(3,"private") if ($debug);
1.55 matthew 508: return;
509: }
510: #
511: # Find the dynamic metadata
512: my %dyn;
513: if ($url=~ m:/default$:) {
514: $url=~ s:/default$:/:;
1.56 matthew 515: &log(3,"Skipping dynamic data") if ($debug);
1.55 matthew 516: } else {
1.56 matthew 517: &log(3,"Retrieving dynamic data") if ($debug);
518: %dyn=&get_dynamic_metadata($url);
1.55 matthew 519: &count_type($url);
520: }
1.69 ! raeburn 521: &getfiledates($ref,$target);
1.55 matthew 522: #
523: my %Data = (
524: %$ref,
525: %dyn,
526: 'url'=>$url,
527: 'version'=>'current');
1.56 matthew 528: if (! $simulate) {
1.69 ! raeburn 529: my ($count,$err) =
! 530: &LONCAPA::lonmetadata::store_metadata($dbh,$newnames{'metadata'},
! 531: 'metadata',\%Data);
1.56 matthew 532: if ($err) {
533: &log(0,"MySQL Error Insert: ".$err);
534: }
535: if ($count < 1) {
536: &log(0,"Unable to insert record into MySQL database for $url");
537: }
1.55 matthew 538: }
539: #
540: # Reset $_ before leaving
541: $_ = $file;
542: }
543:
544: ########################################################
545: ########################################################
546: ### ###
547: ### &metadata($uri) ###
548: ### Retrieve metadata for the given file ###
549: ### ###
550: ########################################################
551: ########################################################
552: sub metadata {
1.69 ! raeburn 553: my ($uri) = @_;
1.55 matthew 554: my %metacache=();
555: $uri=&declutter($uri);
556: my $filename=$uri;
557: $uri=~s/\.meta$//;
558: $uri='';
559: if ($filename !~ /\.meta$/) {
560: $filename.='.meta';
561: }
1.63 matthew 562: my $metastring=&getfile($Apache::lonnet::perlvar{'lonDocRoot'}.'/res/'.$filename);
1.55 matthew 563: return undef if (! defined($metastring));
564: my $parser=HTML::TokeParser->new(\$metastring);
565: my $token;
566: while ($token=$parser->get_token) {
567: if ($token->[0] eq 'S') {
568: my $entry=$token->[1];
569: my $unikey=$entry;
570: if (defined($token->[2]->{'part'})) {
571: $unikey.='_'.$token->[2]->{'part'};
572: }
573: if (defined($token->[2]->{'name'})) {
574: $unikey.='_'.$token->[2]->{'name'};
575: }
576: if ($metacache{$uri.'keys'}) {
577: $metacache{$uri.'keys'}.=','.$unikey;
578: } else {
579: $metacache{$uri.'keys'}=$unikey;
580: }
581: foreach ( @{$token->[3]}) {
582: $metacache{$uri.''.$unikey.'.'.$_}=$token->[2]->{$_};
1.69 ! raeburn 583: }
1.55 matthew 584: if (! ($metacache{$uri.''.$unikey}=$parser->get_text('/'.$entry))){
585: $metacache{$uri.''.$unikey} =
586: $metacache{$uri.''.$unikey.'.default'};
587: }
588: } # End of ($token->[0] eq 'S')
589: }
590: return \%metacache;
1.31 harris41 591: }
1.28 harris41 592:
1.69 ! raeburn 593: ###############################################################
! 594: ###############################################################
! 595: ### ###
! 596: ### &portfolio_metadata($filepath,$dom,$uname,$group) ###
! 597: ### Retrieve metadata for the given file ###
! 598: ### Returns array - ###
! 599: ### contains reference to metadatahash and ###
! 600: ### optional reference to addedfields hash ###
! 601: ### ###
! 602: ###############################################################
! 603: ###############################################################
! 604: sub portfolio_metadata {
! 605: my ($fullpath,$dom,$uname,$group)=@_;
! 606: my ($mime) = ( $fullpath=~/\.(\w+)$/ );
! 607: my %metacache=();
! 608: if ($fullpath !~ /\.meta$/) {
! 609: $fullpath .= '.meta';
! 610: }
! 611: my (@standard_fields,%addedfields);
! 612: my $colsref =
! 613: $LONCAPA::lonmetadata::Portfolio_metadata_table_description;
! 614: if (ref($colsref) eq 'ARRAY') {
! 615: my @columns = @{$colsref};
! 616: foreach my $coldata (@columns) {
! 617: push(@standard_fields,$coldata->{'name'});
! 618: }
! 619: }
! 620: my $metastring=&getfile($fullpath);
! 621: if (! defined($metastring)) {
! 622: $metacache{'keys'}= 'owner,domain,mime';
! 623: $metacache{'owner'} = $uname.':'.$dom;
! 624: $metacache{'domain'} = $dom;
! 625: $metacache{'mime'} = $mime;
! 626: if (defined($group)) {
! 627: $metacache{'keys'} .= ',courserestricted';
! 628: $metacache{'courserestricted'} = 'course.'.$dom.'_'.$uname;
! 629: }
! 630: } else {
! 631: my $parser=HTML::TokeParser->new(\$metastring);
! 632: my $token;
! 633: while ($token=$parser->get_token) {
! 634: if ($token->[0] eq 'S') {
! 635: my $entry=$token->[1];
! 636: if ($metacache{'keys'}) {
! 637: $metacache{'keys'}.=','.$entry;
! 638: } else {
! 639: $metacache{'keys'}=$entry;
! 640: }
! 641: my $value = $parser->get_text('/'.$entry);
! 642: if (!grep(/^\Q$entry\E$/,@standard_fields)) {
! 643: my $clean_value = lc($value);
! 644: $clean_value =~ s/\s/_/g;
! 645: if ($clean_value ne $entry) {
! 646: if (defined($addedfields{$entry})) {
! 647: $addedfields{$entry} .=','.$value;
! 648: } else {
! 649: $addedfields{$entry} = $value;
! 650: }
! 651: }
! 652: } else {
! 653: $metacache{$entry} = $value;
! 654: }
! 655: }
! 656: } # End of ($token->[0] eq 'S')
! 657: }
! 658: if (keys(%addedfields) > 0) {
! 659: foreach my $key (sort keys(%addedfields)) {
! 660: $metacache{'addedfieldnames'} .= $key.',';
! 661: $metacache{'addedfieldvalues'} .= $addedfields{$key}.'&&&';
! 662: }
! 663: $metacache{'addedfieldnames'} =~ s/,$//;
! 664: $metacache{'addedfieldvalues'} =~ s/\&\&\&$//;
! 665: if ($metacache{'keys'}) {
! 666: $metacache{'keys'}.=',addedfieldnames';
! 667: } else {
! 668: $metacache{'keys'}='addedfieldnames';
! 669: }
! 670: $metacache{'keys'}.=',addedfieldvalues';
! 671: }
! 672: return (\%metacache,$metacache{'courserestricted'},\%addedfields);
! 673: }
! 674:
1.55 matthew 675: ##
676: ## &getfile($filename)
677: ## Slurps up an entire file into a scalar.
678: ## Returns undef if the file does not exist
679: sub getfile {
680: my $file = shift();
681: if (! -e $file ) {
682: return undef;
683: }
684: my $fh=IO::File->new($file);
685: my $contents = '';
686: while (<$fh>) {
687: $contents .= $_;
688: }
689: return $contents;
690: }
1.28 harris41 691:
1.69 ! raeburn 692: ##
! 693: ## &getfiledates()
! 694: ## Converts creationdate and modifieddates to SQL format
! 695: ## Applies stat() to file to retrieve dates if missing
! 696: sub getfiledates {
! 697: my ($ref,$target) = @_;
! 698: if (! defined($ref->{'creationdate'}) ||
! 699: $ref->{'creationdate'} =~ /^\s*$/) {
! 700: $ref->{'creationdate'} = (stat($target))[9];
! 701: }
! 702: if (! defined($ref->{'lastrevisiondate'}) ||
! 703: $ref->{'lastrevisiondate'} =~ /^\s*$/) {
! 704: $ref->{'lastrevisiondate'} = (stat($target))[9];
! 705: }
! 706: $ref->{'creationdate'} = &sqltime($ref->{'creationdate'});
! 707: $ref->{'lastrevisiondate'} = &sqltime($ref->{'lastrevisiondate'});
! 708: }
! 709:
1.55 matthew 710: ########################################################
711: ########################################################
712: ### ###
713: ### Dynamic Metadata ###
714: ### ###
715: ########################################################
716: ########################################################
1.56 matthew 717: ##
1.58 www 718: ## Dynamic metadata description (incomplete)
719: ##
720: ## For a full description of all fields,
721: ## see LONCAPA::lonmetadata
1.56 matthew 722: ##
723: ## Field Type
724: ##-----------------------------------------------------------
725: ## count integer
726: ## course integer
1.58 www 727: ## course_list comma separated list of course ids
1.56 matthew 728: ## avetries real
1.58 www 729: ## avetries_list comma separated list of real numbers
1.56 matthew 730: ## stdno real
1.58 www 731: ## stdno_list comma separated list of real numbers
1.56 matthew 732: ## usage integer
1.58 www 733: ## usage_list comma separated list of resources
1.56 matthew 734: ## goto scalar
1.58 www 735: ## goto_list comma separated list of resources
1.56 matthew 736: ## comefrom scalar
1.58 www 737: ## comefrom_list comma separated list of resources
1.56 matthew 738: ## difficulty real
1.58 www 739: ## difficulty_list comma separated list of real numbers
1.56 matthew 740: ## sequsage scalar
1.58 www 741: ## sequsage_list comma separated list of resources
1.56 matthew 742: ## clear real
743: ## technical real
744: ## correct real
745: ## helpful real
746: ## depth real
747: ## comments html of all the comments made
748: ##
749: {
750:
751: my %DynamicData;
752: my %Counts;
753:
754: sub process_dynamic_metadata {
755: my ($user,$dom) = @_;
756: undef(%DynamicData);
757: undef(%Counts);
758: #
759: my $prodir = &propath($dom,$user);
1.55 matthew 760: #
1.56 matthew 761: # Read in the dynamic metadata
1.55 matthew 762: my %evaldata;
763: if (! tie(%evaldata,'GDBM_File',
764: $prodir.'/nohist_resevaldata.db',&GDBM_READER(),0640)) {
1.56 matthew 765: return 0;
1.55 matthew 766: }
1.56 matthew 767: #
1.57 matthew 768: %DynamicData = &LONCAPA::lonmetadata::process_reseval_data(\%evaldata);
1.55 matthew 769: untie(%evaldata);
1.62 matthew 770: $DynamicData{'domain'} = $dom;
1.64 albertel 771: #print('user = '.$user.' domain = '.$dom.$/);
1.56 matthew 772: #
773: # Read in the access count data
774: &log(7,'Reading access count data') if ($debug);
775: my %countdata;
776: if (! tie(%countdata,'GDBM_File',
777: $prodir.'/nohist_accesscount.db',&GDBM_READER(),0640)) {
778: return 0;
779: }
780: while (my ($key,$count) = each(%countdata)) {
781: next if ($key !~ /^$dom/);
782: $key = &unescape($key);
783: &log(8,' Count '.$key.' = '.$count) if ($debug);
784: $Counts{$key}=$count;
785: }
786: untie(%countdata);
787: if ($debug) {
788: &log(7,scalar(keys(%Counts)).
789: " Counts read for ".$user."@".$dom);
790: &log(7,scalar(keys(%DynamicData)).
791: " Dynamic metadata read for ".$user."@".$dom);
792: }
793: #
794: return 1;
795: }
796:
797: sub get_dynamic_metadata {
798: my ($url) = @_;
799: $url =~ s:^/res/::;
1.57 matthew 800: my %data = &LONCAPA::lonmetadata::process_dynamic_metadata($url,
801: \%DynamicData);
1.56 matthew 802: # find the count
803: $data{'count'} = $Counts{$url};
804: #
805: # Log the dynamic metadata
806: if ($debug) {
807: while (my($k,$v)=each(%data)) {
808: &log(8," ".$k." => ".$v);
809: }
1.44 www 810: }
1.56 matthew 811: return %data;
1.30 www 812: }
1.28 harris41 813:
1.56 matthew 814: } # End of %DynamicData and %Counts scope
815:
1.55 matthew 816: ########################################################
817: ########################################################
818: ### ###
819: ### Counts ###
820: ### ###
821: ########################################################
822: ########################################################
823: {
1.1 harris41 824:
1.55 matthew 825: my %countext;
1.15 harris41 826:
1.55 matthew 827: sub count_type {
828: my $file=shift;
829: $file=~/\.(\w+)$/;
830: my $ext=lc($1);
831: $countext{$ext}++;
1.31 harris41 832: }
1.1 harris41 833:
1.55 matthew 834: sub write_type_count {
835: open(RESCOUNT,'>/home/httpd/html/lon-status/rescount.txt');
836: while (my ($extension,$count) = each(%countext)) {
837: print RESCOUNT $extension.'='.$count.'&';
1.47 www 838: }
1.55 matthew 839: print RESCOUNT 'time='.time."\n";
840: close(RESCOUNT);
1.31 harris41 841: }
1.27 www 842:
1.55 matthew 843: } # end of scope for %countext
1.34 matthew 844:
1.55 matthew 845: {
1.34 matthew 846:
1.55 matthew 847: my %copyrights;
1.44 www 848:
1.55 matthew 849: sub count_copyright {
850: $copyrights{@_[0]}++;
1.31 harris41 851: }
1.33 matthew 852:
1.55 matthew 853: sub write_copyright_count {
854: open(COPYCOUNT,'>/home/httpd/html/lon-status/copyrightcount.txt');
855: while (my ($copyright,$count) = each(%copyrights)) {
856: print COPYCOUNT $copyright.'='.$count.'&';
1.31 harris41 857: }
1.55 matthew 858: print COPYCOUNT 'time='.time."\n";
859: close(COPYCOUNT);
1.31 harris41 860: }
1.28 harris41 861:
1.55 matthew 862: } # end of scope for %copyrights
1.28 harris41 863:
1.55 matthew 864: ########################################################
865: ########################################################
866: ### ###
867: ### Miscellanous Utility Routines ###
868: ### ###
869: ########################################################
870: ########################################################
871: ##
872: ## &ishome($username)
873: ## Returns 1 if $username is a LON-CAPA author, 0 otherwise
874: ## (copied from lond, modification of the return value)
1.31 harris41 875: sub ishome {
876: my $author=shift;
877: $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
878: my ($udom,$uname)=split(/\//,$author);
879: my $proname=propath($udom,$uname);
880: if (-e $proname) {
881: return 1;
882: } else {
883: return 0;
884: }
885: }
1.28 harris41 886:
1.55 matthew 887: ##
888: ## &propath($udom,$uname)
889: ## Returns the path to the users LON-CAPA directory
890: ## (copied from lond)
1.31 harris41 891: sub propath {
892: my ($udom,$uname)=@_;
893: $udom=~s/\W//g;
894: $uname=~s/\W//g;
895: my $subdir=$uname.'__';
896: $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
1.63 matthew 897: my $proname="$Apache::lonnet::perlvar{'lonUsersDir'}/$udom/$subdir/$uname";
1.31 harris41 898: return $proname;
899: }
1.28 harris41 900:
1.55 matthew 901: ##
902: ## &sqltime($timestamp)
903: ##
904: ## Convert perl $timestamp to MySQL time. MySQL expects YYYY-MM-DD HH:MM:SS
905: ##
1.31 harris41 906: sub sqltime {
1.55 matthew 907: my ($time) = @_;
908: my $mysqltime;
909: if ($time =~
910: /(\d+)-(\d+)-(\d+) # YYYY-MM-DD
911: \s # a space
912: (\d+):(\d+):(\d+) # HH:MM::SS
913: /x ) {
914: # Some of the .meta files have the time in mysql
915: # format already, so just make sure they are 0 padded and
916: # pass them back.
917: $mysqltime = sprintf('%04d-%02d-%02d %02d:%02d:%02d',
918: $1,$2,$3,$4,$5,$6);
919: } elsif ($time =~ /^\d+$/) {
920: my @TimeData = gmtime($time);
921: # Alter the month to be 1-12 instead of 0-11
922: $TimeData[4]++;
923: # Alter the year to be from 0 instead of from 1900
924: $TimeData[5]+=1900;
925: $mysqltime = sprintf('%04d-%02d-%02d %02d:%02d:%02d',
926: @TimeData[5,4,3,2,1,0]);
1.56 matthew 927: } elsif (! defined($time) || $time == 0) {
928: $mysqltime = 0;
1.55 matthew 929: } else {
1.56 matthew 930: &log(0," sqltime:Unable to decode time ".$time);
1.55 matthew 931: $mysqltime = 0;
932: }
933: return $mysqltime;
1.31 harris41 934: }
1.28 harris41 935:
1.55 matthew 936: ##
937: ## &declutter($filename)
938: ## Given a filename, returns a url for the filename.
939: sub declutter {
940: my $thisfn=shift;
1.63 matthew 941: $thisfn=~s/^$Apache::lonnet::perlvar{'lonDocRoot'}//;
1.55 matthew 942: $thisfn=~s/^\///;
943: $thisfn=~s/^res\///;
944: return $thisfn;
1.31 harris41 945: }
1.28 harris41 946:
1.55 matthew 947: ##
948: ## Escape / Unescape special characters
949: sub unescape {
950: my $str=shift;
951: $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
952: return $str;
1.31 harris41 953: }
1.28 harris41 954:
1.55 matthew 955: sub escape {
956: my $str=shift;
957: $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
958: return $str;
1.45 www 959: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to searchcat.pl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / metadata_database