File Coverage

blib/lib/CGI/URI2param.pm
Criterion Covered Total %
statement 23 24 95.8
branch 4 8 50.0
condition n/a
subroutine 5 5 100.0
pod 1 1 100.0
total 33 38 86.8


line stmt bran cond sub pod time code
1             #-----------------------------------------------------------------
2             # CGI::URI2param - convert parts of an URL to param values
3             #-----------------------------------------------------------------
4             # Copyright Thomas Klausner / ZSI 2001,2002,2006
5             # You may use and distribute this module according to the same terms
6             # that Perl is distributed under.
7             #
8             # Thomas Klausner domm@cpan.org http://domm.plix.at
9             #
10             #-----------------------------------------------------------------
11              
12             package CGI::URI2param;
13              
14             # ABSTRACT: DEPRECATED - convert parts of an URL to param values
15             our $VERSION = '1.03'; # VERSION
16              
17             warn __PACKAGE__ .' is DEPRECATED, please do not use this module anymore';
18              
19 2     2   138210 use strict;
  2         13  
  2         59  
20 2     2   11 use Carp;
  2         4  
  2         106  
21 2     2   13 use Exporter;
  2         4  
  2         67  
22 2     2   11 use vars qw(@ISA @EXPORT_OK);
  2         4  
  2         596  
23              
24             @ISA = qw(Exporter);
25              
26             @EXPORT_OK = qw(uri2param);
27              
28             $CGI::URI2param::VERSION = '1.01';
29              
30             sub uri2param {
31 1     1 1 625 my ($req,$regexs,$options)=@_;
32              
33             # options not implemented, possible options are:
34             # -> don't safe in $q->param but return parsed stuff as hash/array
35             # -> use URI instead of PATH_INFO
36              
37             # check if $req seems to be a valid request object
38 1 50       6 croak "CGI::URI2param: not a valid request object" unless $req->can('param');
39              
40             # check environment and set stuff
41 1         2 my $uri;
42 1 50       4 if ($ENV{MOD_PERL}) {
43 0         0 $uri=$req->uri;
44             } else {
45 1         4 $uri=$req->url . $req->path_info;
46             }
47              
48             # apply regexes
49 1         8 eval {
50 1         7 while(my($key,$regex)=each(%$regexs)) {
51 2 50       55 if ($uri=~m/$regex/) {
52 2         8 $req->param($key,$+);
53             }
54             }
55             };
56              
57 1 50       11 croak $@ if ($@);
58            
59 1         7 return 1;
60             }
61              
62             1;
63              
64             __END__