diff options
Diffstat (limited to 'share/perl/lib/MyCGI.pm')
-rw-r--r-- | share/perl/lib/MyCGI.pm | 91 |
1 files changed, 91 insertions, 0 deletions
diff --git a/share/perl/lib/MyCGI.pm b/share/perl/lib/MyCGI.pm new file mode 100644 index 0000000..1f232aa --- /dev/null +++ b/share/perl/lib/MyCGI.pm | |||
@@ -0,0 +1,91 @@ | |||
1 | package MyCGI; | ||
2 | |||
3 | use strict; | ||
4 | use CGI; | ||
5 | |||
6 | sub getParam { | ||
7 | my $cgi; | ||
8 | if ($ARGV[0]) { | ||
9 | $cgi = new CGI($ARGV[0]); | ||
10 | } else { | ||
11 | $cgi = new CGI; | ||
12 | } | ||
13 | my @param_names = $cgi->param(); | ||
14 | my %param = (); | ||
15 | foreach (@param_names) { | ||
16 | $param{$_} = $cgi->param($_); | ||
17 | } | ||
18 | return \%param; | ||
19 | } | ||
20 | |||
21 | sub getCookie { | ||
22 | my $name = shift; | ||
23 | my $cookie_value = &CGI::cookie($name); | ||
24 | return &_parse($cookie_value); | ||
25 | } | ||
26 | |||
27 | sub outputHtml { | ||
28 | my ($charset, $html) = @_; | ||
29 | print &CGI::header(-charset => $charset); | ||
30 | print $html; | ||
31 | } | ||
32 | |||
33 | sub outputXml { | ||
34 | my ($charset, $xml) = @_; | ||
35 | print &CGI::header( -type => 'text/xml', -charset => $charset ); | ||
36 | print $xml; | ||
37 | } | ||
38 | |||
39 | sub makeCookieValue { | ||
40 | my $param = shift; | ||
41 | my @data = (); | ||
42 | foreach(keys %$param) { | ||
43 | push(@data, $_ . "=" . $param->{$_}); | ||
44 | } | ||
45 | return join("&", @data); | ||
46 | } | ||
47 | |||
48 | sub setCookie { | ||
49 | my $param = shift; | ||
50 | my $cookie = &CGI::cookie( | ||
51 | -name => $param->{name} || return, | ||
52 | -value => $param->{value}, | ||
53 | -domain => $param->{domain}, | ||
54 | -path => $param->{path}, | ||
55 | -expires => $param->{expires}, | ||
56 | ); | ||
57 | return &CGI::header(-cookie => $cookie); | ||
58 | } | ||
59 | |||
60 | sub redirect { | ||
61 | my $dest = shift; | ||
62 | &CGI::redirect($dest); | ||
63 | } | ||
64 | |||
65 | sub urlEncode { | ||
66 | my $str = shift; | ||
67 | $str =~ s/([^\w ])/'%'.unpack('H2', $1)/eg; | ||
68 | $str =~ tr/ /+/; | ||
69 | return $str; | ||
70 | } | ||
71 | |||
72 | sub urlDecode { | ||
73 | my $str = shift; | ||
74 | $str =~ tr/+/ /; | ||
75 | $str =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack('H2', $1)/eg; | ||
76 | return $str; | ||
77 | } | ||
78 | |||
79 | sub _parse { | ||
80 | my $value = shift; | ||
81 | my @pair = split(/&/, $value); | ||
82 | my %data = (); | ||
83 | foreach(@pair) { | ||
84 | my ($name, $value) = split(/=/, $_); | ||
85 | $data{$name} = $value; | ||
86 | } | ||
87 | return \%data; | ||
88 | } | ||
89 | |||
90 | 1; | ||
91 | |||