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

version 1.1370, 2018/03/30 18:07:47 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));
  &do_cache_new('meta',$uri,\%metaentry,$cachetime);          unless ($liburi) {
       &do_cache_new('meta',$uri,\%metaentry,$cachetime);
           }
 # this is the end of "was not already recently cached  # this is the end of "was not already recently cached
     }      }
     return $metaentry{':'.$what};      return $metaentry{':'.$what};
Line 14851  only used internally for recursive metad Line 14870  only used internally for recursive metad
 the toolsymb is only used where the uri is for an external tool (for which  the toolsymb is only used where the uri is for an external tool (for which
 the uri as well as the symb are guaranteed to be unique).  the uri as well as the symb are guaranteed to be unique).
   
 this function automatically caches all requests  this function automatically caches all requests except any made recursively
   to retrieve a list of metadata keys for an imported library file ($liburi is 
   defined).
   
 =item *  =item *
   

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


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