| $upperleft | $messages | @@ -3080,6 +3089,138 @@ sub get_sections { } ############################################### + +=pod + +=item coursegroups + +Retrieve information about groups in a course, + +Input: +1. Reference to hash to populate with group information. +2. Optional course domain +3. Optional course number +4. Optional group name + +Course domain and number will be taken from user's +environment if not supplied. Optional group name will' +be passed to lonnet::get_coursegroups() as a regexp to +use in the call to the dump function. + +Output +Returns number of groups in the course (subject to the +optional group name filter). + +Side effects: +Populates the referenced curr_groups hash, with key, +value pairs. Keys are group names, corresponding values +are scalars containing group information in XML. This +can be sent to &get_group_settings() to be parsed. + +=cut + +############################################### + +sub coursegroups { + my ($curr_groups,$cdom,$cnum,$group) = @_; + my $numgroups; + if (!defined($cdom) || !defined($cnum)) { + my $cid = $env{'request.course.id'}; + $cdom = $env{'course.'.$cid.'.domain'}; + $cnum = $env{'course.'.$cid.'.num'}; + } + %{$curr_groups} = &Apache::lonnet::get_coursegroups($cdom,$cnum,$group); + my ($tmp) = keys(%{$curr_groups}); + if ($tmp=~/^error:/) { + unless ($tmp eq 'error: 2 tie(GDBM) Failed while attempting dump') { + &logthis('Error retrieving groups: '.$tmp.' in '.$cnum.':'. + $cdom); + } + $numgroups = 0; + } else { + $numgroups = keys(%{$curr_groups}); + } + return $numgroups; +} + +############################################### + +=pod + +=item get_group_settings + +Uses TokeParser to extract group information from the +XML used to describe course groups. + +Input: +Scalar containing XML - as retrieved from &coursegroups(). + +Output: +Hash containing group information as key=values for (a), and +hash of hashes for (b) + +Keys (in two categories): +(a) groupname, creator, creation, modified, startdate,enddate. +Corresponding values are name of the group, creator of the group +(username:domain), UNIX time for date group was created, and +settings were last modified, and default start and end access +times for group members. + +(b) functions returned in hash of hashes. +Outer hash key is functions. +Inner hash keys are chat,discussion,email,files,homepage,roster. +Corresponding values are either on or off, depending on +whther this type of functionality is available for the group. + +=cut + +############################################### + +sub get_group_settings { + my ($groupinfo)=@_; + my $parser=HTML::TokeParser->new(\$groupinfo); + my $token; + my $tool = ''; + my %content=(); + while ($token=$parser->get_token) { + if ($token->[0] eq 'S') { + my $entry=$token->[1]; + if ($entry eq 'functions') { + %{$content{$entry}} = (); + $tool = $entry; + } else { + my $value=$parser->get_text('/'.$entry); + if ($entry eq 'name') { + if ($tool eq 'functions') { + my $function = $token->[2]{id}; + $content{$tool}{$function} = $value; + } + } elsif ($entry eq 'groupname') { + $content{$entry}=&Apache::lonnet::unescape($value); + } else { + $content{$entry}=$value; + } + } + } elsif ($token->[0] eq 'E') { + if ($token->[1] eq 'functions') { + $tool = ''; + } + } + } + return %content; +} + +sub check_group_access { + my ($group) = @_; + my $access = 1; + my $now = time; + my ($start,$end) = split(/\./,$env{'user.role.gr/'.$env{'request.course,id'}.'/'.$group}); + if (($end!=0) && ($end<$now)) { $access = 0; } + if (($start!=0) && ($start>$now)) { $access=0; } + return $access; +} + +############################################### =pod @@ -3123,17 +3264,16 @@ sub get_course_users { $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME(); $idx{status} = &Apache::loncoursedata::CL_STATUS(); - if (grep/^st$/,@{$roles}) { + if (grep(/^st$/,@{$roles})) { my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum); my $now = time; foreach my $student (keys(%{$classlist})) { my $match = 0; - if (defined($sections) && (ref($sections) eq 'ARRAY')) { - if (@{$sections} > 0) { - unless(grep/^$$classlist{$student}[$idx{section}]$/,@{$sections}) { - next; - } - } + if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) { + unless(grep(/^\Q$$classlist{$student}[$idx{section}]\E$/, + @{$sections})) { + next; + } } if (defined($$types{'active'})) { if ($$classlist{$student}[$idx{status}] eq 'Active') { @@ -3164,16 +3304,13 @@ sub get_course_users { my $match = 0; my ($role,$user) = ($person =~ /^([^:]*):([^:]+:[^:]+)/); $user =~ s/:$//; - if (($role) && (grep(/^$role$/,@{$roles}))) { + if (($role) && (grep(/^\Q$role\E$/,@{$roles}))) { my ($uname,$udom,$usec) = split(/:/,$user); - unless ($usec eq '') { - if (defined($sections) && (ref($sections) eq 'ARRAY')) { - if (@{$sections} > 0) { - unless(grep/^$usec$/,@{$sections}) { - next; - } - } - } + if ($usec ne '' && (ref($sections) eq 'ARRAY') && + @{$sections} > 0) { + unless(grep(/^\Q$usec\E$/,@{$sections})) { + next; + } } if ($uname ne '' && $udom ne '') { my $status = &check_user_status($udom,$uname,$cdom,$cnum,$role); @@ -3183,25 +3320,23 @@ sub get_course_users { $match = 1; } } - if ($match && defined($userdata)) { - unless(exists($$userdata{$uname.':'.$udom})) { - &get_user_info($udom,$uname,\%idx,$userdata); - } + if ($match && defined($userdata) && + !exists($$userdata{$uname.':'.$udom})) { + &get_user_info($udom,$uname,\%idx,$userdata); } } } } - if (grep/^ow$/,@{$roles}) { + if (grep(/^ow$/,@{$roles})) { if ((defined($cdom)) && (defined($cnum))) { my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum); if ( defined($csettings{'internal.courseowner'}) ) { my $owner = $csettings{'internal.courseowner'}; @{$$users{'ow'}{$owner.':'.$cdom}} = 'any'; - if (defined($userdata)) { - unless(exists($$userdata{$owner.':'.$cdom})) { - &get_user_info($cdom,$owner,\%idx,$userdata); - } - } + if (defined($userdata) && + !exists($$userdata{$owner.':'.$cdom})) { + &get_user_info($cdom,$owner,\%idx,$userdata); + } } } } @@ -3213,8 +3348,8 @@ sub get_user_info { my ($udom,$uname,$idx,$userdata) = @_; $$userdata{$uname.':'.$udom}[$$idx{fullname}] = &plainname($uname,$udom,'lastname'); - $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname - $$userdata{$uname.':'.$udom}[$$idx{uname}] = $udom + $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname; + $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom; return; } @@ -3356,6 +3491,10 @@ sub no_cache { sub content_type { my ($r,$type,$charset) = @_; + if ($r) { + # Note that printout.pl calls this with undef for $r. + &no_cache($r); + } if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; } unless ($charset) { $charset=&Apache::lonlocal::current_encoding; @@ -3590,6 +3729,22 @@ sub upfile_select_html { return $Str; } +sub get_samples { + my ($records,$toget) = @_; + my @samples=({}); + my $got=0; + foreach my $rec (@$records) { + my %temp = &record_sep($rec); + if (! grep(/\S/, values(%temp))) { next; } + if (%temp) { + $samples[$got]=\%temp; + $got++; + if ($got == $toget) { last; } + } + } + return \@samples; +} + ###################################################### ###################################################### @@ -3607,18 +3762,15 @@ Apache Request ref, $records is an array ###################################################### sub csv_print_samples { my ($r,$records) = @_; - my (%sone,%stwo,%sthree); - %sone=&record_sep($$records[0]); - if (defined($$records[1])) {%stwo=&record_sep($$records[1]);} - if (defined($$records[2])) {%sthree=&record_sep($$records[2]);} - # + my $samples = &get_samples($records,3); + $r->print(&mt('Samples').'
| '.&mt('Column [_1]',($_+1)).' | '); } $r->print('||
|---|---|---|
| '); if (defined($$hash{$_})) { $r->print($$hash{$_}); } $r->print(' | '); @@ -3647,8 +3799,8 @@ $d is an array of 2 element arrays (inte ###################################################### sub csv_print_select_table { my ($r,$records,$d) = @_; - my $i=0;my %sone; - %sone=&record_sep($$records[0]); + my $i=0; + my $samples = &get_samples($records,1); $r->print(&mt('Associate columns with student attributes.')."\n". '
| '.&mt('Attribute').' | '. @@ -3660,7 +3812,7 @@ sub csv_print_select_table { $r->print('
|---|