File Coverage

blib/lib/CGI/Simple/Standard.pm
Criterion Covered Total %
statement 66 72 91.6
branch 19 26 73.0
condition 5 6 83.3
subroutine 10 11 90.9
pod 0 1 0.0
total 100 116 86.2


line stmt bran cond sub pod time code
1             package CGI::Simple::Standard;
2              
3 3     3   242089 use strict;
  3         30  
  3         95  
4             #use warnings;
5 3     3   2506 use CGI::Simple;
  3         12  
  3         22  
6 3     3   19 use Carp;
  3         4  
  3         197  
7 3         1741 use vars qw( $VERSION $USE_CGI_PM_DEFAULTS $DISABLE_UPLOADS $POST_MAX
8             $NO_UNDEF_PARAMS $USE_PARAM_SEMICOLONS $HEADERS_ONCE
9 3     3   16 $NPH $DEBUG $NO_NULL $FATAL *in %EXPORT_TAGS $AUTOLOAD );
  3         6  
10              
11             $VERSION = "1.280";
12              
13             %EXPORT_TAGS = (
14             ':html' => [qw(:misc)],
15             ':standard' => [qw(:core :access)],
16             ':cgi' => [qw(:core :access)],
17             ':all' => [
18             qw(:core :misc :cookie :header :push :debug :cgi-lib
19             :access :internal)
20             ],
21             ':core' => [
22             qw(param add_param param_fetch url_param keywords
23             append Delete delete_all Delete_all upload
24             query_string parse_query_string parse_keywordlist
25             Vars save_parameters restore_parameters)
26             ],
27             ':misc' => [qw(url_decode url_encode escapeHTML unescapeHTML put)],
28             ':cookie' => [qw(cookie raw_cookie)],
29             ':header' => [qw(header cache no_cache redirect)],
30             ':push' => [
31             qw(multipart_init multipart_start multipart_end
32             multipart_final)
33             ],
34             ':debug' => [qw(Dump as_string cgi_error _cgi_object)],
35             ':cgi-lib' => [
36             qw(ReadParse SplitParam MethGet MethPost MyBaseUrl MyURL
37             MyFullUrl PrintHeader HtmlTop HtmlBot PrintVariables
38             PrintEnv CgiDie CgiError Vars)
39             ],
40             ':ssl' => [qw(https)],
41             ':access' => [
42             qw(version nph all_parameters charset crlf globals
43             auth_type content_length content_type document_root
44             gateway_interface path_translated referer remote_addr
45             remote_host remote_ident remote_user request_method
46             script_name server_name server_port server_protocol
47             server_software user_name user_agent virtual_host
48             path_info Accept http https protocol url self_url
49             state)
50             ],
51             ':internal' => [
52             qw(_initialize_globals _use_cgi_pm_global_settings
53             _store_globals _reset_globals)
54             ]
55             );
56              
57             # BEGIN {
58             # $SIG{__DIE__} = sub { croak "Undefined Method : @_\n" }
59             # }
60              
61             sub import {
62 3     3   33 my ( $self, @args ) = @_;
63 3         10 my $package = caller();
64 3         6 my ( %exports, %pragmas );
65 3         7 for my $arg ( @args ) {
66 5 50       31 $exports{$arg}++, next if $arg =~ m/^\w+$/;
67 5 100       25 $pragmas{$arg}++, next if $arg =~ m/^-\w+$/;
68 3 50       19 if ( $arg =~ m/^:[-\w]+$/ ) {
69 3 50       10 if ( exists $EXPORT_TAGS{$arg} ) {
70 3         6 my @tags = @{ $EXPORT_TAGS{$arg} };
  3         9  
71 3         8 for my $tag ( @tags ) {
72             my @expanded
73             = exists $EXPORT_TAGS{$tag}
74 27 50       50 ? @{ $EXPORT_TAGS{$tag} }
  27         65  
75             : ( $tag );
76 27         192 $exports{$_}++ for @expanded;
77             }
78             }
79             else {
80 0         0 croak
81             "No '$arg' tag set available for export from CGI::Simple::Standard!\n";
82             }
83             }
84             }
85 3         39 my @exports = keys %exports;
86 3         6 my %valid_exports;
87 3         6 for my $tag ( @{ $EXPORT_TAGS{':all'} } ) {
  3         8  
88 27         42 $valid_exports{$_}++ for @{ $EXPORT_TAGS{$tag} };
  27         167  
89             }
90 3         8 for ( @exports ) {
91             croak
92             "'$_' is not an available export method from CGI::Simple::Standard!\n"
93 261 50       419 unless exists $valid_exports{$_};
94             }
95 3     3   24 no strict 'refs';
  3         7  
  3         1085  
96 3 50       10 if ( exists $pragmas{'-autoload'} ) {
97              
98             # hack symbol table to export our AUTOLOAD sub
99 0         0 *{"${package}::AUTOLOAD"} = sub {
100 0     0   0 my ( $caller, $sub ) = $AUTOLOAD =~ m/(.*)::(\w+)$/;
101 0         0 &CGI::Simple::Standard::loader( $caller, $sub, @_ );
102 0         0 };
103 0         0 delete $pragmas{'-autoload'};
104             }
105 3         11 my @pragmas = keys %pragmas;
106 3 100       43 CGI::Simple->import( @pragmas ) if @pragmas;
107              
108             # export subroutine stubs for all the desired export functions
109             # we will replace them in the symbol table with the real thing
110             # if and when they are first called
111 3         13 for my $i ( 0 .. $#exports ) {
112 261         14620 *{"${package}::$exports[$i]"} = sub {
113 133     133   52940 my $caller = caller;
114 133         383 &CGI::Simple::Standard::loader( $caller, $exports[$i], @_ );
115             }
116 261         905 }
117             }
118              
119             # loader() may be called either via our exported AUTOLOAD sub or by the
120             # subroutine stubs we exported on request. It has three functions:
121             # 1) to initialize and store (via a closure) our CGI::Simple object
122             # 2) to overwrite the exported subroutine stubs with calls to the real ones
123             # 3) to provide two 'virtual' methods - _cgi_object() and restore_parameters()
124             # restore_parameters effectively functions like new() for the OO interface.
125             {
126             my $q;
127              
128             sub loader {
129 133     133 0 204 my $package = shift;
130 133         213 my $sub = shift;
131 133 100       313 if ( $sub eq '_cgi_object' ) { # for debugging get at the object
132 3 50       10 $q = CGI::Simple->new( @_ ) unless $q;
133 3         41 return $q;
134             }
135 130 100 100     545 if ( !$q or $sub eq 'restore_parameters' ) {
136 27 100       68 if ( $sub eq 'restore_parameters' ) {
137 25         138 $q = CGI::Simple->new( @_ );
138 25         76 return;
139             }
140             else {
141 2         12 $q = CGI::Simple->new;
142             }
143             }
144              
145             # hack the symbol table and insert the sub so we only use loader once
146             # get strict to look the other way while we use sym refs
147 3     3   24 no strict 'refs';
  3         7  
  3         632  
148              
149             # stop warnings screaming about redefined subs
150 105         368 local $^W = 0;
151              
152             # hack to ensure %in ends in right package when exported by ReadParse
153 105 100 66     247 @_ = ( *{"${package}::in"} ) if $sub eq 'ReadParse' and !@_;
  1         6  
154              
155             # write the required sub to the callers symbol table
156 105     302   449 *{"${package}::$sub"} = sub { $q->$sub( @_ ) };
  105         460  
  302         60078  
157              
158             # now we have inserted the sub let's call it and return the results :-)
159 105         145 return &{"${package}::$sub"};
  105         217  
160             }
161             }
162              
163             1;
164              
165             =head1 NAME
166              
167             CGI::Simple::Standard - a wrapper module for CGI::Simple that provides a
168             function style interface
169              
170             =head1 SYNOPSIS
171              
172             use CGI::Simple::Standard qw( -autoload );
173             use CGI::Simple::Standard qw( :core :cookie :header :misc );
174             use CGI::Simple::Standard qw( param upload );
175              
176             $CGI::Simple::Standard::POST_MAX = 1024; # max upload via post 1kB
177             $CGI::Simple::Standard::DISABLE_UPLOADS = 0; # enable uploads
178              
179             @params = param(); # return all param names as a list
180             $value = param('foo'); # return the first value supplied for 'foo'
181             @values = param('foo'); # return all values supplied for foo
182              
183             %fields = Vars(); # returns untied key value pair hash
184             $hash_ref = Vars(); # or as a hash ref
185             %fields = Vars("|"); # packs multiple values with "|" rather than "\0";
186              
187             @keywords = keywords(); # return all keywords as a list
188              
189             param( 'foo', 'some', 'new', 'values' ); # set new 'foo' values
190             param( -name=>'foo', -value=>'bar' );
191             param( -name=>'foo', -value=>['bar','baz'] );
192              
193             append( -name=>'foo', -value=>'bar' ); # append values to 'foo'
194             append( -name=>'foo', -value=>['some', 'new', 'values'] );
195              
196             Delete('foo'); # delete param 'foo' and all its values
197             Delete_all(); # delete everything
198              
199            
200              
201             $files = upload() # number of files uploaded
202             @files = upload(); # names of all uploaded files
203             $filename = param('upload_file') # filename of 'upload_file' field
204             $mime = upload_info($filename,'mime'); # MIME type of uploaded file
205             $size = upload_info($filename,'size'); # size of uploaded file
206              
207             my $fh = $q->upload($filename); # open filehandle to read from
208             while ( read( $fh, $buffer, 1024 ) ) { ... }
209              
210             # short and sweet upload
211             $ok = upload( param('upload_file'), '/path/to/write/file.name' );
212             print "Uploaded ".param('upload_file')." and wrote it OK!" if $ok;
213              
214             $decoded = url_decode($encoded);
215             $encoded = url_encode($unencoded);
216             $escaped = escapeHTML('<>"&');
217             $unescaped = unescapeHTML('<>"&');
218              
219             $qs = query_string(); # get all data in $q as a query string OK for GET
220              
221             no_cache(1); # set Pragma: no-cache + expires
222             print header(); # print a simple header
223             # get a complex header
224             $header = header( -type => 'image/gif'
225             -nph => 1,
226             -status => '402 Payment required',
227             -expires =>'+24h',
228             -cookie => $cookie,
229             -charset => 'utf-7',
230             -attachment => 'foo.gif',
231             -Cost => '$2.00');
232              
233             @cookies = cookie(); # get names of all available cookies
234             $value = cookie('foo') # get first value of cookie 'foo'
235             @value = cookie('foo') # get all values of cookie 'foo'
236             # get a cookie formatted for header() method
237             $cookie = cookie( -name => 'Password',
238             -values => ['superuser','god','my dog woofie'],
239             -expires => '+3d',
240             -domain => '.nowhere.com',
241             -path => '/cgi-bin/database',
242             -secure => 1 );
243             print header( -cookie=>$cookie ); # set cookie
244              
245             print redirect('http://go.away.now'); # print a redirect header
246              
247             dienice( cgi_error() ) if cgi_error();
248              
249             =head1 DESCRIPTION
250              
251             This module is a wrapper for the completely object oriented CGI::Simple
252             module and provides a simple functional style interface. It provides two
253             different methods to import function names into your namespace.
254              
255             =head2 Autoloading
256              
257             If you specify the '-autoload' pragma like this:
258              
259             use CGI::Simple::Standard qw( -autoload );
260              
261             Then it will use AUTOLOAD and a symbol table trick to export only those subs
262             you actually call into your namespace. When you specify the '-autoload' pragma
263             this module exports a single AUTOLOAD subroutine into you namespace. This will
264             clash with any AUTOLOAD sub that exists in the calling namespace so if you are
265             using AUTOLOAD for something else don't use this pragma.
266              
267             Anyway, when you call a subroutine that is not defined in your script this
268             AUTOLOAD sub will be called. The first time this happens it
269             will initialize a CGI::Simple object and then apply the requested method
270             (if it exists) to it. A fatal exception will be thrown if you try to use an
271             undefined method (function).
272              
273             =head2 Specified Export
274              
275             Alternatively you can specify the functions you wish to import. You can do
276             this on a per function basis like this:
277              
278             use CGI::Simple::Standard qw( param upload query_string Dump );
279              
280             or utilize the %EXPORT_TAGS that group functions into related groups.
281             Here are the groupings:
282              
283             %EXPORT_TAGS = (
284             ':html' => [ qw(:misc) ],
285             ':standard' => [ qw(:core :access) ],
286             ':cgi' => [ qw(:core :access) ],
287             ':all' => [ qw(:core :misc :cookie :header :push :debug :cgi-lib
288             :access :internal) ],
289             ':core' => [ qw(param add_param param_fetch url_param keywords
290             append Delete delete_all Delete_all upload
291             query_string parse_query_string parse_keywordlist
292             Vars save_parameters restore_parameters) ],
293             ':misc' => [ qw(url_decode url_encode escapeHTML unescapeHTML put) ],
294             ':cookie' => [ qw(cookie raw_cookie) ],
295             ':header' => [ qw(header cache no_cache redirect) ],
296             ':push' => [ qw(multipart_init multipart_start multipart_end
297             multipart_final) ],
298             ':debug' => [ qw(Dump as_string cgi_error _cgi_object) ],
299             ':cgi-lib' => [ qw(ReadParse SplitParam MethGet MethPost MyBaseUrl MyURL
300             MyFullUrl PrintHeader HtmlTop HtmlBot PrintVariables
301             PrintEnv CgiDie CgiError Vars) ],
302             ':ssl' => [ qw(https) ],
303             ':access' => [ qw(version nph all_parameters charset crlf globals
304             auth_type content_length content_type document_root
305             gateway_interface path_translated referer remote_addr
306             remote_host remote_ident remote_user request_method
307             script_name server_name server_port server_protocol
308             server_software user_name user_agent virtual_host
309             path_info Accept http https protocol url self_url
310             state) ],
311             ':internal' => [ qw(_initialize_globals _use_cgi_pm_global_settings
312             _store_globals _reset_globals) ]
313             );
314              
315              
316             The familiar CGI.pm tags are available but do not include the HTML
317             functionality. You specify the import of some function groups like this:
318              
319             use CGI::Simple::Standard qw( :core :cookie :header );
320              
321             Note that the function groups all start with a : char.
322              
323             =head2 Mix and Match
324              
325             You can use the '-autoload' pragma, specifically named function imports and
326             tag group imports together if you desire.
327              
328             =head1 $POST_MAX and $DISABLE_UPLOADS
329              
330             If you wish to set $POST_MAX or $DISABLE_UPLOADS you must do this *after* the
331             use statement and *before* the first function call as shown in the synopsis.
332              
333             Unlike CGI.pm uploads are disabled by default and the maximum acceptable
334             data via post is capped at 102_400kB rather than infinity. This is specifically
335             to avoid denial of service attacks by default. To enable uploads and to
336             allow them to be of infinite size you simply:
337              
338             $CGI::Simple::Standard::POST_MAX = -1; # infinite size upload
339             $CGI::Simple::Standard::$DISABLE_UPLOADS = 0; # enable uploads
340              
341             Alternatively you can specify the CGI.pm default values as shown above by
342             specifying the '-default' pragma in your use statement.
343              
344             use CGI::Simple::Standard qw( -default ..... );
345              
346             =head1 EXPORT
347              
348             Nothing by default.
349              
350             Under the '-autoload' pragma the AUTOLOAD subroutine is
351             exported into the calling namespace. Additional subroutines are only imported
352             into this namespace if you physically call them. They are installed in the
353             symbol table the first time you use them to save repeated calls to AUTOLOAD.
354              
355             If you specifically request a function or group of functions via an EXPORT_TAG
356             then stubs of these functions are exported into the calling namespace. These
357             stub functions will be replaced with the real functions only if you actually
358             call them saving wasted compilation effort.
359              
360             =head1 FUNCTION DETAILS
361              
362             This is a wrapper module for CGI::Simple. Virtually all the methods available
363             in the OO interface are available via the functional interface. Several
364             method names are aliased to prevent namespace conflicts:
365              
366             $q->delete('foo') => Delete('foo')
367             $q->delete_all => Delete_all() or delete_all()
368             $q->save(\*FH) => save_parameters(\*FH)
369             $q->accept() => Accept()
370              
371             Although you could use the new() function to genrate new OO CGI::Simple
372             objects the restore_parameters() function is a better choice as it operates
373             like new but on the correct underlying CGI::Simple object for the functional
374             interface.
375              
376             restore_parameters() can be used exactly as you might use new() in that
377             you can supply arguments to it such as query strings, hashes and file handles
378             to re-initialize your underlying object.
379              
380             $q->new CGI::Simple() => restore_parameters()
381             $q->new CGI::Simple({foo=>'bar'}) => restore_parameters({foo=>'bar'})
382             $q->new CGI::Simple($query_string) => restore_parameters($query_string)
383             $q->new CGI::Simple(\*FH) => restore_parameters(\*FH)
384              
385             For full details of the available functions see the CGI::Simple docs. Just
386             remove the $q-> part and use the method name directly.
387              
388             =head1 BUGS
389              
390             As this is 0.01 there are almost bound to be some.
391              
392             =head1 AUTHOR
393              
394             Dr James Freeman Ejfreeman@tassie.net.auE
395             This release by Andy Armstrong
396              
397             This package is free software and is provided "as is" without express or
398             implied warranty. It may be used, redistributed and/or modified under the terms
399             of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html)
400              
401             Address bug reports and comments to: andy@hexten.net
402              
403             =head1 CREDITS
404              
405             The interface and key sections of the CGI::Simple code come from
406             CGI.pm by Lincoln Stein.
407              
408             =head1 SEE ALSO
409              
410             L which is the back end for this module,
411             B
412              
413             =cut
414