package CGI::Util;
-=pod
-
-=head1 NAME
-
-CGI::Util - various utilities
-
-=cut
-
use strict;
-use vars '$VERSION','@EXPORT_OK','@ISA','$EBCDIC','@A2E';
+use vars '$VERSION','@EXPORT_OK','@ISA','$EBCDIC','@A2E','@E2A';
require Exporter;
@ISA = qw(Exporter);
@EXPORT_OK = qw(rearrange make_attributes unescape escape expires);
$EBCDIC = "\t" ne "\011";
if ($EBCDIC) {
+# (ord('^') == 95) for codepage 1047 as on os390, vmesa
@A2E = (
0, 1, 2, 3, 55, 45, 46, 47, 22, 5, 21, 11, 12, 13, 14, 15,
16, 17, 18, 19, 60, 61, 50, 38, 24, 25, 63, 39, 28, 29, 30, 31,
68, 69, 66, 70, 67, 71,156, 72, 84, 81, 82, 83, 88, 85, 86, 87,
140, 73,205,206,203,207,204,225,112,221,222,219,220,141,142,223
);
+@E2A = (
+ 0, 1, 2, 3,156, 9,134,127,151,141,142, 11, 12, 13, 14, 15,
+ 16, 17, 18, 19,157, 10, 8,135, 24, 25,146,143, 28, 29, 30, 31,
+128,129,130,131,132,133, 23, 27,136,137,138,139,140, 5, 6, 7,
+144,145, 22,147,148,149,150, 4,152,153,154,155, 20, 21,158, 26,
+ 32,160,226,228,224,225,227,229,231,241,162, 46, 60, 40, 43,124,
+ 38,233,234,235,232,237,238,239,236,223, 33, 36, 42, 41, 59, 94,
+ 45, 47,194,196,192,193,195,197,199,209,166, 44, 37, 95, 62, 63,
+248,201,202,203,200,205,206,207,204, 96, 58, 35, 64, 39, 61, 34,
+216, 97, 98, 99,100,101,102,103,104,105,171,187,240,253,254,177,
+176,106,107,108,109,110,111,112,113,114,170,186,230,184,198,164,
+181,126,115,116,117,118,119,120,121,122,161,191,208, 91,222,174,
+172,163,165,183,169,167,182,188,189,190,221,168,175, 93,180,215,
+123, 65, 66, 67, 68, 69, 70, 71, 72, 73,173,244,246,242,243,245,
+125, 74, 75, 76, 77, 78, 79, 80, 81, 82,185,251,252,249,250,255,
+ 92,247, 83, 84, 85, 86, 87, 88, 89, 90,178,212,214,210,211,213,
+ 48, 49, 50, 51, 52, 53, 54, 55, 56, 57,179,219,220,217,218,159
+ );
+if (ord('^') == 106) { # as in the BS2000 posix-bc coded character set
+ $A2E[91] = 187; $A2E[92] = 188; $A2E[94] = 106; $A2E[96] = 74;
+ $A2E[123] = 251; $A2E[125] = 253; $A2E[126] = 255; $A2E[159] = 95;
+ $A2E[162] = 176; $A2E[166] = 208; $A2E[168] = 121; $A2E[172] = 186;
+ $A2E[175] = 161; $A2E[217] = 224; $A2E[219] = 221; $A2E[221] = 173;
+ $A2E[249] = 192;
+
+ $E2A[74] = 96; $E2A[95] = 159; $E2A[106] = 94; $E2A[121] = 168;
+ $E2A[161] = 175; $E2A[173] = 221; $E2A[176] = 162; $E2A[186] = 172;
+ $E2A[187] = 91; $E2A[188] = 92; $E2A[192] = 249; $E2A[208] = 166;
+ $E2A[221] = 219; $E2A[224] = 217; $E2A[251] = 123; $E2A[253] = 125;
+ $E2A[255] = 126;
+}
+elsif (ord('^') == 176) { # as in codepage 037 on os400
+ $A2E[10] = 37; $A2E[91] = 186; $A2E[93] = 187; $A2E[94] = 176;
+ $A2E[133] = 21; $A2E[168] = 189; $A2E[172] = 95; $A2E[221] = 173;
+
+ $E2A[21] = 133; $E2A[37] = 10; $E2A[95] = 172; $E2A[173] = 221;
+ $E2A[176] = 94; $E2A[186] = 91; $E2A[187] = 93; $E2A[189] = 168;
+}
}
# Smart rearrangement of parameters to allow named parameter
my ($i,%pos);
$i = 0;
foreach (@$order) {
- foreach (ref($_) eq 'ARRAY' ? @$_ : $_) { $pos{$_} = $i; }
+ foreach (ref($_) eq 'ARRAY' ? @$_ : $_) { $pos{lc($_)} = $i; }
$i++;
}
my (@result,%leftover);
$#result = $#$order; # preextend
while (@param) {
- my $key = uc(shift(@param));
+ my $key = lc(shift(@param));
$key =~ s/^\-//;
if (exists $pos{$key}) {
$result[$pos{$key}] = shift(@param);
}
}
- push (@result,make_attributes(\%leftover)) if %leftover;
+ push (@result,make_attributes(\%leftover,1)) if %leftover;
@result;
}
foreach (keys %{$attr}) {
my($key) = $_;
$key=~s/^\-//; # get rid of initial - if present
- $key=~tr/a-z_/A-Z-/; # parameters are upper case, use dashes
+ $key=~tr/A-Z_/a-z-/; # parameters are lower case, use dashes
my $value = $escape ? simple_escape($attr->{$_}) : $attr->{$_};
push(@att,defined($attr->{$_}) ? qq/$key="$value"/ : qq/$key/);
}
}
sub simple_escape {
- return unless defined (my $toencode = shift);
- $toencode =~ s{(.)}{
- if ($1 eq '<') { '<' }
- elsif ($1 eq '>') { '>' }
- elsif ($1 eq '&') { '&' }
- elsif ($1 eq '"') { '"' }
- elsif ($1 eq "\x8b") { '‹' }
- elsif ($1 eq "\x9b") { '›' }
- else { $1 }
- }gsex;
+ return unless defined(my $toencode = shift);
+ $toencode =~ s{&}{&}gso;
+ $toencode =~ s{<}{<}gso;
+ $toencode =~ s{>}{>}gso;
+ $toencode =~ s{\"}{"}gso;
+# Doesn't work. Can't work. forget it.
+# $toencode =~ s{\x8b}{‹}gso;
+# $toencode =~ s{\x9b}{›}gso;
$toencode;
}
shift() if ref($_[0]) || (defined $_[1] && $_[0] eq $CGI::DefaultClass);
my $toencode = shift;
return undef unless defined($toencode);
- $toencode=~s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02x",ord($1))/eg;
+ if ($EBCDIC) {
+ $toencode=~s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02x",$E2A[ord($1)])/eg;
+ } else {
+ $toencode=~s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02x",ord($1))/eg;
+ }
return $toencode;
}