File Coverage

blib/lib/HTML/Mason/Utils.pm
Criterion Covered Total %
statement 23 25 92.0
branch 6 8 75.0
condition 1 3 33.3
subroutine 5 6 83.3
pod 2 2 100.0
total 37 44 84.0


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.58';
12 32     32   186 use HTML::Mason::Tools qw(compress_path);
  32         60  
  32         1372  
13 32     32   171 use strict;
  32         57  
  32         604  
14 32     32   136 use warnings;
  32         55  
  32         1089  
15              
16             require Exporter;
17              
18 32     32   149 use vars qw(@ISA @EXPORT_OK);
  32         49  
  32         6666  
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 46 my ($q, $method) = @_;
32              
33 8         11 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     26 $method ne 'POST' || ! $ENV{QUERY_STRING} ? ( 'param' ) : ( 'param', 'url_param' );
42              
43 8         16 foreach my $key ( map { $q->$_() } @methods ) {
  8         22  
44 5 50       68 next if exists $args{$key};
45 5         11 local $CGI::LIST_CONTEXT_WARN = 0;
46 5         7 my @values = map { $q->$_($key) } @methods;
  5         12  
47 5 100       107 $args{$key} = @values == 1 ? $values[0] : \@values;
48             }
49              
50 8 100       102 return wantarray ? %args : \%args;
51             }
52              
53              
54             1;
55              
56             __END__