[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.94 and 1.95

version 1.94, 2001/01/10 22:55:52 version 1.95, 2001/01/11 10:43:09
Line 85 Line 85
 # 05/01/01 Guy Albertelli  # 05/01/01 Guy Albertelli
 # 05/01,06/01,09/01 Gerd Kortemeyer  # 05/01,06/01,09/01 Gerd Kortemeyer
 # 09/01 Guy Albertelli  # 09/01 Guy Albertelli
 # 09/01,10/01 Gerd Kortemeyer  # 09/01,10/01,11/01 Gerd Kortemeyer
   
 package Apache::lonnet;  package Apache::lonnet;
   
Line 245  sub appenv { Line 245  sub appenv {
             $ENV{$_}=$newenv{$_};              $ENV{$_}=$newenv{$_};
         }          }
     } keys %newenv;      } keys %newenv;
   
       my $lockfh;
       unless ($lockfh=Apache::File->new("$ENV{'user.environment'}")) {
          return 'error';
       }
       unless (flock($lockfh,LOCK_EX)) {
            &logthis("<font color=blue>WARNING: ".
                     'Could not obtain exclusive lock in appenv: '.$!);
            $lockfh->close();
            return 'error: '.$!;
       }
   
     my @oldenv;      my @oldenv;
     {      {
      my $fh;       my $fh;
      unless ($fh=Apache::File->new("$ENV{'user.environment'}")) {       unless ($fh=Apache::File->new("$ENV{'user.environment'}")) {
  return 'error';   return 'error';
      }       }
      unless (flock($fh,LOCK_SH)) {  
          &logthis("<font color=blue>WARNING: ".  
                   'Could not obtain shared lock in appenv: '.$!);  
          $fh->close();  
          return 'error: '.$!;  
      }  
      @oldenv=<$fh>;       @oldenv=<$fh>;
      $fh->close();       $fh->close();
     }      }
Line 275  sub appenv { Line 281  sub appenv {
  return 'error';   return 'error';
      }       }
      my $newname;       my $newname;
      unless (flock($fh,LOCK_EX)) {  
          &logthis("<font color=blue>WARNING: ".  
                   'Could not obtain exclusive lock in appenv: '.$!);  
          $fh->close();  
          return 'error: '.$!;  
      }  
      foreach $newname (keys %newenv) {       foreach $newname (keys %newenv) {
  print $fh "$newname=$newenv{$newname}\n";   print $fh "$newname=$newenv{$newname}\n";
      }       }
      $fh->close();       $fh->close();
     }      }
   
       $lockfh->close();
     return 'ok';      return 'ok';
 }  }
 # ----------------------------------------------------- Delete from Environment  # ----------------------------------------------------- Delete from Environment
Line 1593  sub EXT { Line 1595  sub EXT {
       if ($ENV{'request.course.id'}) {        if ($ENV{'request.course.id'}) {
 # ----------------------------------------------------- Cascading lookup scheme  # ----------------------------------------------------- Cascading lookup scheme
        my $symbp=&symbread();         my $symbp=&symbread();
          unless ($symbp) {
              &logthis('No symb for '.$ENV{'request.filename'});
          } 
        my $mapp=(split(/\_\_\_/,$symbp))[0];         my $mapp=(split(/\_\_\_/,$symbp))[0];
   
        my $symbparm=$symbp.'.'.$spacequalifierrest;         my $symbparm=$symbp.'.'.$spacequalifierrest;
Line 1615  sub EXT { Line 1620  sub EXT {
        my $courselevelm=         my $courselevelm=
             $ENV{'request.course.id'}.'.'.$mapparm;              $ENV{'request.course.id'}.'.'.$mapparm;
   
   
 # ----------------------------------------------------------- first, check user  # ----------------------------------------------------------- first, check user
       my %resourcedata=get('resourcedata',        my %resourcedata=get('resourcedata',
                            ($courselevelr,$courselevelm,$courselevel));                             ($courselevelr,$courselevelm,$courselevel));
Line 1636  sub EXT { Line 1640  sub EXT {
                  "</font>");                   "</font>");
   }    }
       }        }
   
 # -------------------------------------------------------- second, check course  # -------------------------------------------------------- second, check course
         my $section='';          my $section='';
         if ($ENV{'request.course.sec'}) {          if ($ENV{'request.course.sec'}) {
Line 1655  sub EXT { Line 1660  sub EXT {
       }        }
       if (($reply=~/^con_lost/) || ($reply=~/^error\:/)) {        if (($reply=~/^con_lost/) || ($reply=~/^error\:/)) {
   &logthis("<font color=blue>WARNING:".    &logthis("<font color=blue>WARNING:".
                 " Getting ".$reply." asking for ".$varname." from ".                  " Getting ".$reply." asking for ".$varname." for ".
                  $ENV{'course.'.$ENV{'request.course.id'}.$section.'.home'}.                  $ENV{'course.'.$ENV{'request.course.id'}.$section.'.num'}.
                   ' at '.
                   $ENV{'course.'.$ENV{'request.course.id'}.$section.'.domain'}.
                   ' from '.
                   $ENV{'course.'.$ENV{'request.course.id'}.$section.'.home'}.
                  "</font>");                   "</font>");
       }        }
 # ------------------------------------------------------ third, check map parms  # ------------------------------------------------------ third, check map parms
Removed from v.1.94  
changed lines
  Added in v.1.95

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