[BACK]Return to lonnet.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.1368 and 1.1373

version 1.1368, 2018/03/23 01:02:04 version 1.1373, 2018/04/02 17:27:52
Line 11735  sub add_prefix_and_part { Line 11735  sub add_prefix_and_part {
   
 my %metaentry;  my %metaentry;
 my %importedpartids;  my %importedpartids;
   my %importedrespids;
 sub metadata {  sub metadata {
     my ($uri,$what,$toolsymb,$liburi,$prefix,$depthcount)=@_;      my ($uri,$what,$toolsymb,$liburi,$prefix,$depthcount)=@_;
     $uri=&declutter($uri);      $uri=&declutter($uri);
Line 11821  sub metadata { Line 11822  sub metadata {
   
     {      {
 # Imported parts would go here  # Imported parts would go here
         my %importedids=();          my @origfiletagids=();
         my @origfileimportpartids=();  
         my $importedparts=0;          my $importedparts=0;
   
   # Imported responseids would go here
           my $importedresponses=0;
 #  #
 # Is this a recursive call for a library?  # Is this a recursive call for a library?
 #  #
Line 11918  sub metadata { Line 11921  sub metadata {
                         my $dir=$filename;                          my $dir=$filename;
                         $dir=~s|[^/]*$||;                          $dir=~s|[^/]*$||;
                         $location=&filelocation($dir,$location);                          $location=&filelocation($dir,$location);
                          
                           my $importid=$token->[2]->{'id'};
                         my $importmode=$token->[2]->{'importmode'};                          my $importmode=$token->[2]->{'importmode'};
   #
   # Check metadata for imported file to
   # see if it contained response items
   #
                           my ($origfile,@libfilekeys);
                           my %currmetaentry = %metaentry;
                           @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);
                                       }
                                   }
                               }
                           }
   # 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') {                          if ($importmode eq 'problem') {
 # Import as problem/response  # Import as problem/response
                            $unikey=&add_prefix_and_part($prefix,$token->[2]->{'part'});                             $unikey=&add_prefix_and_part($prefix,$token->[2]->{'part'});
Line 11928  sub metadata { Line 11968  sub metadata {
                            $importedparts=1;                             $importedparts=1;
 # We need to get the original file and the imported file to get the part order correct  # 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  # Good news: we do not need to worry about nested libraries, since parts cannot be nested
 # Load and inspect original file  # Load and inspect original file if we didn't do that already
                            if ($#origfileimportpartids<0) {                             if ($#origfiletagids<0) {
                               undef(%importedpartids);                                 undef(%importedrespids);
                               my $origfilelocation=$perlvar{'lonDocRoot'}.&clutter($uri);                                 undef(%importedpartids);
                               my $origfile=&getfile($origfilelocation);                                 if ($origfile eq '') {
                               @origfileimportpartids=($origfile=~/<(part|import)[^>]*id\s*=\s*[\"\']([^\"\']+)[\"\'][^>]*>/gs);                                     my $origfilelocation=$perlvar{'lonDocRoot'}.&clutter($uri);
                                      $origfile=&getfile($origfilelocation);
                                      @origfiletagids=($origfile=~/<(part|import)[^>]*id\s*=\s*[\"\']([^\"\']+)[\"\'][^>]*>/gs);
                                  }
                              }
                              my @impfilepartids;
   # If <partorder> 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 <partorder> tag available, load and inspect imported file
                                  my $impfile=&getfile($location);
                                  @impfilepartids=($impfile=~/<part[^>]*id\s*=\s*[\"\']([^\"\']+)[\"\'][^>]*>/gs);
                            }                             }
   
 # Load and inspect imported file  
                            my $impfile=&getfile($location);  
                            my @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 11964  sub metadata { Line 12020  sub metadata {
  $metaentry{':'.$meta}=$metaentry{':'.$meta};   $metaentry{':'.$meta}=$metaentry{':'.$meta};
  $metathesekeys{$meta}=1;   $metathesekeys{$meta}=1;
     }      }
   
                         }                          }
     } else {      } else {
 #  #
Line 12047  sub metadata { Line 12102  sub metadata {
     grep { ! $seen{$_} ++ } (split(',',$metaentry{':packages'}));      grep { ! $seen{$_} ++ } (split(',',$metaentry{':packages'}));
  $metaentry{':packages'} = join(',',@uniq_packages);   $metaentry{':packages'} = join(',',@uniq_packages);
   
         if ($importedparts) {          if (($importedresponses) || ($importedparts)) {
               if ($importedparts) {
 # We had imported parts and need to rebuild partorder  # We had imported parts and need to rebuild partorder
            $metaentry{':partorder'}='';                  $metaentry{':partorder'}='';
            $metathesekeys{'partorder'}=1;                  $metathesekeys{'partorder'}=1;
            for (my $index=0;$index<$#origfileimportpartids;$index+=2) {              }
                if ($origfileimportpartids[$index] eq 'part') {              if ($importedresponses) {
 # original part, part of the problem  # We had imported responses and need to rebuil responseorder
                   $metaentry{':partorder'}.=','.$origfileimportpartids[$index+1];                  $metaentry{':responseorder'}='';
                } else {                  $metathesekeys{'responseorder'}=1;
 # we have imported parts at this position              }
                   $metaentry{':partorder'}.=','.$importedpartids{$origfileimportpartids[$index+1]};              for (my $index=0;$index<$#origfiletagids;$index+=2) {
                }                  my $origid = $origfiletagids[$index+1];
            }                  if ($origfiletagids[$index] eq 'part') {
            $metaentry{':partorder'}=~s/^\,//;  # 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
                           if ($importedpartids{$origid} ne '') {
                               $metaentry{':partorder'}.=','.$importedpartids{$origid};
                           }
                       }
                       if ($importedresponses) {
   # We have imported responses at this position
                           if ($importedrespids{$origid} ne '') {
                               $metaentry{':responseorder'}.=','.$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));   $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 14789  only used internally for recursive metad Line 14875  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.1368  
changed lines
  Added in v.1.1373

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