[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.706 and 1.711

version 1.706, 2006/02/07 05:08:29 version 1.711, 2006/02/14 20:28:57
Line 948  sub studentphoto { Line 948  sub studentphoto {
     my ($udom,$unam,$ext) = @_;      my ($udom,$unam,$ext) = @_;
     my $home=&Apache::lonnet::homeserver($unam,$udom);      my $home=&Apache::lonnet::homeserver($unam,$udom);
     if (defined($env{'request.course.id'})) {      if (defined($env{'request.course.id'})) {
         if ($env{'course.'.$env{'request.course.id'}.'.internal.showphotos'}) {          if ($env{'course.'.$env{'request.course.id'}.'.internal.showphoto'}) {
             if ($udom eq $env{'course.'.$env{'request.course.id'}.'.domain'}) {              if ($udom eq $env{'course.'.$env{'request.course.id'}.'.domain'}) {
                 return(&retrievestudentphoto($udom,$unam,$ext));                   return(&retrievestudentphoto($udom,$unam,$ext)); 
             } else {              } else {
                 my ($result,$perm_reqd)=                  my ($result,$perm_reqd)=
                         &Apache::lonnet::auto_photo_permission($unam,$udom);      &Apache::lonnet::auto_photo_permission($unam,$udom);
                 if ($result eq 'ok') {                  if ($result eq 'ok') {
                     if (!($perm_reqd eq 'yes')) {                      if (!($perm_reqd eq 'yes')) {
                         return(&retrievestudentphoto($udom,$unam,$ext));                          return(&retrievestudentphoto($udom,$unam,$ext));
Line 963  sub studentphoto { Line 963  sub studentphoto {
         }          }
     } else {      } else {
         my ($result,$perm_reqd) =           my ($result,$perm_reqd) = 
                            &Apache::lonnet::auto_photo_permission($unam,$udom);      &Apache::lonnet::auto_photo_permission($unam,$udom);
         if ($result eq 'ok') {          if ($result eq 'ok') {
             if (!($perm_reqd eq 'yes')) {              if (!($perm_reqd eq 'yes')) {
                 return(&retrievestudentphoto($udom,$unam,$ext));                  return(&retrievestudentphoto($udom,$unam,$ext));
Line 1145  sub ssi { Line 1145  sub ssi {
     my $ua=new LWP::UserAgent;      my $ua=new LWP::UserAgent;
           
     my $request;      my $request;
       
       $form{'no_update_last_known'}=1;
   
     if (%form) {      if (%form) {
       $request=new HTTP::Request('POST',"http://".$ENV{'HTTP_HOST'}.$fn);        $request=new HTTP::Request('POST',"http://".$ENV{'HTTP_HOST'}.$fn);
       $request->content(join('&',map { &escape($_).'='.&escape($form{$_}) } keys %form));        $request->content(join('&',map { &escape($_).'='.&escape($form{$_}) } keys %form));
Line 3450  sub allowed { Line 3452  sub allowed {
    return 'F';     return 'F';
 }  }
   
   sub split_uri_for_cond {
       my $uri=&deversion(&declutter(shift));
       my @uriparts=split(/\//,$uri);
       my $filename=pop(@uriparts);
       my $pathname=join('/',@uriparts);
       return ($pathname,$filename);
   }
 # --------------------------------------------------- Is a resource on the map?  # --------------------------------------------------- Is a resource on the map?
   
 sub is_on_map {  sub is_on_map {
     my $uri=&deversion(&declutter(shift));      my ($pathname,$filename) = &split_uri_for_cond(shift);
     my @uriparts=split(/\//,$uri);  
     my $filename=$uriparts[$#uriparts];  
     my $pathname=$uri;  
     $pathname=~s|/\Q$filename\E$||;  
     $pathname=~s/^adm\/wrapper\///;  
     $pathname=~s/^adm\/coursedocs\/showdoc\///;  
     #Trying to find the conditional for the file      #Trying to find the conditional for the file
     my $match=($env{'acc.res.'.$env{'request.course.id'}.'.'.$pathname}=~      my $match=($env{'acc.res.'.$env{'request.course.id'}.'.'.$pathname}=~
        /\&\Q$filename\E\:([\d\|]+)\&/);         /\&\Q$filename\E\:([\d\|]+)\&/);
Line 3735  sub auto_create_password { Line 3738  sub auto_create_password {
 sub auto_photo_permission {  sub auto_photo_permission {
     my ($cnum,$cdom,$students) = @_;      my ($cnum,$cdom,$students) = @_;
     my $homeserver = &homeserver($cnum,$cdom);      my $homeserver = &homeserver($cnum,$cdom);
     my ($outcome,$perm_reqd,$conditions) = split(/:/,&unescape(      my ($outcome,$perm_reqd,$conditions) = 
                           &reply('autophotopermission:'.$cdom,$homeserver)),3);   split(/:/,&unescape(&reply('autophotopermission:'.$cdom,$homeserver)),3);
       if ($outcome =~ /^(con_lost|unknown_cmd|no_such_host)$/) {
    return (undef,undef);
       }
     return ($outcome,$perm_reqd,$conditions);      return ($outcome,$perm_reqd,$conditions);
 }  }
   
Line 3745  sub auto_checkphotos { Line 3751  sub auto_checkphotos {
     my $homeserver = &homeserver($uname,$udom);      my $homeserver = &homeserver($uname,$udom);
     my ($result,$resulttype);      my ($result,$resulttype);
     my $outcome = &unescape(&reply('autophotocheck:'.&escape($udom).':'.      my $outcome = &unescape(&reply('autophotocheck:'.&escape($udom).':'.
                                &escape($uname).':'.&escape($pid),$homeserver));     &escape($uname).':'.&escape($pid),
      $homeserver));
       if ($outcome =~ /^(con_lost|unknown_cmd|no_such_host)$/) {
    return (undef,undef);
       }
     if ($outcome) {      if ($outcome) {
         ($result,$resulttype) = split(/:/,$outcome);          ($result,$resulttype) = split(/:/,$outcome);
     }       } 
Line 3756  sub auto_photochoice { Line 3766  sub auto_photochoice {
     my ($cnum,$cdom) = @_;      my ($cnum,$cdom) = @_;
     my $homeserver = &homeserver($cnum,$cdom);      my $homeserver = &homeserver($cnum,$cdom);
     my ($update,$comment) = split(/:/,&unescape(&reply('autophotochoice:'.      my ($update,$comment) = split(/:/,&unescape(&reply('autophotochoice:'.
                                                 &escape($cdom),$homeserver)));         &escape($cdom),
          $homeserver)));
       if ($update =~ /^(con_lost|unknown_cmd|no_such_host)$/) {
    return (undef,undef);
       }
     return ($update,$comment);      return ($update,$comment);
 }  }
   
Line 5459  sub symblist { Line 5473  sub symblist {
     if (($env{'request.course.fn'}) && (%newhash)) {      if (($env{'request.course.fn'}) && (%newhash)) {
         if (tie(%hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',          if (tie(%hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',
                       &GDBM_WRCREAT(),0640)) {                        &GDBM_WRCREAT(),0640)) {
     foreach (keys %newhash) {      foreach my $url (keys %newhash) {
                 $hash{declutter($_)}=&encode_symb($mapname,$newhash{$_}->[1],   next if ($url eq 'last_known'
   $newhash{$_}->[0]);   && $env{'form.no_update_last_known'});
    $hash{declutter($url)}=&encode_symb($mapname,
       $newhash{$url}->[1],
       $newhash{$url}->[0]);
             }              }
             if (untie(%hash)) {              if (untie(%hash)) {
  return 'ok';   return 'ok';
Removed from v.1.706  
changed lines
  Added in v.1.711

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