[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.59 and 1.68

version 1.59, 2000/11/07 17:20:10 version 1.68, 2000/11/22 12:14:56
Line 43 Line 43
 #                        state string  #                        state string
 # condval(index)     : value of condition index based on state  # condval(index)     : value of condition index based on state
 # EXT(name)          : value of a variable  # EXT(name)          : value of a variable
 # refreshstate()     : refresh the state information string  
 # symblist(map,hash) : Updates symbolic storage links  # symblist(map,hash) : Updates symbolic storage links
 # symbread([filename]) : returns the data handle (filename optional)  # symbread([filename]) : returns the data handle (filename optional)
 # rndseed()          : returns a random seed    # rndseed()          : returns a random seed  
Line 68 Line 67
 # 10/04 Gerd Kortemeyer  # 10/04 Gerd Kortemeyer
 # 10/04 Guy Albertelli  # 10/04 Guy Albertelli
 # 10/06,10/09,10/10,10/11,10/14,10/20,10/23,10/25,10/26,10/27,10/28,10/29,   # 10/06,10/09,10/10,10/11,10/14,10/20,10/23,10/25,10/26,10/27,10/28,10/29, 
 # 10/30,10/31,11/2 Gerd Kortemeyer  # 10/30,10/31,11/2,11/14,11/15,11/16,11/20,11/21,11/22 Gerd Kortemeyer
   
 package Apache::lonnet;  package Apache::lonnet;
   
Line 123  sub reply { Line 122  sub reply {
     my ($cmd,$server)=@_;      my ($cmd,$server)=@_;
     my $answer=subreply($cmd,$server);      my $answer=subreply($cmd,$server);
     if ($answer eq 'con_lost') { $answer=subreply($cmd,$server); }      if ($answer eq 'con_lost') { $answer=subreply($cmd,$server); }
     if (($answer=~/^error:/) || ($answer=~/^refused/) ||       if (($answer=~/^refused/) || ($answer=~/^rejected/)) {
         ($answer=~/^rejected/)) {  
        &logthis("<font color=blue>WARNING:".         &logthis("<font color=blue>WARNING:".
                 " $cmd to $server returned $answer</font>");                  " $cmd to $server returned $answer</font>");
     }      }
Line 370  sub subscribe { Line 368  sub subscribe {
         return 'not_found';           return 'not_found'; 
     }      }
     my $answer=reply("sub:$fname",$home);      my $answer=reply("sub:$fname",$home);
       if (($answer eq 'con_lost') || ($answer eq 'rejected')) {
    $answer.=' by '.$home;
       }
     return $answer;      return $answer;
 }  }
           
Line 381  sub repcopy { Line 382  sub repcopy {
     my $transname="$filename.in.transfer";      my $transname="$filename.in.transfer";
     if ((-e $filename) || (-e $transname)) { return OK; }      if ((-e $filename) || (-e $transname)) { return OK; }
     my $remoteurl=subscribe($filename);      my $remoteurl=subscribe($filename);
     if ($remoteurl eq 'con_lost') {      if ($remoteurl =~ /^con_lost by/) {
    &logthis("Subscribe returned con_lost: $filename");     &logthis("Subscribe returned $remoteurl: $filename");
            return HTTP_SERVICE_UNAVAILABLE;             return HTTP_SERVICE_UNAVAILABLE;
     } elsif ($remoteurl eq 'not_found') {      } elsif ($remoteurl eq 'not_found') {
    &logthis("Subscribe returned not_found: $filename");     &logthis("Subscribe returned not_found: $filename");
    return HTTP_NOT_FOUND;     return HTTP_NOT_FOUND;
     } elsif ($remoteurl eq 'rejected') {      } elsif ($remoteurl =~ /^rejected by/) {
    &logthis("Subscribe returned rejected: $filename");     &logthis("Subscribe returned $remoteurl: $filename");
            return FORBIDDEN;             return FORBIDDEN;
     } elsif ($remoteurl eq 'directory') {      } elsif ($remoteurl eq 'directory') {
            return OK;             return OK;
Line 546  sub coursedescription { Line 547  sub coursedescription {
            $returnhash{'fn'}=$perlvar{'lonDaemons'}.'/tmp/'.             $returnhash{'fn'}=$perlvar{'lonDaemons'}.'/tmp/'.
        $ENV{'user.name'}.'_'.$cdomain.'_'.$cnum;         $ENV{'user.name'}.'_'.$cdomain.'_'.$cnum;
            $envhash{'course.'.$normalid.'.last_cache'}=time;             $envhash{'course.'.$normalid.'.last_cache'}=time;
              $envhash{'course.'.$normalid.'.home'}=$chome;
              $envhash{'course.'.$normalid.'.domain'}=$cdomain;
              $envhash{'course.'.$normalid.'.num'}=$cnum;
            &appenv(%envhash);             &appenv(%envhash);
            return %returnhash;             return %returnhash;
        }         }
Line 772  sub allowed { Line 776  sub allowed {
     }      }
   
 # Course: uri itself is a course  # Course: uri itself is a course
       my $courseuri=$uri;
     if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$uri}      $courseuri=~s/\_(\d)/\/$1/;
       if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$courseuri}
        =~/$priv\&([^\:]*)/) {         =~/$priv\&([^\:]*)/) {
        $thisallowed.=$1;         $thisallowed.=$1;
     }      }
Line 968  sub allowed { Line 973  sub allowed {
    return 'F';     return 'F';
 }  }
   
 # ---------------------------------------------------------- Refresh State Info  
   
 sub refreshstate {  
 }  
   
 # ----------------------------------------------------------------- Define Role  # ----------------------------------------------------------------- Define Role
   
 sub definerole {  sub definerole {
Line 1194  sub condval { Line 1194  sub condval {
   
 sub EXT {  sub EXT {
     my $varname=shift;      my $varname=shift;
       unless ($varname) { return ''; }
     my ($realm,$space,$qualifier,@therest)=split(/\./,$varname);      my ($realm,$space,$qualifier,@therest)=split(/\./,$varname);
     my $rest;      my $rest;
     if ($therest[0]) {      if ($therest[0]) {
Line 1256  sub EXT { Line 1257  sub EXT {
         return $ENV{'course.'.$ENV{'request.course.id'}.$section.'.'.          return $ENV{'course.'.$ENV{'request.course.id'}.$section.'.'.
                               $spacequalifierrest};                                $spacequalifierrest};
     } elsif ($realm eq 'resource') {      } elsif ($realm eq 'resource') {
 # ----------------------------------------------------------- resource metadata        if ($ENV{'request.course.id'}) {
   # ----------------------------------------------------- Cascading lookup scheme
          my $symbparm=&symbread().'.'.$spacequalifierrest;
          my $reslevel=
       $ENV{'request.course.id'}.'.'.$symbparm;
          my $seclevel=
               $ENV{'request.course.id'}.'.'.
    $ENV{'request.course.sec'}.'.'.$spacequalifierrest;
          my $courselevel=
               $ENV{'request.course.id'}.'.'.$spacequalifierrest;
   
   # ----------------------------------------------------------- first, check user
         my %resourcedata=get('resourcedata',($reslevel,$seclevel,$courselevel));
         if ($resourcedata{$reslevel}!~/^error\:/) {
          if ($resourcedata{$reslevel}) { return $resourcedata{$reslevel}; }
          if ($resourcedata{$seclevel}) { return $resourcedata{$seclevel}; }
          if ($resourcedata{$courselevel}) { return $resourcedata{$courselevel}; }
         }
   # -------------------------------------------------------- second, check course
           my $section='';
           if ($ENV{'request.course.sec'}) {
       $section='_'.$ENV{'request.course.sec'};
           }
           my $reply=&reply('get:'.
                 $ENV{'course.'.$ENV{'request.course.id'}.$section.'.domain'}.':'.
                 $ENV{'course.'.$ENV{'request.course.id'}.$section.'.num'}.
                 ':resourcedata:'.
                 escape($reslevel).':'.escape($seclevel).':'.escape($courselevel),
      $ENV{'course.'.$ENV{'request.course.id'}.$section.'.home'});
         if ($reply!~/^error\:/) {
           map {
              my ($name,$value)=split(/\=/,$_);
              $resourcedata{unescape($name)}=unescape($value);  
           } split(/\&/,$reply);
          if ($resourcedata{$reslevel}) { return $resourcedata{$reslevel}; }
          if ($resourcedata{$seclevel}) { return $resourcedata{$seclevel}; }  
          if ($resourcedata{$courselevel}) { return $resourcedata{$courselevel}; }
         }
   
   # ------------------------------------------------------ third, check map parms
          my %parmhash=();
          my $thisparm='';       
          if (tie(%parmhash,'GDBM_File',
             $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640)) {
              $thisparm=$parmhash{$symbparm};
      untie(%parmhash);
          }
          if ($thisparm) { return $thisparm; }
        }
        
   # --------------------------------------------- last, look in resource metadata
  my $uri=&declutter($ENV{'request.filename'});   my $uri=&declutter($ENV{'request.filename'});
         my $filename=$perlvar{'lonDocRoot'}.'/res/'.$ENV.'.meta';          my $filename=$perlvar{'lonDocRoot'}.'/res/'.$uri.'.meta';
         if (-e $filename) {          if (-e $filename) {
             my @content;              my @content;
             {              {
Line 1268  sub EXT { Line 1319  sub EXT {
             if (join('',@content)=~              if (join('',@content)=~
                  /\<$space[^\>]*\>([^\<]*)\<\/$space\>/) {                   /\<$space[^\>]*\>([^\<]*)\<\/$space\>/) {
         return $1;          return $1;
             } else {       }
                 return '';          }
             }  
          }  
     } elsif ($realm eq 'userdata') {  
         my $uhome=&homeserver($qualifier,$space);  
 # ----------------------------------------------- userdata.domain.name.resource  
 # ---------------------------------------------------- Any other user namespace  # ---------------------------------------------------- Any other user namespace
     } elsif ($realm eq 'environment') {      } elsif ($realm eq 'environment') {
 # ----------------------------------------------------------------- environment  # ----------------------------------------------------------------- environment
Line 1340  sub symbread { Line 1386  sub symbread {
                             &GDBM_READER,0640)) {                              &GDBM_READER,0640)) {
 # ---------------------------------------------- Get ID(s) for current resource  # ---------------------------------------------- Get ID(s) for current resource
               my $ids=$bighash{'ids_/res/'.$thisfn};                my $ids=$bighash{'ids_/res/'.$thisfn};
                 unless ($ids) { 
                    $ids=$bighash{'ids_/'.$thisfn};
                 }
               if ($ids) {                if ($ids) {
 # ------------------------------------------------------------------- Has ID(s)  # ------------------------------------------------------------------- Has ID(s)
                  my @possibilities=split(/\,/,$ids);                   my @possibilities=split(/\,/,$ids);
Line 1367  sub symbread { Line 1416  sub symbread {
               untie(%bighash)                untie(%bighash)
            }              } 
         }          }
         if ($syval) { return $syval.'___'.$thisfn; }          if ($syval) {
              return $syval.'___'.$thisfn; 
           }
     }      }
     &appenv('request.ambiguous' => $thisfn);      &appenv('request.ambiguous' => $thisfn);
     return '';      return '';
Removed from v.1.59  
changed lines
  Added in v.1.68

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