Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.145 and 1.148

version 1.145, 2001/08/09 14:03:42 version 1.148, 2001/08/12 01:18:37
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 Gerd Kortemeyer
   
 package Apache::lonnet;  package Apache::lonnet;
   
Line 896  sub rolesinit { Line 896  sub rolesinit {
         my $author=0;          my $author=0;
         map {          map {
             %thesepriv=();              %thesepriv=();
             if (($_!~/^st/) && ($_!~/^ta/)) { $adv=1; }              if (($_!~/^st/) && ($_!~/^ta/) && ($_!~/^cm/)) { $adv=1; }
             if (($_=~/^au/) || ($_=~/^ca/)) { $author=1; }              if (($_=~/^au/) || ($_=~/^ca/)) { $author=1; }
             map {              map {
                 if ($_ ne '') {                  if ($_ ne '') {
Line 1108  sub allowed { Line 1108  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 1141  sub allowed {
               }                }
             }              }
           }            }
           }
        }         }
    }     }
   
Line 1674  sub condval { Line 1687  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 1753  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 1851  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.145  
changed lines
  Added in v.1.148


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