[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.370 and 1.378

version 1.370, 2003/05/08 21:50:54 version 1.378, 2003/06/10 18:17:34
Line 243  sub critical { Line 243  sub critical {
     }      }
     return $answer;      return $answer;
 }  }
    
   # ------------------------------------------- Transfer profile into environment
   
   sub transfer_profile_to_env {
       my ($lonidsdir,$handle)=@_;
       my @profile;
       {
    my $idf=Apache::File->new("$lonidsdir/$handle.id");
    flock($idf,LOCK_SH);
    @profile=<$idf>;
    $idf->close();
       }
       my $envi;
       for ($envi=0;$envi<=$#profile;$envi++) {
    chomp($profile[$envi]);
    my ($envname,$envvalue)=split(/=/,$profile[$envi]);
    $ENV{$envname} = $envvalue;
       }
       $ENV{'user.environment'} = "$lonidsdir/$handle.id";
   }
   
 # ---------------------------------------------------------- Append Environment  # ---------------------------------------------------------- Append Environment
   
Line 358  sub userload { Line 378  sub userload {
  while ($filename=readdir(LONIDS)) {   while ($filename=readdir(LONIDS)) {
     if ($filename eq '.' || $filename eq '..') {next;}      if ($filename eq '.' || $filename eq '..') {next;}
     my ($atime)=(stat($perlvar{'lonIDsDir'}.'/'.$filename))[8];      my ($atime)=(stat($perlvar{'lonIDsDir'}.'/'.$filename))[8];
     if ($curtime-$atime < 3600) { $num_users++; }      if ($curtime-$atime < 3600) { $numusers++; }
  }   }
  closedir(LONIDS);   closedir(LONIDS);
     }      }
     my $userloadpercent=0;      my $userloadpercent=0;
     my $maxuserload=$perlvar{'lonUserLoadLim'};      my $maxuserload=$perlvar{'lonUserLoadLim'};
     if ($maxuserload) {      if ($maxuserload) {
  $userloadpercent=100*$num_users/$maxuserload;   $userloadpercent=100*$numusers/$maxuserload;
     }      }
       $userloadpercent=sprintf("%.2f",$userloadpercent);
     return $userloadpercent;      return $userloadpercent;
 }  }
   
Line 1259  sub get_course_adv_roles { Line 1280  sub get_course_adv_roles {
         } else {          } else {
             $returnhash{$key}=$username.':'.$domain;              $returnhash{$key}=$username.':'.$domain;
         }          }
     }       }
     return sort %returnhash;      return %returnhash;
 }  }
   
 # ---------------------------------------------------------- Course ID routines  # ---------------------------------------------------------- Course ID routines
Line 2640  sub assignrole { Line 2661  sub assignrole {
     } else {      } else {
         my $cwosec=$url;          my $cwosec=$url;
         $cwosec=~s/^\/(\w+)\/(\w+)\/.*/$1\/$2/;          $cwosec=~s/^\/(\w+)\/(\w+)\/.*/$1\/$2/;
         unless (&allowed('c'.$role,$cwosec)) {           unless ((&allowed('c'.$role,$cwosec)) || &allowed('c'.$role,$udom)) { 
            &logthis('Refused assignrole: '.             &logthis('Refused assignrole: '.
              $udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.' by '.               $udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.' by '.
     $ENV{'user.name'}.' at '.$ENV{'user.domain'});      $ENV{'user.name'}.' at '.$ENV{'user.domain'});
Line 2660  sub assignrole { Line 2681  sub assignrole {
     }      }
 # actually delete  # actually delete
     if ($deleteflag) {      if ($deleteflag) {
  if (&allowed('dro',$udom)) {   if ((&allowed('dro',$udom)) || (&allowed('dro',$url))) {
 # modify command to delete the role  # modify command to delete the role
            $command="encrypt:rolesdel:$ENV{'user.domain'}:$ENV{'user.name'}:".             $command="encrypt:rolesdel:$ENV{'user.domain'}:$ENV{'user.name'}:".
                 "$udom:$uname:$url".'_'."$mrole";                  "$udom:$uname:$url".'_'."$mrole";
      &logthis("$ENV{'user.name'} at $ENV{'user.domain'} deletes $mrole in $url for $uname at $udom"); 
 # set start and finish to negative values for userrolelog  # set start and finish to negative values for userrolelog
            $start=-1;             $start=-1;
            $end=-1;             $end=-1;
Line 3062  sub GetFileTimestamp { Line 3084  sub GetFileTimestamp {
     $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;      $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
     my $proname="$studentDomain/$subdir/$studentName";      my $proname="$studentDomain/$subdir/$studentName";
     $proname .= '/'.$filename;      $proname .= '/'.$filename;
     my @dir = &Apache::lonnet::dirlist($proname, $studentDomain, $studentName,      my ($fileStat) = &Apache::lonnet::dirlist($proname, $studentDomain, 
                                        $root);                                                $studentName, $root);
     my $fileStat = $dir[0];  
     my @stats = split('&', $fileStat);      my @stats = split('&', $fileStat);
     if($stats[0] ne 'empty' && $stats[0] ne 'no_such_dir') {      if($stats[0] ne 'empty' && $stats[0] ne 'no_such_dir') {
         return $stats[9];          # @stats contains first the filename, then the stat output
           return $stats[10]; # so this is 10 instead of 9.
     } else {      } else {
         return -1;          return -1;
     }      }
Line 3166  sub courseresdata { Line 3188  sub courseresdata {
 # --------------------------------------------------------- Value of a Variable  # --------------------------------------------------------- Value of a Variable
   
 sub EXT {  sub EXT {
     my ($varname,$symbparm,$udom,$uname,)=@_;      my ($varname,$symbparm,$udom,$uname,$usection)=@_;
   
     unless ($varname) { return ''; }      unless ($varname) { return ''; }
     #get real user name/domain, courseid and symb      #get real user name/domain, courseid and symb
Line 3174  sub EXT { Line 3196  sub EXT {
     my $publicuser;      my $publicuser;
     if (!($uname && $udom)) {      if (!($uname && $udom)) {
       (my $cursymb,$courseid,$udom,$uname,$publicuser)=        (my $cursymb,$courseid,$udom,$uname,$publicuser)=
   &Apache::lonxml::whichuser();    &Apache::lonxml::whichuser($symbparm);
       if (!$symbparm) { $symbparm=$cursymb; }        if (!$symbparm) { $symbparm=$cursymb; }
     } else {      } else {
  $courseid=$ENV{'request.course.id'};   $courseid=$ENV{'request.course.id'};
Line 3252  sub EXT { Line 3274  sub EXT {
     } elsif ($realm eq 'query') {      } elsif ($realm eq 'query') {
 # ---------------------------------------------- pull stuff out of query string  # ---------------------------------------------- pull stuff out of query string
         &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},[$space]);          &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},[$space]);
  return $ENV{'form.'.$space};    return $ENV{'form.'.$spacequalifierrest}; 
    } elsif ($realm eq 'request') {     } elsif ($realm eq 'request') {
 # ------------------------------------------------------------- request.browser  # ------------------------------------------------------------- request.browser
         if ($space eq 'browser') {          if ($space eq 'browser') {
Line 3283  sub EXT { Line 3305  sub EXT {
  ($ENV{'user.domain'} eq $udom)) {   ($ENV{'user.domain'} eq $udom)) {
  $section=$ENV{'request.course.sec'};   $section=$ENV{'request.course.sec'};
     } else {      } else {
  $section=&usection($udom,$uname,$courseid);                  if (! defined($usection)) {
                       $section=&usection($udom,$uname,$courseid);
                   } else {
                       $section = $usection;
                   }
     }      }
   
     my $seclevel=$courseid.'.['.$section.'].'.$spacequalifierrest;      my $seclevel=$courseid.'.['.$section.'].'.$spacequalifierrest;
Removed from v.1.370  
changed lines
  Added in v.1.378

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