Annotation of loncom/interface/longroup.pm, revision 1.1
1.1 ! raeburn 1: # The LearningOnline Network with CAPA
! 2: # accessor routines used to provide information about course groups
! 3: #
! 4: # Copyright Michigan State University Board of Trustees
! 5: #
! 6: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
! 7: #
! 8: # LON-CAPA is free software; you can redistribute it and/or modify
! 9: # it under the terms of the GNU General Public License as published by
! 10: # the Free Software Foundation; either version 2 of the License, or
! 11: # (at your option) any later version.
! 12: #
! 13: # LON-CAPA is distributed in the hope that it will be useful,
! 14: # but WITHOUT ANY WARRANTY; without even the implied warranty of
! 15: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! 16: # GNU General Public License for more details.
! 17: #
! 18: # You should have received a copy of the GNU General Public License
! 19: # along with LON-CAPA; if not, write to the Free Software
! 20: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
! 21: #
! 22: # /home/httpd/html/adm/gpl.txt
! 23: #
! 24: # http://www.lon-capa.org/
! 25: #
! 26:
! 27: package Apache::longroup;
! 28:
! 29: use strict;
! 30: use Apache::lonnet;
! 31:
! 32: ###############################################
! 33: =pod
! 34:
! 35: =item coursegroups
! 36:
! 37: Retrieve information about groups in a course,
! 38:
! 39: Input:
! 40: 1. Optional course domain
! 41: 2. Optional course number
! 42: 3. Optional group name
! 43:
! 44: Course domain and number will be taken from user's
! 45: environment if not supplied. Optional group name will
! 46: be passed to lonnet::get_coursegroups() as a regexp to
! 47: use in the call to the dump function.
! 48:
! 49: Output
! 50: Returns hash of groups in the course (subject to the
! 51: optional group name filter). In the hash, the keys are
! 52: group names, and their corresponding values
! 53: are scalars containing group information in XML. This
! 54: can be sent to &get_group_settings() to be parsed.
! 55:
! 56: Side effects:
! 57: None.
! 58: =cut
! 59:
! 60: ###############################################
! 61:
! 62: sub coursegroups {
! 63: my ($cdom,$cnum,$group) = @_;
! 64: if (!defined($cdom) || !defined($cnum)) {
! 65: my $cid = $env{'request.course.id'};
! 66:
! 67: return if (!defined($cid));
! 68:
! 69: $cdom = $env{'course.'.$cid.'.domain'};
! 70: $cnum = $env{'course.'.$cid.'.num'};
! 71: }
! 72: my %curr_groups = &Apache::lonnet::get_coursegroups($cdom,$cnum,$group);
! 73: my ($tmp) = keys(%curr_groups);
! 74: if ($tmp=~/^(con_lost|no_such_host|error: [^2] )/) {
! 75: undef(%curr_groups);
! 76: &logthis('Error retrieving groups: '.$tmp.' in '.$cnum.':'.$cdom);
! 77: } elsif ($tmp=~/^error: 2 /) {
! 78: undef(%curr_groups);
! 79: }
! 80: return %curr_groups;
! 81: }
! 82:
! 83: ###############################################
! 84:
! 85: =item get_group_settings
! 86:
! 87: Uses TokeParser to extract group information from the
! 88: XML used to describe course groups.
! 89:
! 90: Input:
! 91: Scalar containing XML - as retrieved from &coursegroups().
! 92:
! 93: Output:
! 94: Hash containing group information as key=values for (a), and
! 95: hash of hashes for (b)
! 96:
! 97: Keys (in two categories):
! 98: (a) groupname, creator, creation, modified, startdate,enddate.
! 99: Corresponding values are name of the group, creator of the group
! 100: (username:domain), UNIX time for date group was created, and
! 101: settings were last modified, and default start and end access
! 102: times for group members.
! 103:
! 104: (b) functions returned in hash of hashes.
! 105: Outer hash key is functions.
! 106: Inner hash keys are chat,discussion,email,files,homepage,roster.
! 107: Corresponding values are either on or off, depending on
! 108: whether this type of functionality is available for the group.
! 109:
! 110: =cut
! 111:
! 112: ###############################################
! 113:
! 114: sub get_group_settings {
! 115: my ($groupinfo)=@_;
! 116: my $parser=HTML::TokeParser->new(\$groupinfo);
! 117: my $token;
! 118: my $tool = '';
! 119: my $role = '';
! 120: my %content=();
! 121: while ($token=$parser->get_token) {
! 122: if ($token->[0] eq 'S') {
! 123: my $entry=$token->[1];
! 124: if ($entry eq 'functions' || $entry eq 'autosec') {
! 125: %{$content{$entry}} = ();
! 126: $tool = $entry;
! 127: } elsif ($entry eq 'role') {
! 128: if ($tool eq 'autosec') {
! 129: $role = $token->[2]{id};
! 130: @{$content{$tool}{$role}} = ();
! 131: }
! 132: } else {
! 133: my $value=$parser->get_text('/'.$entry);
! 134: if ($entry eq 'name') {
! 135: if ($tool eq 'functions') {
! 136: my $function = $token->[2]{id};
! 137: $content{$tool}{$function} = $value;
! 138: }
! 139: } elsif ($entry eq 'groupname') {
! 140: $content{$entry}=&unescape($value);
! 141: } elsif (($entry eq 'roles') || ($entry eq 'types') ||
! 142: ($entry eq 'sectionpick') || ($entry eq 'defpriv')) {
! 143: push(@{$content{$entry}},$value);
! 144: } elsif ($entry eq 'section') {
! 145: if ($tool eq 'autosec' && $role ne '') {
! 146: push(@{$content{$tool}{$role}},$value);
! 147: }
! 148: } else {
! 149: $content{$entry}=$value;
! 150: }
! 151: }
! 152: } elsif ($token->[0] eq 'E') {
! 153: if ($token->[1] eq 'functions' || $token->[1] eq 'autosec') {
! 154: $tool = '';
! 155: } elsif ($token->[1] eq 'role') {
! 156: $role = '';
! 157: }
! 158:
! 159: }
! 160: }
! 161: return %content;
! 162: }
! 163:
! 164: ###############################################
! 165:
! 166: sub check_group_access {
! 167: my ($group) = @_;
! 168: my $access = 1;
! 169: my $now = time;
! 170: my ($start,$end) = split(/\./,$env{'user.role.gr/'.$env{'request.course,id'}.'/'.$group});
! 171: if (($end!=0) && ($end<$now)) { $access = 0; }
! 172: if (($start!=0) && ($start>$now)) { $access=0; }
! 173: return $access;
! 174: }
! 175:
! 176: ###############################################
! 177:
! 178: =pod
! 179:
! 180: =item group_changes
! 181:
! 182: Add or drop group memberships in a course as a result of
! 183: changes in a user's roles/sections. Called by
! 184: &Apache::lonnet:assignrole()
! 185:
! 186: Input:
! 187: 1. User's domain
! 188: 2. User's username
! 189: 3. Url of role
! 190: 4. Role
! 191: 5. End date of role
! 192: 6. Start date of role
! 193:
! 194: Checks to see if role for which assignment is being made is in a course.
! 195: If so, gathers information about auto-group population settings for
! 196: groups in the course.
! 197:
! 198: If role is being expired, will also expire any group memberships that
! 199: are specified for auto-group population for the specific role and
! 200: section (including section 'none' and 'all' sections), unless a
! 201: different role/section also included in auto-group population
! 202: for the course is included amongst the user's unexpired roles
! 203: and would trigger membership in teh same group(s)
! 204:
! 205: If role is being added, will add any group memberships specified
! 206: for auto-group population, unless use is already a group member.
! 207: Uses default group privileges and default start and end group access
! 208: times.
! 209:
! 210: Output
! 211: None
! 212:
! 213: Side effects:
! 214: May result in calls to Apache::lonnet::modify_group_roles()
! 215: and Apache::lonnet::modify_coursegroup_membership() to add
! 216: or expire group membership(s) for a user.
! 217:
! 218: =cut
! 219:
! 220: sub group_changes {
! 221: my ($udom,$uname,$url,$role,$origend,$origstart) = @_;
! 222: my $now = time;
! 223: my $chgtype;
! 224: if ($origend > 0 && $origend <= $now) {
! 225: $chgtype = 'drop';
! 226: } else {
! 227: $chgtype = 'add';
! 228: }
! 229: my ($cid,$cdom,$cnum,$sec);
! 230: if ($url =~ m-^(/[^/]+/[^/]+)/([^/]+)$-) {
! 231: $cid = $1;
! 232: $sec = $2;
! 233: } else {
! 234: $cid = $url;
! 235: }
! 236: my $courseid = $cid;
! 237: $courseid =~ s|^/||;
! 238: $courseid =~ s|/|_|;
! 239: my %crshash=&Apache::lonnet::coursedescription($cid);
! 240: $cdom = $crshash{'domain'};
! 241: $cnum = $crshash{'num'};
! 242: if (defined($cdom) && defined($cnum)) {
! 243: my %settings;
! 244: my @changegroups = ();
! 245: my %dropgroup = ();
! 246: my %dropstart = ();
! 247: my %addgroup = ();
! 248: my %curr_groups = &coursegroups($cdom,$cnum);
! 249: if (%curr_groups) {
! 250: foreach my $group (keys(%curr_groups)) {
! 251: %{$settings{$group}}=&get_group_settings($curr_groups{$group});
! 252: if ($chgtype eq 'add') {
! 253: if (!($settings{$group}{autoadd} eq 'on')) {
! 254: next;
! 255: }
! 256: } else {
! 257: if (!($settings{$group}{autodrop} eq 'on')) {
! 258: next;
! 259: }
! 260: }
! 261: my @autosec = ();
! 262: if (ref($settings{$group}{'autosec'}{$role}) eq 'ARRAY') {
! 263: @autosec = @{$settings{$group}{'autosec'}{$role}};
! 264: }
! 265: if ($sec eq '') {
! 266: $sec = 'none';
! 267: }
! 268: if ((grep(/^$sec$/,@autosec)) || (grep(/^all$/,@autosec))) {
! 269: push(@changegroups,$group);
! 270: }
! 271: }
! 272: }
! 273: if (@changegroups > 0) {
! 274: my %currpriv;
! 275: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname,$cid);
! 276: my ($tmp) = keys(%roleshash);
! 277: if ($tmp=~/^error:/) {
! 278: &Apache::lonnet::logthis('Error retrieving roles: '.$tmp.
! 279: ' for '.$uname.':'.$udom);
! 280: } else {
! 281: my $group_privs = '';
! 282: foreach my $group (@changegroups) {
! 283: if ($chgtype eq 'add') {
! 284: if (ref($settings{$group}{'defpriv'}) eq 'ARRAY') {
! 285: $group_privs =
! 286: join(':',@{$settings{$group}{'defpriv'}});
! 287: }
! 288: }
! 289: my $key = $cid.'/'.$group.'_gr';
! 290: if (defined($roleshash{$key})) {
! 291: if ($roleshash{$key}=~ /^gr\/([^_]*)_(\d+)_([\-\d]+)$/) {
! 292: my $grpstart = $3;
! 293: my $grpend = $2;
! 294: $currpriv{$group} = $1;
! 295: if ($chgtype eq 'drop') {
! 296: if ($grpstart == -1) { next; } # deleted
! 297: if ($grpend == 0 || $grpend > $now) {
! 298: unless (defined($dropgroup{$group})) {
! 299: $dropstart{$group} = $grpstart;
! 300: if ($grpstart > $now) {
! 301: $dropstart{$group} = $now;
! 302: }
! 303: $dropgroup{$group} = $now.':'.
! 304: $dropstart{$group}.
! 305: ':'.$currpriv{$group};
! 306: }
! 307: }
! 308: } elsif ($chgtype eq 'add') {
! 309: if (($grpstart == -1) || ($grpend > 0 &&
! 310: ($grpend < $settings{$group}{'enddate'} ||
! 311: $settings{$group}{'enddate'} == 0)) ||
! 312: ($grpstart > $settings{$group}{'startdate'})) {
! 313: unless(defined($addgroup{$group})) {
! 314: $addgroup{$group} =
! 315: $settings{$group}{'enddate'}.':'.
! 316: $settings{$group}{'startdate'}.':'.
! 317: $group_privs;
! 318: }
! 319: }
! 320: }
! 321: }
! 322: } elsif ($chgtype eq 'add') {
! 323: $addgroup{$group} = $settings{$group}{'enddate'}.':'.
! 324: $settings{$group}{'startdate'}.':'.
! 325: $group_privs;
! 326: }
! 327: }
! 328: if ($chgtype eq 'add') {
! 329: foreach my $add (keys(%addgroup)) {
! 330: if (&Apache::lonnet::modify_group_roles($cdom,$cnum,
! 331: $add,$uname.':'.$udom,
! 332: $settings{$add}{'enddate'},
! 333: $settings{$add}{'startdate'},
! 334: $group_privs) eq 'ok') {
! 335: my %usersettings;
! 336: $usersettings{$add.':'.$uname.':'.$udom} =
! 337: $addgroup{$add};
! 338: my $roster_result =
! 339: &Apache::lonnet::modify_coursegroup_membership(
! 340: $cdom,$cnum,\%usersettings);
! 341: }
! 342: }
! 343: } elsif ($chgtype eq 'drop') {
! 344: foreach my $drop (keys(%dropgroup)) {
! 345: my $nodrop = 0;
! 346: if ($settings{$drop}{'autoadd'} eq 'on') {
! 347: foreach my $urole (keys(%{$settings{$drop}{'autosec'}})) {
! 348: if ($nodrop) {
! 349: last;
! 350: } else {
! 351: my @autosec = ();
! 352: if (ref($settings{$drop}{'autosec'}{$urole}) eq 'ARRAY') {
! 353: @autosec = @{$settings{$drop}{'autosec'}{$urole}};
! 354: }
! 355: foreach my $usec (@autosec) {
! 356: if ($usec eq 'all') {
! 357: foreach my $ukey (keys(%roleshash)) {
! 358: if ($ukey =~ /^\Q$cid\E(\/?\w*)_($urole)$/) {
! 359: unless ($sec eq $1) {
! 360: if ($roleshash{$ukey} =~ /_?(\d*)_?([\-\d]*)$/) {
! 361: my $roleend = $1;
! 362: if ((!$roleend) ||
! 363: ($roleend > $now)) {
! 364: $nodrop = 1;
! 365: last;
! 366: }
! 367: }
! 368: }
! 369: }
! 370: }
! 371: } else {
! 372: my $ukey = $cid.'/'.$usec.'_'.$urole;
! 373: if ($usec eq 'none') {
! 374: if ($sec eq '') {
! 375: next;
! 376: }
! 377: } else {
! 378: if ($usec eq $sec) {
! 379: next;
! 380: }
! 381: }
! 382: if (exists($roleshash{$ukey})) {
! 383: if ($roleshash{$ukey} =~
! 384: /_?(\d*)_?([\-\d]*)$/) {
! 385: my $roleend = $1;
! 386: if ((!$roleend) ||
! 387: ($roleend > $now)) {
! 388: $nodrop = 1;
! 389: last;
! 390: }
! 391: }
! 392: }
! 393: }
! 394: }
! 395: }
! 396: }
! 397: }
! 398: if (!$nodrop) {
! 399: if (&Apache::lonnet::modify_group_roles($cdom,
! 400: $cnum,$drop,
! 401: $uname.':'.$udom,$now,
! 402: $dropstart{$drop},
! 403: $currpriv{$drop})
! 404: eq 'ok') {
! 405: my %usersettings;
! 406: $usersettings{$drop.':'.$uname.':'.$udom} =
! 407: $dropgroup{$drop};
! 408: my $roster_result =
! 409: &Apache::lonnet::modify_coursegroup_membership(
! 410: $cdom,$cnum,\%usersettings);
! 411: }
! 412: }
! 413: }
! 414: }
! 415: }
! 416: }
! 417: }
! 418: return;
! 419: }
! 420:
! 421: ###############################################
! 422:
! 423: 1;
! 424:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to longroup.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface