--- loncom/lonnet/perl/lonnet.pm 2006/06/16 22:37:35 1.749 +++ loncom/lonnet/perl/lonnet.pm 2006/07/20 01:18:46 1.763 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.749 2006/06/16 22:37:35 raeburn Exp $ +# $Id: lonnet.pm,v 1.763 2006/07/20 01:18:46 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -281,6 +281,17 @@ sub critical { return $answer; } +# ------------------------------------------- check if return value is an error + +sub error { + my ($result) = @_; + if ($result =~ /^(con_lost|no_such_host|error: (\d+) (.*))/) { + if ($2 == 2) { return undef; } + return $1; + } + return undef; +} + # ------------------------------------------- Transfer profile into environment sub transfer_profile_to_env { @@ -1874,9 +1885,6 @@ sub get_course_adv_roles { (!$nothide{$username.':'.$domain})) { next; } if ($role eq 'cr') { next; } my $key=&plaintext($role); - if ($role =~ /^cr/) { - $key=(split('/',$role))[3]; - } if ($section) { $key.=' (Sec/Grp '.$section.')'; } if ($returnhash{$key}) { $returnhash{$key}.=','.$username.':'.$domain; @@ -2922,23 +2930,25 @@ sub del { # -------------------------------------------------------------- dump interface sub dump { - my ($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 (@pairs) { - my ($key,$value)=split(/=/,$_,2); - $returnhash{unescape($key)}=&thaw_unescape($value); - } - return %returnhash; + my ($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); + $key = &unescape($key); + next if ($key =~ /^error: 2 /); + $returnhash{$key}=&thaw_unescape($value); + } + return %returnhash; } # --------------------------------------------------------- dumpstore interface @@ -3264,7 +3274,7 @@ sub allowed { return 'F'; } -# bre access to group if user has rgf priv for this group and course. +# bre access to group portfolio for rgf priv in group, or mdg or vcg in course. if (($space=~/^(uploaded|editupload)$/) && ($dir[0] eq 'groups') && ($dir[2] eq 'portfolio') && ($priv eq 'bre')) { if (exists($env{'request.course.id'})) { @@ -3276,6 +3286,14 @@ sub allowed { if ($env{'user.priv.'.$env{'request.role'}.'./'.$courseprivid .'/'.$dir[1]} =~/rgf\&([^\:]*)/) { return $1; + } else { + if ($env{'request.course.sec'}) { + $courseprivid.='/'.$env{'request.course.sec'}; + } + if ($env{'user.priv.'.$env{'request.role'}.'./'. + $courseprivid} =~/(mdg|vcg)\&([^\:]*)/) { + return $2; + } } } } @@ -3344,14 +3362,6 @@ sub allowed { $thisallowed.=$1; } -# Group: uri itself is a group - my $groupuri=$uri; - $groupuri=~s/^([^\/])/\/$1/; - if ($env{'user.priv.'.$env{'request.role'}.'.'.$groupuri} - =~/\Q$priv\E\&([^\:]*)/) { - $thisallowed.=$1; - } - # URI is an uploaded document for this course, default permissions don't matter # not allowing 'edit' access (editupload) to uploaded course docs if (($priv eq 'bre') && ($uri=~m|^uploaded/|)) { @@ -4100,6 +4110,9 @@ sub devalidate_getgroups_cache { sub plaintext { my ($short,$type,$cid) = @_; + if ($short =~ /^cr/) { + return (split('/',$short))[-1]; + } if (!defined($cid)) { $cid = $env{'request.course.id'}; } @@ -4569,6 +4582,14 @@ sub is_locked { } } +sub declutter_portfile { + my ($file) = @_; + &logthis("got $file"); + $file =~ s-^(/portfolio/|portfolio/)-/-; + &logthis("ret $file"); + return $file; +} + # ------------------------------------------------------------- Mark as Read Only sub mark_as_readonly { @@ -4577,6 +4598,7 @@ sub mark_as_readonly { my ($tmp)=keys(%current_permissions); if ($tmp=~/^error:/) { undef(%current_permissions); } foreach my $file (@{$files}) { + $file = &declutter_portfile($file); push(@{$current_permissions{$file}},$what); } &put('file_permissions',\%current_permissions,$domain,$user); @@ -4693,25 +4715,6 @@ sub get_access_controls { return %access; } -sub parse_access_controls { - my ($access_item) = @_; - my %content; - my $token; - my $parser=HTML::TokeParser->new(\$access_item); - while ($token=$parser->get_token) { - if ($token->[0] eq 'S') { - my $entry=$token->[1]; - if ($entry eq 'scope') { - my $type = $token->[2]{'type'}; - } else { - my $value=$parser->get_text('/'.$entry); - $content{$entry}=$value; - } - } - } - return %content; -} - sub modify_access_controls { my ($file_name,$changes,$domain,$user)=@_; my ($outcome,$deloutcome); @@ -4817,7 +4820,7 @@ sub get_marked_as_readonly { if (ref($value) eq "ARRAY"){ foreach my $stored_what (@{$value}) { my $cmp2=$stored_what; - if (ref($stored_what eq 'ARRAY')) { + if (ref($stored_what) eq 'ARRAY') { $cmp2=join('',@{$stored_what}); } if ($cmp1 eq $cmp2) { @@ -4846,12 +4849,18 @@ sub get_marked_as_readonly_hash { if (ref($value) eq "ARRAY"){ foreach my $stored_what (@{$value}) { if (ref($stored_what) eq 'ARRAY') { - if ($stored_what eq $what) { - $readonly_files{$file_name} = 'locked'; - } elsif (!defined($what)) { - $readonly_files{$file_name} = 'locked'; + foreach my $lock_descriptor(@{$stored_what}) { + if ($lock_descriptor eq 'graded') { + $readonly_files{$file_name} = 'graded'; + } elsif ($lock_descriptor eq 'handback') { + $readonly_files{$file_name} = 'handback'; + } else { + if (!exists($readonly_files{$file_name})) { + $readonly_files{$file_name} = 'locked'; + } + } } - } + } } } } @@ -4863,6 +4872,7 @@ sub unmark_as_readonly { # unmarks $file_name (if $file_name is defined), or all files locked by $what # for portfolio submissions, $what contains [$symb,$crsid] my ($domain,$user,$what,$file_name,$group) = @_; + $file_name = &declutter_portfile($file_name); my $symb_crs = $what; if (ref($what)) { $symb_crs=join('',@$what); } my %current_permissions = &dump('file_permissions',$domain,$user,$group); @@ -4870,7 +4880,8 @@ sub unmark_as_readonly { if ($tmp=~/^error:/) { undef(%current_permissions); } my @readonly_files = &get_marked_as_readonly($domain,$user,$what,$group); foreach my $file (@readonly_files) { - if (defined($file_name) && ($file_name ne $file)) { next; } + my $clean_file = &declutter_portfile($file); + if (defined($file_name) && ($file_name ne $clean_file)) { next; } my $current_locks = $current_permissions{$file}; my @new_locks; my @del_keys; @@ -5144,6 +5155,17 @@ sub devalidatecourseresdata { &devalidate_cache_new('courseres',$hashid); } +# ------------------------------------------------------ Devalidate title cache + +sub devalidate_title_cache { + my ($url)=@_; + if (!$env{'request.course.id'}) { return; } + my $symb=&symbread($url); + if (!$symb) { return; } + my $key=$env{'request.course.id'}."\0".$symb; + &devalidate_cache_new('title',$key); +} + # --------------------------------------------------- Course Resourcedata Query sub get_courseresdata {