--- loncom/interface/loncommon.pm 2006/06/12 18:56:05 1.381 +++ loncom/interface/loncommon.pm 2006/07/03 00:46:00 1.415 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.381 2006/06/12 18:56:05 albertel Exp $ +# $Id: loncommon.pm,v 1.415 2006/07/03 00:46:00 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -707,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' || @@ -721,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) { @@ -730,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 .= @@ -2725,6 +2724,7 @@ Returns: value of designparamter $which =cut + ############################################## sub designparm { my ($which,$domain)=@_; @@ -2739,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}; @@ -2796,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. @@ -2867,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  
@@ -2926,7 +2922,7 @@ ENDROLE $lastitem = $thisdisfn; } $titleinfo = - &Apache::loncommon::help_open_menu('','','','',3,'Authoring'). + &Apache::loncommon::help_open_menu('','',3,'Authoring'). 'Construction Space: '. '
' @@ -3098,13 +3094,16 @@ 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'; @@ -3117,7 +3116,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) @@ -3345,15 +3499,14 @@ sub headtag { my $function = $args->{'function'} || &get_users_function(); my $domain = $args->{'domain'} || &determinedomain(); my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain); - my $url = join(':',$env{'user.name'},$env{'user.domain'}, - $env{'environment.color.timestamp'}, + my $url = join(':',$env{'user.name'},$env{'user.domain'},time(), + #$env{'environment.color.timestamp'}, $function,$domain,$bgcolor); $url = '/adm/css/'.&escape($url).'.css'; my $result = ''. - ''. &font_settings(). &Apache::lonhtmlcommon::htmlareaheaders(); @@ -3362,9 +3515,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.=< @@ -3374,7 +3529,9 @@ ADDMETA $title = 'The LearningOnline Network with CAPA'; } - $result .= ' LON-CAPA '.&mt($title).''.$head_extra; + $result .= ' LON-CAPA '.&mt($title).'' + .'' + .$head_extra; return $result; } @@ -3466,6 +3623,7 @@ Returns a uniform complete .. + =back =cut @@ -3579,7 +3737,6 @@ Inputs: $args - additional optio a html attribute frameset -> if true will start with a rather than -=back =cut @@ -3674,29 +3831,29 @@ sub simple_error_page { my $row_count; sub start_data_table { undef($row_count); - return ''; + return '
'."\n"; } sub end_data_table { undef($row_count); - return '
'; + return ''."\n";; } sub start_data_table_row { $row_count++; - return ''; + return ''."\n";; } sub end_data_table_row { - return ''; + return ''."\n";; } sub start_data_table_header_row { - return ''; + return ''."\n";; } sub end_data_table_header_row { - return ''; + return ''."\n";; } } @@ -3704,9 +3861,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'. @@ -3733,7 +3888,7 @@ 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. @@ -3748,33 +3903,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'; } } @@ -3787,7 +3944,7 @@ 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. @@ -3848,9 +4005,9 @@ sub get_sections { ############################################### =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. @@ -3873,9 +4030,9 @@ 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 = (); @@ -3894,11 +4051,23 @@ sub get_course_users { my $now = time; foreach my $student (keys(%{$classlist})) { my $match = 0; + my $secmatch = 0; if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) { - unless(grep(/^\Q$$classlist{$student}[$idx{section}]\E$/, + if (grep/^all$/,@{$sections}) { + $secmatch = 1; + } elsif ($$classlist{$student}[$idx{section}] eq '') { + if (grep/^none$/,@{$sections}) { + $secmatch = 1; + } + } else { + if (grep(/^\Q$$classlist{$student}[$idx{section}]\E$/, @{$sections})) { - next; + $secmatch = 1; + } } + if (!$secmatch) { + next; + } } if (defined($$types{'active'})) { if ($$classlist{$student}[$idx{status}] eq 'Active') { @@ -3918,35 +4087,47 @@ 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 ($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; $match = 1; } } - if ($match && defined($userdata) && - !exists($$userdata{$uname.':'.$udom})) { + if (($match) && (ref($userdata) eq 'HASH') && + (!exists($$userdata{$uname.':'.$udom}))) { &get_user_info($udom,$uname,\%idx,$userdata); } } @@ -3978,6 +4159,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) @@ -4998,13 +5216,22 @@ sub course_type { if (!defined($cid)) { $cid = $env{'request.course.id'}; } - if (defined($env{'course.'.$cid.'type'})) { - return $env{'course.'.$cid.'type'}; + 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)=@_; my $curfext = (split(/\./,$file))[-1];