--- loncom/interface/loncommon.pm 2006/03/21 18:32:19 1.316 +++ loncom/interface/loncommon.pm 2006/05/12 02:17:50 1.370 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.316 2006/03/21 18:32:19 albertel Exp $ +# $Id: loncommon.pm,v 1.370 2006/05/12 02:17:50 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -58,10 +58,13 @@ use strict; use Apache::lonnet; use GDBM_File; use POSIX qw(strftime mktime); -use Apache::Constants qw(:common :http :methods); use Apache::lonmenu(); use Apache::lonlocal; use HTML::Entities; +use Apache::lonhtmlcommon(); +use Apache::loncoursedata(); +use Apache::lontexconvert(); +use LONCAPA; my $readit; @@ -74,7 +77,7 @@ my %language; my %supported_language; my %cprtag; my %scprtag; -my %fe; my %fd; +my %fe; my %fd; my %fm; my %category_extensions; # ---------------------------------------------- Designs @@ -105,10 +108,10 @@ BEGIN { my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}. '/language.tab'; if ( open(my $fh,"<$langtabfile") ) { - while (<$fh>) { - next if /^\#/; - chomp; - my ($key,$two,$country,$three,$enc,$val,$sup)=(split(/\t/,$_)); + while (my $line = <$fh>) { + next if ($line=~/^\#/); + chomp($line); + my ($key,$two,$country,$three,$enc,$val,$sup)=(split(/\t/,$line)); $language{$key}=$val.' - '.$enc; if ($sup) { $supported_language{$key}=$sup; @@ -122,24 +125,24 @@ BEGIN { my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}. '/copyright.tab'; if ( open (my $fh,"<$copyrightfile") ) { - while (<$fh>) { - next if /^\#/; - chomp; - my ($key,$val)=(split(/\s+/,$_,2)); + while (my $line = <$fh>) { + next if ($line=~/^\#/); + chomp($line); + my ($key,$val)=(split(/\s+/,$line,2)); $cprtag{$key}=$val; } close($fh); } } -# ------------------------------------------------------------------ source copyrights +# ----------------------------------------------------------- source copyrights { my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}. '/source_copyright.tab'; if ( open (my $fh,"<$sourcecopyrightfile") ) { - while (<$fh>) { - next if /^\#/; - chomp; - my ($key,$val)=(split(/\s+/,$_,2)); + while (my $line = <$fh>) { + next if ($line =~ /^\#/); + chomp($line); + my ($key,$val)=(split(/\s+/,$line,2)); $scprtag{$key}=$val; } close($fh); @@ -157,10 +160,10 @@ BEGIN { { my $designfile = $designdir.'/'.$filename; if ( open (my $fh,"<$designfile") ) { - while (<$fh>) { - next if /^\#/; - chomp; - my ($key,$val)=(split(/\=/,$_)); + while (my $line = <$fh>) { + next if ($line =~ /^\#/); + chomp($line); + my ($key,$val)=(split(/\=/,$line)); if ($val) { $designhash{$domain.'.'.$key}=$val; } } close($fh); @@ -176,10 +179,10 @@ BEGIN { my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}. '/filecategories.tab'; if ( open (my $fh,"<$categoryfile") ) { - while (<$fh>) { - next if /^\#/; - chomp; - my ($extension,$category)=(split(/\s+/,$_,2)); + while (my $line = <$fh>) { + next if ($line =~ /^\#/); + chomp($line); + my ($extension,$category)=(split(/\s+/,$line,2)); push @{$category_extensions{lc($category)}},$extension; } close($fh); @@ -191,13 +194,14 @@ BEGIN { my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}. '/filetypes.tab'; if ( open (my $fh,"<$typesfile") ) { - while (<$fh>) { - next if (/^\#/); - chomp; - my ($ending,$emb,$descr)=split(/\s+/,$_,3); + while (my $line = <$fh>) { + next if ($line =~ /^\#/); + chomp($line); + my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4); if ($descr ne '') { $fe{$ending}=lc($emb); $fd{$ending}=$descr; + if ($mime ne 'unk') { $fm{$ending}=$mime; } } } close($fh); @@ -704,8 +708,9 @@ sub help_open_menu { my $origurl = $ENV{'REQUEST_URI'}; $origurl=~s|^/~|/priv/|; my $timestamp = time; - foreach (\$color,\$function,\$topic,\$component_help,\$faq,\$bug,\$origurl) { - $$_ = &Apache::lonnet::escape($$_); + foreach my $datum (\$color,\$function,\$topic,\$component_help,\$faq, + \$bug,\$origurl) { + $$datum = &escape($$datum); } if (!$stayOnPage) { $link = "javascript:helpMenu('open')"; @@ -721,8 +726,18 @@ sub help_open_menu { "$text"; } my $nothing=&Apache::lonhtmlcommon::javascript_nothing(); - my $html=&Apache::lonxml::xmlbegin(); my $helpicon=&lonhttpdurl("/adm/lonIcons/helpgateway.gif"); + my $start_page = + &Apache::loncommon::start_page('Help Menu', undef, + {'frameset' => 1, + 'js_ready' => 1, + 'add_entries' => { + 'border' => '0', + 'rows' => "105,*",},}); + my $end_page = + &Apache::loncommon::end_page({'frameset' => 1, + 'js_ready' => 1,}); + $template .= <<"ENDTEMPLATE"; }{}xmsg; + return $result; } @@ -3121,11 +3609,13 @@ sub validate_page { if ( exists($env{'internal.start_page'}) && $env{'internal.start_page'} > 1) { &Apache::lonnet::logthis('start_page called multiple times '. + $env{'internal.start_page'}.' '. $ENV{'request.filename'}); } if ( exists($env{'internal.end_page'}) && $env{'internal.end_page'} > 1) { &Apache::lonnet::logthis('end_page called multiple times '. + $env{'internal.end_page'}.' '. $env{'request.filename'}); } if ( exists($env{'internal.start_page'}) @@ -3140,6 +3630,49 @@ sub validate_page { } } +sub simple_error_page { + my ($r,$title,$msg) = @_; + my $page = + &Apache::loncommon::start_page($title). + &mt($msg). + &Apache::loncommon::end_page(); + if (ref($r)) { + $r->print($page); + return; + } + return $page; +} + +{ + my $row_count; + sub start_data_table { + undef($row_count); + return ''; + } + + sub end_data_table { + undef($row_count); + return '
'; + } + + sub start_data_table_row { + $row_count++; + return ''; + } + + sub end_data_table_row { + return ''; + } + + sub start_data_table_header_row { + return ''; + } + + sub end_data_table_header_row { + return ''; + } +} + ############################################### =pod @@ -3243,20 +3776,27 @@ Returns number of sections. ############################################### 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}++; } } } @@ -3272,10 +3812,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; + return %sectioncount; } ############################################### @@ -3312,25 +3851,24 @@ can be sent to &get_group_settings() to ############################################### sub coursegroups { - my ($curr_groups,$cdom,$cnum,$group) = @_; - my $numgroups; + 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'}; } - %{$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}); + 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 $numgroups; + return %curr_groups; } ############################################### @@ -3391,7 +3929,7 @@ sub get_group_settings { $content{$tool}{$function} = $value; } } elsif ($entry eq 'groupname') { - $content{$entry}=&Apache::lonnet::unescape($value); + $content{$entry}=&unescape($value); } elsif (($entry eq 'roles') || ($entry eq 'types') || ($entry eq 'sectionpick') || ($entry eq 'defpriv')) { push(@{$content{$entry}},$value); @@ -3558,78 +4096,6 @@ sub get_user_info { return; } -############################################### - -sub get_posted_cgi { - my $r=shift; - - my $buffer; - if ($r->header_in('Content-length')) { - $r->read($buffer,$r->header_in('Content-length'),0); - } - unless ($buffer=~/^(\-+\w+)\s+Content\-Disposition\:\s*form\-data/si) { - my @pairs=split(/&/,$buffer); - my $pair; - foreach $pair (@pairs) { - my ($name,$value) = split(/=/,$pair); - $value =~ tr/+/ /; - $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; - $name =~ tr/+/ /; - $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; - &add_to_env("form.$name",$value); - } - } else { - my $contentsep=$1; - my @lines = split (/\n/,$buffer); - my $name=''; - my $value=''; - my $fname=''; - my $fmime=''; - my $i; - for ($i=0;$i<=$#lines;$i++) { - if ($lines[$i]=~/^$contentsep/) { - if ($name) { - chomp($value); - if ($fname) { - $env{"form.$name.filename"}=$fname; - $env{"form.$name.mimetype"}=$fmime; - } else { - $value=~s/\s+$//s; - } - &add_to_env("form.$name",$value); - } - if ($i<$#lines) { - $i++; - $lines[$i]=~ - /Content\-Disposition\:\s*form\-data\;\s*name\=\"([^\"]+)\"/i; - $name=$1; - $value=''; - if ($lines[$i]=~/filename\=\"([^\"]+)\"/i) { - $fname=$1; - if - ($lines[$i+1]=~/Content\-Type\:\s*([\w\-\/]+)/i) { - $fmime=$1; - $i++; - } else { - $fmime=''; - } - } else { - $fname=''; - $fmime=''; - } - $i++; - } - } else { - $value.=$lines[$i]."\n"; - } - } - } - $env{'request.method'}=$ENV{'REQUEST_METHOD'}; - $r->method_number(M_GET); - $r->method('GET'); - $r->headers_in->unset('Content-length'); -} - =pod =item * get_unprocessed_cgi($query,$possible_names) @@ -3648,9 +4114,9 @@ will result in $env{'form.uname'} and $e sub get_unprocessed_cgi { my ($query,$possible_names)= @_; # $Apache::lonxml::debug=1; - foreach (split(/&/,$query)) { - my ($name, $value) = split(/=/,$_); - $name = &Apache::lonnet::unescape($name); + foreach my $pair (split(/&/,$query)) { + my ($name, $value) = split(/=/,$pair); + $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; @@ -3866,8 +4332,7 @@ sub record_sep { if ($env{'form.upfiletype'} eq 'xml') { } elsif ($env{'form.upfiletype'} eq 'space') { my $i=0; - foreach (split(/\s+/,$record)) { - my $field=$_; + foreach my $field (split(/\s+/,$record)) { $field=~s/^(\"|\')//; $field=~s/(\"|\')$//; $components{&takeleft($i)}=$field; @@ -3875,8 +4340,7 @@ sub record_sep { } } elsif ($env{'form.upfiletype'} eq 'tab') { my $i=0; - foreach (split(/\t/,$record)) { - my $field=$_; + foreach my $field (split(/\t/,$record)) { $field=~s/^(\"|\')//; $field=~s/(\"|\')$//; $components{&takeleft($i)}=$field; @@ -3970,14 +4434,14 @@ sub csv_print_samples { my $samples = &get_samples($records,3); $r->print(&mt('Samples').'
'); - foreach (sort({$a <=> $b} keys(%{ $samples->[0] }))) { - $r->print(''); } + foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { + $r->print(''); } $r->print(''); foreach my $hash (@$samples) { $r->print(''); - foreach (sort({$a <=> $b} keys(%{ $samples->[0] }))) { + foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { $r->print(''); } $r->print(''); @@ -4010,17 +4474,17 @@ sub csv_print_select_table { '
'.&mt('Column [_1]',($_+1)).''.&mt('Column [_1]',($sample+1)).'
'); - if (defined($$hash{$_})) { $r->print($$hash{$_}); } + if (defined($$hash{$sample})) { $r->print($$hash{$sample}); } $r->print('
'. ''. ''."\n"); - foreach (@$d) { - my ($value,$display,$defaultcol)=@{ $_ }; + foreach my $array_ref (@$d) { + my ($value,$display,$defaultcol)=@{ $array_ref }; $r->print(''); $r->print(''."\n"); $i++; @@ -4281,9 +4745,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; @@ -4363,9 +4827,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', @@ -4460,9 +4924,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, @@ -4534,7 +4998,7 @@ Inputs: sub chartlink { my ($linktext, $sname, $sdomain) = @_; my $link = ''.$linktext.''; } @@ -4597,11 +5061,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}) { @@ -4635,7 +5099,7 @@ sub restore_course_settings { } elsif ($type eq 'array') { $env{'form.'.$setting} = [ map { - &Apache::lonnet::unescape($_); + &unescape($_); } split(',',$env{$envname}) ]; } @@ -4708,7 +5172,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
'.&mt('Attribute').''.&mt('Column').'
'.$display.'