[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.707 and 1.712

version 1.707, 2006/02/07 16:21:05 version 1.712, 2006/02/21 22:39:28
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 {
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 3737  sub auto_photo_permission { Line 3740  sub auto_photo_permission {
     my $homeserver = &homeserver($cnum,$cdom);      my $homeserver = &homeserver($cnum,$cdom);
     my ($outcome,$perm_reqd,$conditions) =       my ($outcome,$perm_reqd,$conditions) = 
  split(/:/,&unescape(&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 3747  sub auto_checkphotos { Line 3753  sub auto_checkphotos {
     my $outcome = &unescape(&reply('autophotocheck:'.&escape($udom).':'.      my $outcome = &unescape(&reply('autophotocheck:'.&escape($udom).':'.
    &escape($uname).':'.&escape($pid),     &escape($uname).':'.&escape($pid),
    $homeserver));     $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 3759  sub auto_photochoice { Line 3768  sub auto_photochoice {
     my ($update,$comment) = split(/:/,&unescape(&reply('autophotochoice:'.      my ($update,$comment) = split(/:/,&unescape(&reply('autophotochoice:'.
        &escape($cdom),         &escape($cdom),
        $homeserver)));         $homeserver)));
       if ($update =~ /^(con_lost|unknown_cmd|no_such_host)$/) {
    return (undef,undef);
       }
     return ($update,$comment);      return ($update,$comment);
 }  }
   
Line 4655  sub GetFileTimestamp { Line 4667  sub GetFileTimestamp {
     }      }
 }  }
   
   sub stat_file {
       my ($uri) = @_;
       $uri = &clutter($uri);
       my ($udom,$uname,$file,$dir);
       if ($uri =~ m-^/(uploaded|editupload)/-) {
    ($udom,$uname,$file) =
       ($uri =~ m-/(?:uploaded|editupload)/?([^/]*)/?([^/]*)/?(.*)-);
    $file = 'userfiles/'.$file;
    $dir = &Apache::loncommon::propath($udom,$uname);
       }
       if ($uri =~ m-^/res/-) {
    ($udom,$uname) = 
       ($uri =~ m-/(?:res)/?([^/]*)/?([^/]*)/-);
    $file = $uri;
       }
   
       if (!$udom || !$uname || !$file) {
    # unable to handle the uri
    return ();
       }
   
       my ($result) = &dirlist($file,$udom,$uname,$dir);
       my @stats = split('&', $result);
       if($stats[0] ne 'empty' && $stats[0] ne 'no_such_dir') {
    shift(@stats); #filename is first
    return @stats;
       }
       return ();
   }
   
 # -------------------------------------------------------- Value of a Condition  # -------------------------------------------------------- Value of a Condition
   
 sub directcondval {  sub directcondval {
Line 5461  sub symblist { Line 5503  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';
Line 7324  getfile($file,$caller) : two cases - req Line 7369  getfile($file,$caller) : two cases - req
    - returns the entire contents of a file or -1;      - returns the entire contents of a file or -1; 
    it properly subscribes to and replicates the file if neccessary.     it properly subscribes to and replicates the file if neccessary.
   
   
   =item *
   
   stat_file($url) : $url is expected to be a /res/ or /uploaded/ style file
                     reference
   
   returns either a stat() list of data about the file or an empty list
   if the file doesn't exist or couldn't find out about it (connection
   problems or user unknown)
   
 =item *  =item *
   
 filelocation($dir,$file) : returns file system location of a file  filelocation($dir,$file) : returns file system location of a file
Removed from v.1.707  
changed lines
  Added in v.1.712

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