--- loncom/lonnet/perl/lonnet.pm 2010/05/21 12:11:17 1.1064 +++ loncom/lonnet/perl/lonnet.pm 2010/06/03 17:04:41 1.1069 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1064 2010/05/21 12:11:17 raeburn Exp $ +# $Id: lonnet.pm,v 1.1069 2010/06/03 17:04:41 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -5497,8 +5497,6 @@ sub metadata_query { my @server_list = (defined($server_array) ? @$server_array : keys(%libserv) ); for my $server (@server_list) { -#SD remove this -&logthis("Querying server:$server"); unless ($custom or $customshow) { my $reply=&reply("querysend:".&escape($query),$server); $rhash{$server}=$reply; @@ -5750,8 +5748,8 @@ sub auto_validate_instcode { $homeserver = &domain($cdom,'primary'); } } - my $response=&unescape(&reply('autovalidateinstcode:'.$cdom.':'. - &escape($instcode).':'.&escape($owner),$homeserver)); + $response=&unescape(&reply('autovalidateinstcode:'.$cdom.':'. + &escape($instcode).':'.&escape($owner),$homeserver)); my ($outcome,$description) = map { &unescape($_); } split('&',$response,2); return ($outcome,$description); } @@ -8159,6 +8157,9 @@ sub metadata { if (defined($cached)) { return $result->{':'.$what}; } } { +# Imported parts would go here + my @newpartorder=(); + my $importedparts=0; # # Is this a recursive call for a library? # @@ -8242,27 +8243,57 @@ sub metadata { # This is not a package - some other kind of start tag # my $entry=$token->[1]; - my $unikey; - if ($entry eq 'import') { - $unikey=''; - } else { - $unikey=$entry; - } - $unikey.=&add_prefix_and_part($prefix,$token->[2]->{'part'}); - - if (defined($token->[2]->{'id'})) { - $unikey.='_'.$token->[2]->{'id'}; - } + my $unikey=''; if ($entry eq 'import') { # # Importing a library here # + my $location=$parser->get_text('/import'); + my $dir=$filename; + $dir=~s|[^/]*$||; + $location=&filelocation($dir,$location); + + my $importmode=$token->[2]->{'importmode'}; + if ($importmode eq 'problem') { +# Import as problem/response + $unikey=&add_prefix_and_part($prefix,$token->[2]->{'part'}); + } elsif ($importmode eq 'part') { +# Import as part(s) + $importedparts=1; +# 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 +# Load and inspect original file + my $origfilelocation=$perlvar{'lonDocRoot'}.&clutter($uri); + my $origfile=&getfile($origfilelocation); + my @origfileimportpartids=($origfile=~/<(part|import)[^>]*id\s*=\s*[\"\']([^\"\']+)[\"\'][^>]*>/gs); +# Load and inspect imported file + my $impfile=&getfile($location); + my @impfilepartids=($impfile=~/]*id\s*=\s*[\"\']([^\"\']+)[\"\'][^>]*>/gs); + +#&logthis("Found imported parts".join(',',@impfilepartids)); +#&logthis("Found original parts and imports".join(',',@origfileimportpartids)); + if ($#impfilepartids>=0) { +# This problem had parts +#&logthis("Importing parted problem"); + } else { +# Importing by turning a single problem into a problem part +# It gets the import-tags ID as part-ID +#&logthis("Importing unparted problem"); + $unikey=&add_prefix_and_part($prefix,$token->[2]->{'id'}); + push(@newpartorder,$token->[2]->{'id'}); + } + } else { +# Normal import + $unikey=&add_prefix_and_part($prefix,$token->[2]->{'part'}); + if (defined($token->[2]->{'id'})) { + $unikey.='_'.$token->[2]->{'id'}; + } + } + +#&logthis("About to use unikey $unikey"); + if ($depthcount<20) { - my $location=$parser->get_text('/import'); - my $dir=$filename; - $dir=~s|[^/]*$||; - $location=&filelocation($dir,$location); my $metadata = &metadata($uri,'keys', $location,$unikey, $depthcount+1); @@ -8270,9 +8301,17 @@ sub metadata { $metaentry{':'.$meta}=$metaentry{':'.$meta}; $metathesekeys{$meta}=1; } - } - } else { +#&logthis("Metadata $metadata"); + } + } else { +# +# Not importing, some other kind of non-package, non-library start tag +# + $unikey=$entry.&add_prefix_and_part($prefix,$token->[2]->{'part'}); + if (defined($token->[2]->{'id'})) { + $unikey.='_'.$token->[2]->{'id'}; + } if (defined($token->[2]->{'name'})) { $unikey.='_'.$token->[2]->{'name'}; }