[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.64 and 1.65

version 1.64, 2000/11/15 23:25:59 version 1.65, 2000/11/16 12:00:01
Line 67 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,11/14,11/15 Gerd Kortemeyer  # 10/30,10/31,11/2,11/14,11/15,11/16 Gerd Kortemeyer
   
 package Apache::lonnet;  package Apache::lonnet;
   
Line 122  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 1258  sub EXT { Line 1257  sub EXT {
     } elsif ($realm eq 'resource') {      } elsif ($realm eq 'resource') {
       if ($ENV{'request.course.id'}) {        if ($ENV{'request.course.id'}) {
 # ----------------------------------------------------- Cascading lookup scheme  # ----------------------------------------------------- Cascading lookup scheme
          my $symbparm=&symbread().'.'.$spacequalifierrest;
        my $reslevel=         my $reslevel=
     $ENV{'request.course.id'}.'.'.&symbread().'.'.$spacequalifierrest;      $ENV{'request.course.id'}.'.'.$symbparm;
        my $seclevel=         my $seclevel=
             $ENV{'request.course.id'}.'.'.              $ENV{'request.course.id'}.'.'.
  $ENV{'request.course.sec'}.'.'.$spacequalifierrest;   $ENV{'request.course.sec'}.'.'.$spacequalifierrest;
Line 1295  sub EXT { Line 1295  sub EXT {
       }        }
   
 # ------------------------------------------------------ third, check map parms  # ------------------------------------------------------ third, check map parms
                 my %parmhash=();
        if ($ENV{'resource.parms.'.$reslevel}) {         my $thisparm='';       
    return $ENV{'resource.parms.'.$reslevel};         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  # --------------------------------------------- last, look in resource metadata
Line 1328  sub EXT { Line 1332  sub EXT {
     return '';      return '';
 }  }
   
 # ---------------------------------------- Append resource parms to environment  
   
 sub appendparms {  
     my ($symb,$parms)=@_;  
     my %storehash=();  
     my $prefix='resource.parms.'.$ENV{'request.course.id'}.'.'.$symb;  
     map {  
  my ($typename,$value)=split(/\=/,$_);  
         my ($type,$name)=split(/\:/,$typename);  
         $storehash{$prefix.'.'.unescape($name)}=unescape($value);  
  $storehash{$prefix.'.'.unescape($name).'.type'}=unescape($type);  
     } split(/\&/,$parms);  
     &appenv(%storehash);  
 }  
   
 # ------------------------------------------------- Update symbolic store links  # ------------------------------------------------- Update symbolic store links
   
 sub symblist {  sub symblist {
Line 1374  sub symbread { Line 1363  sub symbread {
     my %hash;      my %hash;
     my %bighash;      my %bighash;
     my $syval='';      my $syval='';
     my $parms='';  
     if (($ENV{'request.course.fn'}) && ($thisfn)) {      if (($ENV{'request.course.fn'}) && ($thisfn)) {
         if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'_symb.db',          if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'_symb.db',
                       &GDBM_READER,0640)) {                        &GDBM_READER,0640)) {
Line 1396  sub symbread { Line 1384  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);
                  if ($#possibilities==0) {                   if ($#possibilities==0) {
 # ----------------------------------------------- There is only one possibility  # ----------------------------------------------- There is only one possibility
      my ($mapid,$resid)=split(/\./,$ids);       my ($mapid,$resid)=split(/\./,$ids);
                      $parms=$bighash{'param_'.$ids};  
                      $syval=declutter($bighash{'map_id_'.$mapid}).'___'.$resid;                       $syval=declutter($bighash{'map_id_'.$mapid}).'___'.$resid;
                  } else {                   } else {
 # ------------------------------------------ There is more than one possibility  # ------------------------------------------ There is more than one possibility
Line 1413  sub symbread { Line 1403  sub symbread {
              my ($mapid,$resid)=split(/\./,$_);               my ($mapid,$resid)=split(/\./,$_);
                             if ($bighash{'map_type_'.$mapid} ne 'page') {                              if ($bighash{'map_type_'.$mapid} ne 'page') {
  $realpossible++;   $realpossible++;
                                 $parms=$bighash{'param_'.$_};  
                                 $syval=declutter($bighash{'map_id_'.$mapid}).                                  $syval=declutter($bighash{'map_id_'.$mapid}).
                                        '___'.$resid;                                         '___'.$resid;
                             }                              }
Line 1426  sub symbread { Line 1415  sub symbread {
            }              } 
         }          }
         if ($syval) {          if ($syval) {
            if ($parms) {  
        &appendparms($syval.'___'.$thisfn,$parms);  
            }  
            return $syval.'___'.$thisfn;              return $syval.'___'.$thisfn; 
         }          }
     }      }
Removed from v.1.64  
changed lines
  Added in v.1.65

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