[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.146 and 1.149

version 1.146, 2001/08/09 16:43:06 version 1.149, 2001/08/16 11:25:03
Line 122 Line 122
 # 5/30 H. K. Ng  # 5/30 H. K. Ng
 # 6/1 Gerd Kortemeyer  # 6/1 Gerd Kortemeyer
 # July Guy Albertelli  # July Guy Albertelli
 # 8/4,8/7,8/8,8/9 Gerd Kortemeyer  # 8/4,8/7,8/8,8/9,8/11,8/16 Gerd Kortemeyer
   
 package Apache::lonnet;  package Apache::lonnet;
   
Line 659  sub log { Line 659  sub log {
     return critical("log:$dom:$nam:$what",$hom);      return critical("log:$dom:$nam:$what",$hom);
 }  }
   
   # ----------------------------------------------------------- Check out an item
   
   
   sub checkout {
       my ($symb,$tuname,$tudom,$tcrsid)=@_;
       my $now=time;
       my $lonhost=$perlvar{'lonHostID'};
       my $infostr=&escape(
                    $tuname.'&'.
                    $tudom.'&'.
                    $tcrsid.'&'.
                    $symb.'&'.
    $now.'&'.$ENV{'REMOTE_ADDR'});
       my $token=&reply('tmpput:'.$infostr,$lonhost);
       if ($token=~/^error\:/) { return ''; }
       $token=~s/^(\d+)\_.*\_(\d+)$/$1\*$2\*$lonhost/;
       $token=~tr/a-z/A-Z/;
   
       my %infohash=('token' => $token,
                     'checktime' => $now,
                     'remote' => $ENV{'REMOTE_ADDR'});
   
       unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') {
          return '';
       }    
   
       if (&log($tudom,$tuname,&homeserver($tuname,$tudom),
                            &escape('Checkout '.$infostr.' - '.
                                                    $token)) ne 'ok') {
    return '';
       }
   }
   
   # ------------------------------------------------------------ Check in an item
   
   sub checkin {
       my $token=shift;
   }
   
 # --------------------------------------------- Set Expire Date for Spreadsheet  # --------------------------------------------- Set Expire Date for Spreadsheet
   
 sub expirespread {  sub expirespread {
Line 1108  sub allowed { Line 1147  sub allowed {
            }             }
        }         }
                 
        if (($ENV{'HTTP_REFERER'}) && ($checkreferer)) {         if ($checkreferer) {
   my $refuri=$ENV{'HTTP_REFERER'};    my $refuri=$ENV{'httpref.'.$uri};
           $refuri=~s/^http\:\/\/$ENV{'request.host'}//i;  
           $refuri=&declutter($refuri);              unless ($refuri) {
                   map {
       if ($_=~/^httpref\..*\*/) {
    my $pattern=$_;
                           $pattern=~s/\*/\[\^\/\]\+/g;
                           $pattern=~s/\//\\\//g;
                           if ($uri=~/$pattern/) {
       $refuri=$ENV{$_};
                           }
                       }
                   } keys %ENV;
               }
            if ($refuri) { 
           my @uriparts=split(/\//,$refuri);            my @uriparts=split(/\//,$refuri);
           my $filename=$uriparts[$#uriparts];            my $filename=$uriparts[$#uriparts];
           my $pathname=$refuri;            my $pathname=$refuri;
Line 1129  sub allowed { Line 1180  sub allowed {
               }                }
             }              }
           }            }
           }
        }         }
    }     }
   
Line 1674  sub condval { Line 1726  sub condval {
 # --------------------------------------------------------- Value of a Variable  # --------------------------------------------------------- Value of a Variable
   
 sub EXT {  sub EXT {
     my $varname=shift;      my ($varname,$symbparm)=@_;
     unless ($varname) { return ''; }      unless ($varname) { return ''; }
     my ($realm,$space,$qualifier,@therest)=split(/\./,$varname);      my ($realm,$space,$qualifier,@therest)=split(/\./,$varname);
     my $rest;      my $rest;
Line 1740  sub EXT { Line 1792  sub EXT {
   
   
 # ----------------------------------------------------- Cascading lookup scheme  # ----------------------------------------------------- Cascading lookup scheme
          my $symbp=&symbread();           my $symbp;
            if ($symbparm) {
               $symbp=$symbparm;
    } else {
               $symbp=&symbread();
            }            
          my $mapp=(split(/\_\_\_/,$symbp))[0];           my $mapp=(split(/\_\_\_/,$symbp))[0];
   
          my $symbparm=$symbp.'.'.$spacequalifierrest;           my $symbparm=$symbp.'.'.$spacequalifierrest;
Line 1833  sub EXT { Line 1890  sub EXT {
       unless ($space eq '0') {        unless ($space eq '0') {
           my ($part,$id)=split(/\_/,$space);            my ($part,$id)=split(/\_/,$space);
           if ($id) {            if ($id) {
       my $partgeneral=&EXT('resource.'.$part.'.'.$qualifierrest);        my $partgeneral=&EXT('resource.'.$part.'.'.$qualifierrest,
                                      $symbparm);
               if ($partgeneral) { return $partgeneral; }                if ($partgeneral) { return $partgeneral; }
           } else {            } else {
               my $resourcegeneral=&EXT('resource.0.'.$qualifierrest);                my $resourcegeneral=&EXT('resource.0.'.$qualifierrest,
                                          $symbparm);
               if ($resourcegeneral) { return $resourcegeneral; }                if ($resourcegeneral) { return $resourcegeneral; }
           }            }
       }        }
Removed from v.1.146  
changed lines
  Added in v.1.149

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