[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.407 and 1.413

version 1.407, 2003/08/29 20:38:12 version 1.413, 2003/09/16 17:54:50
Line 246  sub critical { Line 246  sub critical {
     return $answer;      return $answer;
 }  }
   
   #
 # -------------- Remove all key from the env that start witha lowercase letter  # -------------- Remove all key from the env that start witha lowercase letter
 #                (Which is alweways a lon-capa value)  #                (Which is always a lon-capa value)
   
 sub cleanenv {  sub cleanenv {
   #    unless (defined(&Apache::exists_config_define("MODPERL2"))) { return; }
   #    unless (&Apache::exists_config_define("MODPERL2")) { return; }
     foreach my $key (keys(%ENV)) {      foreach my $key (keys(%ENV)) {
  if ($key =~ /^[a-z]/) {   if ($key =~ /^[a-z]/) {
     delete($ENV{$key});      delete($ENV{$key});
Line 436  sub spareserver { Line 440  sub spareserver {
     my $lowestserver=$loadpercent > $userloadpercent?      my $lowestserver=$loadpercent > $userloadpercent?
              $loadpercent :  $userloadpercent;               $loadpercent :  $userloadpercent;
     foreach $tryserver (keys %spareid) {      foreach $tryserver (keys %spareid) {
        my $loadans=reply('load',$tryserver);   my $loadans=reply('load',$tryserver);
        my $userloadans=reply('userload',$tryserver);   my $userloadans=reply('userload',$tryserver);
        if ($userloadans !~ /\d/) { $userloadans=0; }   if ($loadans !~ /\d/ && $userloadans !~ /\d/) {
        my $answer=$loadans > $userloadans?      next; #didn't get a number from the server
                   $loadans :  $userloadans;   }
        if (($answer =~ /\d/) && ($answer<$lowestserver)) {   my $answer;
    $spareserver="http://$hostname{$tryserver}";   if ($loadans =~ /\d/) {
            $lowestserver=$answer;      if ($userloadans =~ /\d/) {
        }   #both are numbers, pick the bigger one
    $answer=$loadans > $userloadans?
       $loadans :  $userloadans;
       } else {
    $answer = $loadans;
       }
    } else {
       $answer = $userloadans;
    }
    if (($answer =~ /\d/) && ($answer<$lowestserver)) {
       $spareserver="http://$hostname{$tryserver}";
       $lowestserver=$answer;
    }
     }      }
     return $spareserver;      return $spareserver;
 }  }
Line 1228  sub courseacclog { Line 1244  sub courseacclog {
     my $fnsymb=shift;      my $fnsymb=shift;
     unless ($ENV{'request.course.id'}) { return ''; }      unless ($ENV{'request.course.id'}) { return ''; }
     my $what=$fnsymb.':'.$ENV{'user.name'}.':'.$ENV{'user.domain'};      my $what=$fnsymb.':'.$ENV{'user.name'}.':'.$ENV{'user.domain'};
     if ($fnsymb=~/(problem|exam|quiz|assess|survey|form)$/) {      if ($fnsymb=~/(problem|exam|quiz|assess|survey|form|page)$/) {
         $what.=':POST';          $what.=':POST';
  foreach (keys %ENV) {   foreach (keys %ENV) {
             if ($_=~/^form\.(.*)/) {              if ($_=~/^form\.(.*)/) {
Line 2590  sub is_on_map { Line 2606  sub is_on_map {
     if ($match) {      if ($match) {
  return (1,$1);   return (1,$1);
     } else {      } else {
  return (0,0);   my ($name,$ext)=($filename=~/^(.+)\.(\w+)$/);
           $ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~
          /\&(\Q$name\E\.\d+\.$ext)\:([\d\|]+)\&/;
    return (0,$2,$pathname.'/'.$1);
     }      }
 }  }
   
Line 3165  sub dirlist { Line 3184  sub dirlist {
 # when it was last modified.  It will also return an error of -1  # when it was last modified.  It will also return an error of -1
 # if an error occurs  # if an error occurs
   
   ##
   ## FIXME: This subroutine assumes its caller knows something about the
   ## directory structure of the home server for the student ($root).
   ## Not a good assumption to make.  Since this is for looking up files
   ## in user directories, the full path should be constructed by lond, not
   ## whatever machine we request data from.
   ##
 sub GetFileTimestamp {  sub GetFileTimestamp {
     my ($studentDomain,$studentName,$filename,$root)=@_;      my ($studentDomain,$studentName,$filename,$root)=@_;
     $studentDomain=~s/\W//g;      $studentDomain=~s/\W//g;
Line 3410  sub EXT { Line 3436  sub EXT {
 # ----------------------------------------------------- Cascading lookup scheme  # ----------------------------------------------------- Cascading lookup scheme
     if (!$symbparm) { $symbparm=&symbread(); }      if (!$symbparm) { $symbparm=&symbread(); }
     my $symbp=$symbparm;      my $symbp=$symbparm;
     my $mapp=(split(/\_\_\_/,$symbp))[0];      my $mapp=(&decode_symb($symbp))[0];
   
     my $symbparm=$symbp.'.'.$spacequalifierrest;      my $symbparm=$symbp.'.'.$spacequalifierrest;
     my $mapparm=$mapp.'___(all).'.$spacequalifierrest;      my $mapparm=$mapp.'___(all).'.$spacequalifierrest;
Line 3489  sub EXT { Line 3515  sub EXT {
  my $filename;   my $filename;
  if (!$symbparm) { $symbparm=&symbread(); }   if (!$symbparm) { $symbparm=&symbread(); }
  if ($symbparm) {   if ($symbparm) {
     $filename=(split(/\_\_\_/,$symbparm))[2];      $filename=(&decode_symb($symbparm))[2];
  } else {   } else {
     $filename=$ENV{'request.filename'};      $filename=$ENV{'request.filename'};
  }   }
Line 3764  sub gettitle { Line 3790  sub gettitle {
     delete($titlecache{$symb});      delete($titlecache{$symb});
  }   }
     }      }
     my ($map,$resid,$url)=split(/\_\_\_/,$symb);      my ($map,$resid,$url)=&decode_symb($symb);
     my $title='';      my $title='';
     my %bighash;      my %bighash;
     if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',      if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
Line 3810  sub symbverify { Line 3836  sub symbverify {
 # 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; }
 # check URL part  # check URL part
     my ($map,$resid,$url)=split(/\_\_\_/,$symb);      my ($map,$resid,$url)=&decode_symb($symb);
     unless (&symbclean($url) eq &symbclean($thisfn)) { return 0; }      unless (&symbclean($url) eq &symbclean($thisfn)) { return 0; }
   
     $symb=&symbclean($symb);      $symb=&symbclean($symb);
Line 3853  sub symbclean { Line 3879  sub symbclean {
     return $symb;      return $symb;
 }  }
   
   # ---------------------------------------------- Split symb to find map and url
   
   sub decode_symb {
       my ($map,$resid,$url)=split(/\_\_\_/,shift);
       return (&fixversion($map),$resid,&fixversion($url));
   }
   
   sub fixversion {
       my $fn=shift;
       if ($fn=~/^(adm|uploaded|public)/) { return $fn; }
       my ($match,$cond,$versioned)=&is_on_map($fn);
       unless ($match) {
    $fn=$versioned;
       }
       return $fn;
   }
   
 # ------------------------------------------------------ Return symb list entry  # ------------------------------------------------------ Return symb list entry
   
 sub symbread {  sub symbread {
Removed from v.1.407  
changed lines
  Added in v.1.413

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