[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.785 and 1.788

version 1.785, 2006/09/28 20:03:55 version 1.788, 2006/10/04 19:48:32
Line 303  sub convert_and_load_session_env { Line 303  sub convert_and_load_session_env {
     }      }
     my %temp_env;      my %temp_env;
     foreach my $line (@profile) {      foreach my $line (@profile) {
    if ($line !~ m/=/) {
       return 0;
    }
  chomp($line);   chomp($line);
  my ($envname,$envvalue)=split(/=/,$line,2);   my ($envname,$envvalue)=split(/=/,$line,2);
  $temp_env{&unescape($envname)} = &unescape($envvalue);   $temp_env{&unescape($envname)} = &unescape($envvalue);
Line 314  sub convert_and_load_session_env { Line 317  sub convert_and_load_session_env {
  @env{keys(%temp_env)} = @disk_env{keys(%temp_env)};   @env{keys(%temp_env)} = @disk_env{keys(%temp_env)};
  untie(%disk_env);   untie(%disk_env);
     }      }
       return 1;
 }  }
   
 # ------------------------------------------- Transfer profile into environment  # ------------------------------------------- Transfer profile into environment
 my $env_loaded;  my $env_loaded;
 sub transfer_profile_to_env {  sub transfer_profile_to_env {
     if ($env_loaded) { return; }       my ($lonidsdir,$handle,$force_transfer) = @_;
       if (!$force_transfer && $env_loaded) { return; } 
   
     my ($lonidsdir,$handle)=@_;  
     if (!defined($lonidsdir)) {      if (!defined($lonidsdir)) {
  $lonidsdir = $perlvar{'lonIDsDir'};   $lonidsdir = $perlvar{'lonIDsDir'};
     }      }
Line 329  sub transfer_profile_to_env { Line 333  sub transfer_profile_to_env {
         ($handle) = ($env{'user.environment'} =~m|/([^/]+)\.id$| );          ($handle) = ($env{'user.environment'} =~m|/([^/]+)\.id$| );
     }      }
   
     my %remove;      my $convert;
     if (tie(my %disk_env,'GDBM_File',"$lonidsdir/$handle.id",&GDBM_READER(),      {
     0640)) {      open(my $idf,"$lonidsdir/$handle.id");
  @env{keys(%disk_env)} = @disk_env{keys(%disk_env)};   flock($idf,LOCK_SH);
  untie(%disk_env);   if (tie(my %disk_env,'GDBM_File',"$lonidsdir/$handle.id",
     } else {   &GDBM_READER(),0640)) {
  &convert_and_load_session_env($lonidsdir,$handle);      @env{keys(%disk_env)} = @disk_env{keys(%disk_env)};
       untie(%disk_env);
    } else {
       $convert = 1;
    }
       }
       if ($convert) {
    if (!&convert_and_load_session_env($lonidsdir,$handle)) {
       &logthis("Failed to load session, or convert session.");
    }
     }      }
   
       my %remove;
     while ( my $envname = each(%env) ) {      while ( my $envname = each(%env) ) {
         if (my ($key,$time) = ($envname =~ /^(cgi\.(\d+)_\d+\.)/)) {          if (my ($key,$time) = ($envname =~ /^(cgi\.(\d+)_\d+\.)/)) {
             if ($time < time-300) {              if ($time < time-300) {
Line 5272  sub GetFileTimestamp { Line 5286  sub GetFileTimestamp {
   
 sub stat_file {  sub stat_file {
     my ($uri) = @_;      my ($uri) = @_;
     $uri = &clutter($uri);      $uri = &clutter_with_no_wrapper($uri);
   
     # we want just the url part without the unneeded accessor url bits  
     if ($uri =~ m-^/adm/-) {  
  $uri=~s-^/adm/wrapper/-/-;  
  $uri=~s-^/adm/coursedocs/showdoc/-/-;  
     }  
     my ($udom,$uname,$file,$dir);      my ($udom,$uname,$file,$dir);
     if ($uri =~ m-^/(uploaded|editupload)/-) {      if ($uri =~ m-^/(uploaded|editupload)/-) {
  ($udom,$uname,$file) =   ($udom,$uname,$file) =
Line 6214  sub symblist { Line 6223  sub symblist {
 sub symbverify {  sub symbverify {
     my ($symb,$thisurl)=@_;      my ($symb,$thisurl)=@_;
     my $thisfn=$thisurl;      my $thisfn=$thisurl;
 # wrapper not part of symbs  
     $thisfn=~s/^\/adm\/wrapper//;  
     $thisfn=~s/^\/adm\/coursedocs\/showdoc\///;  
     $thisfn=&declutter($thisfn);      $thisfn=&declutter($thisfn);
 # direct jump to resource in page or to a sequence - will construct own symbs  # direct jump to resource in page or to a sequence - will construct own symbs
     if ($thisfn=~/\.(page|sequence)$/) { return 1; }      if ($thisfn=~/\.(page|sequence)$/) { return 1; }
Line 7053  sub clutter { Line 7059  sub clutter {
     return $thisfn;      return $thisfn;
 }  }
   
   sub clutter_with_no_wrapper {
       my $uri = &clutter(shift);
       if ($uri =~ m-^/adm/-) {
    $uri =~ s-^/adm/wrapper/-/-;
    $uri =~ s-^/adm/coursedocs/showdoc/-/-;
       }
       return $uri;
   }
   
 sub freeze_escape {  sub freeze_escape {
     my ($value)=@_;      my ($value)=@_;
     if (ref($value)) {      if (ref($value)) {
Removed from v.1.785  
changed lines
  Added in v.1.788

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