--- loncom/lonnet/perl/lonnet.pm 2000/11/27 20:44:04 1.71
+++ loncom/lonnet/perl/lonnet.pm 2000/12/12 23:43:05 1.79
@@ -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};
}
@@ -1419,26 +1426,14 @@ sub EXT {
my $reply=&reply('get:'.
$ENV{'course.'.$ENV{'request.course.id'}.$section.'.domain'}.':'.
$ENV{'course.'.$ENV{'request.course.id'}.$section.'.num'}.
- ':resourcedata:'.
- escape($seclevelr).':'.escape($seclevelm).':'.escape($seclevel).':'.
- escape($courselevelr).':'.escape($courselevelm).':'.escape($courselevel),
+ ':resourcedata:'.
+ &escape($seclevelr).'&'.&escape($seclevelm).'&'.&escape($seclevel).'&'.
+ &escape($courselevelr).'&'.&escape($courselevelm).'&'.&escape($courselevel),
$ENV{'course.'.$ENV{'request.course.id'}.$section.'.home'});
if ($reply!~/^error\:/) {
- map {
- my ($name,$value)=split(/\=/,$_);
- $resourcedata{unescape($name)}=unescape($value);
- } split(/\&/,$reply);
-
- if ($resourcedata{$seclevelr}) { return $resourcedata{$seclevelr}; }
- if ($resourcedata{$seclevelm}) { return $resourcedata{$seclevelm}; }
- if ($resourcedata{$seclevel}) { return $resourcedata{$seclevel}; }
-
- if ($resourcedata{$courselevelr}) {
- return $resourcedata{$courselevelr}; }
- if ($resourcedata{$courselevelm}) {
- return $resourcedata{$courselevelm}; }
- if ($resourcedata{$courselevel}) { return $resourcedata{$courselevel}; }
-
+ map {
+ if ($_) { return &unescape($_); }
+ } split(/\&/,$reply);
}
# ------------------------------------------------------ third, check map parms
@@ -1454,8 +1449,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 +1473,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 +1499,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 +1630,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 {