--- loncom/lonnet/perl/lonnet.pm 2007/01/02 12:53:58 1.818 +++ 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.818 2007/01/02 12:53:58 raeburn Exp $ +# $Id: lonnet.pm,v 1.824 2007/01/14 02:01:16 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -1701,6 +1701,12 @@ sub removeuserfile { if (($fname !~ /\.meta$/) && (&is_portfolio_file($fname))) { my $metafile = $fname.'.meta'; my $metaresult = &removeuserfile($docuname,$docudom,$metafile); + my $url = "/uploaded/$docudom/$docuname/$fname"; + my ($file,$group) = (&parse_portfolio_url($url))[3,4]; + my $sqlresult = + &update_portfolio_table($docuname,$docudom,$file, + 'portfolio_metadata',$group, + 'delete'); } } return $result; @@ -1723,6 +1729,12 @@ sub renameuserfile { my $newmeta = $new.'.meta'; my $metaresult = &renameuserfile($docuname,$docudom,$oldmeta,$newmeta); + my $url = "/uploaded/$docudom/$docuname/$old"; + my ($file,$group) = (&parse_portfolio_url($url))[3,4]; + my $sqlresult = + &update_portfolio_table($docuname,$docudom,$file, + 'portfolio_metadata',$group, + 'delete'); } } return $result; @@ -3048,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 @@ -3082,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=(); @@ -3107,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}) && @@ -3519,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; @@ -3544,7 +3574,7 @@ sub is_portfolio_url { sub is_portfolio_file { my ($file) = @_; - if (($file =~ /^portfolio/) || ($file =~ /^groups\/\w\/portfolio/)) { + if (($file =~ /^portfolio/) || ($file =~ /^groups\/\w+\/portfolio/)) { return 1; } return; @@ -3556,7 +3586,7 @@ sub is_portfolio_file { sub customaccess { my ($priv,$uri)=@_; my ($urole,$urealm)=split(/\./,$env{'request.role'},2); - my ($udom,$ucrs,$usec)=split(/\//,$urealm); + my (undef,$udom,$ucrs,$usec)=split(/\//,$urealm); $udom = &LONCAPA::clean_domain($udom); $ucrs = &LONCAPA::clean_username($ucrs); my $access=0; @@ -4099,11 +4129,11 @@ sub log_query { # -------------------------- Update MySQL table for portfolio file sub update_portfolio_table { - my ($uname,$udom,$file_name,$query,$group) = @_; + my ($uname,$udom,$file_name,$query,$group,$action) = @_; my $homeserver = &homeserver($uname,$udom); my $queryid= - &reply("querysend:".$query.':'.&escape($uname.':'.$udom).':'. - &escape($file_name).':'.&escape($group),$homeserver); + &reply("querysend:".$query.':'.&escape($uname.':'.$udom.':'.$group). + ':'.&escape($file_name).':'.$action,$homeserver); my $reply = &get_query_reply($queryid); return $reply; } @@ -7272,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 {