--- loncom/lonnet/perl/lonnet.pm 2002/07/30 19:57:40 1.255
+++ 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.255 2002/07/30 19:57:40 albertel Exp $
+# $Id: lonnet.pm,v 1.261 2002/08/05 21:02:07 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -712,11 +712,65 @@ 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, coursedoc=1 means this is for the course
+# output: url of file in userspace
+
+sub userfileupload {
+ 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 $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.'/userfiles/'.$path);
+ my $count;
+ for ($count=4;$count<=$#parts;$count++) {
+ $filepath.="/$parts[$count]";
+ if ((-e $filepath)!=1) {
+ mkdir($filepath,0777);
+ }
+ }
+# Save the file
+ {
+ 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 '/uploaded/'.$path.$fname;
+}
# ------------------------------------------------------------------------- Log
@@ -1043,7 +1097,7 @@ sub tmpreset {
my %hash;
if (tie(%hash,'GDBM_File',
$path.'/tmpstore_'.$stuname.'_'.$domain.'_'.$namespace.'.db',
- &GDBM_WRCREAT,0640)) {
+ &GDBM_WRCREAT(),0640)) {
foreach my $key (keys %hash) {
if ($key=~ /:$symb/) {
delete($hash{$key});
@@ -1079,7 +1133,7 @@ sub tmpstore {
my $path=$perlvar{'lonDaemons'}.'/tmp';
if (tie(%hash,'GDBM_File',
$path.'/tmpstore_'.$stuname.'_'.$domain.'_'.$namespace.'.db',
- &GDBM_WRCREAT,0640)) {
+ &GDBM_WRCREAT(),0640)) {
$hash{"version:$symb"}++;
my $version=$hash{"version:$symb"};
my $allkeys='';
@@ -1123,7 +1177,7 @@ sub tmprestore {
my $path=$perlvar{'lonDaemons'}.'/tmp';
if (tie(%hash,'GDBM_File',
$path.'/tmpstore_'.$stuname.'_'.$domain.'_'.$namespace.'.db',
- &GDBM_READER,0640)) {
+ &GDBM_READER(),0640)) {
my $version=$hash{"version:$symb"};
$returnhash{'version'}=$version;
my $scope;
@@ -2477,7 +2531,7 @@ sub EXT {
my $thisparm='';
if (tie(%parmhash,'GDBM_File',
$ENV{'request.course.fn'}.'_parms.db',
- &GDBM_READER,0640)) {
+ &GDBM_READER(),0640)) {
$thisparm=$parmhash{$symbparm};
untie(%parmhash);
}
@@ -2649,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
@@ -2656,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 {
@@ -2664,7 +2747,7 @@ sub symblist {
my %hash;
if (($ENV{'request.course.fn'}) && (%newhash)) {
if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'_symb.db',
- &GDBM_WRCREAT,0640)) {
+ &GDBM_WRCREAT(),0640)) {
foreach (keys %newhash) {
$hash{declutter($_)}=$mapname.'___'.$newhash{$_};
}
@@ -2692,7 +2775,7 @@ sub symbverify {
my %bighash;
my $okay=0;
if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
- &GDBM_READER,0640)) {
+ &GDBM_READER(),0640)) {
my $ids=$bighash{'ids_/res/'.$thisfn};
unless ($ids) {
$ids=$bighash{'ids_/'.$thisfn};
@@ -2746,7 +2829,7 @@ sub symbread {
my $syval='';
if (($ENV{'request.course.fn'}) && ($thisfn)) {
if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'_symb.db',
- &GDBM_READER,0640)) {
+ &GDBM_READER(),0640)) {
$syval=$hash{$thisfn};
untie(%hash);
}
@@ -2762,7 +2845,7 @@ sub symbread {
} else {
# ------------------------------------------------------- Was not in symb table
if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
- &GDBM_READER,0640)) {
+ &GDBM_READER(),0640)) {
# ---------------------------------------------- Get ID(s) for current resource
my $ids=$bighash{'ids_/res/'.$thisfn};
unless ($ids) {
@@ -2864,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 {