[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.280 and 1.287

version 1.280, 2002/09/14 18:57:59 version 1.287, 2002/10/01 07:09:05
Line 348  sub delenv { Line 348  sub delenv {
     return 'ok';      return 'ok';
 }  }
   
   # ------------------------------------------ Fight off request when overloaded
   
   sub overloaderror {
       my ($r,$checkserver)=@_;
       unless ($checkserver) { $checkserver=$perlvar{'lonHostID'}; }
       my $loadavg;
       if ($checkserver eq $perlvar{'lonHostID'}) {
          my $loadfile=Apache::File->new('/proc/loadavg');
          $loadavg=<$loadfile>;
          $loadavg =~ s/\s.*//g;
          $loadavg = 100*$loadavg/$perlvar{'lonLoadLim'};
       } else {
          $loadavg=&reply('load',$checkserver);
       }
       my $overload=$loadavg-100;
       if ($overload>0) {
    $r->err_headers_out->{'Retry-After'}=$overload;
           $r->log_error('Overload of '.$overload.' on '.$checkserver);
           return 413;
       }    
       return '';
   }
   
 # ------------------------------ Find server with least workload from spare.tab  # ------------------------------ Find server with least workload from spare.tab
   
 sub spareserver {  sub spareserver {
       my $loadpercent = shift;
     my $tryserver;      my $tryserver;
     my $spareserver='';      my $spareserver='';
     my $lowestserver=100;      my $lowestserver=$loadpercent; 
     foreach $tryserver (keys %spareid) {      foreach $tryserver (keys %spareid) {
        my $answer=reply('load',$tryserver);         my $answer=reply('load',$tryserver);
        if (($answer =~ /\d/) && ($answer<$lowestserver)) {         if (($answer =~ /\d/) && ($answer<$lowestserver)) {
Line 871  sub countacc { Line 895  sub countacc {
     my $url=&declutter(shift);      my $url=&declutter(shift);
     unless ($ENV{'request.course.id'}) { return ''; }      unless ($ENV{'request.course.id'}) { return ''; }
     $accesshash{$ENV{'request.course.id'}.'___'.$url.'___course'}=1;      $accesshash{$ENV{'request.course.id'}.'___'.$url.'___course'}=1;
     my $key=$processmarker.'_'.$dumpcount.'___'.$url.'___count';      my $key=$$.$processmarker.'_'.$dumpcount.'___'.$url.'___count';
     if (defined($accesshash{$key})) {      if (defined($accesshash{$key})) {
  $accesshash{$key}++;   $accesshash{$key}++;
     } else {      } else {
Line 2564  sub courseresdata { Line 2588  sub courseresdata {
  }   }
     }      }
     foreach my $item (@which) {      foreach my $item (@which) {
  if ($courseresdatacache{$hashid}->{$item}) {   if (defined($courseresdatacache{$hashid}->{$item})) {
     return $courseresdatacache{$hashid}->{$item};      return $courseresdatacache{$hashid}->{$item};
  }   }
     }      }
Line 2574  sub courseresdata { Line 2598  sub courseresdata {
 # --------------------------------------------------------- Value of a Variable  # --------------------------------------------------------- Value of a Variable
   
 sub EXT {  sub EXT {
     my ($varname,$symbparm,$udom,$uname)=@_;      my ($varname,$symbparm,$udom,$uname,)=@_;
   
     unless ($varname) { return ''; }      unless ($varname) { return ''; }
   
Line 2715  sub EXT { Line 2739  sub EXT {
   ($seclevelr,$seclevelm,$seclevel,    ($seclevelr,$seclevelm,$seclevel,
    $courselevelr,$courselevelm,     $courselevelr,$courselevelm,
    $courselevel));     $courselevel));
     if ($coursereply) { return $coursereply; }      if (defined($coursereply)) { return $coursereply; }
   
 # ------------------------------------------------------ third, check map parms  # ------------------------------------------------------ third, check map parms
     my %parmhash=();      my %parmhash=();
Line 2731  sub EXT { Line 2755  sub EXT {
 # --------------------------------------------- last, look in resource metadata  # --------------------------------------------- last, look in resource metadata
   
  $spacequalifierrest=~s/\./\_/;   $spacequalifierrest=~s/\./\_/;
  my $metadata=&metadata($ENV{'request.filename'},$spacequalifierrest);   my $filename;
    if (!$symbparm) { $symbparm=&symbread(); }
    if ($symbparm) {
       $filename=(split(/\_\_\_/,$symbparm))[2];
    } else {
       $filename=$ENV{'request.filename'};
    }
    my $metadata=&metadata($filename,$spacequalifierrest);
  if ($metadata) { return $metadata; }   if ($metadata) { return $metadata; }
  $metadata=&metadata($ENV{'request.filename'},   $metadata=&metadata($filename,'parameter_'.$spacequalifierrest);
     'parameter_'.$spacequalifierrest);  
  if ($metadata) { return $metadata; }   if ($metadata) { return $metadata; }
   
 # ------------------------------------------------------------------ Cascade up  # ------------------------------------------------------------------ Cascade up
Line 3301  BEGIN { Line 3331  BEGIN {
   
     while (my $configline=<$config>) {      while (my $configline=<$config>) {
        chomp($configline);         chomp($configline);
        if (($configline) && ($configline ne $perlvar{'lonHostID'})) {         if ($configline) {
           $spareid{$configline}=1;            $spareid{$configline}=1;
        }         }
     }      }
Line 3349  BEGIN { Line 3379  BEGIN {
   
 %metacache=();  %metacache=();
   
 $processmarker=$$.'_'.time.'_'.$perlvar{'lonHostID'};  $processmarker='_'.time.'_'.$perlvar{'lonHostID'};
 $dumpcount=0;  $dumpcount=0;
   
 &logtouch();  &logtouch();
Line 3565  modify user Line 3595  modify user
   
 =item *  =item *
   
 modifystudent($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec,$end,$start) : modify student  modifystudent
   
   modify a students enrollment and identification information.
   The course id is resolved based on the current users environment.  
   This means the envoking user must be a course coordinator or otherwise
   associated with a course.
   
   This call is essentially a wrapper for lonnet::modifyuser
   
   Inputs: 
   
   =over 4
   
   =item B<$udom> Students loncapa domain
   
   =item B<$uname> Students loncapa login name
   
   =item B<$uid> Students id/student number
   
   =item B<$umode> Students authentication mode
   
   =item B<$upass> Students password
   
   =item B<$first> Students first name
   
   =item B<$middle> Students middle name
   
   =item B<$last> Students last name
   
   =item B<$gene> Students generation
   
   =item B<$usec> Students section in course
   
   =item B<$end> Unix time of the roles expiration
   
   =item B<$start> Unix time of the roles start date
   
   =item B<$forceid> If defined, allow $uid to be changed
   
   =item B<$desiredhome> server to use as home server for student
   
   =back
   
 =item *  =item *
   
Removed from v.1.280  
changed lines
  Added in v.1.287

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