--- loncom/lonnet/perl/lonnet.pm 2006/06/19 21:05:51 1.751 +++ loncom/lonnet/perl/lonnet.pm 2006/06/22 13:06:50 1.752 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.751 2006/06/19 21:05:51 banghart Exp $ +# $Id: lonnet.pm,v 1.752 2006/06/22 13:06:50 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -4696,6 +4696,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 +4706,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 = ''; } } }