[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.587.2.2 and 1.589

version 1.587.2.2, 2005/01/28 09:25:18 version 1.589, 2005/01/18 22:09:14
Line 1739  sub get_first_access { Line 1739  sub get_first_access {
     my ($symb,$courseid,$udom,$uname)=&Apache::lonxml::whichuser();      my ($symb,$courseid,$udom,$uname)=&Apache::lonxml::whichuser();
     if ($argsymb) { $symb=$argsymb; }      if ($argsymb) { $symb=$argsymb; }
     my ($map,$id,$res)=&decode_symb($symb);      my ($map,$id,$res)=&decode_symb($symb);
     if ($type eq 'map') { $res=$map; }      if ($type eq 'map') {
     my %times=&get('firstaccesstimes',[$res],$udom,$uname);   $res=&symbread($map);
     return $times{$res};      } else {
    $res=$symb;
       }
       my %times=&get('firstaccesstimes',["$courseid\0$res"],$udom,$uname);
       return $times{"$courseid\0$res"};
 }  }
   
 sub set_first_access {  sub set_first_access {
     my ($type)=@_;      my ($type)=@_;
     my ($symb,$courseid,$udom,$uname)=&Apache::lonxml::whichuser();      my ($symb,$courseid,$udom,$uname)=&Apache::lonxml::whichuser();
     my ($map,$id,$res)=&decode_symb($symb);      my ($map,$id,$res)=&decode_symb($symb);
     if ($type eq 'map') { $res=$map; }      if ($type eq 'map') {
     my $firstaccess=&get_first_access($type);   $res=&symbread($map);
       } else {
    $res=$symb;
       }
       my $firstaccess=&get_first_access($type,$symb);
     if (!$firstaccess) {      if (!$firstaccess) {
  return &put('firstaccesstimes',{$res=>time},$udom,$uname);   return &put('firstaccesstimes',{"$courseid\0$res"=>time},$udom,$uname);
     }      }
     return 'already_set';      return 'already_set';
 }  }
Line 2092  sub tmpreset { Line 2100  sub tmpreset {
   $namespace=~s/\//\_/g;    $namespace=~s/\//\_/g;
   $namespace=~s/\W//g;    $namespace=~s/\W//g;
   
     #FIXME needs to do something for /pub resources
   if (!$domain) { $domain=$ENV{'user.domain'}; }    if (!$domain) { $domain=$ENV{'user.domain'}; }
   if (!$stuname) { $stuname=$ENV{'user.name'}; }    if (!$stuname) { $stuname=$ENV{'user.name'}; }
   if ($domain eq 'public' && $stuname eq 'public') {  
       $stuname=$ENV{'REMOTE_ADDR'};  
   }  
   my $path=$perlvar{'lonDaemons'}.'/tmp';    my $path=$perlvar{'lonDaemons'}.'/tmp';
   my %hash;    my %hash;
   if (tie(%hash,'GDBM_File',    if (tie(%hash,'GDBM_File',
Line 2129  sub tmpstore { Line 2135  sub tmpstore {
   }    }
   $namespace=~s/\//\_/g;    $namespace=~s/\//\_/g;
   $namespace=~s/\W//g;    $namespace=~s/\W//g;
   #FIXME needs to do something for /pub resources
   if (!$domain) { $domain=$ENV{'user.domain'}; }    if (!$domain) { $domain=$ENV{'user.domain'}; }
   if (!$stuname) { $stuname=$ENV{'user.name'}; }    if (!$stuname) { $stuname=$ENV{'user.name'}; }
   if ($domain eq 'public' && $stuname eq 'public') {  
       $stuname=$ENV{'REMOTE_ADDR'};  
   }  
   my $now=time;    my $now=time;
   my %hash;    my %hash;
   my $path=$perlvar{'lonDaemons'}.'/tmp';    my $path=$perlvar{'lonDaemons'}.'/tmp';
Line 2145  sub tmpstore { Line 2149  sub tmpstore {
     my $allkeys='';       my $allkeys=''; 
     foreach my $key (keys(%$storehash)) {      foreach my $key (keys(%$storehash)) {
       $allkeys.=$key.':';        $allkeys.=$key.':';
       $hash{"$version:$symb:$key"}=&freeze_escape($$storehash{$key});        $hash{"$version:$symb:$key"}=$$storehash{$key};
     }      }
     $hash{"$version:$symb:timestamp"}=$now;      $hash{"$version:$symb:timestamp"}=$now;
     $allkeys.='timestamp';      $allkeys.='timestamp';
Line 2172  sub tmprestore { Line 2176  sub tmprestore {
   $symb=escape($symb);    $symb=escape($symb);
   
   if (!$namespace) { $namespace=$ENV{'request.state'}; }    if (!$namespace) { $namespace=$ENV{'request.state'}; }
     #FIXME needs to do something for /pub resources
   if (!$domain) { $domain=$ENV{'user.domain'}; }    if (!$domain) { $domain=$ENV{'user.domain'}; }
   if (!$stuname) { $stuname=$ENV{'user.name'}; }    if (!$stuname) { $stuname=$ENV{'user.name'}; }
   if ($domain eq 'public' && $stuname eq 'public') {  
       $stuname=$ENV{'REMOTE_ADDR'};  
   }  
   my %returnhash;    my %returnhash;
   $namespace=~s/\//\_/g;    $namespace=~s/\//\_/g;
   $namespace=~s/\W//g;    $namespace=~s/\W//g;
Line 2195  sub tmprestore { Line 2197  sub tmprestore {
       my $key;        my $key;
       $returnhash{"$scope:keys"}=$vkeys;        $returnhash{"$scope:keys"}=$vkeys;
       foreach $key (@keys) {        foreach $key (@keys) {
  $returnhash{"$scope:$key"}=&thaw_unescape($hash{"$scope:$symb:$key"});   $returnhash{"$scope:$key"}=$hash{"$scope:$symb:$key"};
  $returnhash{"$key"}=&thaw_unescape($hash{"$scope:$symb:$key"});   $returnhash{"$key"}=$hash{"$scope:$symb:$key"};
       }        }
     }      }
     if (!(untie(%hash))) {      if (!(untie(%hash))) {
Line 2237  sub store { Line 2239  sub store {
   
     my $namevalue='';      my $namevalue='';
     foreach (keys %$storehash) {      foreach (keys %$storehash) {
         $namevalue.=&escape($_).'='.&freeze_escape($$storehash{$_}).'&';          $namevalue.=escape($_).'='.escape($$storehash{$_}).'&';
     }      }
     $namevalue=~s/\&$//;      $namevalue=~s/\&$//;
     &courselog($symb.':'.$stuname.':'.$domain.':STORE:'.$namevalue);      &courselog($symb.':'.$stuname.':'.$domain.':STORE:'.$namevalue);
Line 2273  sub cstore { Line 2275  sub cstore {
   
     my $namevalue='';      my $namevalue='';
     foreach (keys %$storehash) {      foreach (keys %$storehash) {
         $namevalue.=&escape($_).'='.&freeze_escape($$storehash{$_}).'&';          $namevalue.=escape($_).'='.escape($$storehash{$_}).'&';
     }      }
     $namevalue=~s/\&$//;      $namevalue=~s/\&$//;
     &courselog($symb.':'.$stuname.':'.$domain.':CSTORE:'.$namevalue);      &courselog($symb.':'.$stuname.':'.$domain.':CSTORE:'.$namevalue);
Line 2307  sub restore { Line 2309  sub restore {
     my %returnhash=();      my %returnhash=();
     foreach (split(/\&/,$answer)) {      foreach (split(/\&/,$answer)) {
  my ($name,$value)=split(/\=/,$_);   my ($name,$value)=split(/\=/,$_);
         $returnhash{&unescape($name)}=&thaw_unescape($value);          $returnhash{&unescape($name)}=&unescape($value);
     }      }
     my $version;      my $version;
     for ($version=1;$version<=$returnhash{'version'};$version++) {      for ($version=1;$version<=$returnhash{'version'};$version++) {
Line 2698  sub putstore { Line 2700  sub putstore {
            my $key = $1.':keys:'.$2;             my $key = $1.':keys:'.$2;
            $allitems{$key} .= $3.':';             $allitems{$key} .= $3.':';
        }         }
        $items.=$_.'='.&freeze_escape($$storehash{$_}).'&';         $items.=$_.'='.&escape($$storehash{$_}).'&';
    }     }
    foreach (keys %allitems) {     foreach (keys %allitems) {
        $allitems{$_} =~ s/\:$//;         $allitems{$_} =~ s/\:$//;
Removed from v.1.587.2.2  
changed lines
  Added in v.1.589

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