--- loncom/lonnet/perl/lonnet.pm 2004/08/25 16:03:17 1.532 +++ loncom/lonnet/perl/lonnet.pm 2004/08/30 18:25:56 1.536 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.532 2004/08/25 16:03:17 albertel Exp $ +# $Id: lonnet.pm,v 1.536 2004/08/30 18:25:56 sakharuk Exp $ # # Copyright Michigan State University Board of Trustees # @@ -3679,38 +3679,11 @@ sub revokecustomrole { $deleteflag); } - -# ------------------------------------------------------------ Portfolio Director Lister -# returns listing of contents of user's /userfiles/portfolio/ directory -# - -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); +# ------------------------------------------------------------ Disk usage +sub diskusage { + my ($udom,$uname,$directoryRoot)=@_; + $directoryRoot =~ s/\/$//; + my $listing=&reply('du:'.$directoryRoot,homeserver($uname,$udom)); return $listing; } @@ -4466,27 +4439,27 @@ sub metadata_generate_part0 { sub gettitle { my $urlsymb=shift; my $symb=&symbread($urlsymb); - unless ($symb) { - unless ($urlsymb) { $urlsymb=$ENV{'request.filename'}; } - return &metadata($urlsymb,'title'); - } - my ($result,$cached)=&is_cached(\%titlecache,$symb,'title',600); - if (defined($cached)) { return $result; } - my ($map,$resid,$url)=&decode_symb($symb); - my $title=''; - my %bighash; - if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db', - &GDBM_READER(),0640)) { - my $mapid=$bighash{'map_pc_'.&clutter($map)}; - $title=$bighash{'title_'.$mapid.'.'.$resid}; - untie %bighash; - } - $title=~s/\&colon\;/\:/gs; - if ($title) { - return &do_cache(\%titlecache,$symb,$title,'title'); - } else { - return &metadata($urlsymb,'title'); - } + if ($symb) { + my ($result,$cached)=&is_cached(\%titlecache,$symb,'title',600); + if (defined($cached)) { return $result; } + my ($map,$resid,$url)=&decode_symb($symb); + my $title=''; + my %bighash; + if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db', + &GDBM_READER(),0640)) { + my $mapid=$bighash{'map_pc_'.&clutter($map)}; + $title=$bighash{'title_'.$mapid.'.'.$resid}; + untie %bighash; + } + $title=~s/\&colon\;/\:/gs; + if ($title) { + return &do_cache(\%titlecache,$symb,$title,'title'); + } + $urlsymb=$url; + } + my $title=&metadata($urlsymb,'title'); + if (!$title) { $title=(split('/',$urlsymb))[-1]; } + return $title; } # ------------------------------------------------- Update symbolic store links @@ -5083,20 +5056,15 @@ sub filelocation { $location = $file; $location =~ s:/~(.*?)/(.*):/home/$1/public_html/$2:; } elsif ($file=~/^\/*uploaded/) { # is an uploaded file - if ($file=~/^\/uploaded\/([^\/]+)\/([^\/]+)\/(\/)?simplepage\/([^\/]+)$/) { - $location=&Apache::loncommon::propath($1,$2).'/userfiles/simplepage/'.$4; - if (not -e $location) { - $file=~/^\/uploaded\/(.*)$/; - $location=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles/'.$1; - } - } elsif ($file=~/^\/uploaded\/([^\/]+)\/([^\/]+)\/aboutme\/([^\/]+)$/) { - $location=&Apache::loncommon::propath($1,$2).'/userfiles/aboutme/'.$3; - if (not -e $location) { - $file=~/^\/uploaded\/(.*)$/; - $location=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles/'.$1; - } + $file=~/^\/uploaded\/([^\/]+)\/([^\/]+)\/(\/)?(.*)$/; + my $home=&homeserver($2,$1); + my $allowed=0; + my @ids=¤t_machine_ids(); + foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } } + if ($allowed) { + $location=&Apache::loncommon::propath($1,$2).'/userfiles/'.$4; } else { - $location=$file; + $location=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles/'.$1.'/'.$2.'/'.$4; } } else { $file=~s/^\Q$perlvar{'lonDocRoot'}\E//;