--- loncom/lonnet/perl/lonnet.pm 2007/01/11 21:09:10 1.822 +++ 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.822 2007/01/11 21:09:10 albertel 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'); } @@ -3559,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; @@ -7153,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; @@ -7312,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 (¤t_machine_domains(), + &additional_machine_domains()) { + if (lc($posdom) eq lc($testdomain)) { + $domain=$posdom; + last; + } + } + return $domain; +} + # ------------------------------------------------------------- Declutters URLs sub declutter { @@ -7484,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);