--- loncom/lonnet/perl/lonnet.pm 2018/03/30 21:30:00 1.1371 +++ loncom/lonnet/perl/lonnet.pm 2018/04/02 17:27:52 1.1373 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1371 2018/03/30 21:30:00 raeburn Exp $ +# $Id: lonnet.pm,v 1.1373 2018/04/02 17:27:52 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -11928,23 +11928,31 @@ sub metadata { # Check metadata for imported file to # see if it contained response items # + my ($origfile,@libfilekeys); 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; + @libfilekeys = split(/,/,&metadata($location,'keys',undef,undef,undef, + $depthcount+1)); + if (grep(/^responseorder$/,@libfilekeys)) { + my $libresponseorder = &metadata($location,'responseorder',undef,undef, + undef,$depthcount+1); + if ($libresponseorder ne '') { + if ($#origfiletagids<0) { + undef(%importedrespids); + undef(%importedpartids); + } + my @respids = split(/\s*,\s*/,$libresponseorder); + if (@respids) { + $importedrespids{$importid} = join(',',map { $importid.'_'.$_ } @respids); + } + if ($importedrespids{$importid} ne '') { + $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); + if ($#origfiletagids<0) { + my $origfilelocation=$perlvar{'lonDocRoot'}.&clutter($uri); + $origfile=&getfile($origfilelocation); + @origfiletagids=($origfile=~/<((?:\w+)response|import|part)[^>]*id\s*=\s*[\"\']([^\"\']+)[\"\'][^>]*>/gs); + } } } } @@ -11970,10 +11978,23 @@ sub metadata { @origfiletagids=($origfile=~/<(part|import)[^>]*id\s*=\s*[\"\']([^\"\']+)[\"\'][^>]*>/gs); } } - -# Load and inspect imported file - my $impfile=&getfile($location); - my @impfilepartids=($impfile=~/]*id\s*=\s*[\"\']([^\"\']+)[\"\'][^>]*>/gs); + my @impfilepartids; +# If tag is included in metadata for the imported file +# get the parts in the imported file from that. + if (grep(/^partorder$/,@libfilekeys)) { + %currmetaentry = %metaentry; + my $libpartorder = &metadata($location,'partorder',undef,undef,undef, + $depthcount+1); + %metaentry = %currmetaentry; + undef(%currmetaentry); + if ($libpartorder ne '') { + @impfilepartids=split(/\s*,\s*/,$libpartorder); + } + } else { +# If no tag available, load and inspect imported file + my $impfile=&getfile($location); + @impfilepartids=($impfile=~/]*id\s*=\s*[\"\']([^\"\']+)[\"\'][^>]*>/gs); + } if ($#impfilepartids>=0) { # This problem had parts $importedpartids{$token->[2]->{'id'}}=join(',',@impfilepartids); @@ -12102,12 +12123,14 @@ sub metadata { } elsif ($origfiletagids[$index] eq 'import') { if ($importedparts) { # We have imported parts at this position - $metaentry{':partorder'}.=','.$importedpartids{$origid}; + if ($importedpartids{$origid} ne '') { + $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}}); + if ($importedrespids{$origid} ne '') { + $metaentry{':responseorder'}.=','.$importedrespids{$origid}; } } } else { @@ -12124,7 +12147,6 @@ sub metadata { $metaentry{':responseorder'}=~s/^\,//; } } - $metaentry{':keys'} = join(',',keys(%metathesekeys)); &metadata_generate_part0(\%metathesekeys,\%metaentry,$uri); $metaentry{':allpossiblekeys'}=join(',',keys(%metathesekeys));