[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.531 and 1.536

version 1.531, 2004/08/24 07:26:04 version 1.536, 2004/08/30 18:25:56
Line 1047  sub currentversion { Line 1047  sub currentversion {
 sub subscribe {  sub subscribe {
     my $fname=shift;      my $fname=shift;
     if ($fname=~/\/(aboutme|syllabus|bulletinboard|smppg)$/) { return ''; }      if ($fname=~/\/(aboutme|syllabus|bulletinboard|smppg)$/) { return ''; }
       $fname=~s/[\n\r]//g;
     my $author=$fname;      my $author=$fname;
     $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;      $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
     my ($udom,$uname)=split(/\//,$author);      my ($udom,$uname)=split(/\//,$author);
Line 1067  sub repcopy { Line 1068  sub repcopy {
     my $filename=shift;      my $filename=shift;
     $filename=~s/\/+/\//g;      $filename=~s/\/+/\//g;
     if ($filename=~/^\/home\/httpd\/html\/adm\//) { return OK; }      if ($filename=~/^\/home\/httpd\/html\/adm\//) { return OK; }
       $filename=~s/[\n\r]//g;
     my $transname="$filename.in.transfer";      my $transname="$filename.in.transfer";
     if ((-e $filename) || (-e $transname)) { return OK; }      if ((-e $filename) || (-e $transname)) { return OK; }
     my $remoteurl=subscribe($filename);      my $remoteurl=subscribe($filename);
Line 3677  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 4464  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
Line 5081  sub filelocation { Line 5056  sub filelocation {
     $location = $file;      $location = $file;
     $location =~ s:/~(.*?)/(.*):/home/$1/public_html/$2:;      $location =~ s:/~(.*?)/(.*):/home/$1/public_html/$2:;
   } elsif ($file=~/^\/*uploaded/) { # is an uploaded file    } elsif ($file=~/^\/*uploaded/) { # is an uploaded file
       if ($file=~/^\/uploaded\/([^\/]+)\/([^\/]+)\/(\/)?simplepage\/([^\/]+)$/) {        $file=~/^\/uploaded\/([^\/]+)\/([^\/]+)\/(\/)?(.*)$/;
   $location=&Apache::loncommon::propath($1,$2).'/userfiles/simplepage/'.$4;        my $home=&homeserver($2,$1);
   if (not -e $location) {        my $allowed=0;
       $file=~/^\/uploaded\/(.*)$/;        my @ids=&current_machine_ids();
       $location=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles/'.$1;        foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } }
   }        if ($allowed) {
       } elsif ($file=~/^\/uploaded\/([^\/]+)\/([^\/]+)\/aboutme\/([^\/]+)$/) {    $location=&Apache::loncommon::propath($1,$2).'/userfiles/'.$4;
   $location=&Apache::loncommon::propath($1,$2).'/userfiles/aboutme/'.$3;  
          if (not -e $location) {  
      $file=~/^\/uploaded\/(.*)$/;  
      $location=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles/'.$1;  
          }  
       } else {        } else {
   $location=$file;    $location=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles/'.$1.'/'.$2.'/'.$4;
       }        }
   } else {    } else {
     $file=~s/^\Q$perlvar{'lonDocRoot'}\E//;      $file=~s/^\Q$perlvar{'lonDocRoot'}\E//;
Removed from v.1.531  
changed lines
  Added in v.1.536

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