--- loncom/lonnet/perl/lonnet.pm 2002/08/09 19:49:30 1.266
+++ loncom/lonnet/perl/lonnet.pm 2002/09/05 19:37:00 1.278
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.266 2002/08/09 19:49:30 albertel Exp $
+# $Id: lonnet.pm,v 1.278 2002/09/05 19:37:00 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -761,6 +761,12 @@ sub userfileupload {
$docudom=$ENV{'user.domain'};
$docuhome=$ENV{'user.home'};
}
+ return
+ &finishuserfileupload($docuname,$docudom,$docuhome,$formname,$fname);
+}
+
+sub finishuserfileupload {
+ my ($docuname,$docudom,$docuhome,$formname,$fname)=@_;
my $path=$docudom.'/'.$docuname.'/';
my $filepath=$perlvar{'lonDocRoot'};
my @parts=split(/\//,$filepath.'/userfiles/'.$path);
@@ -1114,7 +1120,7 @@ sub str2hashref {
}
} else {
$string =~ s/^(.*?)=//;
- $key=$1
+ $key=&unescape($1);
}
$string =~ s/^=//;
@@ -1435,7 +1441,7 @@ sub coursedescription {
while (my ($name,$value) = each %returnhash) {
$envhash{'course.'.$normalid.'.'.$name}=$value;
}
- $returnhash{'url'}='/res/'.declutter($returnhash{'url'});
+ $returnhash{'url'}=&clutter($returnhash{'url'});
$returnhash{'fn'}=$perlvar{'lonDaemons'}.'/tmp/'.
$ENV{'user.name'}.'_'.$cdomain.'_'.$cnum;
$envhash{'course.'.$normalid.'.last_cache'}=time;
@@ -1563,6 +1569,9 @@ sub get {
my $rep=&reply("get:$udomain:$uname:$namespace:$items",$uhome);
my @pairs=split(/\&/,$rep);
+ if ( $#pairs==0 && $pairs[0] =~ /^(con_lost|error|no_such_host)/i) {
+ return @pairs;
+ }
my %returnhash=();
my $i=0;
foreach (@$storearr) {
@@ -2137,7 +2146,8 @@ sub modifyuserauth {
my $uhome=&homeserver($uname,$udom);
unless (&allowed('mau',$udom)) { return 'refused'; }
&logthis('Call to modify user authentication '.$udom.', '.$uname.', '.
- $umode.' by '.$ENV{'user.name'}.' at '.$ENV{'user.domain'});
+ $umode.' by '.$ENV{'user.name'}.' at '.$ENV{'user.domain'}.
+ ' in domain '.$ENV{'request.role.domain'});
my $reply=&reply('encrypt:changeuserauth:'.$udom.':'.$uname.':'.$umode.':'.
&escape($upass),$uhome);
&log($ENV{'user.domain'},$ENV{'user.name'},$ENV{'user.home'},
@@ -2168,7 +2178,8 @@ sub modifyuser {
$last.', '.$gene.'(forceid: '.$forceid.')'.
(defined($desiredhome) ? ' desiredhome = '.$desiredhome :
' desiredhome not specified').
- ' by '.$ENV{'user.name'}.' at '.$ENV{'user.domain'});
+ ' by '.$ENV{'user.name'}.' at '.$ENV{'user.domain'}.
+ ' in domain '.$ENV{'request.role.domain'});
my $uhome=&homeserver($uname,$udom,'true');
# ----------------------------------------------------------------- Create User
if (($uhome eq 'no_host') && ($umode) && ($upass)) {
@@ -2293,7 +2304,7 @@ sub writecoursepref {
# ---------------------------------------------------------- Make/modify course
sub createcourse {
- my ($udom,$description,$url,$course_server)=@_;
+ my ($udom,$description,$url,$course_server,$nonstandard)=@_;
$url=&declutter($url);
my $cid='';
unless (&allowed('ccc',$udom)) {
@@ -2325,9 +2336,29 @@ sub createcourse {
if (($uhome eq '') || ($uhome eq 'no_host')) {
return 'error: no such course';
}
+# ----------------------------------------------------------------- Course made
+ my $topurl=$url;
+ unless ($nonstandard) {
+# ------------------------------------------ For standard courses, make top url
+ my $mapurl=&clutter($url);
+ if ($mapurl eq '/res/') { $mapurl=''; }
+ $ENV{'form.initmap'}=(<<ENDINITMAP);
+<map>
+<resource id="1" type="start"></resource>
+<resource id="2" src="$mapurl"></resource>
+<resource id="3" type="finish"></resource>
+<link index="1" from="1" to="2"></link>
+<link index="2" from="2" to="3"></link>
+</map>
+ENDINITMAP
+ $topurl=&declutter(
+ &finishuserfileupload($uname,$udom,$uhome,'initmap','default.sequence')
+ );
+ }
+# ----------------------------------------------------------- Write preferences
&writecoursepref($udom.'_'.$uname,
('description' => $description,
- 'url' => $url));
+ 'url' => $topurl));
return '/'.$udom.'/'.$uname;
}
@@ -2428,6 +2459,30 @@ sub dirlist {
}
}
+# --------------------------------------------- GetFileTimestamp
+# This function utilizes dirlist and returns the date stamp for
+# when it was last modified. It will also return an error of -1
+# if an error occurs
+
+sub GetFileTimestamp {
+ my ($studentDomain,$studentName,$filename,$root)=@_;
+ $studentDomain=~s/\W//g;
+ $studentName=~s/\W//g;
+ my $subdir=$studentName.'__';
+ $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
+ my $proname="$studentDomain/$subdir/$studentName";
+ $proname .= '/'.$filename;
+ my @dir = &Apache::lonnet::dirlist($proname, $studentDomain, $studentName,
+ $root);
+ my $fileStat = $dir[0];
+ my @stats = split('&', $fileStat);
+ if($stats[0] ne 'empty' && $stats[0] ne 'no_such_dir') {
+ return $stats[9];
+ } else {
+ return -1;
+ }
+}
+
# -------------------------------------------------------- Value of a Condition
sub directcondval {
@@ -2720,7 +2775,7 @@ sub metadata {
# Look at timestamp of caching
# Everything is cached by the main uri, libraries are never directly cached
#
- unless (abs($metacache{$uri.':cachedtimestamp'}-time)<600) {
+ unless (abs($metacache{$uri.':cachedtimestamp'}-time)<600 && !defined($liburi)) {
#
# Is this a recursive call for a library?
#
@@ -2743,7 +2798,7 @@ sub metadata {
my $package=$token->[2]->{'package'};
my $keyroot='';
if ($prefix) {
- $keyroot.='_'.$prefix;
+ $keyroot.=$prefix;
} else {
if (defined($token->[2]->{'part'})) {
$keyroot.='_'.$token->[2]->{'part'};
@@ -2801,12 +2856,14 @@ sub metadata {
#
# Importing a library here
#
- if (defined($depthcount)) { $depthcount++; } else
- { $depthcount=0; }
if ($depthcount<20) {
- foreach (split(/\,/,&metadata($uri,'keys',
- $parser->get_text('/import'),$unikey,
- $depthcount))) {
+ my $location=$parser->get_text('/import');
+ my $dir=$filename;
+ $dir=~s|[^/]*$||;
+ $location=&filelocation($dir,$location);
+ foreach (sort(split(/\,/,&metadata($uri,'keys',
+ $location,$unikey,
+ $depthcount+1)))) {
$metathesekeys{$_}=1;
}
}
@@ -2831,8 +2888,9 @@ sub metadata {
# the next is the end of "start tag"
}
}
- &metadata_generate_part0(\%metathesekeys,\%metacache,$uri);
$metacache{$uri.':keys'}=join(',',keys %metathesekeys);
+ &metadata_generate_part0(\%metathesekeys,\%metacache,$uri);
+ $metacache{$uri.':allpossiblekeys'}=join(',',keys %metathesekeys);
$metacache{$uri.':cachedtimestamp'}=time;
# this is the end of "was not already recently cached
}
@@ -3082,13 +3140,24 @@ sub receipt {
# ------------------------------------------------------------ Serves up a file
# returns either the contents of the file or a -1
sub getfile {
- my $file=shift;
+ my $file=shift;
+ if ($file=~/^\/*uploaded\//) { # user file
+ my $ua=new LWP::UserAgent;
+ my $request=new HTTP::Request('GET',&tokenwrapper($file));
+ my $response=$ua->request($request);
+ if ($response->is_success()) {
+ return $response->content;
+ } else {
+ return -1;
+ }
+ } else { # normal file from res space
&repcopy($file);
if (! -e $file ) { return -1; };
my $fh=Apache::File->new($file);
my $a='';
while (<$fh>) { $a .=$_; }
- return $a
+ return $a;
+ }
}
sub filelocation {
@@ -3098,6 +3167,8 @@ sub filelocation {
if ($file=~m:^/~:) { # is a contruction space reference
$location = $file;
$location =~ s:/~(.*?)/(.*):/home/$1/public_html/$2:;
+ } elsif ($file=~/^\/*uploaded/) { # is an uploaded file
+ $location=$file;
} else {
$file=~s/^$perlvar{'lonDocRoot'}//;
$file=~s:^/*res::;
@@ -3135,6 +3206,16 @@ sub declutter {
return $thisfn;
}
+# ------------------------------------------------------------- Clutter up URLs
+
+sub clutter {
+ my $thisfn='/'.&declutter(shift);
+ unless ($thisfn=~/^\/(uploaded|adm|userfiles|ext|raw|priv)\//) {
+ $thisfn='/res'.$thisfn;
+ }
+ return $thisfn;
+}
+
# -------------------------------------------------------- Escape Special Chars
sub escape {