[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.935 and 1.941.2.2

version 1.935, 2007/12/21 04:34:50 version 1.941.2.2, 2008/04/04 16:58:44
Line 1631  sub ssi_body { Line 1631  sub ssi_body {
     if (! exists($form{'LONCAPA_INTERNAL_no_discussion'})) {      if (! exists($form{'LONCAPA_INTERNAL_no_discussion'})) {
         $form{'LONCAPA_INTERNAL_no_discussion'}='true';          $form{'LONCAPA_INTERNAL_no_discussion'}='true';
     }      }
     my $output=($filelink=~/^http\:/?&externalssi($filelink):      my $output='';
                                      &ssi($filelink,%form));      my $response;
       if ($filelink=~/^http\:/) {
           ($output,$response)=&externalssi($filelink);
       } else {
           ($output,$response)=&ssi($filelink,%form);
       }
     $output=~s|//(\s*<!--)? BEGIN LON-CAPA Internal.+?// END LON-CAPA Internal\s*(-->)?\s||gs;      $output=~s|//(\s*<!--)? BEGIN LON-CAPA Internal.+?// END LON-CAPA Internal\s*(-->)?\s||gs;
     $output=~s/^.*?\<body[^\>]*\>//si;      $output=~s/^.*?\<body[^\>]*\>//si;
     $output=~s/\<\/body\s*\>.*?$//si;      $output=~s/\<\/body\s*\>.*?$//si;
     return $output;      if (wantarray) {
           return ($output, $response);
       } else {
           return $output;
       }
 }  }
   
 # --------------------------------------------------------- Server Side Include  # --------------------------------------------------------- Server Side Include
Line 1650  sub absolute_url { Line 1659  sub absolute_url {
     return $protocol.$host_name;      return $protocol.$host_name;
 }  }
   
   #
   #   Server side include.
   # Parameters:
   #  fn     Possibly encrypted resource name/id.
   #  form   Hash that describes how the rendering should be done
   #         and other things.
   # Returns:
   #   Scalar context: The content of the response.
   #   Array context:  2 element list of the content and the full response object.
   #     
 sub ssi {  sub ssi {
   
     my ($fn,%form)=@_;      my ($fn,%form)=@_;
   
     my $ua=new LWP::UserAgent;      my $ua=new LWP::UserAgent;
       
     my $request;      my $request;
   
     $form{'no_update_last_known'}=1;      $form{'no_update_last_known'}=1;
Line 1670  sub ssi { Line 1687  sub ssi {
     $request->header(Cookie => $ENV{'HTTP_COOKIE'});      $request->header(Cookie => $ENV{'HTTP_COOKIE'});
     my $response=$ua->request($request);      my $response=$ua->request($request);
   
     return $response->content;      if (wantarray) {
    return ($response->content, $response);
       } else {
    return $response->content;
       }
 }  }
   
 sub externalssi {  sub externalssi {
Line 1678  sub externalssi { Line 1699  sub externalssi {
     my $ua=new LWP::UserAgent;      my $ua=new LWP::UserAgent;
     my $request=new HTTP::Request('GET',$url);      my $request=new HTTP::Request('GET',$url);
     my $response=$ua->request($request);      my $response=$ua->request($request);
     return $response->content;      if (wantarray) {
           return ($response->content, $response);
       } else {
           return $response->content;
       }
 }  }
   
 # -------------------------------- Allow a /uploaded/ URI to be vouched for  # -------------------------------- Allow a /uploaded/ URI to be vouched for
Line 2200  sub flushcourselogs { Line 2225  sub flushcourselogs {
             }              }
         }          }
         $courseidbuffer{$coursehombuf{$crsid}}{$crsid} = {          $courseidbuffer{$coursehombuf{$crsid}}{$crsid} = {
             'description' => &escape($coursedescrbuf{$crsid}),              'description' => $coursedescrbuf{$crsid},
             'inst_code'    => &escape($courseinstcodebuf{$crsid}),              'inst_code'    => $courseinstcodebuf{$crsid},
             'type'        => &escape($coursetypebuf{$crsid}),              'type'        => $coursetypebuf{$crsid},
             'owner'       => &escape($courseownerbuf{$crsid}),              'owner'       => $courseownerbuf{$crsid},
         };          };
     }      }
 #  #
Line 2399  sub get_course_adv_roles { Line 2424  sub get_course_adv_roles {
     my %coursehash=&coursedescription($cid);      my %coursehash=&coursedescription($cid);
     my %nothide=();      my %nothide=();
     foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {      foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
  $nothide{join(':',split(/[\@\:]/,$user))}=1;          if ($user !~ /:/) {
       $nothide{join(':',split(/[\@]/,$user))}=1;
           } else {
               $nothide{$user}=1;
           }
     }      }
     my %returnhash=();      my %returnhash=();
     my %dumphash=      my %dumphash=
Line 2427  sub get_course_adv_roles { Line 2456  sub get_course_adv_roles {
 }  }
   
 sub get_my_roles {  sub get_my_roles {
     my ($uname,$udom,$context,$types,$roles,$roledoms,$withsec)=@_;      my ($uname,$udom,$context,$types,$roles,$roledoms,$withsec,$hidepriv)=@_;
     unless (defined($uname)) { $uname=$env{'user.name'}; }      unless (defined($uname)) { $uname=$env{'user.name'}; }
     unless (defined($udom)) { $udom=$env{'user.domain'}; }      unless (defined($udom)) { $udom=$env{'user.domain'}; }
     my %dumphash;      my (%dumphash,%nothide);
     if ($context eq 'userroles') {       if ($context eq 'userroles') { 
         %dumphash = &dump('roles',$udom,$uname);          %dumphash = &dump('roles',$udom,$uname);
     } else {      } else {
         %dumphash=          %dumphash=
             &dump('nohist_userroles',$udom,$uname);              &dump('nohist_userroles',$udom,$uname);
           if ($hidepriv) {
               my %coursehash=&coursedescription($udom.'_'.$uname);
               foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
                   if ($user !~ /:/) {
                       $nothide{join(':',split(/[\@]/,$user))} = 1;
                   } else {
                       $nothide{$user} = 1;
                   }
               }
           }
     }      }
     my %returnhash=();      my %returnhash=();
     my $now=time;      my $now=time;
Line 2448  sub get_my_roles { Line 2487  sub get_my_roles {
         }          }
         if (($tstart) && ($tstart<0)) { next; }          if (($tstart) && ($tstart<0)) { next; }
         my $status = 'active';          my $status = 'active';
         if (($tend) && ($tend<$now)) {          if (($tend) && ($tend<=$now)) {
             $status = 'previous';              $status = 'previous';
         }           } 
         if (($tstart) && ($now<$tstart)) {          if (($tstart) && ($now<$tstart)) {
Line 2486  sub get_my_roles { Line 2525  sub get_my_roles {
                 }                  }
             }              }
         }          }
           if ($hidepriv) {
               if ((&privileged($username,$domain)) &&
                   (!$nothide{$username.':'.$domain})) { 
                   next;
               }
           }
         if ($withsec) {          if ($withsec) {
             $returnhash{$username.':'.$domain.':'.$role.':'.$section} =              $returnhash{$username.':'.$domain.':'.$role.':'.$section} =
                 $tstart.':'.$tend;                  $tstart.':'.$tend;
Line 2555  sub courseidput { Line 2600  sub courseidput {
         foreach my $cid (keys(%$storehash)) {          foreach my $cid (keys(%$storehash)) {
             $what .= &escape($cid).'=';              $what .= &escape($cid).'=';
             foreach my $item ('description','inst_code','owner','type') {              foreach my $item ('description','inst_code','owner','type') {
                 $what .= &escape($storehash->{$item}).':';                  $what .= &escape($storehash->{$cid}{$item}).':';
             }              }
             $what =~ s/\:$/&/;              $what =~ s/\:$/&/;
         }          }
Line 3507  sub set_userprivs { Line 3552  sub set_userprivs {
     }      }
     foreach my $role (keys(%{$allroles})) {      foreach my $role (keys(%{$allroles})) {
         my %thesepriv;          my %thesepriv;
         if (($role=~/^au/) || ($role=~/^ca/)) { $author=1; }          if (($role=~/^au/) || ($role=~/^ca/) || ($role=~/^aa/)) { $author=1; }
         foreach my $item (split(/:/,$$allroles{$role})) {          foreach my $item (split(/:/,$$allroles{$role})) {
             if ($item ne '') {              if ($item ne '') {
                 my ($privilege,$restrictions)=split(/&/,$item);                  my ($privilege,$restrictions)=split(/&/,$item);
Line 6697  sub EXT { Line 6742  sub EXT {
     if ($part eq '') { $part='0'; }      if ($part eq '') { $part='0'; }
     my @partgeneral=&EXT('resource.'.$part.'.'.$qualifierrest,      my @partgeneral=&EXT('resource.'.$part.'.'.$qualifierrest,
  $symbparm,$udom,$uname,$section,1);   $symbparm,$udom,$uname,$section,1);
     if (@partgeneral) { return &get_reply(\@partgeneral); }      if (defined($partgeneral[0])) { return &get_reply(\@partgeneral); }
  }   }
  if ($recurse) { return undef; }   if ($recurse) { return undef; }
  my $pack_def=&packages_tab_default($filename,$varname);   my $pack_def=&packages_tab_default($filename,$varname);
Line 6731  sub EXT { Line 6776  sub EXT {
   
 sub get_reply {  sub get_reply {
     my ($reply_value) = @_;      my ($reply_value) = @_;
     if (wantarray) {      if (ref($reply_value) eq 'ARRAY') {
  return @$reply_value;          if (wantarray) {
       return @$reply_value;
           }
           return $reply_value->[0];
       } else {
           return $reply_value;
     }      }
     return $reply_value->[0];  
 }  }
   
 sub check_group_parms {  sub check_group_parms {
Removed from v.1.935  
changed lines
  Added in v.1.941.2.2

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