--- loncom/lonnet/perl/lonnet.pm	2006/06/16 22:37:35	1.749
+++ loncom/lonnet/perl/lonnet.pm	2006/06/22 14:30:14	1.755
@@ -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.755 2006/06/22 14:30:14 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -281,6 +281,18 @@ 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;
+    }
+    &logthis("accepting $result");
+    return undef;
+}
+
 # ------------------------------------------- Transfer profile into environment
 
 sub transfer_profile_to_env {
@@ -2922,23 +2934,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
@@ -4696,6 +4710,9 @@ sub get_access_controls {
 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) {
@@ -4703,9 +4720,48 @@ sub parse_access_controls {
             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);
-                $content{$entry}=$value;
+                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 = '';
             }
         }
     }
@@ -4846,12 +4902,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';
+                            }
+                        }
                     }
-                }
+                } 
             }
         } 
     }