--- loncom/lonnet/perl/lonnet.pm	2007/01/03 02:00:38	1.821
+++ loncom/lonnet/perl/lonnet.pm	2007/01/18 15:58:29	1.826
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.821 2007/01/03 02:00:38 raeburn Exp $
+# $Id: lonnet.pm,v 1.826 2007/01/18 15:58:29 www Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -1701,15 +1701,10 @@ sub removeuserfile {
         if (($fname !~ /\.meta$/) && (&is_portfolio_file($fname))) {
             my $metafile = $fname.'.meta';
             my $metaresult = &removeuserfile($docuname,$docudom,$metafile); 
-            my ($group,$file);
-            if ($fname =~ /^groups\/(\w+)\/portfolio(\/.+)$/) {
-                $group = $1;
-                $file = $2;
-            } elsif ($fname =~ /^portfolio(\/.+)$/) {
-                $file = $1;
-            }
+	    my $url = "/uploaded/$docudom/$docuname/$fname";
+            my ($file,$group) = (&parse_portfolio_url($url))[3,4];
             my $sqlresult = 
-                &update_portfolio_table($docuname,$docudom,$group.$file,
+                &update_portfolio_table($docuname,$docudom,$file,
                                         'portfolio_metadata',$group,
                                         'delete');
         }
@@ -1734,15 +1729,10 @@ sub renameuserfile {
             my $newmeta = $new.'.meta';
             my $metaresult = 
                 &renameuserfile($docuname,$docudom,$oldmeta,$newmeta);
-            my ($group,$file);
-            if ($old =~ /^groups\/(\w+)\/portfolio(\/.+)$/) {
-                $group = $1;
-                $file = $2;
-            } elsif ($old =~ /^portfolio(\/.+)$/) {
-                $file = $1;
-            }
+	    my $url = "/uploaded/$docudom/$docuname/$old";
+            my ($file,$group) = (&parse_portfolio_url($url))[3,4];
             my $sqlresult = 
-                &update_portfolio_table($docuname,$docudom,$group.$file,
+                &update_portfolio_table($docuname,$docudom,$file,
                                         'portfolio_metadata',$group,
                                         'delete');
         }
@@ -3070,7 +3060,23 @@ sub dump {
 
 sub dumpstore {
    my ($namespace,$udomain,$uname,$regexp,$range)=@_;
-   return &dump($namespace,$udomain,$uname,$regexp,$range);
+   if (!$udomain) { $udomain=$env{'user.domain'}; }
+   if (!$uname) { $uname=$env{'user.name'}; }
+   my $uhome=&homeserver($uname,$udomain);
+   if ($regexp) {
+       $regexp=&escape($regexp);
+   } else {
+       $regexp='.';
+   }
+   my $rep=&reply("dump:$udomain:$uname:$namespace:$regexp:$range",$uhome);
+   my @pairs=split(/\&/,$rep);
+   my %returnhash=();
+   foreach my $item (@pairs) {
+       my ($key,$value)=split(/=/,$item,2);
+       next if ($key =~ /^error: 2 /);
+       $returnhash{$key}=&thaw_unescape($value);
+   }
+   return %returnhash;
 }
 
 # -------------------------------------------------------------- keys interface
@@ -3104,7 +3110,7 @@ sub currentdump {
    if ($rep eq "unknown_cmd") { 
        # an old lond will not know currentdump
        # Do a dump and make it look like a currentdump
-       my @tmp = &dump($courseid,$sdom,$sname,'.');
+       my @tmp = &dumpstore($courseid,$sdom,$sname,'.');
        return if ($tmp[0] =~ /^(error:|no_such_host)/);
        my %hash = @tmp;
        @tmp=();
@@ -3129,6 +3135,8 @@ sub convert_dump_to_currentdump{
     # we might run in to problems with parameter names =~ /^v\./
     while (my ($key,$value) = each(%hash)) {
         my ($v,$symb,$param) = split(/:/,$key);
+	$symb  = &unescape($symb);
+	$param = &unescape($param);
         next if ($v eq 'version' || $symb eq 'keys');
         next if (exists($returnhash{$symb}) &&
                  exists($returnhash{$symb}->{$param}) &&
@@ -3541,12 +3549,12 @@ sub parse_portfolio_url {
 
     my ($type,$udom,$unum,$group,$file_name);
     
-    if ($url =~  m-^/*uploaded/($match_domain)/($match_username)/portfolio(/.+)$-) {
+    if ($url =~  m-^/*(?:uploaded|editupload)/($match_domain)/($match_username)/portfolio(/.+)$-) {
 	$type = 1;
         $udom = $1;
         $unum = $2;
         $file_name = $3;
-    } elsif ($url =~ m-^/*uploaded/($match_domain)/($match_courseid)/groups/([^/]+)/portfolio/(.+)$-) {
+    } elsif ($url =~ m-^/*(?:uploaded|editupload)/($match_domain)/($match_courseid)/groups/([^/]+)/portfolio/(.+)$-) {
 	$type = 2;
         $udom = $1;
         $unum = $2;
@@ -7135,6 +7143,10 @@ sub repcopy_userfile {
 	if ($lwpresp ne 'ok') {
 	    my $ua=new LWP::UserAgent;
 	    my $request=new HTTP::Request('GET',&tokenwrapper($uri));
+	    # FIXME, right reads everything into memory then writes it out
+	    # doing something like
+	    # 	    my $response=$ua->request($request,$file);
+	    # would make this write directly to disk
 	    my $response=$ua->request($request);
 	    if ($response->is_success()) {
 		$info=$response->content;
@@ -7294,6 +7306,29 @@ sub current_machine_ids {
     return @ids;
 }
 
+sub additional_machine_domains {
+    my @domains;
+    open(my $fh,"<$perlvar{'lonTabDir'}/expected_domains.tab");
+    while( my $line = <$fh>) {
+        $line =~ s/\s//g;
+        push(@domains,$line);
+    }
+    return @domains;
+}
+
+sub default_login_domain {
+    my $domain = $perlvar{'lonDefDomain'};
+    my $testdomain=(split(/\./,$ENV{'HTTP_HOST'}))[0];
+    foreach my $posdom (&current_machine_domains(),
+                        &additional_machine_domains()) {
+        if (lc($posdom) eq lc($testdomain)) {
+            $domain=$posdom;
+            last;
+        }
+    }
+    return $domain;
+}
+
 # ------------------------------------------------------------- Declutters URLs
 
 sub declutter {
@@ -7466,7 +7501,7 @@ sub get_iphost {
 	if (!exists($name_to_ip{$name})) {
 	    $ip = gethostbyname($name);
 	    if (!$ip || length($ip) ne 4) {
-		&logthis("Skipping host $id name $name no IP found\n");
+		&logthis("Skipping host $id name $name no IP found");
 		next;
 	    }
 	    $ip=inet_ntoa($ip);