Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.1069 and 1.1070

version 1.1069, 2010/06/03 17:04:41 version 1.1070, 2010/06/04 00:14:15
Line 8131  sub add_prefix_and_part { Line 8131  sub add_prefix_and_part {
 # ---------------------------------------------------------------- Get metadata  # ---------------------------------------------------------------- Get metadata
   
 my %metaentry;  my %metaentry;
   my %importedpartids;
 sub metadata {  sub metadata {
     my ($uri,$what,$liburi,$prefix,$depthcount)=@_;      my ($uri,$what,$liburi,$prefix,$depthcount)=@_;
     $uri=&declutter($uri);      $uri=&declutter($uri);
Line 8158  sub metadata { Line 8159  sub metadata {
     }      }
     {      {
 # Imported parts would go here  # Imported parts would go here
         my @newpartorder=();          my %importedids=();
           my @origfileimportpartids=();
         my $importedparts=0;          my $importedparts=0;
 #  #
 # Is this a recursive call for a library?  # Is this a recursive call for a library?
Line 8264  sub metadata { Line 8266  sub metadata {
 # 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
                            my $origfilelocation=$perlvar{'lonDocRoot'}.&clutter($uri);                             if ($#origfileimportpartids<0) {
                            my $origfile=&getfile($origfilelocation);                                undef(%importedpartids);
                            my @origfileimportpartids=($origfile=~/<(part|import)[^>]*id\s*=\s*[\"\']([^\"\']+)[\"\'][^>]*>/gs);                                my $origfilelocation=$perlvar{'lonDocRoot'}.&clutter($uri);
                                 my $origfile=&getfile($origfilelocation);
                                 @origfileimportpartids=($origfile=~/<(part|import)[^>]*id\s*=\s*[\"\']([^\"\']+)[\"\'][^>]*>/gs);
                              }
   
 # Load and inspect imported file  # Load and inspect imported file
                            my $impfile=&getfile($location);                             my $impfile=&getfile($location);
                            my @impfilepartids=($impfile=~/<part[^>]*id\s*=\s*[\"\']([^\"\']+)[\"\'][^>]*>/gs);                             my @impfilepartids=($impfile=~/<part[^>]*id\s*=\s*[\"\']([^\"\']+)[\"\'][^>]*>/gs);
   
 #&logthis("Found imported parts".join(',',@impfilepartids));  
 #&logthis("Found original parts and imports".join(',',@origfileimportpartids));  
                            if ($#impfilepartids>=0) {                             if ($#impfilepartids>=0) {
 # This problem had parts  # This problem had parts
 #&logthis("Importing parted problem");                                 $importedpartids{$token->[2]->{'id'}}=join(',',@impfilepartids);
                            } else {                             } else {
 # Importing by turning a single problem into a problem part  # Importing by turning a single problem into a problem part
 # It gets the import-tags ID as part-ID  # It gets the import-tags ID as part-ID
 #&logthis("Importing unparted problem");  
                                $unikey=&add_prefix_and_part($prefix,$token->[2]->{'id'});                                 $unikey=&add_prefix_and_part($prefix,$token->[2]->{'id'});
                                push(@newpartorder,$token->[2]->{'id'});                                 $importedpartids{$token->[2]->{'id'}}=$token->[2]->{'id'};
                            }                             }
                         } else {                          } else {
 # Normal import  # Normal import
Line 8291  sub metadata { Line 8293  sub metadata {
                            }                             }
                         }                          }
   
 #&logthis("About to use unikey $unikey");  
   
  if ($depthcount<20) {   if ($depthcount<20) {
     my $metadata =       my $metadata = 
  &metadata($uri,'keys', $location,$unikey,   &metadata($uri,'keys', $location,$unikey,
Line 8302  sub metadata { Line 8302  sub metadata {
  $metathesekeys{$meta}=1;   $metathesekeys{$meta}=1;
     }      }
   
 #&logthis("Metadata $metadata");  
                         }                          }
     } else {      } else {
 #  #
Line 8385  sub metadata { Line 8384  sub metadata {
     grep { ! $seen{$_} ++ } (split(',',$metaentry{':packages'}));      grep { ! $seen{$_} ++ } (split(',',$metaentry{':packages'}));
  $metaentry{':packages'} = join(',',@uniq_packages);   $metaentry{':packages'} = join(',',@uniq_packages);
   
           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{':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.1069  
changed lines
  Added in v.1.1070


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