--- loncom/lonnet/perl/lonnet.pm 2002/07/31 13:50:38 1.258 +++ loncom/lonnet/perl/lonnet.pm 2002/08/05 21:02:07 1.261 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.258 2002/07/31 13:50:38 www Exp $ +# $Id: lonnet.pm,v 1.261 2002/08/05 21:02:07 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -712,26 +712,46 @@ sub ssi { sub tokenwrapper { my $uri=shift; - my $token=&reply('tmpput:'.&escape($uri),$perlvar{'lonHostID'}); - return $uri.(($uri=~/\?/)?'&':'?'). - 'token='.$token.'&server='.$perlvar{'lonHostID'}; + $uri=~s/^http\:\/\/([^\/]+)//; + $uri=~s/^\///; + $ENV{'user.environment'}=~/\/([^\/]+)\.id/; + my $token=$1; + if ($uri=~/^uploaded\/([^\/]+)\/([^\/]+)\/([^\/]+)(\?\.*)*$/) { + &appenv('userfile.'.$1.'/'.$2.'/'.$3 => $ENV{'request.course.id'}); + return 'http://'.$hostname{ &homeserver($2,$1)}.'/'.$uri. + (($uri=~/\?/)?'&':'?').'token='.$token; + } else { + return '/adm/notfound.html'; + } } # --------------- Take an uploaded file and put it into the userfiles directory -# input: name of form element +# input: name of form element, coursedoc=1 means this is for the course # output: url of file in userspace sub userfileupload { - my $formname=shift; + my ($formname,$coursedoc)=@_; my $fname=$ENV{'form.'.$formname.'.filename'}; $fname=~s/\\/\//g; $fname=~s/^.*\/([^\/]+)$/$1/; unless ($fname) { return 'error: no uploaded file'; } chop($ENV{'form.'.$formname}); # Create the directory if not present - my $path='/userfiles/'.$ENV{'user.domain'}.'/'.$ENV{'user.name'}.'/'; + my $docuname=''; + my $docudom=''; + my $docuhome=''; + if ($coursedoc) { + $docuname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'}; + $docudom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; + $docuhome=$ENV{'course.'.$ENV{'request.course.id'}.'.home'}; + } else { + $docuname=$ENV{'user.name'}; + $docudom=$ENV{'user.domain'}; + $docuhome=$ENV{'user.home'}; + } + my $path=$docudom.'/'.$docuname.'/'; my $filepath=$perlvar{'lonDocRoot'}; - my @parts=split(/\//,$filepath.$path); + my @parts=split(/\//,$filepath.'/userfiles/'.$path); my $count; for ($count=4;$count<=$#parts;$count++) { $filepath.="/$parts[$count]"; @@ -744,8 +764,12 @@ sub userfileupload { my $fh=Apache::File->new('>'.$filepath.'/'.$fname); print $fh $ENV{'form.'.$formname}; } +# Notify homeserver to grep it +# +# FIXME - this still needs to happen +# # Return the URL to it - return 'http://'.$ENV{'SERVER_NAME'}.$path.$fname; + return '/uploaded/'.$path.$fname; } # ------------------------------------------------------------------------- Log @@ -2679,6 +2703,7 @@ sub metadata { # the next is the end of "start tag" } } + &metadata_generate_part0(\%metathesekeys,\%metacache,$uri); $metacache{$uri.':keys'}=join(',',keys %metathesekeys); $metacache{$uri.':cachedtimestamp'}=time; # this is the end of "was not already recently cached @@ -2686,6 +2711,34 @@ sub metadata { return $metacache{$uri.':'.$what}; } +sub metadata_generate_part0 { + my ($metadata,$metacache,$uri) = @_; + my %allnames; + foreach my $metakey (sort keys %$metadata) { + if ($metakey=~/^parameter\_(.*)/) { + my $part=$$metacache{$uri.':'.$metakey.'.part'}; + my $name=$$metacache{$uri.':'.$metakey.'.name'}; + if (! exists($$metadata{'parameter_0_'.$name})) { + $allnames{$name}=$part; + } + } + } + foreach my $name (keys(%allnames)) { + $$metadata{"parameter_0_$name"}=1; + my $key="$uri:parameter_0_$name"; + $$metacache{"$key.part"}='0'; + $$metacache{"$key.name"}=$name; + $$metacache{"$key.type"}=$$metacache{$uri.':parameter_'. + $allnames{$name}.'_'.$name. + '.type'}; + my $olddis=$$metacache{$uri.':parameter_'.$allnames{$name}.'_'.$name. + '.display'}; + my $expr='\\[Part: '.$allnames{$name}.'\\]'; + $olddis=~s/$expr/\[Part: 0\]/; + $$metacache{"$key.display"}=$olddis; + } +} + # ------------------------------------------------- Update symbolic store links sub symblist { @@ -2894,10 +2947,10 @@ sub ireceipt { } sub receipt { - return &ireceipt($ENV{'user.name'},$ENV{'user.domain'}, - $ENV{'request.course.id'},&symbread()); + my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser(); + return &ireceipt($name,$domain,$courseid,$symb); } - + # ------------------------------------------------------------ Serves up a file # returns either the contents of the file or a -1 sub getfile {