--- loncom/lonnet/perl/lonnet.pm 2018/04/29 00:56:53 1.1172.2.93.4.10 +++ loncom/lonnet/perl/lonnet.pm 2018/04/29 00:53:23 1.1172.2.94 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1172.2.93.4.10 2018/04/29 00:56:53 raeburn Exp $ +# $Id: lonnet.pm,v 1.1172.2.94 2018/04/29 00:53:23 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -142,7 +142,7 @@ our @EXPORT = qw(%env); sub logtouch { my $execdir=$perlvar{'lonDaemons'}; unless (-e "$execdir/logs/lonnet.log") { - open(my $fh,">>","$execdir/logs/lonnet.log"); + open(my $fh,">>$execdir/logs/lonnet.log"); close $fh; } my ($wwwuid,$wwwgid)=(getpwnam('www'))[2,3]; @@ -154,7 +154,7 @@ sub logthis { my $execdir=$perlvar{'lonDaemons'}; my $now=time; my $local=localtime($now); - if (open(my $fh,">>","$execdir/logs/lonnet.log")) { + if (open(my $fh,">>$execdir/logs/lonnet.log")) { my $logstring = $local. " ($$): ".$message."\n"; # Keep any \'s in string. print $fh $logstring; close($fh); @@ -167,7 +167,7 @@ sub logperm { my $execdir=$perlvar{'lonDaemons'}; my $now=time; my $local=localtime($now); - if (open(my $fh,">>","$execdir/logs/lonnet.perm.log")) { + if (open(my $fh,">>$execdir/logs/lonnet.perm.log")) { print $fh "$now:$message:$local\n"; close($fh); } @@ -436,7 +436,7 @@ sub reconlonc { &logthis("Trying to reconnect lonc"); my $loncfile="$perlvar{'lonDaemons'}/logs/lonc.pid"; - if (open(my $fh,"<",$loncfile)) { + if (open(my $fh,"<$loncfile")) { my $loncpid=<$fh>; chomp($loncpid); if (kill 0 => $loncpid) { @@ -476,7 +476,7 @@ sub critical { $dumpcount++; { my $dfh; - if (open($dfh,">",$dfilename)) { + if (open($dfh,">$dfilename")) { print $dfh "$cmd\n"; close($dfh); } @@ -485,7 +485,7 @@ sub critical { my $wcmd=''; { my $dfh; - if (open($dfh,"<",$dfilename)) { + if (open($dfh,"<$dfilename")) { $wcmd=<$dfh>; close($dfh); } @@ -601,7 +601,7 @@ sub transfer_profile_to_env { # ---------------------------------------------------- Check for valid session sub check_for_valid_session { - my ($r,$name,$userhashref,$domref) = @_; + my ($r,$name,$userhashref) = @_; my %cookies=CGI::Cookie->parse($r->header_in('Cookie')); if ($name eq '') { $name = 'lonID'; @@ -616,16 +616,7 @@ sub check_for_valid_session { } else { $lonidsdir=$r->dir_config('lonIDsDir'); } - if (!-e "$lonidsdir/$handle.id") { - if ((ref($domref)) && ($name eq 'lonID') && - ($handle =~ /^($match_username)\_\d+\_($match_domain)\_(.+)$/)) { - my ($possuname,$possudom,$possuhome) = ($1,$2,$3); - if ((&domain($possudom) ne '') && (&homeserver($possuname,$possudom) eq $possuhome)) { - $$domref = $possudom; - } - } - return undef; - } + return undef if (!-e "$lonidsdir/$handle.id"); my $opened = open(my $idf,'+<',"$lonidsdir/$handle.id"); return undef if (!$opened); @@ -1697,12 +1688,7 @@ sub get_dom { } } if ($udom && $uhome && ($uhome ne 'no_host')) { - my $rep; - if ($namespace =~ /^enc/) { - $rep=&reply("encrypt:egetdom:$udom:$namespace:$items",$uhome); - } else { - $rep=&reply("getdom:$udom:$namespace:$items",$uhome); - } + my $rep=&reply("getdom:$udom:$namespace:$items",$uhome); my %returnhash; if ($rep eq '' || $rep =~ /^error: 2 /) { return %returnhash; @@ -1746,11 +1732,7 @@ sub put_dom { $items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&'; } $items=~s/\&$//; - if ($namespace =~ /^enc/) { - return &reply("encrypt:putdom:$udom:$namespace:$items",$uhome); - } else { - return &reply("putdom:$udom:$namespace:$items",$uhome); - } + return &reply("putdom:$udom:$namespace:$items",$uhome); } else { &logthis("put_dom failed - no homeserver and/or domain"); } @@ -1841,24 +1823,13 @@ sub inst_directory_query { my $homeserver = &domain($udom,'primary'); my $outcome; if ($homeserver ne '') { - unless ($homeserver eq $perlvar{'lonHostID'}) { - if ($srch->{'srchby'} eq 'email') { - my $lcrev = &get_server_loncaparev(undef,$homeserver); - my ($major,$minor,$subver) = ($lcrev =~ /^\'?(\d+)\.(\d+)\.([\w.\-]+)\'?$/); - if (($major eq '' && $minor eq '') || ($major < 2) || - (($major == 2) && ($minor < 11)) || - (($major == 2) && ($minor == 11) && ($subver !~ /^2\.B/))) { - return; - } - } - } my $queryid=&reply("querysend:instdirsearch:". &escape($srch->{'srchby'}).':'. &escape($srch->{'srchterm'}).':'. &escape($srch->{'srchtype'}),$homeserver); my $host=&hostname($homeserver); if ($queryid !~/^\Q$host\E\_/) { - &logthis('institutional directory search invalid queryid: '.$queryid.' for host: '.$homeserver.' in domain '.$udom); + &logthis('institutional directory search invalid queryid: '.$queryid.' for host: '.$homeserver.'in domain '.$udom); return; } my $response = &get_query_reply($queryid); @@ -1893,15 +1864,6 @@ sub usersearch { my $query = 'usersearch'; foreach my $tryserver (keys(%libserv)) { if (&host_domain($tryserver) eq $dom) { - unless ($tryserver eq $perlvar{'lonHostID'}) { - if ($srch->{'srchby'} eq 'email') { - my $lcrev = &get_server_loncaparev(undef,$tryserver); - my ($major,$minor,$subver) = ($lcrev =~ /^\'?(\d+)\.(\d+)\.([\w.\-]+)\'?$/); - next if (($major eq '' && $minor eq '') || ($major < 2) || - (($major == 2) && ($minor < 11)) || - (($major == 2) && ($minor == 11) && ($subver !~ /^2\.B/))); - } - } my $host=&hostname($tryserver); my $queryid= &reply("querysend:".&escape($query).':'. @@ -2282,22 +2244,6 @@ sub get_domain_defaults { return %domdefaults; } -sub course_portal_url { - my ($cnum,$cdom) = @_; - my $chome = &homeserver($cnum,$cdom); - my $hostname = &hostname($chome); - my $protocol = $protocol{$chome}; - $protocol = 'http' if ($protocol ne 'https'); - my %domdefaults = &get_domain_defaults($cdom); - my $firsturl; - if ($domdefaults{'portal_def'}) { - $firsturl = $domdefaults{'portal_def'}; - } else { - $firsturl = $protocol.'://'.$hostname; - } - return $firsturl; -} - # --------------------------------------------------- Assign a key to a student sub assign_access_key { @@ -3058,14 +3004,6 @@ sub can_edit_resource { $forceedit = 1; } $cfile = $resurl; - } elsif ($resurl =~ m{^/adm/wrapper/adm/$cdom/$cnum/\d+/ext\.tool$}) { - $incourse = 1; - if ($env{'form.forceedit'}) { - $forceview = 1; - } else { - $forceedit = 1; - } - $cfile = $resurl; } elsif ($resurl =~ m{^/?adm/viewclasslist$}) { $incourse = 1; if ($env{'form.forceedit'}) { @@ -3090,14 +3028,6 @@ sub can_edit_resource { $forceedit = 1; } $cfile = $resurl; - } elsif (($resurl =~ m{^/adm/wrapper/adm/$cdom/$cnum/\d+/ext\.tool$}) && ($env{'form.folderpath'} =~ /^supplemental/)) { - $incourse = 1; - if ($env{'form.forceedit'}) { - $forceview = 1; - } else { - $forceedit = 1; - } - $cfile = $resurl; } elsif (($resurl eq '/adm/extresedit') && ($symb || $env{'form.folderpath'})) { $incourse = 1; $forceview = 1; @@ -3107,13 +3037,8 @@ sub can_edit_resource { $cfile = &clutter($res); } else { $cfile = $env{'form.suppurl'}; - my $escfile = &unescape($cfile); - if ($escfile =~ m{^/adm/$cdom/$cnum/\d+/ext\.tool$}) { - $cfile = '/adm/wrapper'.$escfile; - } else { - $escfile =~ s{^http://}{}; - $cfile = &escape("/adm/wrapper/ext/$escfile"); - } + $cfile =~ s{^http://}{}; + $cfile = '/adm/wrapper/ext/'.$cfile; } } elsif ($resurl =~ m{^/?adm/viewclasslist$}) { if ($env{'form.forceedit'}) { @@ -3269,7 +3194,7 @@ sub process_coursefile { $home); } } elsif ($action eq 'uploaddoc') { - open(my $fh,'>',$filepath.'/'.$fname); + open(my $fh,'>'.$filepath.'/'.$fname); print $fh $env{'form.'.$source}; close($fh); if ($parser eq 'parse') { @@ -3327,7 +3252,7 @@ sub store_edited_file { ($fpath,$fname) = ($file =~ m|^(.*)/([^/]+)$|); $fpath=$docudom.'/'.$docuname.'/'.$fpath; my $filepath = &build_filepath($fpath); - open(my $fh,'>',$filepath.'/'.$fname); + open(my $fh,'>'.$filepath.'/'.$fname); print $fh $content; close($fh); my $home=&homeserver($docuname,$docudom); @@ -3443,12 +3368,12 @@ sub userfileupload { '_'.$env{'user.domain'}.'/pending'; } elsif (($context eq 'existingfile') || ($context eq 'canceloverwrite')) { my ($docuname,$docudom); - if ($destudom =~ /^$match_domain$/) { + if ($destudom) { $docudom = $destudom; } else { $docudom = $env{'user.domain'}; } - if ($destuname =~ /^$match_username$/) { + if ($destuname) { $docuname = $destuname; } else { $docuname = $env{'user.name'}; @@ -3478,7 +3403,7 @@ sub userfileupload { mkdir($fullpath,0777); } } - open(my $fh,'>',$fullpath.'/'.$fname); + open(my $fh,'>'.$fullpath.'/'.$fname); print $fh $env{'form.'.$formname}; close($fh); if ($context eq 'existingfile') { @@ -3553,7 +3478,7 @@ sub finishuserfileupload { # Save the file { - if (!open(FH,'>',$filepath.'/'.$file)) { + if (!open(FH,'>'.$filepath.'/'.$file)) { &logthis('Failed to create '.$filepath.'/'.$file); print STDERR ('Failed to create '.$filepath.'/'.$file."\n"); return '/adm/notfound.html'; @@ -3611,8 +3536,7 @@ sub finishuserfileupload { my $input = $filepath.'/'.$file; my $output = $filepath.'/'.'tn-'.$file; my $thumbsize = $thumbwidth.'x'.$thumbheight; - my @args = ('convert','-sample',$thumbsize,$input,$output); - system({$args[0]} @args); + system("convert -sample $thumbsize $input $output"); if (-e $filepath.'/'.'tn-'.$file) { $fetchthumb = 1; } @@ -4572,7 +4496,7 @@ sub postannounce { sub getannounce { - if (open(my $fh,"<",$perlvar{'lonDocRoot'}.'/announcement.txt')) { + if (open(my $fh,$perlvar{'lonDocRoot'}.'/announcement.txt')) { my $announcement=''; while (my $line = <$fh>) { $announcement .= $line; } close($fh); @@ -4828,10 +4752,9 @@ my %cachedtimes=(); my $cachedtime=''; sub load_all_first_access { - my ($uname,$udom,$ignorecache)=@_; + my ($uname,$udom)=@_; if (($cachedkey eq $uname.':'.$udom) && - (abs($cachedtime-time)<5) && (!$env{'form.markaccess'}) && - (!$ignorecache)) { + (abs($cachedtime-time)<5) && (!$env{'form.markaccess'})) { return; } $cachedtime=time; @@ -4840,7 +4763,7 @@ sub load_all_first_access { } sub get_first_access { - my ($type,$argsymb,$argmap,$ignorecache)=@_; + my ($type,$argsymb,$argmap)=@_; my ($symb,$courseid,$udom,$uname)=&whichuser(); if ($argsymb) { $symb=$argsymb; } my ($map,$id,$res)=&decode_symb($symb); @@ -4852,7 +4775,7 @@ sub get_first_access { } else { $res=$symb; } - &load_all_first_access($uname,$udom,$ignorecache); + &load_all_first_access($uname,$udom); return $cachedtimes{"$courseid\0$res"}; } @@ -6258,7 +6181,7 @@ sub currentdump { # my %returnhash=(); # - if ($rep eq 'unknown_cmd') { + if ($rep eq "unknown_cmd") { # an old lond will not know currentdump # Do a dump and make it look like a currentdump my @tmp = &dumpstore($courseid,$sdom,$sname,'.'); @@ -7191,7 +7114,7 @@ sub allowed { if (defined($env{'allowed.'.$priv})) { return $env{'allowed.'.$priv}; } # Free bre access to adm and meta resources - if (((($uri=~/^adm\//) && ($uri !~ m{/(?:smppg|bulletinboard|ext\.tool)$})) + if (((($uri=~/^adm\//) && ($uri !~ m{/(?:smppg|bulletinboard)$})) || (($uri=~/\.meta$/) && ($uri!~m|^uploaded/|) )) && ($priv eq 'bre')) { return 'F'; @@ -7852,8 +7775,7 @@ sub get_commblock_resources { } } } - if ($interval[0] =~ /^(\d+)/) { - my $timelimit = $1; + if ($interval[0] =~ /^\d+$/) { my $first_access; if ($type eq 'resource') { $first_access=&get_first_access($interval[1],$item); @@ -7863,7 +7785,7 @@ sub get_commblock_resources { $first_access=&get_first_access($interval[1]); } if ($first_access) { - my $timesup = $first_access+$timelimit; + my $timesup = $first_access+$interval[0]; if ($timesup > $now) { my $activeblock; foreach my $res (@to_test) { @@ -8191,7 +8113,7 @@ sub fetch_enrollment_query { if ($xml_classlist =~ /^error/) { &logthis('fetch_enrollment_query - autoretrieve error: '.$xml_classlist.' for '.$filename.' from server: '.$homeserver.' '.$context.' '.$cnum); } else { - if ( open(FILE,">",$destname) ) { + if ( open(FILE,">$destname") ) { print FILE &unescape($xml_classlist); close(FILE); } else { @@ -8220,7 +8142,7 @@ sub get_query_reply { for (1..$loopmax) { sleep($sleep); if (-e $replyfile.'.end') { - if (open(my $fh,"<",$replyfile)) { + if (open(my $fh,$replyfile)) { $reply = join('',<$fh>); close($fh); } else { return 'error: reply_file_error'; } @@ -9872,7 +9794,7 @@ sub save_selected_files { my ($user, $path, @files) = @_; my $filename = $user."savedfiles"; my @other_files = &files_not_in_path($user, $path); - open (OUT,'>',LONCAPA::tempdir().$filename); + open (OUT, '>'.$tmpdir.$filename); foreach my $file (@files) { print (OUT $env{'form.currentpath'}.$file."\n"); } @@ -9886,7 +9808,7 @@ sub save_selected_files { sub clear_selected_files { my ($user) = @_; my $filename = $user."savedfiles"; - open (OUT,'>',LONCAPA::tempdir().$filename); + open (OUT, '>'.LONCAPA::tempdir().$filename); print (OUT undef); close (OUT); return ("ok"); @@ -9896,7 +9818,7 @@ sub files_in_path { my ($user, $path) = @_; my $filename = $user."savedfiles"; my %return_files; - open (IN,'<',LONCAPA::tempdir().$filename); + open (IN, '<'.LONCAPA::tempdir().$filename); while (my $line_in = ) { chomp ($line_in); my @paths_and_file = split (m!/!, $line_in); @@ -9918,7 +9840,7 @@ sub files_not_in_path { my $filename = $user."savedfiles"; my @return_files; my $path_part; - open(IN,'<',LONCAPA::tempdir().$filename); + open(IN, '<'.LONCAPA::.$filename); while (my $line = ) { #ok, I know it's clunky, but I want it to work my @paths_and_file = split(m|/|, $line); @@ -10578,7 +10500,7 @@ sub get_userresdata { # Parameters: # $name - Course/user name. # $domain - Name of the domain the user/course is registered on. -# $type - Type of thing $name is (must be 'course' or 'user') +# $type - Type of thing $name is (must be 'course' or 'user' # @which - Array of names of resources desired. # Returns: # The value of the first reasource in @which that is found in the @@ -10597,44 +10519,13 @@ sub resdata { } if (!ref($result)) { return $result; } foreach my $item (@which) { - if (ref($item) eq 'ARRAY') { - if (defined($result->{$item->[0]})) { - return [$result->{$item->[0]},$item->[1]]; - } - } + if (defined($result->{$item->[0]})) { + return [$result->{$item->[0]},$item->[1]]; + } } return undef; } -sub get_domain_ltitools { - my ($cdom) = @_; - my %ltitools; - my ($result,$cached)=&is_cached_new('ltitools',$cdom); - if (defined($cached)) { - if (ref($result) eq 'HASH') { - %ltitools = %{$result}; - } - } else { - my %domconfig = &get_dom('configuration',['ltitools'],$cdom); - if (ref($domconfig{'ltitools'}) eq 'HASH') { - %ltitools = %{$domconfig{'ltitools'}}; - my %encdomconfig = &get_dom('encconfig',['ltitools'],$cdom); - if (ref($encdomconfig{'ltitools'}) eq 'HASH') { - foreach my $id (keys(%ltitools)) { - if (ref($encdomconfig{'ltitools'}{$id}) eq 'HASH') { - foreach my $item ('key','secret') { - $ltitools{$id}{$item} = $encdomconfig{'ltitools'}{$id}{$item}; - } - } - } - } - } - my $cachetime = 24*60*60; - &do_cache_new('ltitools',$cdom,\%ltitools,$cachetime); - } - return %ltitools; -} - sub get_numsuppfiles { my ($cnum,$cdom,$ignorecache)=@_; my $hashid=$cnum.':'.$cdom; @@ -11083,14 +10974,13 @@ sub add_prefix_and_part { my %metaentry; my %importedpartids; -my %importedrespids; sub metadata { my ($uri,$what,$liburi,$prefix,$depthcount)=@_; $uri=&declutter($uri); # if it is a non metadata possible uri return quickly if (($uri eq '') || (($uri =~ m|^/*adm/|) && - ($uri !~ m|^adm/includes|) && ($uri !~ m{/(smppg|bulletinboard|ext\.tool)$})) || + ($uri !~ m|^adm/includes|) && ($uri !~ m{/(smppg|bulletinboard)$})) || ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ m{^/*uploaded/.+\.sequence$})) { return undef; } @@ -11111,11 +11001,9 @@ sub metadata { } { # Imported parts would go here - my @origfiletagids=(); + my %importedids=(); + my @origfileimportpartids=(); my $importedparts=0; - -# Imported responseids would go here - my $importedresponses=0; # # Is this a recursive call for a library? # @@ -11210,37 +11098,8 @@ sub metadata { my $dir=$filename; $dir=~s|[^/]*$||; $location=&filelocation($dir,$location); - - my $importid=$token->[2]->{'id'}; + my $importmode=$token->[2]->{'importmode'}; -# -# Check metadata for imported file to -# see if it contained response items -# - my %currmetaentry = %metaentry; - my $libresponseorder = &metadata($location,'responseorder'); - my $origfile; - if ($libresponseorder ne '') { - if ($#origfiletagids<0) { - undef(%importedrespids); - undef(%importedpartids); - } - @{$importedrespids{$importid}} = split(/\s*,\s*/,$libresponseorder); - if (@{$importedrespids{$importid}} > 0) { - $importedresponses = 1; -# We need to get the original file and the imported file to get the response order correct -# Load and inspect original file - if ($#origfiletagids<0) { - my $origfilelocation=$perlvar{'lonDocRoot'}.&clutter($uri); - $origfile=&getfile($origfilelocation); - @origfiletagids=($origfile=~/<((?:\w+)response|import|part)[^>]*id\s*=\s*[\"\']([^\"\']+)[\"\'][^>]*>/gs); - } - } - } -# Do not overwrite contents of %metaentry hash for resource itself with -# hash populated for imported library file - %metaentry = %currmetaentry; - undef(%currmetaentry); if ($importmode eq 'problem') { # Import as problem/response $unikey=&add_prefix_and_part($prefix,$token->[2]->{'part'}); @@ -11249,15 +11108,12 @@ sub metadata { $importedparts=1; # We need to get the original file and the imported file to get the part order correct # Good news: we do not need to worry about nested libraries, since parts cannot be nested -# Load and inspect original file if we didn't do that already - if ($#origfiletagids<0) { - undef(%importedrespids); - undef(%importedpartids); - if ($origfile eq '') { - my $origfilelocation=$perlvar{'lonDocRoot'}.&clutter($uri); - $origfile=&getfile($origfilelocation); - @origfiletagids=($origfile=~/<(part|import)[^>]*id\s*=\s*[\"\']([^\"\']+)[\"\'][^>]*>/gs); - } +# Load and inspect original file + if ($#origfileimportpartids<0) { + undef(%importedpartids); + my $origfilelocation=$perlvar{'lonDocRoot'}.&clutter($uri); + my $origfile=&getfile($origfilelocation); + @origfileimportpartids=($origfile=~/<(part|import)[^>]*id\s*=\s*[\"\']([^\"\']+)[\"\'][^>]*>/gs); } # Load and inspect imported file @@ -11371,48 +11227,20 @@ sub metadata { grep { ! $seen{$_} ++ } (split(',',$metaentry{':packages'})); $metaentry{':packages'} = join(',',@uniq_packages); - if (($importedresponses) || ($importedparts)) { - if ($importedparts) { + if ($importedparts) { # We had imported parts and need to rebuild partorder - $metaentry{':partorder'}=''; - $metathesekeys{'partorder'}=1; - } - if ($importedresponses) { -# We had imported responses and need to rebuild responseorder - $metaentry{':responseorder'}=''; - $metathesekeys{'responseorder'}=1; - } - for (my $index=0;$index<$#origfiletagids;$index+=2) { - my $origid = $origfiletagids[$index+1]; - if ($origfiletagids[$index] eq 'part') { -# Original part, part of the problem - if ($importedparts) { - $metaentry{':partorder'}.=','.$origid; - } - } elsif ($origfiletagids[$index] eq 'import') { - if ($importedparts) { -# We have imported parts at this position - $metaentry{':partorder'}.=','.$importedpartids{$origid}; - } - if ($importedresponses) { -# We have imported responses at this position - if (ref($importedrespids{$origid}) eq 'ARRAY') { - $metaentry{':responseorder'}.=','.join(',',map { $origid.'_'.$_ } @{$importedrespids{$origid}}); - } - } - } else { -# Original response item, part of the problem - if ($importedresponses) { - $metaentry{':responseorder'}.=','.$origid; - } - } - } - if ($importedparts) { - $metaentry{':partorder'}=~s/^\,//; - } - if ($importedresponses) { - $metaentry{':responseorder'}=~s/^\,//; - } + $metaentry{':partorder'}=''; + $metathesekeys{'partorder'}=1; + for (my $index=0;$index<$#origfileimportpartids;$index+=2) { + if ($origfileimportpartids[$index] eq 'part') { +# original part, part of the problem + $metaentry{':partorder'}.=','.$origfileimportpartids[$index+1]; + } else { +# we have imported parts at this position + $metaentry{':partorder'}.=','.$importedpartids{$origfileimportpartids[$index+1]}; + } + } + $metaentry{':partorder'}=~s/^\,//; } $metaentry{':keys'} = join(',',keys(%metathesekeys)); @@ -12500,7 +12328,7 @@ sub readfile { my $file = shift; if ( (! -e $file ) || ($file eq '') ) { return -1; }; my $fh; - open($fh,"<",$file); + open($fh,"<$file"); my $a=''; while (my $line = <$fh>) { $a .= $line; } return $a; @@ -12613,7 +12441,7 @@ sub machine_ids { sub additional_machine_domains { my @domains; - open(my $fh,"<","$perlvar{'lonTabDir'}/expected_domains.tab"); + open(my $fh,"<$perlvar{'lonTabDir'}/expected_domains.tab"); while( my $line = <$fh>) { $line =~ s/\s//g; push(@domains,$line); @@ -12684,8 +12512,6 @@ sub clutter { # &logthis("Got a blank emb style"); } } - } elsif ($thisfn =~ m{^/adm/$match_domain/$match_courseid/\d+/ext\.tool$}) { - $thisfn='/adm/wrapper'.$thisfn; } return $thisfn; } @@ -12759,7 +12585,7 @@ sub get_dns { } my %alldns; - open(my $config,"<","$perlvar{'lonTabDir'}/hosts.tab"); + open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab"); foreach my $dns (<$config>) { next if ($dns !~ /^\^(\S*)/x); my $line = $1; @@ -12787,7 +12613,7 @@ sub get_dns { close($config); my $which = (split('/',$url))[3]; &logthis("unable to contact DNS defaulting to on disk file dns_$which.tab\n"); - open($config,"<","$perlvar{'lonTabDir'}/dns_$which.tab"); + open($config,"<$perlvar{'lonTabDir'}/dns_$which.tab"); my @content = <$config>; &$func(\@content,$hashref); return; @@ -12880,7 +12706,7 @@ sub fetch_dns_checksums { my ($ignore_cache,$nocache) = @_; &get_dns('/adm/dns/domain',\&parse_domain_tab,$ignore_cache,$nocache); my $fh; - if (open($fh,"<",$perlvar{'lonTabDir'}.'/domain.tab')) { + if (open($fh,"<".$perlvar{'lonTabDir'}.'/domain.tab')) { my @lines = <$fh>; &parse_domain_tab(\@lines); } @@ -12932,23 +12758,8 @@ sub fetch_dns_checksums { my ($id,$domain,$role,$name,$protocol,$intdom)=split(/:/,$configline); $name=~s/\s//g; if ($id && $domain && $role && $name) { - if ((exists($hostname{$id})) && ($hostname{$id} ne '')) { - my $curr = $hostname{$id}; - my $skip; - if (ref($name_to_host{$curr}) eq 'ARRAY') { - if (($curr eq $name) && (@{$name_to_host{$curr}} == 1)) { - $skip = 1; - } else { - @{$name_to_host{$curr}} = grep { $_ ne $id } @{$name_to_host{$curr}}; - } - } - unless ($skip) { - push(@{$name_to_host{$name}},$id); - } - } else { - push(@{$name_to_host{$name}},$id); - } $hostname{$id}=$name; + push(@{$name_to_host{$name}}, $id); $hostdom{$id}=$domain; if ($role eq 'library') { $libserv{$id}=$name; } if (defined($protocol)) { @@ -12981,7 +12792,7 @@ sub fetch_dns_checksums { sub load_hosts_tab { my ($ignore_cache,$nocache) = @_; &get_dns('/adm/dns/hosts',\&parse_hosts_tab,$ignore_cache,$nocache); - open(my $config,"<","$perlvar{'lonTabDir'}/hosts.tab"); + open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab"); my @config = <$config>; &parse_hosts_tab(\@config); close($config); @@ -13247,7 +13058,7 @@ sub all_loncaparevs { { sub load_loncaparevs { if (-e "$perlvar{'lonTabDir'}/loncaparevs.tab") { - if (open(my $config,"<","$perlvar{'lonTabDir'}/loncaparevs.tab")) { + if (open(my $config,"<$perlvar{'lonTabDir'}/loncaparevs.tab")) { while (my $configline=<$config>) { chomp($configline); my ($hostid,$loncaparev)=split(/:/,$configline); @@ -13263,7 +13074,7 @@ sub all_loncaparevs { { sub load_serverhomeIDs { if (-e "$perlvar{'lonTabDir'}/serverhomeIDs.tab") { - if (open(my $config,"<","$perlvar{'lonTabDir'}/serverhomeIDs.tab")) { + if (open(my $config,"<$perlvar{'lonTabDir'}/serverhomeIDs.tab")) { while (my $configline=<$config>) { chomp($configline); my ($name,$id)=split(/:/,$configline); @@ -13288,7 +13099,7 @@ BEGIN { # ------------------------------------------------------ Read spare server file { - open(my $config,"<","$perlvar{'lonTabDir'}/spare.tab"); + open(my $config,"<$perlvar{'lonTabDir'}/spare.tab"); while (my $configline=<$config>) { chomp($configline); @@ -13302,7 +13113,7 @@ BEGIN { } # ------------------------------------------------------------ Read permissions { - open(my $config,"<","$perlvar{'lonTabDir'}/roles.tab"); + open(my $config,"<$perlvar{'lonTabDir'}/roles.tab"); while (my $configline=<$config>) { chomp($configline); @@ -13316,7 +13127,7 @@ BEGIN { # -------------------------------------------- Read plain texts for permissions { - open(my $config,"<","$perlvar{'lonTabDir'}/rolesplain.tab"); + open(my $config,"<$perlvar{'lonTabDir'}/rolesplain.tab"); while (my $configline=<$config>) { chomp($configline); @@ -13336,7 +13147,7 @@ BEGIN { # ---------------------------------------------------------- Read package table { - open(my $config,"<","$perlvar{'lonTabDir'}/packages.tab"); + open(my $config,"<$perlvar{'lonTabDir'}/packages.tab"); while (my $configline=<$config>) { if ($configline !~ /\S/ || $configline=~/^#/) { next; } @@ -13382,7 +13193,7 @@ BEGIN { # ---------------------------------------------------------- Read managers table { if (-e "$perlvar{'lonTabDir'}/managers.tab") { - if (open(my $config,"<","$perlvar{'lonTabDir'}/managers.tab")) { + if (open(my $config,"<$perlvar{'lonTabDir'}/managers.tab")) { while (my $configline=<$config>) { chomp($configline); next if ($configline =~ /^\#/);