line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# Copyright (c) 1998-2005 by Jonathan Swartz. All rights reserved. |
2
|
|
|
|
|
|
|
# This program is free software; you can redistribute it and/or modify it |
3
|
|
|
|
|
|
|
# under the same terms as Perl itself. |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
# |
6
|
|
|
|
|
|
|
# Miscellaneous Mason-related utilities expected to be used by |
7
|
|
|
|
|
|
|
# external applications. |
8
|
|
|
|
|
|
|
# |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
package HTML::Mason::Utils; |
11
|
|
|
|
|
|
|
$HTML::Mason::Utils::VERSION = '1.59'; |
12
|
32
|
|
|
32
|
|
242
|
use HTML::Mason::Tools qw(compress_path); |
|
32
|
|
|
|
|
63
|
|
|
32
|
|
|
|
|
1568
|
|
13
|
32
|
|
|
32
|
|
173
|
use strict; |
|
32
|
|
|
|
|
59
|
|
|
32
|
|
|
|
|
612
|
|
14
|
32
|
|
|
32
|
|
148
|
use warnings; |
|
32
|
|
|
|
|
54
|
|
|
32
|
|
|
|
|
1145
|
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
require Exporter; |
17
|
|
|
|
|
|
|
|
18
|
32
|
|
|
32
|
|
174
|
use vars qw(@ISA @EXPORT_OK); |
|
32
|
|
|
|
|
60
|
|
|
32
|
|
|
|
|
8701
|
|
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
@ISA = qw(Exporter); |
21
|
|
|
|
|
|
|
@EXPORT_OK = qw(data_cache_namespace cgi_request_args); |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
sub data_cache_namespace |
24
|
|
|
|
|
|
|
{ |
25
|
0
|
|
|
0
|
1
|
0
|
my ($comp_id) = @_; |
26
|
0
|
|
|
|
|
0
|
return compress_path($comp_id); |
27
|
|
|
|
|
|
|
} |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
sub cgi_request_args |
30
|
|
|
|
|
|
|
{ |
31
|
8
|
|
|
8
|
1
|
49
|
my ($q, $method) = @_; |
32
|
|
|
|
|
|
|
|
33
|
8
|
|
|
|
|
12
|
my %args; |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
# Checking that there really is no query string when the method is |
36
|
|
|
|
|
|
|
# not POST is important because otherwise ->url_param returns a |
37
|
|
|
|
|
|
|
# parameter named 'keywords' with a value of () (empty array). |
38
|
|
|
|
|
|
|
# This is apparently a feature related to queries or |
39
|
|
|
|
|
|
|
# something (see the CGI.pm) docs. It makes my head hurt. - dave |
40
|
|
|
|
|
|
|
my @methods = |
41
|
8
|
50
|
33
|
|
|
43
|
$method ne 'POST' || ! $ENV{QUERY_STRING} ? ( 'param' ) : ( 'param', 'url_param' ); |
42
|
|
|
|
|
|
|
|
43
|
8
|
|
|
|
|
18
|
foreach my $key ( map { $q->$_() } @methods ) { |
|
8
|
|
|
|
|
27
|
|
44
|
5
|
50
|
|
|
|
78
|
next if exists $args{$key}; |
45
|
5
|
|
|
|
|
11
|
local $CGI::LIST_CONTEXT_WARN = 0; |
46
|
5
|
|
|
|
|
10
|
my @values = map { $q->$_($key) } @methods; |
|
5
|
|
|
|
|
18
|
|
47
|
5
|
100
|
|
|
|
134
|
$args{$key} = @values == 1 ? $values[0] : \@values; |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
|
50
|
8
|
100
|
|
|
|
130
|
return wantarray ? %args : \%args; |
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
1; |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
__END__ |