--- loncom/metadata_database/searchcat.pl 2005/03/11 03:25:18 1.62 +++ loncom/metadata_database/searchcat.pl 2013/08/22 09:30:21 1.81 @@ -2,7 +2,7 @@ # The LearningOnline Network # searchcat.pl "Search Catalog" batch script # -# $Id: searchcat.pl,v 1.62 2005/03/11 03:25:18 matthew Exp $ +# $Id: searchcat.pl,v 1.81 2013/08/22 09:30:21 bisitz Exp $ # # Copyright Michigan State University Board of Trustees # @@ -65,32 +65,31 @@ and correct user experience. =cut use strict; - use DBI; use lib '/home/httpd/lib/perl/'; -use LONCAPA::Configuration; use LONCAPA::lonmetadata; - +use LONCAPA; use Getopt::Long; use IO::File; use HTML::TokeParser; use GDBM_File; use POSIX qw(strftime mktime); +use Mail::Send; +use Apache::loncommon(); -use Sys::Hostname; +use Apache::lonnet(); use File::Find; # # Set up configuration options -my ($simulate,$oneuser,$help,$verbose,$logfile,$debug,$multidom); +my ($simulate,$oneuser,$help,$verbose,$logfile,$debug); GetOptions ( 'help' => \$help, 'simulate' => \$simulate, 'only=s' => \$oneuser, 'verbose=s' => \$verbose, 'debug' => \$debug, - 'multi_domain' => \$multidom, ); if ($help) { @@ -103,7 +102,6 @@ Options: -only=user Only compute for the given user. Implies -simulate -verbose=val Sets logging level, val must be a number -debug Turns on debugging output - -multi_domain Parse the hosts.tab file domain(s) to use. ENDHELP exit 0; } @@ -122,31 +120,38 @@ if (defined($oneuser)) { ## ## Use variables for table names so we can test this routine a little easier -my $oldname = 'metadata'; -my $newname = 'newmetadata'.$$; # append pid to have unique temporary table +my %oldnames = ( + 'metadata' => 'metadata', + 'portfolio' => 'portfolio_metadata', + 'access' => 'portfolio_access', + 'addedfields' => 'portfolio_addedfields', + 'allusers' => 'allusers', + ); + +my %newnames; +# new table names - append pid to have unique temporary tables +foreach my $key (keys(%oldnames)) { + $newnames{$key} = 'new'.$oldnames{$key}.$$; +} # -# Read loncapa_apache.conf and loncapa.conf -my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf'); -my %perlvar=%{$perlvarref}; -undef $perlvarref; -delete $perlvar{'lonReceipt'}; # remove since sensitive (really?) & not needed -# # Only run if machine is a library server -exit if ($perlvar{'lonRole'} ne 'library'); +exit if ($Apache::lonnet::perlvar{'lonRole'} ne 'library'); +my $hostid = $Apache::lonnet::perlvar{'lonHostID'}; + # # Make sure this process is running from user=www my $wwwid=getpwnam('www'); if ($wwwid!=$<) { - my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}"; - my $subj="LON: $perlvar{'lonHostID'} User ID mismatch"; + my $emailto="$Apache::lonnet::perlvar{'lonAdmEMail'},$Apache::lonnet::perlvar{'lonSysEMail'}"; + my $subj="LON: $Apache::lonnet::perlvar{'lonHostID'} User ID mismatch"; system("echo 'User ID mismatch. searchcat.pl must be run as user www.' |\ - mailto $emailto -s '$subj' > /dev/null"); + mail -s '$subj' $emailto > /dev/null"); exit 1; } # # Let people know we are running -open(LOG,'>>'.$perlvar{'lonDaemons'}.'/logs/searchcat.log'); +open(LOG,'>>'.$Apache::lonnet::perlvar{'lonDaemons'}.'/logs/searchcat.log'); &log(0,'==== Searchcat Run '.localtime()."===="); @@ -158,56 +163,45 @@ if ($debug) { # # Connect to database my $dbh; -if (! ($dbh = DBI->connect("DBI:mysql:loncapa","www",$perlvar{'lonSqlAccess'}, +if (! ($dbh = DBI->connect("DBI:mysql:loncapa","www",$Apache::lonnet::perlvar{'lonSqlAccess'}, { RaiseError =>0,PrintError=>0}))) { &log(0,"Cannot connect to database!"); die "MySQL Error: Cannot connect to database!\n"; } # This can return an error and still be okay, so we do not bother checking. # (perhaps it should be more robust and check for specific errors) -$dbh->do('DROP TABLE IF EXISTS '.$newname); -# -# Create the new table -my $request = &LONCAPA::lonmetadata::create_metadata_storage($newname); -$dbh->do($request); -if ($dbh->err) { - $dbh->disconnect(); - &log(0,"MySQL Error Create: ".$dbh->errstr); - die $dbh->errstr; +foreach my $key (keys(%newnames)) { + if ($newnames{$key} ne '') { + $dbh->do('DROP TABLE IF EXISTS '.$newnames{$key}); + } } + # -# find out which users we need to examine -my @domains; -if (defined($multidom)) { - &log(1,'====multi domain setup===='); - # Peek into the hosts.tab and look for matches of our hostname - my $host = hostname(); - &log(9,'hostname = "'.$host.'"'); - open(HOSTFILE,$perlvar{'lonTabDir'}.'/hosts.tab') || - die ("Unable to determine domain(s) of multi-domain server"); - my %domains; - while () { - next if (/^\#/); - next if (!/:\Q$host\E/); - &log(9,$_); - $domains{(split(':',$_))[1]}++; - } - close HOSTFILE; - @domains = sort(keys(%domains)); - &log(9,join(',',@domains)); - if (! scalar(@domains)) { - die ("Unable to find any domains in the hosts.tab that match ".$host); +# Create the new metadata, portfolio and allusers tables +foreach my $key (keys(%newnames)) { + if ($newnames{$key} ne '') { + my $request = + &LONCAPA::lonmetadata::create_metadata_storage($newnames{$key},$oldnames{$key}); + $dbh->do($request); + if ($dbh->err) { + $dbh->disconnect(); + &log(0,"MySQL Error Create: ".$dbh->errstr); + die $dbh->errstr; + } } -} else { - push(@domains,$perlvar{'lonDefDomain'}); } +# +# find out which users we need to examine +my @domains = sort(&Apache::lonnet::current_machine_domains()); +&log(9,'domains ="'.join('","',@domains).'"'); + foreach my $dom (@domains) { &log(9,'domain = '.$dom); - opendir(RESOURCES,"$perlvar{'lonDocRoot'}/res/$dom"); + opendir(RESOURCES,"$Apache::lonnet::perlvar{'lonDocRoot'}/res/$dom"); my @homeusers = grep { - &ishome("$perlvar{'lonDocRoot'}/res/$dom/$_"); + &ishome("$Apache::lonnet::perlvar{'lonDocRoot'}/res/$dom/$_"); } grep { !/^\.\.?$/; } readdir(RESOURCES); @@ -217,6 +211,7 @@ foreach my $dom (@domains) { if ($oneuser) { @homeusers=($oneuser); } + # # Loop through the users foreach my $user (@homeusers) { @@ -229,18 +224,190 @@ foreach my $dom (@domains) { #wanted => \&print_filename, #wanted => \&log_metadata, wanted => \&process_meta_file, - }, join('/',($perlvar{'lonDocRoot'},'res',$dom,$user)) ); + no_chdir => 1, + }, join('/',($Apache::lonnet::perlvar{'lonDocRoot'},'res',$dom,$user)) ); + } + # Search for all users and public portfolio files + my (%allusers,%portusers,%courses); + if ($oneuser) { + %portusers = ( + $oneuser => '', + ); + %allusers = ( + $oneuser => '', + ); + %courses = &courseiddump($dom,'.',1,'.','.',$oneuser,undef, + undef,'.'); + } else { + # get courseIDs for domain on current machine + %courses=&Apache::lonnet::courseiddump($dom,'.',1,'.','.','.',1,[$hostid],'.'); + my $dir = $Apache::lonnet::perlvar{lonUsersDir}.'/'.$dom; + &descend_tree($dom,$dir,0,\%portusers,\%allusers); + } + foreach my $uname (keys(%portusers)) { + my $urlstart = '/uploaded/'.$dom.'/'.$uname; + my $pathstart = &propath($dom,$uname).'/userfiles'; + my $is_course = ''; + if (exists($courses{$dom.'_'.$uname})) { + $is_course = 1; + } + my $curr_perm = &Apache::lonnet::get_portfile_permissions($dom,$uname); + my %access = &Apache::lonnet::get_access_controls($curr_perm); + foreach my $file (keys(%access)) { + my ($group,$url,$fullpath); + if ($is_course) { + ($group, my ($path)) = ($file =~ /^(\w+)(\/.+)$/); + $fullpath = $pathstart.'/groups/'.$group.'/portfolio'.$path; + $url = $urlstart.'/groups/'.$group.'/portfolio'.$path; + } else { + $fullpath = $pathstart.'/portfolio'.$file; + $url = $urlstart.'/portfolio'.$file; + } + if (ref($access{$file}) eq 'HASH') { + my %portaccesslog = + &LONCAPA::lonmetadata::process_portfolio_access_data($dbh, + $simulate,\%newnames,$url,$fullpath,$access{$file}); + &portfolio_logging(%portaccesslog); + } + my %portmetalog = &LONCAPA::lonmetadata::process_portfolio_metadata($dbh,$simulate,\%newnames,$url,$fullpath,$is_course,$dom,$uname,$group); + &portfolio_logging(%portmetalog); + } + } + my (%names_by_id,,%ids_by_name,%idstodelete,%idstoadd,%duplicates); + unless ($simulate || $oneuser) { + my $idshashref; + $idshashref = &tie_domain_hash($dom, "ids", &GDBM_WRCREAT()); + if (ref($idshashref) eq 'HASH') { + %names_by_id = %{$idshashref}; + while (my ($id,$uname) = each(%{$idshashref}) ) { + $id = &unescape($id); + $uname = &unescape($uname); + $names_by_id{$id} = $uname; + push(@{$ids_by_name{$uname}},$id); + } + &untie_domain_hash($idshashref); + } + } + # Update allusers + foreach my $uname (keys(%allusers)) { + next if (exists($courses{$dom.'_'.$uname})); + my %userdata = + &Apache::lonnet::get('environment',['firstname','lastname', + 'middlename','generation','id','permanentemail'],$dom,$uname); + unless ($simulate || $oneuser) { + my $addid; + if ($userdata{'id'} ne '') { + $addid = $userdata{'id'}; + $addid=~tr/A-Z/a-z/; + } + if (exists($ids_by_name{$uname})) { + if (ref($ids_by_name{$uname}) eq 'ARRAY') { + if (scalar(@{$ids_by_name{$uname}}) > 1) { + &log(0,"Multiple employee/student IDs found in ids.db for $uname:$dom -- ".join(', ',@{$ids_by_name{$uname}})); + } + foreach my $id (@{$ids_by_name{$uname}}) { + if ($id eq $userdata{'id'}) { + undef($addid); + } else { + $idstodelete{$id} = $uname; + } + } + } + } + if ($addid ne '') { + if (exists($idstoadd{$addid})) { + push(@{$duplicates{$addid}},$uname); + } else { + $idstoadd{$addid} = $uname; + } + } + } + + $userdata{'username'} = $uname; + $userdata{'domain'} = $dom; + my %alluserslog = + &LONCAPA::lonmetadata::process_allusers_data($dbh,$simulate, + \%newnames,$uname,$dom,\%userdata); + foreach my $item (keys(%alluserslog)) { + &log(0,$alluserslog{$item}); + } + } + unless ($simulate || $oneuser) { + if (keys(%idstodelete) > 0) { + my %resulthash = &Apache::lonnet::iddel($dom,\%idstodelete,$hostid); + if ($resulthash{$hostid} eq 'ok') { + foreach my $id (sort(keys(%idstodelete))) { + &log(0,"Record deleted from ids.db for $dom -- $id => ".$idstodelete{$id}); + } + } else { + &log(0,"Error: '$resulthash{$hostid}' occurred when attempting to delete records from ids.db for $dom"); + } + } + if (keys(%idstoadd) > 0) { + my $idmessage = ''; + my %newids; + foreach my $addid (sort(keys(%idstoadd))) { + if ((exists($names_by_id{$addid})) && ($names_by_id{$addid} ne $idstoadd{$addid}) && !($idstodelete{$addid})) { + &log(0,"Two usernames associated with a single ID $addid in domain: $dom: $names_by_id{$addid} (current) and $idstoadd{$addid}\n"); + $idmessage .= "$addid,$names_by_id{$addid},$idstoadd{$addid}\n"; + } else { + $newids{$addid} = $idstoadd{$addid}; + } + } + if (keys(%newids) > 0) { + my $putresult = &Apache::lonnet::put_dom('ids',\%idstoadd,$dom,$hostid); + if ($putresult eq 'ok') { + foreach my $id (sort(keys(%idstoadd))) { + &log(0,"Record added to ids.db for $dom -- $id => ".$idstoadd{$id}); + } + } else { + &log(0,"Error: '$putresult' occurred when attempting to add records to ids.db for $dom"); + } + } + if ($idmessage) { + my $to = &Apache::loncommon::build_recipient_list(undef,'idconflictsmail',$dom); + if ($to ne '') { + my $msg = new Mail::Send; + $msg->to($to); + $msg->subject('LON-CAPA studentIDs conflict'); + my $lonhost = $Apache::lonnet::perlvar{'lonHostID'}; + my $hostname = &Apache::lonnet::hostname($lonhost); + my $replytoaddress = 'do-not-reply@'.$hostname; + $msg->add('Reply-to',$replytoaddress); + $msg->add('From',"www@$hostname"); + $msg->add('Content-type','text/plain; charset=UTF-8'); + if (my $fh = $msg->open()) { + print $fh + 'The following IDs are used for more than one user in your domain:'."\n". + 'Each row contains: Student/Employee ID, Current username in ids.db file, '. + 'Additional username'."\n\n". + $idmessage; + $fh->close; + } + } + } + } + if (keys(%duplicates) > 0) { + foreach my $id (sort(keys(%duplicates))) { + &log(0,"Duplicate IDs found for entries to add to ids.db in $dom -- $id => $idstodelete{$id}"); + } + } } } + # -# Rename the table +# Rename the tables if (! $simulate) { - $dbh->do('DROP TABLE IF EXISTS '.$oldname); - if (! $dbh->do('RENAME TABLE '.$newname.' TO '.$oldname)) { - &log(0,"MySQL Error Rename: ".$dbh->errstr); - die $dbh->errstr; - } else { - &log(1,"MySQL table rename successful."); + foreach my $key (keys(%oldnames)) { + if (($oldnames{$key} ne '') && ($newnames{$key} ne '')) { + $dbh->do('DROP TABLE IF EXISTS '.$oldnames{$key}); + if (! $dbh->do('RENAME TABLE '.$newnames{$key}.' TO '.$oldnames{$key})) { + &log(0,"MySQL Error Rename: ".$dbh->errstr); + die $dbh->errstr; + } else { + &log(1,"MySQL table rename successful for $key."); + } + } } } if (! $dbh->disconnect) { @@ -274,6 +441,39 @@ sub log { } } +sub portfolio_logging { + my (%portlog) = @_; + foreach my $key (keys(%portlog)) { + if (ref($portlog{$key}) eq 'HASH') { + foreach my $item (keys(%{$portlog{$key}})) { + &log(0,$portlog{$key}{$item}); + } + } + } +} + +sub descend_tree { + my ($dom,$dir,$depth,$allportusers,$alldomusers) = @_; + if (-d $dir) { + opendir(DIR,$dir); + my @contents = grep(!/^\./,readdir(DIR)); + closedir(DIR); + $depth ++; + foreach my $item (@contents) { + if ($depth < 4) { + &descend_tree($dom,$dir.'/'.$item,$depth,$allportusers,$alldomusers); + } else { + if (-e $dir.'/'.$item.'/file_permissions.db') { + $$allportusers{$item} = ''; + } + if (-e $dir.'/'.$item.'/passwd') { + $$alldomusers{$item} = ''; + } + } + } + } +} + ######################################################## ######################################################## ### ### @@ -293,7 +493,7 @@ sub only_meta_files { foreach my $file (@PossibleFiles) { if ( ($file =~ /\.meta$/ && # Ends in meta $file !~ /\.\d+\.[^\.]+\.meta$/ # is not for a prior version - ) || (-d $file )) { # directories are okay + ) || (-d $File::Find::dir."/".$file )) { # directories are okay # but we do not want /. or /.. push(@ChosenFiles,$file); } @@ -324,7 +524,7 @@ sub log_metadata { return if (-d $fullfilename); # No need to do anything here for directories if ($debug) { &log(6,$fullfilename); - my $ref=&metadata($fullfilename); + my $ref = &metadata($fullfilename); if (! defined($ref)) { &log(6," No data"); return; @@ -348,7 +548,7 @@ sub process_meta_file { # &log(3,$filename) if ($debug); # - my $ref=&metadata($filename); + my $ref = &metadata($filename); # # $url is the original file url, not the metadata file my $target = $filename; @@ -377,25 +577,17 @@ sub process_meta_file { %dyn=&get_dynamic_metadata($url); &count_type($url); } + &LONCAPA::lonmetadata::getfiledates($ref,$target); # - if (! defined($ref->{'creationdate'}) || - $ref->{'creationdate'} =~ /^\s*$/) { - $ref->{'creationdate'} = (stat($target))[9]; - } - if (! defined($ref->{'lastrevisiondate'}) || - $ref->{'lastrevisiondate'} =~ /^\s*$/) { - $ref->{'lastrevisiondate'} = (stat($target))[9]; - } - $ref->{'creationdate'} = &sqltime($ref->{'creationdate'}); - $ref->{'lastrevisiondate'} = &sqltime($ref->{'lastrevisiondate'}); my %Data = ( %$ref, %dyn, 'url'=>$url, 'version'=>'current'); if (! $simulate) { - my ($count,$err) = &LONCAPA::lonmetadata::store_metadata($dbh,$newname, - \%Data); + my ($count,$err) = + &LONCAPA::lonmetadata::store_metadata($dbh,$newnames{'metadata'}, + 'metadata',\%Data); if ($err) { &log(0,"MySQL Error Insert: ".$err); } @@ -417,7 +609,7 @@ sub process_meta_file { ######################################################## ######################################################## sub metadata { - my ($uri)=@_; + my ($uri) = @_; my %metacache=(); $uri=&declutter($uri); my $filename=$uri; @@ -426,7 +618,8 @@ sub metadata { if ($filename !~ /\.meta$/) { $filename.='.meta'; } - my $metastring=&getfile($perlvar{'lonDocRoot'}.'/res/'.$filename); + my $metastring = + &LONCAPA::lonmetadata::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.'/res/'.$filename); return undef if (! defined($metastring)); my $parser=HTML::TokeParser->new(\$metastring); my $token; @@ -447,7 +640,7 @@ sub metadata { } foreach ( @{$token->[3]}) { $metacache{$uri.''.$unikey.'.'.$_}=$token->[2]->{$_}; - } + } if (! ($metacache{$uri.''.$unikey}=$parser->get_text('/'.$entry))){ $metacache{$uri.''.$unikey} = $metacache{$uri.''.$unikey.'.default'}; @@ -457,23 +650,6 @@ sub metadata { return \%metacache; } -## -## &getfile($filename) -## Slurps up an entire file into a scalar. -## Returns undef if the file does not exist -sub getfile { - my $file = shift(); - if (! -e $file ) { - return undef; - } - my $fh=IO::File->new($file); - my $contents = ''; - while (<$fh>) { - $contents .= $_; - } - return $contents; -} - ######################################################## ######################################################## ### ### @@ -535,7 +711,7 @@ sub process_dynamic_metadata { %DynamicData = &LONCAPA::lonmetadata::process_reseval_data(\%evaldata); untie(%evaldata); $DynamicData{'domain'} = $dom; - print('user = '.$user.' domain = '.$dom.$/); + #print('user = '.$user.' domain = '.$dom.$/); # # Read in the access count data &log(7,'Reading access count data') if ($debug); @@ -641,7 +817,7 @@ sub write_copyright_count { ## (copied from lond, modification of the return value) sub ishome { my $author=shift; - $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; + $author=~s{/home/httpd/html/res/([^/]*)/([^/]*).*}{$1/$2}; my ($udom,$uname)=split(/\//,$author); my $proname=propath($udom,$uname); if (-e $proname) { @@ -652,75 +828,13 @@ sub ishome { } ## -## &propath($udom,$uname) -## Returns the path to the users LON-CAPA directory -## (copied from lond) -sub propath { - my ($udom,$uname)=@_; - $udom=~s/\W//g; - $uname=~s/\W//g; - my $subdir=$uname.'__'; - $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/; - my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname"; - return $proname; -} - -## -## &sqltime($timestamp) -## -## Convert perl $timestamp to MySQL time. MySQL expects YYYY-MM-DD HH:MM:SS -## -sub sqltime { - my ($time) = @_; - my $mysqltime; - if ($time =~ - /(\d+)-(\d+)-(\d+) # YYYY-MM-DD - \s # a space - (\d+):(\d+):(\d+) # HH:MM::SS - /x ) { - # Some of the .meta files have the time in mysql - # format already, so just make sure they are 0 padded and - # pass them back. - $mysqltime = sprintf('%04d-%02d-%02d %02d:%02d:%02d', - $1,$2,$3,$4,$5,$6); - } elsif ($time =~ /^\d+$/) { - my @TimeData = gmtime($time); - # Alter the month to be 1-12 instead of 0-11 - $TimeData[4]++; - # Alter the year to be from 0 instead of from 1900 - $TimeData[5]+=1900; - $mysqltime = sprintf('%04d-%02d-%02d %02d:%02d:%02d', - @TimeData[5,4,3,2,1,0]); - } elsif (! defined($time) || $time == 0) { - $mysqltime = 0; - } else { - &log(0," sqltime:Unable to decode time ".$time); - $mysqltime = 0; - } - return $mysqltime; -} - -## ## &declutter($filename) ## Given a filename, returns a url for the filename. sub declutter { my $thisfn=shift; - $thisfn=~s/^$perlvar{'lonDocRoot'}//; + $thisfn=~s/^$Apache::lonnet::perlvar{'lonDocRoot'}//; $thisfn=~s/^\///; $thisfn=~s/^res\///; return $thisfn; } -## -## Escape / Unescape special characters -sub unescape { - my $str=shift; - $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; - return $str; -} - -sub escape { - my $str=shift; - $str =~ s/(\W)/"%".unpack('H2',$1)/eg; - return $str; -}