Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.91 and 1.94

version 1.91, 2001/01/09 22:27:07 version 1.94, 2001/01/10 22:55:52
Line 84 Line 84
 # 12/02,12/12,12/13,12/14,12/28,12/29 Gerd Kortemeyer  # 12/02,12/12,12/13,12/14,12/28,12/29 Gerd Kortemeyer
 # 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,10/01 Gerd Kortemeyer
   
 package Apache::lonnet;  package Apache::lonnet;
   
Line 234  sub critical { Line 236  sub critical {
   
 sub appenv {  sub appenv {
     my %newenv=@_;      my %newenv=@_;
     my ($in,$out);  
     map {      map {
  if (($newenv{$_}=~/^user\.role/) || ($newenv{$_}=~/^user\.priv/)) {   if (($newenv{$_}=~/^user\.role/) || ($newenv{$_}=~/^user\.priv/)) {
             &logthis("<font color=blue>WARNING: ".              &logthis("<font color=blue>WARNING: ".
Line 256  sub appenv { Line 257  sub appenv {
          $fh->close();           $fh->close();
          return 'error: '.$!;           return 'error: '.$!;
      }       }
      &logthis("<font color=green>appenv LOCK_SH gotten");  
      @oldenv=<$fh>;       @oldenv=<$fh>;
      $in=$#oldenv+1;  
      &logthis("<font color=green>appenv LOCK_SH to be closed");  
      $fh->close();       $fh->close();
     }      }
     &logthis("<font color=green>Number of elements read appenv: ".$in."from".join(" ",caller));  
     for (my $i=0; $i<=$#oldenv; $i++) {      for (my $i=0; $i<=$#oldenv; $i++) {
         chomp($oldenv[$i]);          chomp($oldenv[$i]);
         if ($oldenv[$i] ne '') {          if ($oldenv[$i] ne '') {
Line 284  sub appenv { Line 281  sub appenv {
          $fh->close();           $fh->close();
          return 'error: '.$!;           return 'error: '.$!;
      }       }
      &logthis("<font color=green>appenv LOCK_EX gotten");       foreach $newname (keys %newenv) {
      $out=0;  
      foreach $newname (sort keys %newenv) {  
  print $fh "$newname=$newenv{$newname}\n";   print $fh "$newname=$newenv{$newname}\n";
  $out++;  
      }       }
      &logthis("<font color=green>appenv LOCK_EX to be closed");  
      $fh->close();       $fh->close();
     }      }
     &logthis("<font color=green>Number of elements read appenv: ".$in." number out:".$out."from".join(" ",caller));  
     return 'ok';      return 'ok';
 }  }
 # ----------------------------------------------------- Delete from Environment  # ----------------------------------------------------- Delete from Environment
Line 1049  sub allowed { Line 1041  sub allowed {
            if ($envkey=~/^user\.role\.(st|ta)\.([^\.]*)/) {             if ($envkey=~/^user\.role\.(st|ta)\.([^\.]*)/) {
                my $courseid=$2;                 my $courseid=$2;
                my $roleid=$1.'.'.$2;                 my $roleid=$1.'.'.$2;
                  $courseid=~s/^\///;
                my $expiretime=600;                 my $expiretime=600;
                if ($ENV{'request.role'} eq $roleid) {                 if ($ENV{'request.role'} eq $roleid) {
   $expiretime=120;    $expiretime=120;
Line 1626  sub EXT { Line 1619  sub EXT {
 # ----------------------------------------------------------- first, check user  # ----------------------------------------------------------- first, check user
       my %resourcedata=get('resourcedata',        my %resourcedata=get('resourcedata',
                            ($courselevelr,$courselevelm,$courselevel));                             ($courselevelr,$courselevelm,$courselevel));
       if ($resourcedata{$courselevelr}!~/^error\:/) {        if (($resourcedata{$courselevelr}!~/^error\:/) &&
             ($resourcedata{$courselevelr}!~/^con_lost/)) {
   
        if ($resourcedata{$courselevelr}) {          if ($resourcedata{$courselevelr}) { 
           return $resourcedata{$courselevelr}; }            return $resourcedata{$courselevelr}; }
Line 1634  sub EXT { Line 1628  sub EXT {
           return $resourcedata{$courselevelm}; }            return $resourcedata{$courselevelm}; }
        if ($resourcedata{$courselevel}) { return $resourcedata{$courselevel}; }         if ($resourcedata{$courselevel}) { return $resourcedata{$courselevel}; }
   
         } else {
     if ($resourcedata{$courselevelr}!~/No such file/) {
       &logthis("<font color=blue>WARNING:".
      " Trying to get resource data for ".$ENV{'user.name'}." at "
                      .$ENV{'user.domain'}.": ".$resourcedata{$courselevelr}.
                    "</font>");
     }
       }        }
 # -------------------------------------------------------- second, check course  # -------------------------------------------------------- second, check course
         my $section='';          my $section='';
Line 1652  sub EXT { Line 1653  sub EXT {
       if ($_) { return &unescape($_); }        if ($_) { return &unescape($_); }
           } split(/\&/,$reply);            } split(/\&/,$reply);
       }        }
         if (($reply=~/^con_lost/) || ($reply=~/^error\:/)) {
     &logthis("<font color=blue>WARNING:".
                   " Getting ".$reply." asking for ".$varname." from ".
                    $ENV{'course.'.$ENV{'request.course.id'}.$section.'.home'}.
                    "</font>");
         }
 # ------------------------------------------------------ third, check map parms  # ------------------------------------------------------ third, check map parms
        my %parmhash=();         my %parmhash=();
        my $thisparm='';                my $thisparm='';       

Removed from v.1.91  
changed lines
  Added in v.1.94


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