--- loncom/interface/loncommon.pm 2006/05/12 02:17:50 1.370 +++ loncom/interface/loncommon.pm 2006/07/07 19:17:19 1.424 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.370 2006/05/12 02:17:50 www Exp $ +# $Id: loncommon.pm,v 1.424 2006/07/07 19:17:19 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -386,10 +386,11 @@ sub selectstudent_link { sub coursebrowser_javascript { my ($domainfilter)=@_; + my $crs_or_grp_alert = &mt('Please select the type of LON-CAPA entity - Course or Group - for which you wish to add/modify a user role'); return (< var stdeditbrowser; - function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag) { + function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,crstype) { var url = '/adm/pickcourse?'; var filter; if (filter != null) { @@ -415,6 +416,18 @@ sub coursebrowser_javascript { if (multflag !=null && multflag != '') { url += '&multiple='+multflag; } + if (crstype == 'Course/Group') { + if (formname == 'cu') { + crstype = document.cu.crstype.options[document.cu.crstype.selectedIndex].value; + if (crstype == "") { + alert("$crs_or_grp_alert"); + return; + } + } + } + if (crstype !=null && crstype != '') { + url += '&type='+crstype; + } var title = 'Course_Browser'; var options = 'scrollbars=1,resizable=1,menubar=0'; options += ',width=700,height=600'; @@ -426,9 +439,9 @@ ENDSTDBRW } sub selectcourse_link { - my ($form,$unameele,$udomele,$desc,$extra_element,$multflag)=@_; + my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype)=@_; return "".&mt('Select Course').""; + '","'.$udomele.'","'.$desc.'","'.$extra_element.'","'.$multflag.'","'.$selecttype.'");'."'>".&mt('Select [_1]',$selecttype).""; } sub check_uncheck_jscript { @@ -694,7 +707,7 @@ sub helpLatexCheatsheet { } sub help_open_menu { - my ($color,$topic,$component_help,$function,$faq,$bug,$stayOnPage,$width,$height,$text) = @_; + my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text) = @_; $text = "" if (not defined $text); $stayOnPage = 0 if (not defined $stayOnPage); if ($env{'browser.interface'} eq 'textual' || @@ -708,8 +721,7 @@ sub help_open_menu { my $origurl = $ENV{'REQUEST_URI'}; $origurl=~s|^/~|/priv/|; my $timestamp = time; - foreach my $datum (\$color,\$function,\$topic,\$component_help,\$faq, - \$bug,\$origurl) { + foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) { $$datum = &escape($$datum); } if (!$stayOnPage) { @@ -717,8 +729,8 @@ sub help_open_menu { } else { $link = "javascript:helpMenu('display')"; } - my $banner_link = "/adm/helpmenu?page=banner&color=$color&function=$function&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage"; - my $details_link = "/adm/helpmenu?page=body&color=$color&function=$function&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp"; + my $banner_link = "/adm/helpmenu?page=banner&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage"; + my $details_link = "/adm/helpmenu?page=body&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp"; my $template; if ($text ne "") { $template .= @@ -803,8 +815,8 @@ sub help_open_bug { $topic=~s/\W+/\+/g; my $link=''; my $template=''; - my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='. - &escape($ENV{'REQUEST_URI'}).'&component='.$topic; + my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='. + &escape($ENV{'REQUEST_URI'}).'&component='.$topic; if (!$stayOnPage) { $link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))"; @@ -2608,10 +2620,7 @@ sub timehash { sub utc_string { my ($date)=@_; - my @utctime=gmtime($date); - my $year=$utctime[5]+1900; - my $month=$utctime[4]+1; - return "$year$month$utctime[3]T$utctime[2]$utctime[1]$utctime[0]Z"; + return strftime("%Y%m%dT%H%M%SZ",gmtime($date)); } sub maketime { @@ -2715,6 +2724,7 @@ Returns: value of designparamter $which =cut + ############################################## sub designparm { my ($which,$domain)=@_; @@ -2729,11 +2739,11 @@ sub designparm { return '#CCCCCC'; } } - if ($env{'environment.color.'.$which}) { + if (exists($env{'environment.color.'.$which})) { return $env{'environment.color.'.$which}; } $domain=&determinedomain($domain); - if ($designhash{$domain.'.'.$which}) { + if (exists($designhash{$domain.'.'.$which})) { return $designhash{$domain.'.'.$which}; } else { return $designhash{'default.'.$which}; @@ -2786,7 +2796,6 @@ Inputs: =item * $no_inline_link, if true and in remote mode, don't show the 'Switch To Inline Menu' link - =back Returns: A uniform header for LON-CAPA web pages. @@ -2816,11 +2825,19 @@ sub bodytag { @$addentries{keys(%design)} = @design{keys(%design)}; # role and realm - my ($role,$realm) = - &Apache::lonnet::plaintext((split(/\./,$env{'request.role'}))[0]); + my ($role,$realm) = split(/\./,$env{'request.role'},2); + if ($role eq 'ca') { + my ($rdom,$rname) = ($realm =~ m-^/(\w+)/(\w+)$-); + $realm = &plainname($rname,$rdom).':'.$rdom; + } # realm if ($env{'request.course.id'}) { + if ($env{'request.role'} !~ /^cr/) { + $role = &Apache::lonnet::plaintext($role,&course_type()); + } $realm = $env{'course.'.$env{'request.course.id'}.'.description'}; + } else { + $role = &Apache::lonnet::plaintext($role); } if (!$realm) { $realm=' '; } # Set messages @@ -2849,15 +2866,12 @@ sub bodytag { return $bodytag; } - + my $name = &plainname($env{'user.name'},$env{'user.domain'}); my $roleinfo=(<
- $env{'environment.firstname'} - $env{'environment.middlename'} - $env{'environment.lastname'} - $env{'environment.generation'} + $name  
@@ -2881,6 +2895,7 @@ ENDROLE '.domain'}.'/'})) { my $cid = $env{'request.course.id'}; $dc_info.= $cid.' '.$env{'course.'.$cid.'.internal.coursecode'}; + $dc_info =~ s/\s+$//; $dc_info = '('.$dc_info.')'; } @@ -2907,7 +2922,7 @@ ENDROLE $lastitem = $thisdisfn; } $titleinfo = - &Apache::loncommon::help_open_menu('','','','',3,'Authoring'). + &Apache::loncommon::help_open_menu('','',3,'Authoring'). 'Construction Space: '. '
' @@ -3079,16 +3094,20 @@ sub standard_css { my $tabbg = &designparm($function.'.tabbg', $domain); my $font = &designparm($function.'.font', $domain); my $sidebg = &designparm($function.'.sidebg',$domain); - my $pgbg = $bgcolor || + my $pgbg_or_bgcolor = + $bgcolor || &designparm($function.'.pgbg', $domain); + my $pgbg = &designparm($function.'.pgbg', $domain); my $alink = &designparm($function.'.alink', $domain); my $vlink = &designparm($function.'.vlink', $domain); my $link = &designparm($function.'.link', $domain); my $sans = 'Arial,Helvetica,sans-serif'; + my $mono = 'monospace'; my $data_table_head = $tabbg; my $data_table_light = '#EEEEEE'; my $data_table_dark = '#DDD'; + my $data_table_darker = '#CCC'; my $data_table_highlight = '#FFFF00'; my $mail_new = '#FFBB77'; my $mail_new_hover = '#DD9955'; @@ -3098,7 +3117,10 @@ sub standard_css { my $mail_replied_hover = '#888855'; my $mail_other = '#99BBBB'; my $mail_other_hover = '#669999'; + my $table_header = '#DDDDDD'; + my $border = ($env{'browser.type'} eq 'explorer') ? '0px 2px 0px 2px' + : '0px 3px 0px 4px'; return < array ref of seconds before redirect occurs - url to redirect to + redirect -> array ref of + 1- seconds before redirect occurs + 2- url to redirect to + 3- whether the side effect should occur (side effect of setting $env{'internal.head.redirect'} to the url redirected too) @@ -3318,6 +3614,7 @@ sub headtag { my $domain = $args->{'domain'} || &determinedomain(); my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain); my $url = join(':',$env{'user.name'},$env{'user.domain'}, + #time(), $env{'environment.color.timestamp'}, $function,$domain,$bgcolor); @@ -3325,7 +3622,6 @@ sub headtag { my $result = ''. - ''. &font_settings(). &Apache::lonhtmlcommon::htmlareaheaders(); @@ -3334,9 +3630,11 @@ sub headtag { } if (ref($args->{'redirect'})) { - my ($time,$url) = @{$args->{'redirect'}}; + my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}}; $url = &Apache::lonenc::check_encrypt($url); - $env{'internal.head.redirect'} = $url; + if (!$inhibit_continue) { + $env{'internal.head.redirect'} = $url; + } $result.=< @@ -3346,7 +3644,9 @@ ADDMETA $title = 'The LearningOnline Network with CAPA'; } - $result .= ' LON-CAPA '.&mt($title).''.$head_extra; + $result .= ' LON-CAPA '.&mt($title).'' + .'' + .$head_extra; return $result; } @@ -3438,6 +3738,7 @@ Returns a uniform complete .. + =back =cut @@ -3551,13 +3852,11 @@ Inputs: $args - additional optio a html attribute frameset -> if true will start with a rather than -=back =cut sub end_page { my ($args) = @_; - #&Apache::lonnet::logthis("end_page ".join(':',caller(0))); $env{'internal.end_page'}++; my $result; if ($args->{'discussion'}) { @@ -3600,7 +3899,7 @@ sub js_ready { $result =~ s/[\n\r]/ /xmsg; $result =~ s/\\/\\\\/xmsg; $result =~ s/'/\\'/xmsg; - $result =~ s{}{}xmsg; + $result =~ s{'; + return ''."\n"; } sub end_data_table { undef($row_count); - return '
'; + return ''."\n";; } sub start_data_table_row { + my ($add_class) = @_; $row_count++; - return ''; + my $css_class = ($row_count % 2)?'':'LC_even_row'; + my $css_class = (join(' ',$css_class,$add_class)); + return ''."\n";; } sub end_data_table_row { - return ''; + return ''."\n";; + } + + sub start_data_table_empty_row { + $row_count++; + return ''."\n";; + } + + sub end_data_table_empty_row { + return ''."\n";; } sub start_data_table_header_row { - return ''; + return ''."\n";; } sub end_data_table_header_row { - return ''; + return ''."\n";; } } @@ -3677,9 +3990,7 @@ sub simple_error_page { =pod -=over 4 - -=item get_users_function +=item * &get_users_function() Used by &bodytag to determine the current users primary role. Returns either 'student','coordinator','admin', or 'author'. @@ -3706,14 +4017,14 @@ sub get_users_function { =pod -=item check_user_status +=item * &check_user_status Determines current status of supplied role for a specific user. Roles can be active, previous or future. Inputs: user's domain, user's username, course's domain, -course's number, optional section/group. +course's number, optional section ID. Outputs: role status: active, previous or future. @@ -3721,33 +4032,35 @@ role status: active, previous or future. =cut sub check_user_status { - my ($udom,$uname,$cdom,$crs,$role,$secgrp) = @_; + my ($udom,$uname,$cdom,$crs,$role,$sec) = @_; my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname); my @uroles = keys %userinfo; my $srchstr; my $active_chk = 'none'; + my $now = time; if (@uroles > 0) { - if (($role eq 'cc') || ($secgrp eq '') || (!defined($secgrp))) { + if (($role eq 'cc') || ($sec eq '') || (!defined($sec))) { $srchstr = '/'.$cdom.'/'.$crs.'_'.$role; } else { - $srchstr = '/'.$cdom.'/'.$crs.'/'.$secgrp.'_'.$role; } - if (grep/^$srchstr$/,@uroles) { + $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role; + } + if (grep/^\Q$srchstr\E$/,@uroles) { my $role_end = 0; my $role_start = 0; $active_chk = 'active'; - if ($userinfo{$srchstr} =~ m/^($role)_(\d+)/) { - $role_end = $2; - if ($userinfo{$srchstr} =~ m/^($role)_($role_end)_(\d+)$/) { - $role_start = $3; + if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) { + $role_end = $1; + if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) { + $role_start = $1; } } if ($role_start > 0) { - if (time < $role_start) { + if ($now < $role_start) { $active_chk = 'future'; } } if ($role_end > 0) { - if (time > $role_end) { + if ($now > $role_end) { $active_chk = 'previous'; } } @@ -3760,23 +4073,32 @@ sub check_user_status { =pod -=item get_sections +=item * &get_sections() Determines all the sections for a course including sections with students and sections containing other roles. -Incoming parameters: domain, course number, reference to -section hash (keys to be section/group IDs), reference to -array containing roles for which sections should be gathered -(optional). If the fourth argument is undefined, sections -are gathered for any role. +Incoming parameters: + +1. domain +2. course number +3. reference to array containing roles for which sections should +be gathered (optional). +4. reference to array containing status types for which sections +should be gathered (optional). + +If the third argument is undefined, sections are gathered for any role. +If the fourth argument is undefined, sections are gathered for any status. +Permissible values are 'active' or 'future' or 'previous'. -Returns number of sections. +Returns section hash (keys are section IDs, values are +number of users in each section), subject to the +optional roles filter, optional status filter =cut ############################################### sub get_sections { - my ($cdom,$cnum,$possible_roles) = @_; + my ($cdom,$cnum,$possible_roles,$possible_status) = @_; if (!defined($cdom) || !defined($cnum)) { my $cid = $env{'request.course.id'}; @@ -3787,16 +4109,32 @@ sub get_sections { } my %sectioncount; + my $now = time; if (!defined($possible_roles) || (grep(/^st$/,@$possible_roles))) { my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum); my $sec_index = &Apache::loncoursedata::CL_SECTION(); my $status_index = &Apache::loncoursedata::CL_STATUS(); + my $start_index = &Apache::loncoursedata::CL_START(); + my $end_index = &Apache::loncoursedata::CL_END(); + my $status; while (my ($student,$data) = each(%$classlist)) { - my ($section,$status) = ($data->[$sec_index], - $data->[$status_index]); - unless ($section eq '-1' || $section =~ /^\s*$/) { - $sectioncount{$section}++; + my ($section,$stu_status,$start,$end) = ($data->[$sec_index], + $data->[$status_index], + $data->[$start_index], + $data->[$end_index]); + if ($stu_status eq 'Active') { + $status = 'active'; + } elsif ($end < $now) { + $status = 'previous'; + } elsif ($start > $now) { + $status = 'future'; + } + if ($section ne '-1' && $section !~ /^\s*$/) { + if ((!defined($possible_status)) || (($status ne '') && + (grep/^\Q$status\E$/,@{$possible_status}))) { + $sectioncount{$section}++; + } } } } @@ -3805,170 +4143,41 @@ sub get_sections { if ($user !~ /^(\w{2})/) { next; } my ($role) = ($user =~ /^(\w{2})/); if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; } - my $section; + my ($section,$status); if ($role eq 'cr' && $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) { $section=$1; } if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; } if (!defined($section) || $section eq '-1') { next; } - $sectioncount{$section}++; - } - return %sectioncount; -} - -############################################### - -=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 ($cdom,$cnum,$group) = @_; - if (!defined($cdom) || !defined($cnum)) { - my $cid = $env{'request.course.id'}; - - return if (!defined($cid)); - - $cdom = $env{'course.'.$cid.'.domain'}; - $cnum = $env{'course.'.$cid.'.num'}; - } - my %curr_groups = &Apache::lonnet::get_coursegroups($cdom,$cnum,$group); - my ($tmp) = keys(%curr_groups); - if ($tmp=~/^(con_lost|no_such_host|error: [^2] )/) { - undef(%curr_groups); - &logthis('Error retrieving groups: '.$tmp.' in '.$cnum.':'.$cdom); - } elsif ($tmp=~/^error: 2 /) { - undef(%curr_groups); - } - return %curr_groups; -} - -############################################### - -=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 -whether 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 $role = ''; - my %content=(); - while ($token=$parser->get_token) { - if ($token->[0] eq 'S') { - my $entry=$token->[1]; - if ($entry eq 'functions' || $entry eq 'autosec') { - %{$content{$entry}} = (); - $tool = $entry; - } elsif ($entry eq 'role') { - if ($tool eq 'autosec') { - $role = $token->[2]{id}; - } - } 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}=&unescape($value); - } elsif (($entry eq 'roles') || ($entry eq 'types') || - ($entry eq 'sectionpick') || ($entry eq 'defpriv')) { - push(@{$content{$entry}},$value); - } elsif ($entry eq 'section') { - if ($tool eq 'autosec' && $role ne '') { - push(@{$content{$tool}{$role}},$value); - } - } else { - $content{$entry}=$value; - } + my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/); + if ($end == -1 && $start == -1) { + next; #deleted role + } + if (!defined($possible_status)) { + $sectioncount{$section}++; + } else { + if ((!$end || $end >= $now) && (!$start || $start <= $now)) { + $status = 'active'; + } elsif ($end < $now) { + $status = 'future'; + } elsif ($start > $now) { + $status = 'previous'; } - } elsif ($token->[0] eq 'E') { - if ($token->[1] eq 'functions' || $token->[1] eq 'autosec') { - $tool = ''; - } elsif ($token->[1] eq 'role') { - $role = ''; + if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) { + $sectioncount{$section}++; } - } } - 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; + return %sectioncount; } ############################################### =pod - -=item get_course_users - + +=item * &get_course_users() + Retrieves usernames:domains for users in the specified course with specific role(s), and access status. @@ -3991,12 +4200,13 @@ Entries for end, start, section and stat of the possibility of multiple values for non-student roles. =cut - + ############################################### - + sub get_course_users { my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata) = @_; my %idx = (); + my %seclists; $idx{udom} = &Apache::loncoursedata::CL_SDOM(); $idx{uname} = &Apache::loncoursedata::CL_SNAME(); @@ -4012,12 +4222,28 @@ sub get_course_users { my $now = time; foreach my $student (keys(%{$classlist})) { my $match = 0; + my $secmatch = 0; + my $section = $$classlist{$student}[$idx{section}]; + if ($section eq '') { + $section = 'none'; + } if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) { - unless(grep(/^\Q$$classlist{$student}[$idx{section}]\E$/, - @{$sections})) { - next; + if (grep(/^all$/,@{$sections})) { + $secmatch = 1; + } elsif ($$classlist{$student}[$idx{section}] eq '') { + if (grep(/^none$/,@{$sections})) { + $secmatch = 1; + } + } else { + if (grep(/^\Q$section\E$/,@{$sections})) { + $secmatch = 1; + } } - } + if (!$secmatch) { + next; + } + } + push(@{$seclists{$student}},$section); if (defined($$types{'active'})) { if ($$classlist{$student}[$idx{status}] eq 'Active') { push(@{$$users{st}{$student}},'active'); @@ -4036,36 +4262,57 @@ sub get_course_users { $match = 1; } } - if ($match && defined($userdata)) { + if ($match && ref($userdata) eq 'HASH') { $$userdata{$student} = $$classlist{$student}; } } } - if ((@{$roles} > 0) && (@{$roles} ne "st")) { + if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) { my @coursepersonnel = &Apache::lonnet::getkeys('nohist_userroles',$cdom,$cnum); foreach my $person (@coursepersonnel) { my $match = 0; - my ($role,$user) = ($person =~ /^([^:]*):([^:]+:[^:]+)/); + my $secmatch = 0; + my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/); $user =~ s/:$//; if (($role) && (grep(/^\Q$role\E$/,@{$roles}))) { - my ($uname,$udom,$usec) = split(/:/,$user); - if ($usec ne '' && (ref($sections) eq 'ARRAY') && - @{$sections} > 0) { - unless(grep(/^\Q$usec\E$/,@{$sections})) { - next; - } + my ($uname,$udom) = split(/:/,$user); + if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) { + if (grep(/^all$/,@{$sections})) { + $secmatch = 1; + } elsif ($usec eq '') { + if (grep(/^none$/,@{$sections})) { + $secmatch = 1; + } + } else { + if (grep(/^\Q$usec\E$/,@{$sections})) { + $secmatch = 1; + } + } + if (!$secmatch) { + next; + } + } + if ($usec eq '') { + $usec = 'none'; } if ($uname ne '' && $udom ne '') { - my $status = &check_user_status($udom,$uname,$cdom,$cnum,$role); + my $status = &check_user_status($udom,$uname,$cdom,$cnum,$role, + $usec); foreach my $type (keys(%{$types})) { if ($status eq $type) { - @{$$users{$role}{$user}} = $type; + if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) { + push(@{$$users{$role}{$user}},$type); + } $match = 1; } } - if ($match && defined($userdata) && - !exists($$userdata{$uname.':'.$udom})) { - &get_user_info($udom,$uname,\%idx,$userdata); + if (($match) && (ref($userdata) eq 'HASH')) { + if (!exists($$userdata{$uname.':'.$udom})) { + &get_user_info($udom,$uname,\%idx,$userdata); + } + if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) { + push(@{$seclists{$uname.':'.$udom}},$usec); + } } } } @@ -4079,10 +4326,17 @@ sub get_course_users { if (defined($userdata) && !exists($$userdata{$owner.':'.$cdom})) { &get_user_info($cdom,$owner,\%idx,$userdata); + if (!grep(/^none$/,@{$seclists{$owner.':'.$cdom}})) { + push(@{$seclists{$owner.':'.$cdom}},'none'); + } } } } } + foreach my $user (keys(%seclists)) { + @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}}); + $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}}); + } } return; } @@ -4096,6 +4350,43 @@ sub get_user_info { return; } +sub get_secgrprole_info { + my ($cdom,$cnum,$needroles,$type) = @_; + my %sections_count = &get_sections($cdom,$cnum); + my @sections = (sort {$a <=> $b} keys(%sections_count)); + my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum); + my @groups = sort(keys(%curr_groups)); + my $allroles = []; + my $rolehash; + my $accesshash = { + active => 'Currently has access', + future => 'Will have future access', + previous => 'Previously had access', + }; + if ($needroles) { + $rolehash = {'all' => 'all'}; + my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum); + if (&Apache::lonnet::error(%user_roles)) { + undef(%user_roles); + } + foreach my $item (keys(%user_roles)) { + my ($role)=split(/\:/,$item,2); + if ($role eq 'cr') { next; } + if ($role =~ /^cr/) { + $$rolehash{$role} = (split('/',$role))[3]; + } else { + $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type); + } + } + foreach my $key (sort(keys(%{$rolehash}))) { + push(@{$allroles},$key); + } + push (@{$allroles},'st'); + $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type); + } + return (\@sections,\@groups,$allroles,$rolehash,$accesshash); +} + =pod =item * get_unprocessed_cgi($query,$possible_names) @@ -5028,6 +5319,7 @@ a hash ref describing the data to be sto 'chartoutputmode' => 'scalar', 'chartoutputdata' => 'scalar', 'Section' => 'array', + 'Group' => 'array', 'StudentData' => 'array', 'Maps' => 'array'); @@ -5110,15 +5402,26 @@ sub restore_course_settings { ############################################################ ############################################################ -sub propath { - my ($udom,$uname)=@_; - $udom=~s/\W//g; - $uname=~s/\W//g; - my $subdir=$uname.'__'; - $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/; - my $proname="$Apache::lonnet::perlvar{'lonUsersDir'}/$udom/$subdir/$uname"; - return $proname; -} +sub course_type { + my ($cid) = @_; + if (!defined($cid)) { + $cid = $env{'request.course.id'}; + } + if (defined($env{'course.'.$cid.'.type'})) { + return $env{'course.'.$cid.'.type'}; + } else { + return 'Course'; + } +} + +sub group_term { + my $crstype = &course_type(); + my %names = ( + 'Course' => 'group', + 'Group' => 'team', + ); + return $names{$crstype}; +} sub icon { my ($file)=@_;