File Coverage

blib/lib/AxKit/XSP/QueryParam.pm
Criterion Covered Total %
statement 1 3 33.3
branch n/a
condition n/a
subroutine 1 1 100.0
pod n/a
total 2 4 50.0


line stmt bran cond sub pod time code
1             package AxKit::XSP::QueryParam;
2             # $Id: QueryParam.pm,v 1.6 2004/01/28 00:35:19 nachbaur Exp $
3 1     1   7906 use Apache;
  0            
  0            
4             use Apache::Request;
5             use Apache::AxKit::Language::XSP::TaglibHelper;
6             sub parse_char { Apache::AxKit::Language::XSP::TaglibHelper::parse_char(@_); }
7             sub parse_start { Apache::AxKit::Language::XSP::TaglibHelper::parse_start(@_); }
8             sub parse_end { Apache::AxKit::Language::XSP::TaglibHelper::parse_end(@_); }
9              
10             @EXPORT_TAGLIB = (
11             'exists($name):isreally=paramexists',
12             'remove($name)',
13             'set($name,$value)',
14             'get($name;$index)',
15             'count(;$name)',
16             'if($name;$value):conditional=1:isreally=ifparam',
17             'unless($name;$value):conditional=1:isreally=unlessparam',
18             'if_regex($name,$value):conditional=1',
19             'unless_regex($name,$value):conditional=1',
20             'if_exists($name):conditional=1',
21             'unless_exists($name):conditional=1',
22             'enumerate(;$name):listtag=param-list:itemtag=param:forcearray=1',
23             );
24              
25             @ISA = qw(Apache::AxKit::Language::XSP::TaglibHelper);
26             $NS = 'http://www.axkit.org/2002/XSP/QueryParam';
27             $VERSION = "0.02";
28              
29             use strict;
30              
31             ## Taglib subs
32              
33             sub if_exists
34             {
35             my ( $name ) = @_;
36             if (paramexists($name)) {
37             return 1;
38             }
39             return undef;
40             }
41              
42             sub unless_exists
43             {
44             return undef if (if_exists(@_));
45             return 1;
46             }
47              
48             sub if_regex
49             {
50             my ( $name, $value ) = @_;
51             my $r = Apache->request;
52             my $req = Apache::Request->instance($r);
53             if ($req->param($name) =~ /$value/) {
54             return 1;
55             }
56             return undef;
57             }
58              
59             sub unless_regex
60             {
61             return undef if (if_regex(@_));
62             return 1;
63             }
64              
65             sub ifparam
66             {
67             my ( $name, $value ) = @_;
68             my $r = Apache->request;
69             my $req = Apache::Request->instance($r);
70             if (defined($value)) {
71             if ($req->param($name) =~ /^-?\d*\.?\d+$/ and $value =~ /^-?\d*\.?\d+$/) {
72             if ($req->param($name) == $value) {
73             return 1;
74             }
75             } else {
76             if ($req->param($name) eq $value) {
77             return 1;
78             }
79             }
80             } else {
81             if ($req->param($name)) {
82             return 1;
83             }
84             }
85             return undef;
86             }
87              
88             sub unlessparam
89             {
90             return undef if (ifparam(@_));
91             return 1;
92             }
93              
94             sub paramexists
95             {
96             my ( $name ) = @_;
97             my $r = Apache->request;
98             my $req = Apache::Request->instance($r);
99             my @params = $req->param;
100             foreach my $key (@params) {
101             return 1 if ($key eq $name);
102             }
103             return 0;
104             }
105              
106             sub remove
107             {
108             my ( $name ) = @_;
109             my $r = Apache->request;
110             my $req = Apache::Request->instance($r);
111             my $table = $req->parms;
112             $table->unset($name);
113             return undef;
114             }
115              
116             sub set
117             {
118             my ( $name, $value ) = @_;
119             my $r = Apache->request;
120             my $req = Apache::Request->instance($r);
121             $req->param($name, $value);
122             return undef;
123             }
124              
125             sub get
126             {
127             my ( $name, $index ) = @_;
128             my $r = Apache->request;
129             my $req = Apache::Request->instance($r);
130             my @values = $req->param($name);
131             if ($index) {
132             return $values[$index - 1];
133             } else {
134             return $values[0];
135             }
136             }
137              
138             sub enumerate
139             {
140             my ( $name ) = @_;
141             my $r = Apache->request;
142             my $req = Apache::Request->instance($r);
143             my @tree = ();
144             if ($name) {
145             foreach my $value ($req->param($name)) {
146             push @tree, {
147             name => $name,
148             value => $value,
149             };
150             }
151             } else {
152             foreach my $key ($req->param) {
153             foreach my $value ($req->param($key)) {
154             push @tree, {
155             name => $key,
156             value => $value,
157             };
158             }
159             }
160             }
161             return @tree;
162             }
163              
164             sub count
165             {
166             my ( $name ) = @_;
167             my $r = Apache->request;
168             my $req = Apache::Request->instance($r);
169             if ($name) {
170             my @values = $req->param($name);
171             return scalar(@values);
172             } else {
173             my $count = 0;
174             foreach my $key ($req->param) {
175             foreach my $value ($req->param($key)) {
176             $count++;
177             }
178             }
179             return $count;
180             }
181             }
182              
183             1;
184              
185             __END__