[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.305 and 1.316

version 1.305, 2002/12/05 19:53:19 version 1.316, 2003/01/10 20:55:44
Line 80  use vars Line 80  use vars
 qw(%perlvar %hostname %homecache %badServerCache %hostip %iphost %spareid %hostdom   qw(%perlvar %hostname %homecache %badServerCache %hostip %iphost %spareid %hostdom 
    %libserv %pr %prp %metacache %packagetab %titlecache      %libserv %pr %prp %metacache %packagetab %titlecache 
    %courselogs %accesshash $processmarker $dumpcount      %courselogs %accesshash $processmarker $dumpcount 
    %coursedombuf %coursehombuf %courseresdatacache %domaindescription);     %coursedombuf %coursehombuf %courseresdatacache 
      %domaindescription);
 use IO::Socket;  use IO::Socket;
 use GDBM_File;  use GDBM_File;
 use Apache::Constants qw(:common :http);  use Apache::Constants qw(:common :http);
Line 142  sub reply { Line 143  sub reply {
     unless (defined($hostname{$server})) { return 'no_such_host'; }      unless (defined($hostname{$server})) { return 'no_such_host'; }
     my $answer=subreply($cmd,$server);      my $answer=subreply($cmd,$server);
     if ($answer eq 'con_lost') {      if ($answer eq 'con_lost') {
        #sleep 5;           #sleep 5; 
        #$answer=subreply($cmd,$server);          #$answer=subreply($cmd,$server);
        #if ($answer eq 'con_lost') {          #if ($answer eq 'con_lost') {
  #   &logthis("Second attempt con_lost on $server");   #   &logthis("Second attempt con_lost on $server");
         #   my $peerfile="$perlvar{'lonSockDir'}/$server";          #   my $peerfile="$perlvar{'lonSockDir'}/$server";
         #   my $client=IO::Socket::UNIX->new(Peer    =>"$peerfile",          #   my $client=IO::Socket::UNIX->new(Peer    =>"$peerfile",
Line 202  sub critical { Line 203  sub critical {
                " Critical message to unknown server ($server)</font>");                 " Critical message to unknown server ($server)</font>");
         return 'no_such_host';          return 'no_such_host';
     }      }
     sleep 2;  
     my $answer=reply($cmd,$server);      my $answer=reply($cmd,$server);
     if ($answer eq 'con_lost') {      if ($answer eq 'con_lost') {
         my $pingreply=reply('ping',$server);          my $pingreply=reply('ping',$server);
Line 729  sub currentversion { Line 729  sub currentversion {
   
 sub subscribe {  sub subscribe {
     my $fname=shift;      my $fname=shift;
       if ($fname=~/\/(aboutme|syllabus|bulletinboard|smppg)$/) { return ''; }
     my $author=$fname;      my $author=$fname;
     $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;      $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
     my ($udom,$uname)=split(/\//,$author);      my ($udom,$uname)=split(/\//,$author);
Line 856  sub tokenwrapper { Line 857  sub tokenwrapper {
 sub userfileupload {  sub userfileupload {
     my ($formname,$coursedoc)=@_;      my ($formname,$coursedoc)=@_;
     my $fname=$ENV{'form.'.$formname.'.filename'};      my $fname=$ENV{'form.'.$formname.'.filename'};
   # Replace Windows backslashes by forward slashes
     $fname=~s/\\/\//g;      $fname=~s/\\/\//g;
   # Get rid of everything but the actual filename
     $fname=~s/^.*\/([^\/]+)$/$1/;      $fname=~s/^.*\/([^\/]+)$/$1/;
   # Replace spaces by underscores
       $fname=~s/\s+/\_/g;
   # Replace all other weird characters by nothing
       $fname=~s/[^\w\.\-\+]//g;
   # See if there is anything left
     unless ($fname) { return 'error: no uploaded file'; }      unless ($fname) { return 'error: no uploaded file'; }
     chop($ENV{'form.'.$formname});      chop($ENV{'form.'.$formname});
 # Create the directory if not present  # Create the directory if not present
Line 1863  sub allowed { Line 1871  sub allowed {
        $thisallowed.=$1;         $thisallowed.=$1;
     }      }
   
   # URI is an uploaded document for this course
   
       if (($priv eq 'bre') && 
           ($uri=~/^uploaded\/$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}\/$ENV{'course.'.$ENV{'request.course.id'}.'.num'}/)) {
           return 'F';
       }
 # Full access at system, domain or course-wide level? Exit.  # Full access at system, domain or course-wide level? Exit.
   
     if ($thisallowed=~/F/) {      if ($thisallowed=~/F/) {
Line 2349  sub modifyuser { Line 2363  sub modifyuser {
        }         }
     }      }
 # -------------------------------------------------------------- Add names, etc  # -------------------------------------------------------------- Add names, etc
     my %names=&get('environment',      my @tmp=&get('environment',
    ['firstname','middlename','lastname','generation'],     ['firstname','middlename','lastname','generation'],
    $udom,$uname);     $udom,$uname);
     if ($names{'firstname'} =~ m/^error:.*/) { %names=(); }      my %names;
       if ($tmp[0] =~ m/^error:.*/) { 
           %names=(); 
       } else {
           %names = @tmp;
       }
     if ($first)  { $names{'firstname'}  = $first; }      if ($first)  { $names{'firstname'}  = $first; }
     if ($middle) { $names{'middlename'} = $middle; }      if ($middle) { $names{'middlename'} = $middle; }
     if ($last)   { $names{'lastname'}   = $last; }      if ($last)   { $names{'lastname'}   = $last; }
Line 2720  sub courseresdata { Line 2739  sub courseresdata {
  if ($tmp !~ /^(con_lost|error|no_such_host)/i) {   if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
     $courseresdatacache{$hashid.'.time'}=time;      $courseresdatacache{$hashid.'.time'}=time;
     $courseresdatacache{$hashid}=\%dumpreply;      $courseresdatacache{$hashid}=\%dumpreply;
    } elsif ($tmp =~ /^(con_lost|no_such_host)/) {
       return $tmp;
  }   }
     }      }
     foreach my $item (@which) {      foreach my $item (@which) {
Line 2846  sub EXT { Line 2867  sub EXT {
     my $courselevelm=$courseid.'.'.$mapparm;      my $courselevelm=$courseid.'.'.$mapparm;
   
 # ----------------------------------------------------------- first, check user  # ----------------------------------------------------------- first, check user
     my %resourcedata=&get('resourcedata',      #most student don't have any data set, check if there is some data
   [$courselevelr,$courselevelm,$courselevel],              #every thirty minutes
  $udom,$uname);      if (!
     if (($resourcedata{$courselevelr}!~/^error\:/) &&   (exists($ENV{'cache.studentresdata'})
  ($resourcedata{$courselevelr}!~/^con_lost/)) {      && (($ENV{'cache.studentresdata'}+1800) > time))) {
    my %resourcedata=&get('resourcedata',
  if ($resourcedata{$courselevelr}) {        [$courselevelr,$courselevelm,$courselevel],
     return $resourcedata{$courselevelr}; }        $udom,$uname);
  if ($resourcedata{$courselevelm}) {   my ($tmp)=keys(%resourcedata);
     return $resourcedata{$courselevelm}; }   if (($tmp!~/^error\:/) && ($tmp!~/^con_lost/)) {
  if ($resourcedata{$courselevel}) {      if ($resourcedata{$courselevelr}) {
     return $resourcedata{$courselevel}; }   return $resourcedata{$courselevelr}; }
     } else {      if ($resourcedata{$courselevelm}) {
  if ($resourcedata{$courselevelr}!~/No such file/) {   return $resourcedata{$courselevelm}; }
     &logthis("<font color=blue>WARNING:".      if ($resourcedata{$courselevel}) {
      " Trying to get resource data for ".   return $resourcedata{$courselevel}; }
      $uname." at ".$udom.": ".   } else {
      $resourcedata{$courselevelr}."</font>");      if ($tmp!~/No such file/) {
    &logthis("<font color=blue>WARNING:".
    " Trying to get resource data for ".
    $uname." at ".$udom.": ".
    $tmp."</font>");
       } elsif ($tmp=~/error:No such file/) {
    $ENV{'cache.studentresdata'}=time;
    &appenv(('cache.studentresdata'=>
    $ENV{'cache.studentresdata'}));
       } elsif ($tmp =~ /^(con_lost|no_such_host)/) {
    return $tmp;
       }
  }   }
     }      }
   
Removed from v.1.305  
changed lines
  Added in v.1.316

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