--- loncom/lonnet/perl/lonnet.pm 2000/11/27 20:44:04 1.71 +++ loncom/lonnet/perl/lonnet.pm 2000/12/12 21:32:46 1.78 @@ -45,7 +45,8 @@ # EXT(name) : value of a variable # symblist(map,hash) : Updates symbolic storage links # symbread([filename]) : returns the data handle (filename optional) -# rndseed() : returns a random seed +# rndseed() : returns a random seed +# receipt() : returns a receipt to be given out to users # getfile(filename) : returns the contents of filename, or a -1 if it can't # be found, replicates and subscribes to the file # filelocation(dir,file) : returns a farily clean absolute reference to file @@ -61,6 +62,8 @@ # an array of IDs # idrget(domain,array): returns hash with IDs for usernames (name=>id,...) for # an array of names +# metadata(file,entry): returns the metadata entry for a file. entry='keys' +# returns a comma separated list of keys # # 6/1/99,6/2,6/10,6/11,6/12,6/14,6/26,6/28,6/29,6/30, # 7/1,7/2,7/9,7/10,7/12,7/14,7/15,7/19, @@ -77,7 +80,8 @@ # 10/04 Guy Albertelli # 10/06,10/09,10/10,10/11,10/14,10/20,10/23,10/25,10/26,10/27,10/28,10/29, # 10/30,10/31, -# 11/2,11/14,11/15,11/16,11/20,11/21,11/22,11/25,11/27 Gerd Kortemeyer +# 11/2,11/14,11/15,11/16,11/20,11/21,11/22,11/25,11/27, +# 12/02,12/12 Gerd Kortemeyer package Apache::lonnet; @@ -380,7 +384,7 @@ sub idget { $idlist=~tr/A-Z/a-z/; my $reply=&reply("idget:$udom:".$idlist,$tryserver); my @answer=(); - if ($reply ne 'con_lost') { + if (($reply ne 'con_lost') && ($reply!~/^error\:/)) { @answer=split(/\&/,$reply); } ; my $i; @@ -629,9 +633,12 @@ sub restore { my ($name,$value)=split(/\=/,$_); $returnhash{&unescape($name)}=&unescape($value); } split(/\&/,$answer); - map { - $returnhash{$_}=$returnhash{$returnhash{'version'}.':'.$_}; - } split(/\:/,$returnhash{$returnhash{'version'}.':keys'}); + my $version; + for ($version=1;$version<=$returnhash{'version'};$version++) { + map { + $returnhash{$_}=$returnhash{$version.':'.$_}; + } split(/\:/,$returnhash{$version.':keys'}); + } return %returnhash; } @@ -1147,7 +1154,7 @@ sub fileembstyle { # ------------------------------------------------------------ Description Text -sub filedecription { +sub filedescription { my $ending=shift; return $fd{$ending}; } @@ -1454,8 +1461,12 @@ sub EXT { # --------------------------------------------- last, look in resource metadata + $spacequalifierrest=~s/\./\_/; my $metadata=&metadata($ENV{'request.filename'},$spacequalifierrest); if ($metadata) { return $metadata; } + $metadata=&metadata($ENV{'request.filename'}, + 'parameter_'.$spacequalifierrest); + if ($metadata) { return $metadata; } # ---------------------------------------------------- Any other user namespace } elsif ($realm eq 'environment') { @@ -1474,20 +1485,23 @@ sub EXT { sub metadata { my ($uri,$what)=@_; + $uri=&declutter($uri); - unless ($uri=~/\.meta$/) { $uri.='.meta'; } + my $filename=$uri; + $uri=~s/\.meta$//; unless ($metacache{$uri.':keys'}) { - my $metastring=&getfile($perlvar{'lonDocRoot'}.'/res/'.$uri); + unless ($filename=~/\.meta$/) { $filename.='.meta'; } + my $metastring=&getfile($perlvar{'lonDocRoot'}.'/res/'.$filename); my $parser=HTML::TokeParser->new(\$metastring); my $token; while ($token=$parser->get_token) { if ($token->[0] eq 'S') { my $entry=$token->[1]; my $unikey=$entry; - if ($token->[2]->{'part'}) { + if (defined($token->[2]->{'part'})) { $unikey.='_'.$token->[2]->{'part'}; } - if ($token->[2]->{'name'}) { + if (defined($token->[2]->{'name'})) { $unikey.='_'.$token->[2]->{'name'}; } if ($metacache{$uri.':keys'}) { @@ -1497,8 +1511,12 @@ sub metadata { } map { $metacache{$uri.':'.$unikey.'.'.$_}=$token->[2]->{$_}; - } $token->[3]; - $metacache{$uri.':'.$unikey}=$parser->get_text('/'.$entry); + } @{$token->[3]}; + unless ( + $metacache{$uri.':'.$unikey}=$parser->get_text('/'.$entry) + ) { $metacache{$uri.':'.$unikey}= + $metacache{$uri.':'.$unikey.'.default'}; + } } } } @@ -1624,6 +1642,27 @@ sub rndseed { .$symbchck); } +sub ireceipt { + my ($funame,$fudom,$fucourseid,$fusymb)=@_; + my $cuname=unpack("%32C*",$funame); + my $cudom=unpack("%32C*",$fudom); + my $cucourseid=unpack("%32C*",$fucourseid); + my $cusymb=unpack("%32C*",$fusymb); + my $cunique=unpack("%32C*",$perlvar{'lonReceipt'}); + return unpack("%32C*",$perlvar{'lonHostID'}).'-'. + ($cunique%$cuname+ + $cunique%$cudom+ + $cusymb%$cuname+ + $cusymb%$cudom+ + $cucourseid%$cuname+ + $cucourseid%$cudom); +} + +sub receipt { + return &ireceipt($ENV{'user.name'},$ENV{'user.domain'}, + $ENV{'request.course.id'},&symbread()); +} + # ------------------------------------------------------------ Serves up a file # returns either the contents of the file or a -1 sub getfile {