[LON-CAPA-cvs] cvs: loncom /lonnet/perl lonnet.pm

[banghart]

banghart		Thu Mar 17 14:40:51 2005 EDT

  Modified files:              
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  	Teach a number of subs about editupload, to permit editing
  	portfolio meta files.
  
  
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.608 loncom/lonnet/perl/lonnet.pm:1.609
--- loncom/lonnet/perl/lonnet.pm:1.608	Wed Mar 16 18:04:16 2005
+++ loncom/lonnet/perl/lonnet.pm	Thu Mar 17 14:40:50 2005
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.608 2005/03/16 23:04:16 albertel Exp $
+# $Id: lonnet.pm,v 1.609 2005/03/17 19:40:50 banghart Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -997,7 +997,7 @@
     if ($filename=~m|^/home/httpd/html/adm/|) { return 'ok'; }
     if ($filename=~m|^/home/httpd/html/lonUsers/|) { return 'ok'; }
     if ($filename=~m|^/home/httpd/html/userfiles/| or
-	$filename=~m|^/*uploaded/|) { 
+	$filename=~m -^/*(uploaded|editupload)/-) { 
 	return &repcopy_userfile($filename);
     }
     $filename=~s/[\n\r]//g;
@@ -4446,7 +4446,7 @@
         my %metathesekeys=();
         unless ($filename=~/\.meta$/) { $filename.='.meta'; }
 	my $metastring;
-	if ($uri !~ m|^uploaded/|) {
+	if ($uri !~ m -^(uploaded|editupload)/-) {
 	    my $file=&filelocation('',&clutter($filename));
 	    #push(@{$metaentry{$uri.'.file'}},$file);
 	    $metastring=&getfile($file);
@@ -4789,7 +4789,7 @@
 
 sub fixversion {
     my $fn=shift;
-    if ($fn=~/^(adm|uploaded|public)/) { return $fn; }
+    if ($fn=~/^(adm|uploaded|editupload|public)/) { return $fn; }
     my %bighash;
     my $uri=&clutter($fn);
     my $key=$ENV{'request.course.id'}.'_'.$uri;
@@ -4843,7 +4843,7 @@
     my $syval='';
     if (($ENV{'request.course.fn'}) && ($thisfn)) {
         my $targetfn = $thisfn;
-        if ( ($thisfn =~ m/^uploaded\//) && ($thisfn !~ m/\.(page|sequence)$/) ) {
+        if ( ($thisfn =~ m/^(uploaded|editupload)\//) && ($thisfn !~ m/\.(page|sequence)$/) ) {
             $targetfn = 'adm/wrapper/'.$thisfn;
         }
         if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'_symb.db',
@@ -5251,16 +5251,15 @@
 
 sub getfile {
     my ($file) = @_;
-
-    if ($file =~ m|^/*uploaded/|) { $file=&filelocation("",$file); }
+    if ($file =~ m -^/*(uploaded|editupload)/-) { $file=&filelocation("",$file); }
     &repcopy($file);
     return &readfile($file);
 }
 
 sub repcopy_userfile {
     my ($file)=@_;
-    if ($file =~ m|^/*uploaded/|) { $file=&filelocation("",$file); }
-    if ($file =~ m|^/home/httpd/html/lonUsers/|) { return 'ok'; }
+    if ($file =~ m -^/*(uploaded|editupload)/-) { $file=&filelocation("",$file); }
+    if ($file =~ m|^/home/httpd/html/lonUsers/|) { return 'OK'; }
     my ($cdom,$cnum,$filename) = 
 	($file=~m|^\Q$perlvar{'lonDocRoot'}\E/+userfiles/+([^/]+)/+([^/]+)/+(.*)|);
     my ($info,$rtncode);
@@ -5374,9 +5373,9 @@
     if ($file=~m:^/~:) { # is a contruction space reference
         $location = $file;
         $location =~ s:/~(.*?)/(.*):/home/$1/public_html/$2:;
-    } elsif ($file=~/^\/*uploaded/) { # is an uploaded file
+    } elsif ($file=~/^\/*(uploaded|editupload)/) { # is an uploaded file
         my ($udom,$uname,$filename)=
-  	    ($file=~m|^/+uploaded/+([^/]+)/+([^/]+)/+(.*)$|);
+  	    ($file=~m -^/+(?:uploaded|editupload)/+([^/]+)/+([^/]+)/+(.*)$-);
         my $home=&homeserver($uname,$udom);
         my $is_me=0;
         my @ids=&current_machine_ids();
@@ -5458,7 +5457,7 @@
 
 sub clutter {
     my $thisfn='/'.&declutter(shift);
-    unless ($thisfn=~/^\/(uploaded|adm|userfiles|ext|raw|priv|public)\//) { 
+    unless ($thisfn=~/^\/(uploaded|editupload|adm|userfiles|ext|raw|priv|public)\//) { 
        $thisfn='/res'.$thisfn; 
     }
     return $thisfn;