File Coverage

blib/lib/REST/RequestFast.pm
Criterion Covered Total %
statement 24 24 100.0
branch 6 6 100.0
condition 3 3 100.0
subroutine 7 7 100.0
pod 4 4 100.0
total 44 44 100.0


line stmt bran cond sub pod time code
1             #----------------------------------------------------------------------
2             =pod
3              
4             =head1 NAME
5              
6             REST::RequestFast
7              
8             =head1 SYNOPSIS
9              
10             use REST::Resource;
11              
12             sub main
13             {
14             my( $restul ) = new REST::Resource( request_interface => new REST::RequestFast() );
15             ...
16             }
17              
18             =head1 DESCRIPTION
19              
20             This class provides a standardized interface shim that users can
21             implement in order to wrap around their favorite CGI::Fast interface
22             module so that it can be registered and used by REST::Resource.
23              
24             If you prefer some module other than CGI.pm to access server-side CGI
25             behavior, then create a module that mimics this interface and register
26             it with REST::Resource as shown in the synopsis.
27              
28             =head1 INTERFACE v. ABSTRACT BASE CLASS
29              
30             In this case, I prefer Java's interface-style to an abstract base
31             class that someone must override. Since this class derives from
32             CGI.pm for its implementation, you may not want that baggage in your
33             interface implementation. Therefore, all you need to do is register a
34             class that provides the functionality specified by this module.
35              
36             Since there isn't really a great Perl-based interface specification,
37             REST::Resource will interrogate your registered request_interface
38             to ensure that the class provides the minimum / required methods:
39              
40             new()
41             http()
42             param()
43             header()
44              
45             If you chose to provide an alternate interface implementation, these
46             are the methods that must exist before REST::Resource will accept your
47             interface.
48              
49             =head1 AUTHOR
50              
51             John "Frotz" Fa'atuai
52             frotz@acm.org
53              
54             =head1 INTERFACE METHODS
55              
56             =cut
57              
58             package REST::RequestFast;
59              
60 3     3   18 use strict;
  3         6  
  3         136  
61 3     3   14 use warnings;
  3         7  
  3         95  
62 3     3   14 use base "CGI::Fast";
  3         5  
  3         5982  
63              
64             our( $VERSION ) = '0.5.2.4'; ## MODULE-VERSION-NUMBER
65              
66              
67              
68              
69              
70             #----------------------------------------------------------------------
71             =pod
72              
73             =head2 new()
74              
75             USAGE:
76              
77             my( $restful ) = new REST::Resource( request_interface => new REST::Request() );
78             my( $request ) = new REST::Request();
79              
80             DESCRIPTION:
81              
82             This method constructs a new instance of the request object. The
83             first usage shows how users should pass this into REST::Resource. The
84             second usage shows how you might use this in your unit tests.
85              
86             WARNING:
87              
88             This constructor plays REST games with CGI.pm by detecting PUT or
89             DELETE and transforming the request (temporarily) to POST, then
90             reverting back to the original value before returning an instance.
91             This allows us to use all of the nice POST processing provided by
92             CGI.pm, but for PUT, and DELETE, not just POST.
93              
94             =cut
95              
96             sub new
97             {
98 17     17 1 3374 my( $class ) = shift;
99             #### $class = ref( $class ) if (ref( $class )); ## Impossible to call via an instance.
100              
101 17         42 my( $orig ) = $ENV{REQUEST_METHOD};
102 17 100       45 $orig = "" unless( defined( $orig ) );
103 17 100       127 $ENV{REQUEST_METHOD} = "POST" if ($orig =~ /PUT|DELETE/i);
104              
105 17         76 my( $this ) = $class->SUPER::new( @_ );
106              
107 17 100       795 $ENV{REQUEST_METHOD} = $orig if ($orig =~ /PUT|DELETE/i);
108 17         131 return( $this );
109             }
110              
111              
112              
113              
114             #----------------------------------------------------------------------
115             =pod
116              
117             =head2 http()
118              
119             USAGE:
120              
121             my( $value ) = $request->http( $variable );
122              
123             DESCRIPTION:
124              
125             This method extracts the given CGI $variable from the underlying
126             $request and returns its $value.
127              
128             =cut
129              
130             sub http
131             {
132 8     8 1 106 my( $this ) = shift;
133 8         13 my( $var ) = shift;
134              
135 8   100     50 my( $retval ) = ($ENV{$var} || ## Exact name match.
136             $ENV{ uc( $var ) } || ## Uppercase match.
137             $ENV{ lc( $var ) } ## Lowercase match.
138             );
139 8         46 return( $retval );
140             }
141              
142              
143              
144              
145             #----------------------------------------------------------------------
146             =pod
147              
148             =head2 header()
149              
150             USAGE:
151              
152             $request->header( %args );
153              
154             DESCRIPTION:
155              
156             This interface method provides access to the CGI-response header
157             functionality. This method will be called when you have the
158             collection of response headers that you want to pass down to your base
159             class.
160              
161             =cut
162              
163             sub header()
164             {
165 1     1 1 2 my( $this ) = shift;
166 1         10 return( $this->SUPER::header( @_ ) );
167             }
168              
169              
170              
171              
172              
173             #----------------------------------------------------------------------
174             =pod
175              
176             =head2 param()
177              
178             USAGE:
179              
180             my( $value ) = $request->param( $variable );
181              
182             DESCRIPTION:
183              
184             This method returns the $value of the CGI request parameter $variable.
185              
186             =cut
187              
188             sub param
189             {
190 81     81 1 11967 my( $this ) = shift;
191 81         246 return( $this->SUPER::param( @_ ) );
192             }
193              
194              
195              
196             #----------------------------------------------------------------------
197             =pod
198              
199             =head1 SEE ALSO
200              
201             CGI::Fast
202             REST::Resource
203              
204             =cut
205              
206             1;