--- loncom/interface/loncommon.pm 2006/05/10 21:50:39 1.368 +++ loncom/interface/loncommon.pm 2006/07/20 04:17:55 1.435 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.368 2006/05/10 21:50:39 albertel Exp $ +# $Id: loncommon.pm,v 1.435 2006/07/20 04:17:55 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -64,6 +64,7 @@ use HTML::Entities; use Apache::lonhtmlcommon(); use Apache::loncoursedata(); use Apache::lontexconvert(); +use LONCAPA; my $readit; @@ -284,7 +285,7 @@ sub browser_and_searcher_javascript { } url += 'element=' + elementname + ''; var title = 'Browser'; - var options = 'scrollbars=1,resizable=1,menubar=1,location=1'; + var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1'; options += ',width=700,height=600'; editbrowser = open(url,title,options,'1'); editbrowser.focus(); @@ -305,7 +306,7 @@ sub browser_and_searcher_javascript { } url += 'element=' + elementname + ''; var title = 'Search'; - var options = 'scrollbars=1,resizable=1,menubar=0'; + var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1'; options += ',width=700,height=600'; editsearcher = open(url,title,options,'1'); editsearcher.focus(); @@ -385,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) { @@ -414,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'; @@ -425,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 { @@ -692,8 +706,68 @@ sub helpLatexCheatsheet { .''; } +sub general_help { + my $helptopic='Student_Intro'; + if ($env{'request.role'}=~/^(ca|au)/) { + $helptopic='Authoring_Intro'; + } elsif ($env{'request.role'}=~/^cc/) { + $helptopic='Course_Coordination_Intro'; + } + return $helptopic; +} + +sub update_help_link { + my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_; + my $origurl = $ENV{'REQUEST_URI'}; + $origurl=~s|^/~|/priv/|; + my $timestamp = time; + foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) { + $$datum = &escape($$datum); + } + + my $banner_link = "/adm/helpmenu?page=banner&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage"; + my $output .= <<"ENDOUTPUT"; + +ENDOUTPUT + return $output; +} + +# now just updates the help link and generates a blue icon 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) + = @_; + + $stayOnPage = 0 if (not defined $stayOnPage); + if ($env{'browser.interface'} eq 'textual' || + $env{'environment.remote'} eq 'off' ) { + $stayOnPage=1; + } + my $output; + if ($component_help) { + if (!$text) { + $output=&help_open_topic($component_help,undef,$stayOnPage, + $width,$height); + } else { + my $help_text; + $help_text=&unescape($topic); + $output='
'. + &help_open_topic($component_help,$help_text,$stayOnPage, + $width,$height).'
'; + } + } + my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage); + return $output.$banner_link; +} + +sub top_nav_help { + my ($text) = @_; + + my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height); + $text = "" if (not defined $text); $stayOnPage = 0 if (not defined $stayOnPage); if ($env{'browser.interface'} eq 'textual' || @@ -704,26 +778,15 @@ sub help_open_menu { $height = 600 if (not defined $height); my $link=''; my $title = &mt('Get help'); - my $origurl = $ENV{'REQUEST_URI'}; - $origurl=~s|^/~|/priv/|; - my $timestamp = time; - foreach my $datum (\$color,\$function,\$topic,\$component_help,\$faq, - \$bug,\$origurl) { - $$datum = &Apache::lonnet::escape($$datum); - } - if (!$stayOnPage) { - $link = "javascript:helpMenu('open')"; + if ($stayOnPage) { + $link = "javascript:helpMenu('display')"; } else { - $link = "javascript:helpMenu('display')"; + $link = "javascript:helpMenu('open')"; } - 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 $helptopic=&general_help(); + my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage); + my $details_link = '/adm/help/'.$helptopic.'.hlp'; my $template; - if ($text ne "") { - $template .= - "". - "
$text"; - } my $nothing=&Apache::lonhtmlcommon::javascript_nothing(); my $helpicon=&lonhttpdurl("/adm/lonIcons/helpgateway.gif"); my $start_page = @@ -741,6 +804,7 @@ sub help_open_menu { - (Help Menu) +$banner_link + $text ENDTEMPLATE - if ($component_help) { - if (!$text) { - $template=&help_open_topic($component_help,undef,$stayOnPage, - $width,$height).' '.$template; - } else { - my $help_text; - $help_text=&Apache::lonnet::unescape($topic); - $template='
'. - &help_open_topic($component_help,$help_text,$stayOnPage, - $width,$height).''.$template. - '
'; - } - } - if ($text ne '') { $template.='
' }; return $template; } @@ -802,8 +853,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='. - &Apache::lonnet::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'))"; @@ -1905,12 +1956,20 @@ sub get_related_words { return (); } my @Words=(); + my $count=0; if (exists($thesaurus_db{$keyword})) { # The first element is the number of times # the word appears. We do not need it now. - (undef,@Words) = (split(/:/,$thesaurus_db{$keyword})); - for (my $i=0;$i<=$#Words;$i++) { - ($Words[$i],undef)= split(/\,/,$Words[$i]); + my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword})); + my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]); + my $threshold=$mostfrequentcount/10; + foreach my $possibleword (@RelatedWords) { + my ($word,$wordcount)=split(/\,/,$possibleword); + if ($wordcount>$threshold) { + push(@Words,$word); + $count++; + if ($count>10) { last; } + } } } untie %thesaurus_db; @@ -1989,6 +2048,9 @@ sub nickname { sub getnames { my ($uname,$udom)=@_; + if ($udom eq 'public' && $uname eq 'public') { + return ('lastname' => &mt('Public')); + } my $id=$uname.':'.$udom; my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id); if ($cached) { @@ -2024,10 +2086,11 @@ sub screenname { # ------------------------------------------------------------- Message Wrapper sub messagewrapper { - my ($link,$username,$domain)=@_; + my ($link,$username,$domain,$subject,$text)=@_; return ''.$link.''; } # --------------------------------------------------------------- Notes Wrapper @@ -2394,7 +2457,7 @@ sub get_previous_attempt { } else { $value=$returnhash{$version.':'.$key}; } - $prevattempts.=''.&Apache::lonnet::unescape($value).' '; + $prevattempts.=''.&unescape($value).' '; } } } @@ -2406,7 +2469,7 @@ sub get_previous_attempt { } else { $value=$lasthash{$key}; } - $value=&Apache::lonnet::unescape($value); + $value=&unescape($value); if ($key =~/$regexp$/ && (defined &$gradesub)) {$value = &$gradesub($value)} $prevattempts.=''.$value.' '; } @@ -2528,7 +2591,7 @@ sub submlink { if (!$symb) { $symb=$cursymb; } } if (!$symb) { $symb=&Apache::lonnet::symbread(); } - $symb=&Apache::lonnet::escape($symb); + $symb=&escape($symb); if ($target) { $target="target=\"$target\""; } return '
- $env{'environment.firstname'} - $env{'environment.middlename'} - $env{'environment.lastname'} - $env{'environment.generation'} + $name  
@@ -2871,6 +2950,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.')'; } @@ -2897,7 +2977,7 @@ ENDROLE $lastitem = $thisdisfn; } $titleinfo = - &Apache::loncommon::help_open_menu('','','','',3,'Authoring'). + &Apache::loncommon::help_open_menu('','',3,'Authoring'). 'Construction Space: '. '
' @@ -3069,16 +3149,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'; @@ -3088,61 +3172,72 @@ 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) @@ -3308,14 +3679,14 @@ 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); - $url = '/adm/css/'.&Apache::lonnet::escape($url).'.css'; + $url = '/adm/css/'.&escape($url).'.css'; my $result = ''. - ''. &font_settings(). &Apache::lonhtmlcommon::htmlareaheaders(); @@ -3324,9 +3695,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.=< @@ -3336,7 +3709,9 @@ ADDMETA $title = 'The LearningOnline Network with CAPA'; } - $result .= ' LON-CAPA '.&mt($title).''.$head_extra; + $result .= ' LON-CAPA '.&mt($title).'' + .'' + .$head_extra; return $result; } @@ -3428,6 +3803,7 @@ Returns a uniform complete .. + =back =cut @@ -3541,13 +3917,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'}) { @@ -3590,7 +3964,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'; + $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";; } } @@ -3667,9 +4055,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'. @@ -3696,14 +4082,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. @@ -3711,33 +4097,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'; } } @@ -3750,23 +4138,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'}; @@ -3777,16 +4174,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}++; + } } } } @@ -3795,170 +4208,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}=&Apache::lonnet::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. @@ -3981,12 +4265,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(); @@ -4002,12 +4287,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'); @@ -4026,36 +4327,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); + } } } } @@ -4069,10 +4391,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; } @@ -4086,6 +4415,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) @@ -4106,7 +4472,7 @@ sub get_unprocessed_cgi { # $Apache::lonxml::debug=1; foreach my $pair (split(/&/,$query)) { my ($name, $value) = split(/=/,$pair); - $name = &Apache::lonnet::unescape($name); + $name = &unescape($name); if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) { $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; @@ -4735,9 +5101,9 @@ sub DrawBarGraph { $Title = '' if (! defined($Title)); $xlabel = '' if (! defined($xlabel)); $ylabel = '' if (! defined($ylabel)); - $ValuesHash{$id.'.title'} = &Apache::lonnet::escape($Title); - $ValuesHash{$id.'.xlabel'} = &Apache::lonnet::escape($xlabel); - $ValuesHash{$id.'.ylabel'} = &Apache::lonnet::escape($ylabel); + $ValuesHash{$id.'.title'} = &escape($Title); + $ValuesHash{$id.'.xlabel'} = &escape($xlabel); + $ValuesHash{$id.'.ylabel'} = &escape($ylabel); $ValuesHash{$id.'.y_max_value'} = $Max; $ValuesHash{$id.'.NumBars'} = $NumBars; $ValuesHash{$id.'.NumSets'} = $NumSets; @@ -4817,9 +5183,9 @@ sub DrawXYGraph { $ylabel = '' if (! defined($ylabel)); my %ValuesHash = ( - $id.'.title' => &Apache::lonnet::escape($Title), - $id.'.xlabel' => &Apache::lonnet::escape($xlabel), - $id.'.ylabel' => &Apache::lonnet::escape($ylabel), + $id.'.title' => &escape($Title), + $id.'.xlabel' => &escape($xlabel), + $id.'.ylabel' => &escape($ylabel), $id.'.y_max_value'=> $Max, $id.'.labels' => join(',',@$Xlabels), $id.'.PlotType' => 'XY', @@ -4914,9 +5280,9 @@ sub DrawXYYGraph { $ylabel = '' if (! defined($ylabel)); my %ValuesHash = ( - $id.'.title' => &Apache::lonnet::escape($Title), - $id.'.xlabel' => &Apache::lonnet::escape($xlabel), - $id.'.ylabel' => &Apache::lonnet::escape($ylabel), + $id.'.title' => &escape($Title), + $id.'.xlabel' => &escape($xlabel), + $id.'.ylabel' => &escape($ylabel), $id.'.labels' => join(',',@$Xlabels), $id.'.PlotType' => 'XY', $id.'.NumSets' => 2, @@ -4988,7 +5354,7 @@ Inputs: sub chartlink { my ($linktext, $sname, $sdomain) = @_; my $link = ''.$linktext.''; } @@ -5018,6 +5384,7 @@ a hash ref describing the data to be sto 'chartoutputmode' => 'scalar', 'chartoutputdata' => 'scalar', 'Section' => 'array', + 'Group' => 'array', 'StudentData' => 'array', 'Maps' => 'array'); @@ -5051,11 +5418,11 @@ sub store_course_settings { if (ref($env{'form.'.$setting})) { $stored_form = join(',', map { - &Apache::lonnet::escape($_); + &escape($_); } sort(@{$env{'form.'.$setting}})); } else { $stored_form = - &Apache::lonnet::escape($env{'form.'.$setting}); + &escape($env{'form.'.$setting}); } # Determine if the array contents are the same. if ($stored_form ne $env{$envname}) { @@ -5089,7 +5456,7 @@ sub restore_course_settings { } elsif ($type eq 'array') { $env{'form.'.$setting} = [ map { - &Apache::lonnet::unescape($_); + &unescape($_); } split(',',$env{$envname}) ]; } @@ -5100,15 +5467,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)=@_; @@ -5162,7 +5540,7 @@ sub escape_double { sub escape_url { my ($url) = @_; my @urlslices = split(/\//, $url,-1); - my $lastitem = &Apache::lonnet::escape(pop(@urlslices)); + my $lastitem = &escape(pop(@urlslices)); return join('/',@urlslices).'/'.$lastitem; } =pod