Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.1371 and 1.1372

version 1.1371, 2018/03/30 21:30:00 version 1.1372, 2018/03/30 23:50:29
Line 11928  sub metadata { Line 11928  sub metadata {
 # Check metadata for imported file to  # Check metadata for imported file to
 # see if it contained response items  # see if it contained response items
 #  #
                           my ($origfile,@libfilekeys);
                         my %currmetaentry = %metaentry;                          my %currmetaentry = %metaentry;
                         my $libresponseorder = &metadata($location,'responseorder');                          @libfilekeys = split(/,/,&metadata($location,'keys',undef,undef,undef,
                         my $origfile;                                                             $depthcount+1));
                         if ($libresponseorder ne '') {                          if (grep(/^responseorder$/,@libfilekeys)) {
                             if ($#origfiletagids<0) {                              my $libresponseorder = &metadata($location,'responseorder',undef,undef,
                                 undef(%importedrespids);                                                               undef,$depthcount+1);
                                 undef(%importedpartids);                              if ($libresponseorder ne '') {
                             }                                  if ($#origfiletagids<0) {
                             @{$importedrespids{$importid}} = split(/\s*,\s*/,$libresponseorder);                                      undef(%importedrespids);
                             if (@{$importedrespids{$importid}} > 0) {                                      undef(%importedpartids);
                                 $importedresponses = 1;                                  }
                                   @{$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  # We need to get the original file and the imported file to get the response order correct
 # Load and inspect original file  # Load and inspect original file
                                 if ($#origfiletagids<0) {                                      if ($#origfiletagids<0) {
                                     my $origfilelocation=$perlvar{'lonDocRoot'}.&clutter($uri);                                          my $origfilelocation=$perlvar{'lonDocRoot'}.&clutter($uri);
                                     $origfile=&getfile($origfilelocation);                                          $origfile=&getfile($origfilelocation);
                                     @origfiletagids=($origfile=~/<((?:\w+)response|import|part)[^>]*id\s*=\s*[\"\']([^\"\']+)[\"\'][^>]*>/gs);                                          @origfiletagids=($origfile=~/<((?:\w+)response|import|part)[^>]*id\s*=\s*[\"\']([^\"\']+)[\"\'][^>]*>/gs);
                                       }
                                 }                                  }
                             }                              }
                         }                          }
Line 11970  sub metadata { Line 11975  sub metadata {
                                    @origfiletagids=($origfile=~/<(part|import)[^>]*id\s*=\s*[\"\']([^\"\']+)[\"\'][^>]*>/gs);                                     @origfiletagids=($origfile=~/<(part|import)[^>]*id\s*=\s*[\"\']([^\"\']+)[\"\'][^>]*>/gs);
                                }                                 }
                            }                             }
                              my @impfilepartids;
 # Load and inspect imported file  # If <partorder> tag is included in metadata for the imported file
                            my $impfile=&getfile($location);  # get the parts in the imported file from that.
                            my @impfilepartids=($impfile=~/<part[^>]*id\s*=\s*[\"\']([^\"\']+)[\"\'][^>]*>/gs);                             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 <partorder> tag available, load and inspect imported file
                                  my $impfile=&getfile($location);
                                  @impfilepartids=($impfile=~/<part[^>]*id\s*=\s*[\"\']([^\"\']+)[\"\'][^>]*>/gs);
                              }
                            if ($#impfilepartids>=0) {                             if ($#impfilepartids>=0) {
 # This problem had parts  # This problem had parts
                                $importedpartids{$token->[2]->{'id'}}=join(',',@impfilepartids);                                 $importedpartids{$token->[2]->{'id'}}=join(',',@impfilepartids);
Line 12124  sub metadata { Line 12142  sub metadata {
                 $metaentry{':responseorder'}=~s/^\,//;                  $metaentry{':responseorder'}=~s/^\,//;
             }              }
         }          }
   
  $metaentry{':keys'} = join(',',keys(%metathesekeys));   $metaentry{':keys'} = join(',',keys(%metathesekeys));
  &metadata_generate_part0(\%metathesekeys,\%metaentry,$uri);   &metadata_generate_part0(\%metathesekeys,\%metaentry,$uri);
  $metaentry{':allpossiblekeys'}=join(',',keys(%metathesekeys));   $metaentry{':allpossiblekeys'}=join(',',keys(%metathesekeys));

Removed from v.1.1371  
changed lines
  Added in v.1.1372


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>