--- loncom/metadata_database/searchcat.pl 2007/01/02 12:52:22 1.75 +++ loncom/metadata_database/searchcat.pl 2016/01/31 21:25:49 1.84 @@ -2,7 +2,7 @@ # The LearningOnline Network # searchcat.pl "Search Catalog" batch script # -# $Id: searchcat.pl,v 1.75 2007/01/02 12:52:22 raeburn Exp $ +# $Id: searchcat.pl,v 1.84 2016/01/31 21:25:49 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -68,12 +68,14 @@ use strict; use DBI; use lib '/home/httpd/lib/perl/'; 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 Apache::lonnet(); @@ -123,6 +125,7 @@ my %oldnames = ( 'portfolio' => 'portfolio_metadata', 'access' => 'portfolio_access', 'addedfields' => 'portfolio_addedfields', + 'allusers' => 'allusers', ); my %newnames; @@ -134,6 +137,8 @@ foreach my $key (keys(%oldnames)) { # # Only run if machine is a library server 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'); @@ -172,7 +177,7 @@ foreach my $key (keys(%newnames)) { } # -# Create the new metadata and portfolio tables +# Create the new metadata, portfolio and allusers tables foreach my $key (keys(%newnames)) { if ($newnames{$key} ne '') { my $request = @@ -206,6 +211,7 @@ foreach my $dom (@domains) { if ($oneuser) { @homeusers=($oneuser); } + # # Loop through the users foreach my $user (@homeusers) { @@ -221,20 +227,30 @@ foreach my $dom (@domains) { no_chdir => 1, }, join('/',($Apache::lonnet::perlvar{'lonDocRoot'},'res',$dom,$user)) ); } - # Search for public portfolio files - my %portusers; + # 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($dir,0,\%portusers); + &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 = &Apache::lonnet::is_course($dom,$uname); + 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)) { @@ -257,6 +273,201 @@ foreach my $dom (@domains) { &portfolio_logging(%portmetalog); } } + my %duplicates; + my %names_by_id = ( + id => {}, + clickers => {}, + ); + my %ids_by_name = ( + id => {}, + clickers => {}, + ); + my %idstodelete = ( + id => {}, + clickers => {}, + ); + my %idstoadd = ( + id => {}, + clickers => {}, + ); + my %namespace = ( + id => 'ids', + clickers => 'clickers', + ); + my %idtext = ( + id => 'employee/student IDs', + clickers => 'clicker IDs', + ); + unless ($simulate || $oneuser) { + foreach my $key ('id','clickers') { + my $hashref = &tie_domain_hash($dom,$namespace{$key},&GDBM_WRCREAT()); + if (ref($hashref) eq 'HASH') { + while (my ($id,$unamestr) = each(%{$hashref}) ) { + $id = &unescape($id); + $unamestr = &unescape($unamestr); + if ($key eq 'clickers') { + my @unames = split(/,/,$unamestr); + foreach my $uname (@unames) { + push(@{$ids_by_name{$key}{$uname}},$id); + } + $names_by_id{$key}{$id} = $unamestr; + } else { + $names_by_id{$key}{$id} = $unamestr; + push(@{$ids_by_name{$key}{$unamestr}},$id); + } + } + &untie_domain_hash($hashref); + } + } + } + # 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','clickers'], + $dom,$uname); + unless ($simulate || $oneuser) { + foreach my $key ('id','clickers') { + my %addid = (); + if ($userdata{$key} ne '') { + my $idfromenv = $userdata{$key}; + if ($key eq 'id') { + $idfromenv=~tr/A-Z/a-z/; + $addid{$idfromenv} = 1; + } else { + $idfromenv =~ s/^\s+//; + $idfromenv =~ s/\s+$//; + map { $addid{$_} = 1; } split(/,/,$idfromenv); + } + } + if (ref($ids_by_name{$key}{$uname}) eq 'ARRAY') { + if (scalar(@{$ids_by_name{$key}{$uname}}) > 1) { + &log(0,"Multiple $idtext{$key} found in $namespace{$key}.db for $uname:$dom -- ". + join(', ',@{$ids_by_name{$key}{$uname}})); + } + foreach my $id (@{$ids_by_name{$key}{$uname}}) { + if ($addid{$id}) { + delete($addid{$id}); + } else { + if ($key eq 'id') { + $idstodelete{$key}{$id} = $uname; + } else { + $idstodelete{$key}{$id} .= $uname.','; + } + } + } + } + if (keys(%addid)) { + foreach my $id (keys(%addid)) { + if ($key eq 'id') { + if (exists($idstoadd{$key}{$id})) { + push(@{$duplicates{$id}},$uname); + } else { + $idstoadd{$key}{$id} = $uname; + } + } else { + $idstoadd{$key}{$id} .= $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) { + foreach my $key ('id','clickers') { + if (keys(%{$idstodelete{$key}}) > 0) { + my %resulthash; + if ($key eq 'id') { + %resulthash = &Apache::lonnet::iddel($dom,$idstodelete{$key},$hostid,$namespace{$key}); + } else { + foreach my $delid (sort(keys(%{$idstodelete{$key}}))) { + $idstodelete{$key}{$delid} =~ s/,$//; + } + %resulthash = &Apache::lonnet::iddel($dom,$idstodelete{$key},$hostid,$namespace{$key}); + } + if ($resulthash{$hostid} eq 'ok') { + foreach my $id (sort(keys(%{$idstodelete{$key}}))) { + &log(0,"Record deleted from $namespace{$key}.db for $dom -- $id => ".$idstodelete{$key}{$id}); + } + } else { + &log(0,"Error: '$resulthash{$hostid}' occurred when attempting to delete records from $namespace{$key}.db for $dom"); + } + } + if (keys(%{$idstoadd{$key}}) > 0) { + my $idmessage = ''; + my %newids; + if ($key eq 'id') { + foreach my $addid (sort(keys(%{$idstoadd{$key}}))) { + if ((exists($names_by_id{$key}{$addid})) && ($names_by_id{$key}{$addid} ne $idstoadd{$key}{$addid}) && !($idstodelete{$key}{$addid})) { + &log(0,"Two usernames associated with a single ID $addid in domain: $dom: $names_by_id{$key}{$addid} (current) and $idstoadd{$key}{$addid}\n"); + $idmessage .= "$addid,$names_by_id{$key}{$addid},$idstoadd{$key}{$addid}\n"; + } else { + $newids{$addid} = $idstoadd{$key}{$addid}; + } + } + } else { + foreach my $addid (sort(keys(%{$idstoadd{$key}}))) { + $idstoadd{$key}{$addid} =~ s/,$//; + $newids{$addid} = $idstoadd{$key}{$addid}; + } + } + if (keys(%newids) > 0) { + my $putresult; + if ($key eq 'clickers') { + $putresult = &Apache::lonnet::updateclickers($dom,'add',\%newids,$hostid); + } else { + $putresult = &Apache::lonnet::put_dom($namespace{$key},\%newids,$dom,$hostid); + } + if ($putresult eq 'ok') { + foreach my $id (sort(keys(%newids))) { + &log(0,"Record added to $namespace{$key}.db for $dom -- $id => ".$newids{$id}); + } + } else { + &log(0,"Error: '$putresult' occurred when attempting to add records to $namespace{$key}.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))) { + if (ref($duplicates{$id}) eq 'ARRAY') { + &log(0,"Duplicate IDs found for entries to add to ids.db in $dom -- $id => ".join(',',@{$duplicates{$id}})); + } + } + } + } } # @@ -317,18 +528,20 @@ sub portfolio_logging { } sub descend_tree { - my ($dir,$depth,$alldomusers) = @_; + 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($dir.'/'.$item,$depth,$alldomusers); + if (($depth < 4) && (length($item) == 1)) { + &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} = ''; } } @@ -679,7 +892,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) { @@ -690,20 +903,6 @@ 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="$Apache::lonnet::perlvar{'lonUsersDir'}/$udom/$subdir/$uname"; - return $proname; -} - -## ## &declutter($filename) ## Given a filename, returns a url for the filename. sub declutter { @@ -714,16 +913,3 @@ sub declutter { 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; -}