--- loncom/lonnet/perl/lonnet.pm	2004/03/30 20:46:24	1.480
+++ loncom/lonnet/perl/lonnet.pm	2004/03/31 19:25:08	1.481
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.480 2004/03/30 20:46:24 www Exp $
+# $Id: lonnet.pm,v 1.481 2004/03/31 19:25:08 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -32,6 +32,7 @@ package Apache::lonnet;
 use strict;
 use LWP::UserAgent();
 use HTTP::Headers;
+use Date::Parse;
 use vars 
 qw(%perlvar %hostname %homecache %badServerCache %hostip %iphost %spareid %hostdom 
    %libserv %pr %prp %metacache %packagetab %titlecache %courseresversioncache %resversioncache
@@ -1200,6 +1201,12 @@ sub tokenwrapper {
 #         and will then be copied to
 #          /home/httpd/lonUsers/$domain/1/2/3/$course/userfiles/$file in
 #         course's home server.
+# action = uploaddoc - /home/httpd/html/userfiles/$domain/1/2/3/$course/$file
+#         will be retrived from $ENV{form.$source} via DOCS interface to
+#         /home/httpd/html/userfiles/$domain/1/2/3/$course/$file
+#         and will then be copied to /home/httpd/lonUsers/1/2/3/$course/userfiles/$file
+#         in course's home server.
+
 
 sub process_coursefile {
     my ($action,$docuname,$docudom,$docuhome,$file,$source)=@_;
@@ -1207,7 +1214,7 @@ sub process_coursefile {
     if ($action eq 'propagate') {
         $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file
                             ,$docuhome);
-    } elsif ($action eq 'copy') {
+    } else {
         my $fetchresult = '';
         my $fpath = '';
         my $fname = $file;
@@ -1223,14 +1230,29 @@ sub process_coursefile {
                 }
             }
         }
-        if ($source eq '') {
-            $fetchresult = 'no source file';
-        } else {
-            my $destination = $filepath.'/'.$fname;
-            print STDERR "Getting ready to rename $source to $destination\n";
-            rename($source,$destination);
+        if ($action eq 'copy') {
+            if ($source eq '') {
+                $fetchresult = 'no source file';
+                return $fetchresult;
+            } else {
+                my $destination = $filepath.'/'.$fname;
+                rename($source,$destination);
+                $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file,
+                                 $docuhome);
+            }
+        } elsif ($action eq 'uploaddoc') {
+            open(my $fh,'>'.$filepath.'/'.$fname);
+            print $fh $ENV{'form.'.$source};
+            close($fh);
             $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file,
                                  $docuhome);
+            if ($fetchresult eq 'ok') {
+                return '/uploaded/'.$fpath.'/'.$fname;
+            } else {
+                &logthis('Failed to transfer '.$docudom.'/'.$docuname.'/'.$file.
+                        ' to host '.$docuhome.': '.$fetchresult);
+                return '/adm/notfound.html';
+            }
         }
     }
     unless ( ($fetchresult eq 'ok') || ($fetchresult eq 'no source file') ) {
@@ -1258,6 +1280,7 @@ sub userfileupload {
 # See if there is anything left
     unless ($fname) { return 'error: no uploaded file'; }
     chop($ENV{'form.'.$formname});
+    my $url = '';
 # Create the directory if not present
     my $docuname='';
     my $docudom='';
@@ -1266,6 +1289,12 @@ sub userfileupload {
 	$docuname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};
 	$docudom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
 	$docuhome=$ENV{'course.'.$ENV{'request.course.id'}.'.home'};
+        if ($ENV{'form.folder'} =~ m/^default/) {
+            $url = &finishuserfileupload($docuname,$docudom,$docuhome,$formname,$fname);
+        } else {
+            $fname=$ENV{'form.folder'}.'/'.$fname;
+            $url = &process_coursefile('uploaddoc',$docuname,$docudom,$docuhome,$fname,$formname);
+        }
     } else {
         $docuname=$ENV{'user.name'};
         $docudom=$ENV{'user.domain'};
@@ -4267,9 +4296,13 @@ sub symbread {
     my %bighash;
     my $syval='';
     if (($ENV{'request.course.fn'}) && ($thisfn)) {
+        my $targetfn = $thisfn;
+        if ( ($thisfn =~ m/^uploaded\//) && ($thisfn !~ m/\.(page|sequence)$/) ) {
+            $targetfn = 'adm/wrapper/'.$thisfn;
+        }
         if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'_symb.db',
                       &GDBM_READER(),0640)) {
-	    $syval=$hash{$thisfn};
+	    $syval=$hash{$targetfn};
             untie(%hash);
         }
 # ---------------------------------------------------------- There was an entry
@@ -4321,7 +4354,7 @@ sub symbread {
                  }
 	      }
               untie(%bighash)
-           } 
+           }
         }
         if ($syval) {
            return &symbclean($syval.'___'.$thisfn); 
@@ -4524,39 +4557,112 @@ sub receipt {
 # ------------------------------------------------------------ Serves up a file
 # returns either the contents of the file or 
 # -1 if the file doesn't exist
-# -2 if an error occured when trying to aqcuire the file
+#
+# if the target is a file that was uploaded via DOCS, 
+# a check will be made to see if a current copy exists on the local server,
+# if it does this will be served, otherwise a copy will be retrieved from
+# the home server for the course and stored in /home/httpd/html/userfiles on
+# the local server.   
 
 sub getfile {
-    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 { 
-	    #&logthis("Return Code is ".$response->code." for $file ".
-	    #         &tokenwrapper($file));
-	    # 500 for ISE when tokenwrapper can't figure out what server to
-            #  contact
-            # 503 when lonuploadacc can't contact the requested server
-	    if ($response->code eq 503 || $response->code eq 500) {
-		return -2;
-	    } else {
-		return -1;
-	    }
-	}
+    my ($file,$caller) = @_;
+    if ($file=~ m|^/*uploaded/(\w+)/(\w+)/(.+)$|) { # user file
+        my $info;
+        my $cdom = $1;
+        my $cnum = $2;
+        my $filename = $3;
+        my $path = $Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles';
+        my ($lwpresp,$rtncode);
+        my $localfile = $path.'/'.$cdom.'/'.$cnum.'/'.$filename;
+        if (-e "$localfile") {
+            my @fileinfo = stat($localfile);
+            $lwpresp = &getuploaded('HEAD',$file,$cdom,$cnum,\$info,\$rtncode);
+            if ($lwpresp eq 'ok') {
+                if ($info > $fileinfo[9]) {
+                    $info = '';
+                    $lwpresp = &getuploaded('GET',$file,$cdom,$cnum,\$info,\$rtncode);
+                    if ($lwpresp eq 'ok') {
+                        open (FILE,">$localfile");
+                        print FILE $info;
+                        close(FILE);
+                        if ($caller eq 'uploadrep') {
+                            return 'ok';
+                        } else {
+                            return $info;
+                        }
+                    } else {
+                        return -1;
+                    }
+	        } else {
+                    return &readfile($localfile);
+                }
+            } else {
+                if ($rtncode eq '404') {
+                    unlink($localfile);
+                }
+                return -1;
+            }
+	} else {
+            $lwpresp = &getuploaded('GET',$file,$cdom,$cnum,\$info,\$rtncode);
+            if ($lwpresp eq 'ok') {
+                my @parts = ($cdom,$cnum); 
+                if ($filename =~ m|^(.+)/[^/]+$|) {
+                    push @parts, split(/\//,$1);
+                }
+                foreach my $part (@parts) {
+                    $path .= '/'.$part;
+                    if (!-e $path) {
+                        mkdir($path,0770);
+                    }
+                }
+                open (FILE,">$localfile");
+                print FILE $info;
+                close(FILE);
+                if ($caller eq 'uploadrep') {
+                    return 'ok';
+                } else {
+                    return $info;
+                }
+            } else {
+                return -1;
+            }
+        }
     } else { # normal file from res space
 	&repcopy($file);
-	if (! -e $file ) { return -1; };
-	my $fh;
-	open($fh,"<$file");
-	my $a='';
-	while (<$fh>) { $a .=$_; }
-	return $a;
+        return &readfile($file);
     }
 }
 
+sub getuploaded {
+    my ($reqtype,$uri,$cdom,$cnum,$info,$rtncode) = @_;
+    $uri=~s/^\///;
+    $uri = 'http://'.$hostname{ &homeserver($cnum,$cdom)}.'/raw/'.$uri;
+    my $ua=new LWP::UserAgent;
+    my $request=new HTTP::Request($reqtype,$uri);
+    my $response=$ua->request($request);
+    $$rtncode = $response->code;
+    if ($response->is_success()) {
+        if ($reqtype eq 'HEAD') {
+            $$info = &Date::Parse::str2time( $response->header('Last-modified') );
+        } elsif ($reqtype eq 'GET') {
+            $$info = $response->content;
+        }
+        return 'ok';
+    } else {
+        return 'failed';
+    }
+}
+
+sub readfile {
+    my $file = shift;
+    if ( (! -e $file ) || ($file eq '') ) { return -1; };
+    my $fh;
+    open($fh,"<$file");
+    my $a='';
+    while (<$fh>) { $a .=$_; }
+    return $a;
+}
+
 sub filelocation {
   my ($dir,$file) = @_;
   my $location;
@@ -5560,8 +5666,29 @@ messages of critical importance should g
 
 =item *
 
-getfile($file) : returns the entire contents of a file or -1; it
-properly subscribes to and replicates the file if neccessary.
+getfile($file,$caller) : two cases - requests for files in /res or in /uploaded.
+(a) files in /uploaded
+  (i) If a local copy of the file exists - 
+      compares modification date of local copy with last-modified date for 
+      definitive version stored on home server for course. If local copy is 
+      stale, requests a new version from the home server and stores it. 
+      If the original has been removed from the home server, then local copy 
+      is unlinked.
+  (ii) If local copy does not exist -
+      requests the file from the home server and stores it. 
+  
+  If $caller is 'uploadrep':  
+    This indicates a call from lonuploadrep.pm (PerlHeaderParserHandler phase)
+    for request for files originally uploaded via DOCS. 
+     - returns 'ok' if fresh local copy now available, -1 otherwise.
+  
+  Otherwise:
+     This indicates a call from the content generation phase of the request.
+     -  returns the entire contents of the file or -1.
+     
+(b) files in /res
+   - returns the entire contents of a file or -1; 
+   it properly subscribes to and replicates the file if neccessary.
 
 =item *