[LON-CAPA-cvs] cvs: loncom /interface loncommon.pm
albertel
lon-capa-cvs@mail.lon-capa.org
Wed, 26 Apr 2006 15:29:51 -0000
This is a MIME encoded message
--albertel1146065391
Content-Type: text/plain
albertel Wed Apr 26 11:29:51 2006 EDT
Modified files:
/loncom/interface loncommon.pm
Log:
- death to $_
- select_form need to esacpe the $key from having bad values
--albertel1146065391
Content-Type: text/plain
Content-Disposition: attachment; filename="albertel-20060426112951.txt"
Index: loncom/interface/loncommon.pm
diff -u loncom/interface/loncommon.pm:1.355 loncom/interface/loncommon.pm:1.356
--- loncom/interface/loncommon.pm:1.355 Tue Apr 25 17:24:06 2006
+++ loncom/interface/loncommon.pm Wed Apr 26 11:29:51 2006
@@ -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.356 2006/04/26 15:29:51 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -107,10 +107,10 @@
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 @@
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 @@
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 @@
{
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 @@
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 @@
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 @@
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 @@
# 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 @@
my @order = ref($order) ? @$order
: sort(keys(%$hash));
foreach my $key (@order) {
- $output.='<option value="'.$key.'" ';
+ $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
$output.='selected="selected" ' if ($selected{$key});
$output.='>'.$hash->{$key}."</option>\n";
}
@@ -1238,10 +1239,11 @@
} else {
@keys=sort(keys(%hash));
}
- foreach (@keys) {
- $selectform.="<option value=\"$_\" ".
- ($_ eq $def ? 'selected="selected" ' : '').
- ">".&mt($hash{$_})."</option>\n";
+ foreach my $key (@keys) {
+ $selectform.=
+ '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
+ ($key eq $def ? 'selected="selected" ' : '').
+ ">".&mt($hash{$key})."</option>\n";
}
$selectform.="</select>";
return $selectform;
@@ -1305,10 +1307,10 @@
my @domains = get_domains();
if ($includeempty) { @domains=('',@domains); }
my $selectdomain = "<select name=\"$name\" size=\"1\">\n";
- foreach (@domains) {
- $selectdomain.="<option value=\"$_\" ".
- ($_ eq $defdom ? 'selected="selected" ' : '').
- ">$_</option>\n";
+ foreach my $dom (@domains) {
+ $selectdomain.="<option value=\"$dom\" ".
+ ($dom eq $defdom ? 'selected="selected" ' : '').
+ ">$dom</option>\n";
}
$selectdomain.="</select>";
return $selectdomain;
@@ -1330,9 +1332,9 @@
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 @@
my $domain = shift;
my %servers = &get_library_servers($domain);
my $result = '';
- foreach (sort keys(%servers)) {
+ foreach my $hostid (sort(keys(%servers))) {
$result.=
- '<option value="'.$_.'">'.$_.' '.$servers{$_}."</option>\n";
+ '<option value="'.$hostid.'">'.
+ $hostid.' '.$servers{$hostid}."</option>\n";
}
return $result;
}
@@ -1846,8 +1849,8 @@
}
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 @@
}
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 @@
=cut
sub filecategorytypes {
- return @{$category_extensions{lc($_[0])}};
+ my ($cat) = @_;
+ return @{$category_extensions{lc($cat)}};
}
=pod
@@ -2259,13 +2263,13 @@
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 @@
}
# 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 @@
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='<table border="0" width="100%"><tr><td bgcolor="#777777">';
$prevattempts.='<table border="0" width="100%"><tr bgcolor="#e6ffff"><td>History</td>';
- 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 @@
if ($getattempt eq '') {
for ($version=1;$version<=$returnhash{'version'};$version++) {
$prevattempts.='</tr><tr bgcolor="#ffffe6"><td>Transaction '.$version.'</td>';
- 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.='<td>'.&Apache::lonnet::unescape($value).' </td>';
}
}
}
$prevattempts.='</tr><tr bgcolor="#ffffe6"><td>Current</td>';
- 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.='<td>'.$value.' </td>';
}
$prevattempts.='</tr></table></td></tr></table>';
@@ -2435,14 +2439,14 @@
}
}
$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
@@ -2959,7 +2963,7 @@
</td></tr>
<tr>
<td bgcolor="$tabbg" align="right"><font size="2" face="Arial, Helvetica, sans-serif">$realm</font> </td></tr>
-</table><br />
+</table>
ENDBODY
}
@@ -4033,8 +4037,8 @@
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 +4255,7 @@
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 +4263,7 @@
}
} 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 +4357,14 @@
my $samples = &get_samples($records,3);
$r->print(&mt('Samples').'<br /><table border="2"><tr>');
- foreach (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
- $r->print('<th>'.&mt('Column [_1]',($_+1)).'</th>'); }
+ foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
+ $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
$r->print('</tr>');
foreach my $hash (@$samples) {
$r->print('<tr>');
- foreach (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
+ foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
$r->print('<td>');
- if (defined($$hash{$_})) { $r->print($$hash{$_}); }
+ if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
$r->print('</td>');
}
$r->print('</tr>');
@@ -4395,17 +4397,17 @@
'<table border="2"><tr>'.
'<th>'.&mt('Attribute').'</th>'.
'<th>'.&mt('Column').'</th></tr>'."\n");
- foreach (@$d) {
- my ($value,$display,$defaultcol)=@{ $_ };
+ foreach my $array_ref (@$d) {
+ my ($value,$display,$defaultcol)=@{ $array_ref };
$r->print('<tr><td>'.$display.'</td>');
$r->print('<td><select name=f'.$i.
' onchange="javascript:flip(this.form,'.$i.');">');
$r->print('<option value="none"></option>');
- foreach (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
- $r->print('<option value="'.$_.'"'.
- ($_ eq $defaultcol ? ' selected="selected" ' : '').
- '>Column '.($_+1).'</option>');
+ foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
+ $r->print('<option value="'.$sample.'"'.
+ ($sample eq $defaultcol ? ' selected="selected" ' : '').
+ '>Column '.($sample+1).'</option>');
}
$r->print('</select></td></tr>'."\n");
$i++;
--albertel1146065391--