--- loncom/lonnet/perl/lonnet.pm 2001/10/16 08:53:19 1.164 +++ loncom/lonnet/perl/lonnet.pm 2001/11/05 22:48:19 1.168 @@ -131,7 +131,6 @@ # 8/4,8/7,8/8,8/9,8/11,8/16,8/17,8/18,8/20,8/23,9/20,9/21,9/26, # 10/2 Gerd Kortemeyer # 10/5,10/10 Scott Harrison -# 10/15 Gerd Kortemeyer package Apache::lonnet; @@ -855,15 +854,155 @@ sub devalidate { } } +sub hash2str { + my (%hash)=@_; + my $result=''; + map { $result.=escape($_).'='.escape($hash{$_}).'&'; } keys %hash; + $result=~s/\&$//; + return $result; +} + +sub str2hash { + my ($string) = @_; + my %returnhash; + map { + my ($name,$value)=split(/\=/,$_); + $returnhash{&unescape($name)}=&unescape($value); + } split(/\&/,$string); + return %returnhash; +} + +# -------------------------------------------------------------------Temp Store + +sub tmpreset { + my ($symb,$namespace,$domain,$stuname) = @_; + if (!$symb) { + $symb=&symbread(); + if (!$symb) { $symb= $ENV{'REQUEST_URI'}; } + } + $symb=escape($symb); + + if (!$namespace) { $namespace=$ENV{'request.state'}; } + $namespace=~s/\//\_/g; + $namespace=~s/\W//g; + + #FIXME needs to do something for /pub resources + if (!$domain) { $domain=$ENV{'user.domain'}; } + if (!$stuname) { $stuname=$ENV{'user.name'}; } + my $path=$perlvar{'lonDaemons'}.'/tmp'; + my %hash; + if (tie(%hash,'GDBM_File', + $path.'/tmpstore_'.$stuname.'_'.$domain.'_'.$namespace.'.db', + &GDBM_WRCREAT,0640)) { + foreach my $key (keys %hash) { + if ($key=~ /:$symb:/) { + delete($hash{$key}); + } + } + } +} + +sub tmpstore { + my ($storehash,$symb,$namespace,$domain,$stuname) = @_; + + if (!$symb) { + $symb=&symbread(); + if (!$symb) { $symb= $ENV{'request.url'}; } + } + $symb=escape($symb); + + if (!$namespace) { + # I don't think we would ever want to store this for a course. + # it seems this will only be used if we don't have a course. + #$namespace=$ENV{'request.course.id'}; + #if (!$namespace) { + $namespace=$ENV{'request.state'}; + #} + } + $namespace=~s/\//\_/g; + $namespace=~s/\W//g; +#FIXME needs to do something for /pub resources + if (!$domain) { $domain=$ENV{'user.domain'}; } + if (!$stuname) { $stuname=$ENV{'user.name'}; } + my $now=time; + my %hash; + my $path=$perlvar{'lonDaemons'}.'/tmp'; + if (tie(%hash,'GDBM_File', + $path.'/tmpstore_'.$stuname.'_'.$domain.'_'.$namespace.'.db', + &GDBM_WRCREAT,0640)) { + $hash{"version:$symb"}++; + my $version=$hash{"version:$symb"}; + my $allkeys=''; + foreach my $key (keys(%$storehash)) { + $allkeys.=$key.':'; + $hash{"$version:$symb:$key"}=$$storehash{$key}; + } + $hash{"$version:$symb:timestamp"}=$now; + $allkeys.='timestamp'; + $hash{"$version:keys:$symb"}=$allkeys; + if (untie(%hash)) { + return 'ok'; + } else { + return "error:$!"; + } + } else { + return "error:$!"; + } +} + +# -----------------------------------------------------------------Temp Restore + +sub tmprestore { + my ($symb,$namespace,$domain,$stuname) = @_; + + if (!$symb) { + $symb=&symbread(); + if (!$symb) { $symb= $ENV{'request.url'}; } + } + $symb=escape($symb); + + if (!$namespace) { $namespace=$ENV{'request.state'}; } + #FIXME needs to do something for /pub resources + if (!$domain) { $domain=$ENV{'user.domain'}; } + if (!$stuname) { $stuname=$ENV{'user.name'}; } + + my %returnhash; + $namespace=~s/\//\_/g; + $namespace=~s/\W//g; + my %hash; + my $path=$perlvar{'lonDaemons'}.'/tmp'; + if (tie(%hash,'GDBM_File', + $path.'/tmpstore_'.$stuname.'_'.$domain.'_'.$namespace.'.db', + &GDBM_READER,0640)) { + my $version=$hash{"version:$symb"}; + $returnhash{'version'}=$version; + my $scope; + for ($scope=1;$scope<=$version;$scope++) { + my $vkeys=$hash{"$scope:keys:$symb"}; + my @keys=split(/:/,$vkeys); + my $key; + $returnhash{"$scope:keys"}=$vkeys; + foreach $key (@keys) { + $returnhash{"$scope:$key"}=$hash{"$scope:$symb:$key"}; + $returnhash{"$key"}=$hash{"$scope:$symb:$key"}; + } + } + if (!(untie(%hash))) { + return "error:$!"; + } + } else { + return "error:$!"; + } + return %returnhash; +} + # ----------------------------------------------------------------------- Store sub store { my ($storehash,$symb,$namespace,$domain,$stuname) = @_; my $home=''; - if ($stuname) { - $home=&homeserver($stuname,$domain); - } + if ($stuname) { $home=&homeserver($stuname,$domain); } if (!$symb) { unless ($symb=&symbread()) { return ''; } } @@ -888,9 +1027,7 @@ sub cstore { my ($storehash,$symb,$namespace,$domain,$stuname) = @_; my $home=''; - if ($stuname) { - $home=&homeserver($stuname,$domain); - } + if ($stuname) { $home=&homeserver($stuname,$domain); } if (!$symb) { unless ($symb=&symbread()) { return ''; } } @@ -916,9 +1053,7 @@ sub restore { my ($symb,$namespace,$domain,$stuname) = @_; my $home=''; - if ($stuname) { - $home=&homeserver($stuname,$domain); - } + if ($stuname) { $home=&homeserver($stuname,$domain); } if (!$symb) { unless ($symb=escape(&symbread())) { return ''; } @@ -1242,7 +1377,7 @@ sub allowed { # If this is generating or modifying users, exit with special codes - if (':csu:cdc:ccc:cin:cta:cep:ccr:cst:cad:cli:cau:cdg:'=~/\:$priv\:/) { + if (':csu:cdc:ccc:cin:cta:cep:ccr:cst:cad:cli:cau:cdg:cca:'=~/\:$priv\:/) { return $thisallowed; } # @@ -1911,6 +2046,10 @@ sub EXT { $spacequalifierrest}; } elsif ($realm eq 'resource') { if ($ENV{'request.course.id'}) { + +# print '
'.$space.' - '.$qualifier.' - '.$spacequalifierrest; + + # ----------------------------------------------------- Cascading lookup scheme my $symbp; if ($symbparm) { @@ -2008,7 +2147,7 @@ sub EXT { # ------------------------------------------------------------------ Cascade up unless ($space eq '0') { - my ($part,$id)=split(/(\.|\_)/,$space); + my ($part,$id)=split(/\_/,$space); if ($id) { my $partgeneral=&EXT('resource.'.$part.'.'.$qualifierrest, $symbparm); @@ -2057,7 +2196,7 @@ sub metadata { $keyroot.='_'.$token->[2]->{'part'}; } if (defined($token->[2]->{'id'})) { - $keyroot.='.'.$token->[2]->{'id'}; + $keyroot.='_'.$token->[2]->{'id'}; } if ($metacache{$uri.':packages'}) { $metacache{$uri.':packages'}.=','.$package.$keyroot; @@ -2070,7 +2209,6 @@ sub metadata { my $value=$packagetab{$_}; my $part=$keyroot; $part=~s/^\_//; - $part=~s/\./\_/g; if ($subp eq 'display') { $value.=' [Part: '.$part.']'; } @@ -2090,7 +2228,7 @@ sub metadata { $unikey.='_'.$token->[2]->{'part'}; } if (defined($token->[2]->{'id'})) { - $unikey.='.'.$token->[2]->{'id'}; + $unikey.='_'.$token->[2]->{'id'}; } if (defined($token->[2]->{'name'})) { $unikey.='_'.$token->[2]->{'name'};