--- loncom/lonnet/perl/lonnet.pm	2006/06/22 13:16:09	1.753
+++ loncom/lonnet/perl/lonnet.pm	2006/07/07 21:55:23	1.761
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.753 2006/06/22 13:16:09 albertel Exp $
+# $Id: lonnet.pm,v 1.761 2006/07/07 21:55:23 raeburn 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
@@ -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,67 +4715,6 @@ sub get_access_controls {
     return %access;
 }
 
-sub parse_access_controls {
-    my ($access_item) = @_;
-    my %content;
-    my $role_id;
-    my $user;
-    my $usercount;
-    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'};
-                if (($type eq 'course') || ($type eq 'group')) {
-                    $content{'roles'} = {};
-                }
-            } elsif ($entry eq 'roles') {
-                $role_id = $token->[2]{id};
-		$content{$entry}{$role_id}} = {
-		                                 role => [],
-                                                 access => [],
-                                                 section => [],
-                                                 group => [],
-                                                };
-            } elsif ($entry eq 'users') {
-                $content{'users'} = {};
-                $usercount = 0;
-            } elsif ($entry eq 'user') {
-                $user = '';
-            } else {
-                my $value=$parser->get_text('/'.$entry);
-                if ($entry eq 'uname') {
-                    $user = $value;
-                } elsif ($entry eq 'udom') {
-                    $user .= ':'.$value;
-                    $content{'users'}{$user} = $usercount;
-                } elsif ($entry eq 'role' ||
-                    $entry eq 'access' ||
-                    $entry eq 'section' ||
-                    $entry eq 'group') {
-                    if ($role_id ne '') {
-                        push(@{$content{'roles'}{$role_id}{$entry}},$value);
-                    }
-                } elsif ($entry eq 'dom') {
-                    push(@{$content{$entry}},$value);
-                } else {
-                    $content{$entry}=$value;
-                }
-            }
-        } elsif ($token->[0] eq 'E') {
-            if ($token->[1] eq 'user') {
-                $user = '';
-                $usercount ++;
-            } elsif ($token->[1] eq 'roles') {
-                $role_id = '';
-            }
-        }
-    }
-    return %content;
-}
-
 sub modify_access_controls {
     my ($file_name,$changes,$domain,$user)=@_;
     my ($outcome,$deloutcome);
@@ -4859,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) {
@@ -4911,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);
@@ -4918,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;