--- loncom/interface/loncommon.pm 2006/04/25 21:24:06 1.355 +++ loncom/interface/loncommon.pm 2006/05/09 14:38:09 1.365 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.355 2006/04/25 21:24:06 albertel Exp $ +# $Id: loncommon.pm,v 1.365 2006/05/09 14:38:09 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -107,10 +107,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; @@ -124,10 +124,10 @@ 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); @@ -138,10 +138,10 @@ BEGIN { 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); @@ -159,10 +159,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); @@ -178,10 +178,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); @@ -193,10 +193,10 @@ BEGIN { my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}. '/filetypes.tab'; if ( open (my $fh,"<$typesfile") ) { - while (<$fh>) { - next if (/^\#/); - chomp; - my ($ending,$emb,$mime,$descr)=split(/\s+/,$_,4); + 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; @@ -707,8 +707,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 = &Apache::lonnet::escape($$datum); } if (!$stayOnPage) { $link = "javascript:helpMenu('open')"; @@ -1153,8 +1154,8 @@ sub get_domains { # The code below was stolen from "The Perl Cookbook", p 102, 1st ed. my @domains; my %seen; - foreach (sort values(%Apache::lonnet::hostdom)) { - push (@domains,$_) unless $seen{$_}++; + foreach my $dom (sort(values(%Apache::lonnet::hostdom))) { + push(@domains,$dom) unless $seen{$dom}++; } return @domains; } @@ -1208,7 +1209,7 @@ sub multiple_select_form { my @order = ref($order) ? @$order : sort(keys(%$hash)); foreach my $key (@order) { - $output.='\n"; } @@ -1238,10 +1239,11 @@ sub select_form { } else { @keys=sort(keys(%hash)); } - foreach (@keys) { - $selectform.="\n"; + foreach my $key (@keys) { + $selectform.= + '\n"; } $selectform.=""; return $selectform; @@ -1305,10 +1307,10 @@ sub select_dom_form { my @domains = get_domains(); if ($includeempty) { @domains=('',@domains); } my $selectdomain = ""; return $selectdomain; @@ -1330,9 +1332,9 @@ given $domain. sub get_library_servers { my $domain = shift; my %library_servers; - foreach (keys(%Apache::lonnet::libserv)) { - if ($Apache::lonnet::hostdom{$_} eq $domain) { - $library_servers{$_} = $Apache::lonnet::hostname{$_}; + foreach my $hostid (keys(%Apache::lonnet::libserv)) { + if ($Apache::lonnet::hostdom{$hostid} eq $domain) { + $library_servers{$hostid} = $Apache::lonnet::hostname{$hostid}; } } return %library_servers; @@ -1354,9 +1356,10 @@ sub home_server_option_list { my $domain = shift; my %servers = &get_library_servers($domain); my $result = ''; - foreach (sort keys(%servers)) { + foreach my $hostid (sort(keys(%servers))) { $result.= - '\n"; + '\n"; } return $result; } @@ -1846,8 +1849,8 @@ sub initialize_keywords { } untie %thesaurus_db; # Remove special values from %Keywords. - foreach ('total.count','average.count') { - delete($Keywords{$_}) if (exists($Keywords{$_})); + foreach my $value ('total.count','average.count') { + delete($Keywords{$value}) if (exists($Keywords{$value})); } return 1; } @@ -1903,11 +1906,11 @@ sub get_related_words { } my @Words=(); if (exists($thesaurus_db{$keyword})) { - $_ = $thesaurus_db{$keyword}; - (undef,@Words) = split/:/; # The first element is the number of times - # the word appears. We do not need it now. + # 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]; + ($Words[$i],undef)= split(/\,/,$Words[$i]); } } untie %thesaurus_db; @@ -2184,7 +2187,8 @@ category =cut sub filecategorytypes { - return @{$category_extensions{lc($_[0])}}; + my ($cat) = @_; + return @{$category_extensions{lc($cat)}}; } =pod @@ -2259,13 +2263,13 @@ sub fileextensions { sub display_languages { my %languages=(); - foreach (&preferred_languages()) { - $languages{$_}=1; + foreach my $lang (&preferred_languages()) { + $languages{$lang}=1; } &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']); if ($env{'form.displaylanguage'}) { - foreach (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) { - $languages{$_}=1; + foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) { + $languages{$lang}=1; } } return %languages; @@ -2300,11 +2304,11 @@ sub preferred_languages { } # turn "en-ca" into "en-ca,en" my @genlanguages; - foreach (@languages) { - unless ($_=~/\w/) { next; } - push (@genlanguages,$_); - if ($_=~/(\-|\_)/) { - push (@genlanguages,(split(/(\-|\_)/,$_))[0]); + foreach my $lang (@languages) { + unless ($lang=~/\w/) { next; } + push (@genlanguages,$lang); + if ($lang=~/(\-|\_)/) { + push(@genlanguages,(split(/(\-|\_)/,$lang))[0]); } } return @genlanguages; @@ -2360,14 +2364,14 @@ sub get_previous_attempt { my %lasthash=(); my $version; for ($version=1;$version<=$returnhash{'version'};$version++) { - foreach (sort(split(/\:/,$returnhash{$version.':keys'}))) { - $lasthash{$_}=$returnhash{$version.':'.$_}; + foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) { + $lasthash{$key}=$returnhash{$version.':'.$key}; } } $prevattempts='
'; $prevattempts.=''; - foreach (sort(keys %lasthash)) { - my ($ign,@parts) = split(/\./,$_); + foreach my $key (sort(keys(%lasthash))) { + my ($ign,@parts) = split(/\./,$key); if ($#parts > 0) { my $data=$parts[-1]; pop(@parts); @@ -2383,27 +2387,27 @@ sub get_previous_attempt { if ($getattempt eq '') { for ($version=1;$version<=$returnhash{'version'};$version++) { $prevattempts.=''; - foreach (sort(keys %lasthash)) { + foreach my $key (sort(keys(%lasthash))) { my $value; - if ($_ =~ /timestamp/) { - $value=scalar(localtime($returnhash{$version.':'.$_})); + if ($key =~ /timestamp/) { + $value=scalar(localtime($returnhash{$version.':'.$key})); } else { - $value=$returnhash{$version.':'.$_}; + $value=$returnhash{$version.':'.$key}; } $prevattempts.=''; } } } $prevattempts.=''; - foreach (sort(keys %lasthash)) { + foreach my $key (sort(keys(%lasthash))) { my $value; - if ($_ =~ /timestamp/) { - $value=scalar(localtime($lasthash{$_})); + if ($key =~ /timestamp/) { + $value=scalar(localtime($lasthash{$key})); } else { - $value=$lasthash{$_}; + $value=$lasthash{$key}; } $value=&Apache::lonnet::unescape($value); - if ($_ =~/$regexp$/ && (defined &$gradesub)) {$value = &$gradesub($value)} + if ($key =~/$regexp$/ && (defined &$gradesub)) {$value = &$gradesub($value)} $prevattempts.=''; } $prevattempts.='
History
Transaction '.$version.''.&Apache::lonnet::unescape($value).' 
Current'.$value.' 
'; @@ -2435,14 +2439,14 @@ sub relative_to_absolute { } } $thisdir=~s-/[^/]*$--; - foreach (@rlinks) { - unless (($_=~/^http:\/\//i) || - ($_=~/^\//) || - ($_=~/^javascript:/i) || - ($_=~/^mailto:/i) || - ($_=~/^\#/)) { - my $newlocation=&Apache::lonnet::hreflocation($thisdir,$_); - $output=~s/(\"|\'|\=\s*)$_(\"|\'|\s|\>)/$1$newlocation$2/; + foreach my $link (@rlinks) { + unless (($link=~/^http:\/\//i) || + ($link=~/^\//) || + ($link=~/^javascript:/i) || + ($link=~/^mailto:/i) || + ($link=~/^\#/)) { + my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link); + $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/; } } # -------------------------------------------------- Deal with Applet codebases @@ -2769,6 +2773,9 @@ Inputs: =item * $notitle, if true keep the nav controls, but remove the title bar +=item * $no_inline_link, if true and in remote mode, don't show the + 'Switch To Inline Menu' link + =back @@ -2781,15 +2788,13 @@ other decorations will be returned. sub bodytag { my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,$customtitle, - $notopbar,$bgcolor,$notitle)=@_; + $notopbar,$bgcolor,$notitle,$no_inline_link)=@_; $title=&mt($title); $function = &get_users_function() if (!$function); my $img = &designparm($function.'.img',$domain); - my $tabbg = &designparm($function.'.tabbg',$domain); my $font = &designparm($function.'.font',$domain); - my $sidebg = &designparm($function.'.sidebg',$domain); my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain); my %design = ( 'style' => 'margin-top: 0px', @@ -2801,14 +2806,13 @@ 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) = + &Apache::lonnet::plaintext((split(/\./,$env{'request.role'}))[0]); # realm if ($env{'request.course.id'}) { - $realm= - $env{'course.'.$env{'request.course.id'}.'.description'}; + $realm = $env{'course.'.$env{'request.course.id'}.'.description'}; } - unless ($realm) { $realm=' '; } + if (!$realm) { $realm=' '; } # Set messages my $messages=&domainlogo($domain); # Port for miniserver @@ -2818,14 +2822,9 @@ sub bodytag { my $extra_body_attr = &make_attr_string($forcereg,$addentries); # construct main body tag - my $bodytag = < -END - - $bodytag .= &Apache::lontexconvert::init_math_support(); + my $bodytag = "". + &Apache::lontexconvert::init_math_support(); - my $upperleft=''.$function.''; if ($bodyonly || ($env{'request.state'} eq 'construct' && $env{'environment.remote'} ne 'off' )) { @@ -2838,75 +2837,92 @@ END $bodytag.='

LON-CAPA: '.$title.'

'; } return $bodytag; - } elsif ($env{'environment.remote'} eq 'off') { -# No Remote - my $roleinfo=(< - + } + + + + my $roleinfo=(< +
$env{'environment.firstname'} $env{'environment.middlename'} $env{'environment.lastname'} $env{'environment.generation'} -   -
-$role  -
-$realm  +   +
+
+$role  +
+
+$realm  +
ENDROLE - my $titleinfo = ''.$title.''; - if ($customtitle) { - $titleinfo = $customtitle; - } + my $titleinfo = ''.$title.''; + if ($customtitle) { + $titleinfo = $customtitle; + } + # + # Extra info if you are the DC + my $dc_info = ''; + if ($env{'user.adv'} && exists($env{'user.role.dc./'. + $env{'course.'.$env{'request.course.id'}. + '.domain'}.'/'})) { + my $cid = $env{'request.course.id'}; + $dc_info.= $cid.' '.$env{'course.'.$cid.'.internal.coursecode'}; + $dc_info = '('.$dc_info.')'; + } + + if ($env{'environment.remote'} eq 'off') { + # No Remote if ($env{'request.state'} eq 'construct') { + $forcereg=1; + } + + if (!$customtitle && $env{'request.state'} eq 'construct') { + # this is for resources; directories have customtitle, and crumbs + # and select recent are created in lonpubdir.pm my ($uname,$thisdisfn)= ($env{'request.filename'} =~ m|^/home/([^/]+)/public_html/(.*)|); my $formaction='/priv/'.$uname.'/'.$thisdisfn; $formaction=~s/\/+/\//g; - unless ($customtitle) { #this is for resources; directories have customtitle, and crumbs and select recent are created in lonpubdir.pm - my $parentpath = ''; - my $lastitem = ''; - if ($thisdisfn =~ m-(.+/)([^/]*)$-) { - $parentpath = $1; - $lastitem = $2; - } else { - $lastitem = $thisdisfn; - } - $titleinfo = &Apache::loncommon::help_open_menu('','','','',3,'Authoring'). - 'Construction Space: '. - '
' - .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv','','+1',1)."$lastitem
" - .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()') - .'
' - .&Apache::lonmenu::constspaceform(); - } - $forcereg=1; + my $parentpath = ''; + my $lastitem = ''; + if ($thisdisfn =~ m-(.+/)([^/]*)$-) { + $parentpath = $1; + $lastitem = $2; + } else { + $lastitem = $thisdisfn; + } + $titleinfo = + &Apache::loncommon::help_open_menu('','','','',3,'Authoring'). + 'Construction Space: '. + '
' + .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv','','+1',1)."$lastitem
" + .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()') + .'
' + .&Apache::lonmenu::constspaceform(); } + my $titletable; if (!$notitle) { $titletable = - ''. - ''.$roleinfo.'
'. - $titleinfo.'
'; + ''. + "".$roleinfo. + '
$titleinfo $dc_info
'; } - if ($env{'request.state'} eq 'construct') { - if ($notopbar) { - $bodytag .= $titletable; - } else { + if ($notopbar) { + $bodytag .= $titletable; + } else { + if ($env{'request.state'} eq 'construct') { $bodytag .= &Apache::lonmenu::menubuttons($forcereg,$forcereg, $titletable); - } - } else { - if ($notopbar) { - $bodytag .= $titletable; } else { $bodytag .= &Apache::lonmenu::menubuttons($forcereg,$forcereg). - $titletable; + $titletable; } } return $bodytag; @@ -2915,51 +2931,26 @@ ENDROLE # # Top frame rendering, Remote is up # - my $titleinfo = ' '.$title.''; - if ($customtitle) { - $titleinfo = $customtitle; - } - # - # Extra info if you are the DC - my $dc_info = ''; - if ($env{'user.adv'} && exists($env{'user.role.dc./'. - $env{'course.'.$env{'request.course.id'}. - '.domain'}.'/'})) { - my $cid = $env{'request.course.id'}; - $dc_info.= $cid.' '.$env{'course.'.$cid.'.internal.coursecode'}; - $dc_info = '('.$dc_info.')'; - } + + my $upperleft=''.$function.''; + # Explicit link to get inline menu - my $menu='
 '.&mt('Switch to Inline Menu Mode').''; + my $menu= ($no_inline_link?'' + :'
'.&mt('Switch to Inline Menu Mode').''); # if ($notitle) { return $bodytag; } return(< - -$upperleft -$messages  + + + - - - - - - -
$upperleft
-$titleinfo $dc_info $menu - - - $env{'environment.firstname'} - $env{'environment.middlename'} - $env{'environment.lastname'} - $env{'environment.generation'} -   -
-$role  -
$realm 

+$titleinfo $dc_info $menu +$roleinfo + ENDBODY } @@ -3098,7 +3089,6 @@ sub standard_css { my $mail_other_hover = '#669999'; return < h1, h2, h3, th { font-family: $sans } a:focus { color: red; background: yellow } table.thinborder { border-collapse: collapse; } @@ -3114,15 +3104,49 @@ form, .inline { display: inline; } color: green; } -table#LC_top_nav, table#LC_menubuttons, table#LC_nav_location { +table#LC_top_nav, table#LC_menubuttons, table#LC_nav_location, table#LC_breadcrumbs { width: 100%; background: $pgbg; border: 0px; - border-spacing: 1px; + border-spacing: 2px 1px; padding: 0px; margin: 0px; border-collapse: separate; } +table#LC_title_bar { + width: 100%; + border: 0; + border-spacing: 0px 1px; + background: $pgbg; + font-family: $sans; + border-collapse: collapse; +} +table#LC_title_bar.LC_with_remote { + width: 100%; + border: 0; + border-spacing: 0; + background: $pgbg; + font-family: $sans; + border-collapse: collapse; +} +table#LC_title_bar td { + padding: 3px; + background: $tabbg; +} +table#LC_title_bar td.LC_title_bar_who { + background: $tabbg; + color: $font; + font: medium $sans; + text-align: right; +} +span.LC_title_bar_title { + font: bold xx-large $sans; +} +table#LC_title_bar td.LC_title_bar_domain_logo { + background: $sidebg; + text-align: right; +} + table#LC_menubuttons_mainmenu { background: $pgbg; border: 0px; @@ -3141,6 +3165,23 @@ table#LC_top_nav td a, div#LC_top_nav a color: $font; font-family: $sans; } +table#LC_top_nav td.LC_top_nav_logo { + background: $tabbg; + text-align: right; +} +table#LC_breadcrumbs td { + background: $tabbg; + color: $font; + font-family: $sans; + font-size: smaller; +} +table#LC_breadcrumbs td.LC_breadcrumb_component { + background: $tabbg; + color: $font; + font-family: $sans; + font-size: larger; + text-align: right; +} .LC_menubuttons_inline_text { color: $font; font-family: $sans; @@ -3223,7 +3264,6 @@ table.LC_mail_list tr.LC_mail_other { table.LC_mail_list tr.LC_mail_other:hover { background-color: $mail_other_hover; } - END } @@ -3257,10 +3297,18 @@ Inputs: $title - optional title for the sub headtag { my ($title,$head_extra,$args) = @_; + 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'}, + $function,$domain,$bgcolor); + + $url = '/adm/css/'.&Apache::lonnet::escape($url).'.css'; + my $result = ''. - &standard_css($args->{'function'},$args->{'domain'}, - $args->{'bgcolor'}). + ''. &font_settings(). &Apache::lonhtmlcommon::htmlareaheaders(); @@ -3419,6 +3467,9 @@ Inputs: $title - optional title for the head -> skip the generation body -> skip all generation + no_inline_link -> if true and in remote mode, don't show the + 'Switch To Inline Menu' link + =back =cut @@ -3454,7 +3505,7 @@ sub start_page { $args->{'only_body'}, $args->{'domain'}, $args->{'force_register'}, $args->{'body_title'}, $args->{'no_nav_bar'}, $args->{'bgcolor'}, - $args->{'no_title'}); + $args->{'no_title'}, $args->{'no_inline_link'}); } } @@ -3769,25 +3820,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; } ############################################### @@ -4033,8 +4083,8 @@ 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(/=/,$_); + foreach my $pair (split(/&/,$query)) { + my ($name, $value) = split(/=/,$pair); $name = &Apache::lonnet::unescape($name); if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) { $value =~ tr/+/ /; @@ -4251,8 +4301,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; @@ -4260,8 +4309,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; @@ -4355,14 +4403,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(''); @@ -4395,17 +4443,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++;
'.&mt('Attribute').''.&mt('Column').'
'.$display.'