--- loncom/lonnet/perl/lonnet.pm 2007/01/11 21:09:10 1.822 +++ loncom/lonnet/perl/lonnet.pm 2007/01/14 02:01:16 1.824 @@ -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.824 2007/01/14 02:01:16 raeburn 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; @@ -7312,6 +7302,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 {