--- loncom/lonnet/perl/lonnet.pm 2018/09/06 14:31:22 1.1172.2.98 +++ loncom/lonnet/perl/lonnet.pm 2018/09/21 03:58:53 1.1172.2.100 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1172.2.98 2018/09/06 14:31:22 raeburn Exp $ +# $Id: lonnet.pm,v 1.1172.2.100 2018/09/21 03:58:53 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -2840,8 +2840,7 @@ sub absolute_url { sub ssi { my ($fn,%form)=@_; - my $ua=new LWP::UserAgent; - my $request; + my ($request,$response); $form{'no_update_last_known'}=1; &Apache::lonenc::check_encrypt(\$fn); @@ -2858,7 +2857,25 @@ sub ssi { } $request->header(Cookie => $ENV{'HTTP_COOKIE'}); - my $response= $ua->request($request); + + if ($islocal) { + if (LWP::UserAgent->VERSION >= 5.834) { + my $ua=new LWP::UserAgent; + $ua->local_address('127.0.0.1'); + $response = $ua->request($request); + } else { + { + require LWP::Protocol::http; + local @LWP::Protocol::http::EXTRA_SOCK_OPTS = (LocalAddr => '127.0.0.1'); + my $ua=new LWP::UserAgent; + $response = $ua->request($request); + @LWP::Protocol::http::EXTRA_SOCK_OPTS = (); + } + } + } else { + my $ua=new LWP::UserAgent; + $response = $ua->request($request); + } if (wantarray) { return ($response->content, $response); } else { @@ -11068,6 +11085,7 @@ sub add_prefix_and_part { my %metaentry; my %importedpartids; +my %importedrespids; sub metadata { my ($uri,$what,$liburi,$prefix,$depthcount)=@_; $uri=&declutter($uri); @@ -11095,9 +11113,11 @@ sub metadata { } { # Imported parts would go here - my %importedids=(); - my @origfileimportpartids=(); + my @origfiletagids=(); my $importedparts=0; + +# Imported responseids would go here + my $importedresponses=0; # # Is this a recursive call for a library? # @@ -11192,8 +11212,37 @@ 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'}); @@ -11202,12 +11251,15 @@ 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 ($#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 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 imported file @@ -11321,20 +11373,48 @@ sub metadata { grep { ! $seen{$_} ++ } (split(',',$metaentry{':packages'})); $metaentry{':packages'} = join(',',@uniq_packages); - if ($importedparts) { + if (($importedresponses) || ($importedparts)) { + if ($importedparts) { # We had imported parts and need to rebuild partorder - $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{':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{':keys'} = join(',',keys(%metathesekeys));