loncom/lonnet/perl/lonnet.pm - diff

Return to lonnet.pm CVS log

Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.167 and 1.168

-version 1.167, 2001/10/30 19:19:09
+version 1.168, 2001/11/05 22:48:19
  Line 854  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) = @_;
+   my ($storehash,$symb,$namespace,$domain,$stuname) = @_;
-     my $home='';
-     if ($stuname) {
+   if (!$symb) {
- 	$home=&homeserver($stuname,$domain);
+     $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
-     if (!$symb) {
+ sub tmprestore {
-       $symb=&symbread();
+   my ($symb,$namespace,$domain,$stuname) = @_;
-       if (!$symb) {
- 	$symb= $ENV{'request.url'};
+   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))) {
-     $symb=escape($symb);
+       return "error:$!";
-     if (!$namespace) { unless ($namespace=$ENV{'request.course.id'}) { return ''; } }
+     }
-     if (!$domain) { $domain=$ENV{'user.domain'}; }
+   } else {
-     if (!$stuname) { $stuname=$ENV{'user.name'}; }
+     return "error:$!";
-     if (!$home) { $home=$ENV{'user.home'}; }
+   }
-     my $namevalue='';
+   return %returnhash;
-     map {
-         $namevalue.=escape($_).'='.escape($$storehash{$_}).'&';
-     } keys %$storehash;
-     $namevalue=~s/\&$//;
  }
  # ----------------------------------------------------------------------- Store
- Line 891  sub store {
+ Line 1002  sub store {
      my ($storehash,$symb,$namespace,$domain,$stuname) = @_;
      my $home='';
-     if ($stuname) {
+     if ($stuname) { $home=&homeserver($stuname,$domain); }
- 	$home=&homeserver($stuname,$domain);
-     }
      if (!$symb) { unless ($symb=&symbread()) { return ''; } }
- Line 918  sub cstore {
+ Line 1027  sub cstore {
      my ($storehash,$symb,$namespace,$domain,$stuname) = @_;
      my $home='';
-     if ($stuname) {
+     if ($stuname) { $home=&homeserver($stuname,$domain); }
- 	$home=&homeserver($stuname,$domain);
-     }
      if (!$symb) { unless ($symb=&symbread()) { return ''; } }
- Line 946  sub restore {
+ Line 1053  sub restore {
      my ($symb,$namespace,$domain,$stuname) = @_;
      my $home='';
-     if ($stuname) {
+     if ($stuname) { $home=&homeserver($stuname,$domain); }
- 	$home=&homeserver($stuname,$domain);
-     }
      if (!$symb) {
        unless ($symb=escape(&symbread())) { return ''; }

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

Removed from v.1.167
changed lines
	Added in v.1.168