[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.532 and 1.534

version 1.532, 2004/08/25 16:03:17 version 1.534, 2004/08/27 21:09:22
Line 3679  sub revokecustomrole { Line 3679  sub revokecustomrole {
            $deleteflag);             $deleteflag);
 }  }
   
   # ------------------------------------------------------------ Disk usage
 # ------------------------------------------------------------ Portfolio Director Lister  sub diskusage{
 # returns listing of contents of user's /userfiles/portfolio/ directory      my ($udom,$uname,$directoryRoot)=@_;
 #       $directoryRoot =~ s/\/$//;
       my $listing=reply('du:'.$directoryRoot,homeserver($uname,$udom))
 sub portfoliolist {  
     my ($currentPath, $currentFile) = @_;  
     my ($udom, $uname, $portfolioRoot);  
     $uname=$ENV{'user.name'};  
     $udom=$ENV{'user.domain'};  
     # really should interrogate the system for home directory information, but . . .  
     $portfolioRoot = '/home/httpd/lonUsers/'.$udom.'/';  
     $uname =~ /^(.?)(.?)(.?)/;  
     $portfolioRoot = $portfolioRoot.$1.'/'.$2.'/'.$3.'/'.$uname.'/userfiles/portfolio';  
     my $listing = &reply('ls:'.$portfolioRoot.$currentPath, &homeserver($uname,$udom));  
     return $listing;  
 }  
   
 sub portfoliomanage {  
   
 #FIXME please user the existing remove userfile function instead and  
 #add a userfilerename functions.  
 #FIXME uhome should never be an argument to any lonnet functions  
   
     # handles deleting and renaming files in user's userfiles/portfolio/ directory  
     #   
     my ($filename, $fileaction, $filenewname) = @_;  
     my ($udom, $uname, $uhome);  
     $uname=$ENV{'user.name'};  
     $udom=$ENV{'user.domain'};  
     $uhome=$ENV{'user.home'};  
     my $listing = reply('portfoliomanage:'.$uname.':'.$udom.':'.$filename.':'.$fileaction.':'.$filenewname, $uhome);  
     return $listing;      return $listing;
 }  }
   
Line 4466  sub metadata_generate_part0 { Line 4439  sub metadata_generate_part0 {
 sub gettitle {  sub gettitle {
     my $urlsymb=shift;      my $urlsymb=shift;
     my $symb=&symbread($urlsymb);      my $symb=&symbread($urlsymb);
     unless ($symb) {      if ($symb) {
  unless ($urlsymb) { $urlsymb=$ENV{'request.filename'}; }   my ($result,$cached)=&is_cached(\%titlecache,$symb,'title',600);
         return &metadata($urlsymb,'title');    if (defined($cached)) { return $result; }
     }   my ($map,$resid,$url)=&decode_symb($symb);
     my ($result,$cached)=&is_cached(\%titlecache,$symb,'title',600);   my $title='';
     if (defined($cached)) { return $result; }   my %bighash;
     my ($map,$resid,$url)=&decode_symb($symb);   if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
     my $title='';   &GDBM_READER(),0640)) {
     my %bighash;      my $mapid=$bighash{'map_pc_'.&clutter($map)};
     if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',      $title=$bighash{'title_'.$mapid.'.'.$resid};
                             &GDBM_READER(),0640)) {      untie %bighash;
         my $mapid=$bighash{'map_pc_'.&clutter($map)};   }
         $title=$bighash{'title_'.$mapid.'.'.$resid};   $title=~s/\&colon\;/\:/gs;
         untie %bighash;   if ($title) {
     }      return &do_cache(\%titlecache,$symb,$title,'title');
     $title=~s/\&colon\;/\:/gs;   }
     if ($title) {   $urlsymb=$url;
         return &do_cache(\%titlecache,$symb,$title,'title');      }
     } else {      my $title=&metadata($urlsymb,'title');
  return &metadata($urlsymb,'title');      if (!$title) { $title=(split('/',$urlsymb))[-1]; }    
     }      return $title;
 }  }
           
 # ------------------------------------------------- Update symbolic store links  # ------------------------------------------------- Update symbolic store links
Removed from v.1.532  
changed lines
  Added in v.1.534

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