--- loncom/lonnet/perl/lonnet.pm 2006/12/28 20:09:10 1.817 +++ loncom/lonnet/perl/lonnet.pm 2007/01/12 22:14:28 1.823 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.817 2006/12/28 20:09:10 raeburn Exp $ +# $Id: lonnet.pm,v 1.823 2007/01/12 22:14:28 albertel 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; @@ -4096,6 +4126,18 @@ sub log_query { return get_query_reply($queryid); } +# -------------------------- Update MySQL table for portfolio file + +sub update_portfolio_table { + my ($uname,$udom,$file_name,$query,$group,$action) = @_; + my $homeserver = &homeserver($uname,$udom); + my $queryid= + &reply("querysend:".$query.':'.&escape($uname.':'.$udom.':'.$group). + ':'.&escape($file_name).':'.$action,$homeserver); + my $reply = &get_query_reply($queryid); + return $reply; +} + # ------- Request retrieval of institutional classlists for course(s) sub fetch_enrollment_query { @@ -5259,6 +5301,15 @@ sub modify_access_controls { # remove lock my @del_lock = ($file_name."\0".'locked_access_records'); my $dellockoutcome = &del('file_permissions',\@del_lock,$domain,$user); + my ($file,$group); + if (&is_course($domain,$user)) { + ($group,$file) = split(/\//,$file_name,2); + } else { + $file = $file_name; + } + my $sqlresult = + &update_portfolio_table($user,$domain,$file,'portfolio_access', + $group); } else { $outcome = "error: could not obtain lockfile\n"; }