[BACK]Return to lonnet.pm CVS log [TXT] [DIR] 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 { 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  # -------------------------------------------------------------------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 {  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  # ----------------------------------------------------------------------- Store
Line 891  sub store { Line 1002  sub store {
     my ($storehash,$symb,$namespace,$domain,$stuname) = @_;      my ($storehash,$symb,$namespace,$domain,$stuname) = @_;
     my $home='';      my $home='';
   
     if ($stuname) {      if ($stuname) { $home=&homeserver($stuname,$domain); }
  $home=&homeserver($stuname,$domain);  
     }  
   
     if (!$symb) { unless ($symb=&symbread()) { return ''; } }      if (!$symb) { unless ($symb=&symbread()) { return ''; } }
   
Line 918  sub cstore { Line 1027  sub cstore {
     my ($storehash,$symb,$namespace,$domain,$stuname) = @_;      my ($storehash,$symb,$namespace,$domain,$stuname) = @_;
     my $home='';      my $home='';
   
     if ($stuname) {      if ($stuname) { $home=&homeserver($stuname,$domain); }
  $home=&homeserver($stuname,$domain);  
     }  
   
     if (!$symb) { unless ($symb=&symbread()) { return ''; } }      if (!$symb) { unless ($symb=&symbread()) { return ''; } }
   
Line 946  sub restore { Line 1053  sub restore {
     my ($symb,$namespace,$domain,$stuname) = @_;      my ($symb,$namespace,$domain,$stuname) = @_;
     my $home='';      my $home='';
   
     if ($stuname) {      if ($stuname) { $home=&homeserver($stuname,$domain); }
  $home=&homeserver($stuname,$domain);  
     }  
   
     if (!$symb) {      if (!$symb) {
       unless ($symb=escape(&symbread())) { return ''; }        unless ($symb=escape(&symbread())) { return ''; }
Removed from v.1.167  
changed lines
  Added in v.1.168

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