--- loncom/interface/loncommon.pm 2006/05/08 18:54:00 1.363 +++ loncom/interface/loncommon.pm 2006/06/26 23:32:56 1.402 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.363 2006/05/08 18:54:00 albertel Exp $ +# $Id: loncommon.pm,v 1.402 2006/06/26 23:32:56 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; @@ -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 { @@ -693,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' || @@ -707,17 +721,16 @@ 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) { - $$datum = &Apache::lonnet::escape($$datum); + foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) { + $$datum = &escape($$datum); } if (!$stayOnPage) { $link = "javascript:helpMenu('open')"; } 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 .= @@ -775,7 +788,7 @@ ENDTEMPLATE $width,$height).' '.$template; } else { my $help_text; - $help_text=&Apache::lonnet::unescape($topic); + $help_text=&unescape($topic); $template=''; + $prevattempts.=''; } } } @@ -2406,7 +2420,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.=''; } @@ -2528,7 +2542,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 'Construction Space: '. '
' @@ -2945,11 +2974,12 @@ ENDROLE return(< - + $roleinfo +
'. &help_open_topic($component_help,$help_text,$stayOnPage, $width,$height).''.$template. @@ -802,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='. - &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'))"; @@ -2024,10 +2037,11 @@ sub screenname { # ------------------------------------------------------------- Message Wrapper sub messagewrapper { - my ($link,$username,$domain)=@_; + my ($link,$username,$domain,$subject,$text)=@_; return ''.$link.''; } # --------------------------------------------------------------- Notes Wrapper @@ -2394,7 +2408,7 @@ sub get_previous_attempt { } else { $value=$returnhash{$version.':'.$key}; } - $prevattempts.=''.&Apache::lonnet::unescape($value).' '.&unescape($value).' '.$value.' 
$upperleft
$titleinfo $dc_info $menu
ENDBODY } @@ -3068,13 +3098,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'; @@ -3087,7 +3120,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 <{'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/'.&Apache::lonnet::escape($url).'.css'; + $url = '/adm/css/'.&escape($url).'.css'; my $result = ''. @@ -3536,7 +3723,6 @@ Inputs: $args - additional optio sub end_page { my ($args) = @_; - #&Apache::lonnet::logthis("end_page ".join(':',caller(0))); $env{'internal.end_page'}++; my $result; if ($args->{'discussion'}) { @@ -3579,7 +3765,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 { $row_count++; - return ''; + return ''."\n";; } sub end_data_table_row { - return ''; + return ''."\n";; + } + + sub start_data_table_header_row { + return ''."\n";; + } + + sub end_data_table_header_row { + return ''."\n";; } } @@ -3684,7 +3878,7 @@ specific user. Roles can be active, prev 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. @@ -3735,32 +3929,40 @@ sub check_user_status { 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: domain, course number, +reference to array containing roles for which sections should +be gathered (optional). If the third argument is undefined, +sections are gathered for any role. -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. =cut ############################################### sub get_sections { - my ($cdom,$cnum,$sectioncount,$possible_roles) = @_; - if (!($cdom && $cnum)) { return 0; } - my $numsections = 0; + my ($cdom,$cnum,$possible_roles) = @_; + if (!defined($cdom) || !defined($cnum)) { + my $cid = $env{'request.course.id'}; - if (!defined($possible_roles) || (grep/^st$/,@$possible_roles)) { + return if (!defined($cid)); + + $cdom = $env{'course.'.$cid.'.domain'}; + $cnum = $env{'course.'.$cid.'.num'}; + } + + my %sectioncount; + + 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(); - while (my ($student,$data) = each %$classlist) { + while (my ($student,$data) = each(%$classlist)) { my ($section,$status) = ($data->[$sec_index], $data->[$status_index]); unless ($section eq '-1' || $section =~ /^\s*$/) { - if (!defined($$sectioncount{$section})) { $numsections++; } - $$sectioncount{$section}++; + $sectioncount{$section}++; } } } @@ -3776,157 +3978,9 @@ sub get_sections { } if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; } if (!defined($section) || $section eq '-1') { next; } - if (!defined($$sectioncount{$section})) { $numsections++; } - $$sectioncount{$section}++; + $sectioncount{$section}++; } - return $numsections; -} - -############################################### - -=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 -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; - } - } - } elsif ($token->[0] eq 'E') { - if ($token->[1] eq 'functions' || $token->[1] eq 'autosec') { - $tool = ''; - } elsif ($token->[1] eq 'role') { - $role = ''; - } - - } - } - 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; } ############################################### @@ -4062,6 +4116,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) @@ -4082,7 +4173,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; @@ -4711,9 +4802,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; @@ -4793,9 +4884,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', @@ -4890,9 +4981,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, @@ -4964,7 +5055,7 @@ Inputs: sub chartlink { my ($linktext, $sname, $sdomain) = @_; my $link = ''.$linktext.''; } @@ -4994,6 +5085,7 @@ a hash ref describing the data to be sto 'chartoutputmode' => 'scalar', 'chartoutputdata' => 'scalar', 'Section' => 'array', + 'Group' => 'array', 'StudentData' => 'array', 'Maps' => 'array'); @@ -5027,11 +5119,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}) { @@ -5065,7 +5157,7 @@ sub restore_course_settings { } elsif ($type eq 'array') { $env{'form.'.$setting} = [ map { - &Apache::lonnet::unescape($_); + &unescape($_); } split(',',$env{$envname}) ]; } @@ -5076,15 +5168,17 @@ 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 icon { my ($file)=@_; @@ -5138,7 +5232,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 500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.