[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.231 and 1.232

version 1.231, 2002/05/22 13:56:43 version 1.232, 2002/05/23 20:37:25
Line 1548  sub allowed { Line 1548  sub allowed {
 # the course  # the course
   
     if ($ENV{'request.course.id'}) {      if ($ENV{'request.course.id'}) {
   
        $courseprivid=$ENV{'request.course.id'};         $courseprivid=$ENV{'request.course.id'};
        if ($ENV{'request.course.sec'}) {         if ($ENV{'request.course.sec'}) {
           $courseprivid.='/'.$ENV{'request.course.sec'};            $courseprivid.='/'.$ENV{'request.course.sec'};
        }         }
        $courseprivid=~s/\_/\//;         $courseprivid=~s/\_/\//;
        my $checkreferer=1;         my $checkreferer=1;
        my @uriparts=split(/\//,$uri);         my ($match,$cond)=&is_on_map($uri);
        my $filename=$uriparts[$#uriparts];         if ($match) {
        my $pathname=$uri;             $statecond=$cond;
        $pathname=~s/\/$filename$//;  
        if ($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~  
            /\&$filename\:([\d\|]+)\&/) {  
            $statecond=$1;  
            if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$courseprivid}             if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$courseprivid}
                =~/$priv\&([^\:]*)/) {                 =~/$priv\&([^\:]*)/) {
                $thisallowed.=$1;                 $thisallowed.=$1;
Line 1570  sub allowed { Line 1567  sub allowed {
                 
        if ($checkreferer) {         if ($checkreferer) {
   my $refuri=$ENV{'httpref.'.$orguri};    my $refuri=$ENV{'httpref.'.$orguri};
   
             unless ($refuri) {              unless ($refuri) {
                 foreach (keys %ENV) {                  foreach (keys %ENV) {
     if ($_=~/^httpref\..*\*/) {      if ($_=~/^httpref\..*\*/) {
Line 1584  sub allowed { Line 1580  sub allowed {
                     }                      }
                 }                  }
             }              }
   
          if ($refuri) {            if ($refuri) { 
   $refuri=&declutter($refuri);    $refuri=&declutter($refuri);
           my @uriparts=split(/\//,$refuri);            my ($match,$cond)=&is_on_map($refuri);
           my $filename=$uriparts[$#uriparts];              if ($match) {
           my $pathname=$refuri;                my $refstatecond=$cond;
           $pathname=~s/\/$filename$//;  
             if ($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~  
               /\&$filename\:([\d\|]+)\&/) {  
               my $refstatecond=$1;  
               if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$courseprivid}                if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$courseprivid}
                   =~/$priv\&([^\:]*)/) {                    =~/$priv\&([^\:]*)/) {
                   $thisallowed.=$1;                    $thisallowed.=$1;
Line 1733  sub allowed { Line 1726  sub allowed {
    return 'F';     return 'F';
 }  }
   
   # --------------------------------------------------- Is a resource on the map?
   
   sub is_on_map {
       my $uri=&declutter(shift);
       my @uriparts=split(/\//,$uri);
       my $filename=$uriparts[$#uriparts];
       my $pathname=$uri;
       $pathname=~s/\/$filename$//;
       my $match=($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~
          /\&$filename\:([\d\|]+)\&/);
       &logthis('is: '.$uri.' '.$match.' '.$1);
       if ($match) {
          return (1,$1);
      } else {
          return (0,0);
      }
   }
   
 # ----------------------------------------------------------------- Define Role  # ----------------------------------------------------------------- Define Role
   
 sub definerole {  sub definerole {
Removed from v.1.231  
changed lines
  Added in v.1.232

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