]> Dogcows Code - chaz/p5-CGI-Ex/blob - lib/CGI/Ex.pm
CGI::Ex 2.24
[chaz/p5-CGI-Ex] / lib / CGI / Ex.pm
1 package CGI::Ex;
2
3 =head1 NAME
4
5 CGI::Ex - CGI utility suite - makes powerful application writing fun and easy
6
7 =cut
8
9 ###----------------------------------------------------------------###
10 # Copyright 2007 - Paul Seamons #
11 # Distributed under the Perl Artistic License without warranty #
12 ###----------------------------------------------------------------###
13
14 ### See perldoc at bottom
15
16 use strict;
17 use vars qw($VERSION
18 $PREFERRED_CGI_MODULE
19 $PREFERRED_CGI_REQUIRED
20 $AUTOLOAD
21 $DEBUG_LOCATION_BOUNCE
22 @EXPORT @EXPORT_OK
23 );
24 use base qw(Exporter);
25
26 BEGIN {
27 $VERSION = '2.24';
28 $PREFERRED_CGI_MODULE ||= 'CGI';
29 @EXPORT = ();
30 @EXPORT_OK = qw(get_form
31 get_cookies
32 print_content_type
33 content_type
34 content_typed
35 set_cookie
36 location_bounce
37 );
38
39 ### cache mod_perl version (light if or if not mod_perl)
40 my $v = (! $ENV{'MOD_PERL'}) ? 0
41 # mod_perl/1.27 or mod_perl/1.99_16 or mod_perl/2.0.1
42 # if MOD_PERL is set - don't die if regex fails - just assume 1.0
43 : ($ENV{'MOD_PERL'} =~ m{ ^ mod_perl / (\d+\.[\d_]+) (?: \.\d+)? $ }x) ? $1
44 : '1.0_0';
45 sub _mod_perl_version () { $v }
46 sub _is_mod_perl_1 () { $v < 1.98 && $v > 0 }
47 sub _is_mod_perl_2 () { $v >= 1.98 }
48
49 ### cache apache request getter (light if or if not mod_perl)
50 my $sub;
51 if (_is_mod_perl_1) { # old mod_perl
52 require Apache;
53 $sub = sub { Apache->request };
54 } elsif (_is_mod_perl_2) {
55 if (eval { require Apache2::RequestRec }) { # debian style
56 require Apache2::RequestUtil;
57 $sub = sub { Apache2::RequestUtil->request };
58 } else { # fedora and mandrake style
59 require Apache::RequestUtil;
60 $sub = sub { Apache->request };
61 }
62 } else {
63 $sub = sub {};
64 }
65 sub apache_request_sub () { $sub }
66 }
67
68 ###----------------------------------------------------------------###
69
70 # my $cgix = CGI::Ex->new;
71 sub new {
72 my $class = shift || die "Missing class name";
73 my $self = ref($_[0]) ? shift : {@_};
74 return bless $self, $class;
75 }
76
77 ###----------------------------------------------------------------###
78
79 ### allow for holding another classed CGI style object
80 # my $query = $cgix->object;
81 # $cgix->object(CGI->new);
82 sub object {
83 my $self = shift || die 'Usage: my $query = $cgix_obj->object';
84 $self->{'object'} = shift if $#_ != -1;
85
86 if (! defined $self->{'object'}) {
87 $PREFERRED_CGI_REQUIRED ||= do {
88 my $file = $self->{'cgi_module'} || $PREFERRED_CGI_MODULE;
89 $file .= ".pm";
90 $file =~ s|::|/|g;
91 eval { require $file };
92 die "Couldn't require $PREFERRED_CGI_MODULE: $@" if $@;
93 1; # return of do
94 };
95 $self->{'object'} = $PREFERRED_CGI_MODULE->new;
96 }
97
98 return $self->{'object'};
99 }
100
101 ### allow for calling CGI MODULE methods
102 sub AUTOLOAD {
103 my $self = shift;
104 my $meth = ($AUTOLOAD =~ /(\w+)$/) ? $1 : die "Invalid method $AUTOLOAD";
105 return $self->object->$meth(@_);
106 }
107
108 sub DESTROY { }
109
110 ###----------------------------------------------------------------###
111
112 ### Form getter that will act like CGI->new->Vars only it will return arrayrefs
113 ### for values that are arrays
114 # my $hash = $cgix->get_form;
115 # my $hash = $cgix->get_form(CGI->new);
116 # my $hash = get_form();
117 # my $hash = get_form(CGI->new);
118 sub get_form {
119 my $self = shift || __PACKAGE__->new;
120 if (! $self->isa(__PACKAGE__)) { # get_form(CGI->new) syntax
121 my $obj = $self;
122 $self = __PACKAGE__->new;
123 $self->object($obj);
124 }
125 return $self->{'form'} if $self->{'form'};
126
127 ### get the info out of the object
128 my $obj = shift || $self->object;
129 my %hash = ();
130 foreach my $key ($obj->param) {
131 my @val = $obj->param($key);
132 $hash{$key} = ($#val <= 0) ? $val[0] : \@val;
133 }
134 return $self->{'form'} = \%hash;
135 }
136
137 ### allow for a setter
138 ### $cgix->set_form(\%form);
139 sub set_form {
140 my $self = shift || die 'Usage: $cgix_obj->set_form(\%form)';
141 return $self->{'form'} = shift || {};
142 }
143
144 ### Combined get and set form
145 # my $hash = $cgix->form;
146 # $cgix->form(\%form);
147 sub form {
148 my $self = shift;
149 return $self->set_form(shift) if @_ == 1;
150 return $self->get_form;
151 }
152
153 ### allow for creating a url encoded key value sequence
154 # my $str = $cgix->make_form(\%form);
155 # my $str = $cgix->make_form(\%form, \@keys_to_include);
156 sub make_form {
157 my $self = shift || die 'Usage: $cgix_obj->make_form(\%form)';
158 my $form = shift || $self->get_form;
159 my $keys = ref($_[0]) ? shift : [sort keys %$form];
160 my $str = '';
161 foreach (@$keys) {
162 my $key = $_; # make a copy
163 my $val = $form->{$key};
164 $key =~ s/([^\w.\-\ ])/sprintf('%%%02X', ord $1)/eg;
165 $key =~ y/ /+/;
166 foreach (ref($val) ? @$val : $val) {
167 my $_val = $_; # make a copy
168 $_val =~ s/([^\w.\-\ ])/sprintf('%%%02X', ord $1)/eg;
169 $_val =~ y/ /+/;
170 $str .= "$key=$_val&"; # intentionally not using join
171 }
172 }
173 chop $str;
174 return $str;
175 }
176
177 ###----------------------------------------------------------------###
178
179 ### like get_form - but a hashref of cookies
180 ### cookies are parsed depending upon the functionality of ->cookie
181 # my $hash = $cgix->get_cookies;
182 # my $hash = $cgix->get_cookies(CGI->new);
183 # my $hash = get_cookies();
184 # my $hash = get_cookies(CGI->new);
185 sub get_cookies {
186 my $self = shift || __PACKAGE__->new;
187 if (! $self->isa(__PACKAGE__)) { # get_cookies(CGI->new) syntax
188 my $obj = $self;
189 $self = __PACKAGE__->new;
190 $self->object($obj);
191 }
192 return $self->{'cookies'} if $self->{'cookies'};
193
194 my $obj = shift || $self->object;
195 my %hash = ();
196 foreach my $key ($obj->cookie) {
197 my @val = $obj->cookie($key);
198 $hash{$key} = ($#val == -1) ? next : ($#val == 0) ? $val[0] : \@val;
199 }
200 return $self->{'cookies'} = \%hash;
201 }
202
203 ### Allow for a setter
204 ### $cgix->set_cookies(\%cookies);
205 sub set_cookies {
206 my $self = shift || die 'Usage: $cgix_obj->set_cookies(\%cookies)';
207 return $self->{'cookies'} = shift || {};
208 }
209
210 ### Combined get and set cookies
211 # my $hash = $cgix->cookies;
212 # $cgix->cookies(\%cookies);
213 sub cookies {
214 my $self = shift;
215 return $self->set_cookies(shift) if @_ == 1;
216 return $self->get_cookies;
217 }
218
219 ###----------------------------------------------------------------###
220
221 ### Allow for shared apache request object
222 # my $r = $cgix->apache_request
223 # $cgix->apache_request($r);
224 sub apache_request {
225 my $self = shift || die 'Usage: $cgix_obj->apache_request';
226 $self->{'apache_request'} = shift if $#_ != -1;
227
228 return $self->{'apache_request'} ||= apache_request_sub()->();
229 }
230
231 ### Get the version of mod_perl running (0 if not mod_perl)
232 # my $version = $cgix->mod_perl_version;
233 sub mod_perl_version { _mod_perl_version }
234 sub is_mod_perl_1 { _is_mod_perl_1 }
235 sub is_mod_perl_2 { _is_mod_perl_2 }
236
237 ### Allow for a setter
238 # $cgix->set_apache_request($r)
239 sub set_apache_request { shift->apache_request(shift) }
240
241 ###----------------------------------------------------------------###
242
243 ### same signature as print_content_type
244 sub content_type { &print_content_type }
245
246 ### will send the Content-type header
247 # $cgix->print_content_type;
248 # $cgix->print_content_type('text/plain');
249 # print_content_type();
250 # print_content_type('text/plain);
251 sub print_content_type {
252 my ($self, $type, $charset) = (@_ && ref $_[0]) ? @_ : (undef, @_);
253 $self = __PACKAGE__->new if ! $self;
254
255 if ($type) {
256 die "Invalid type: $type" if $type !~ m|^[\w\-\.]+/[\w\-\.\+]+$|; # image/vid.x-foo
257 } else {
258 $type = 'text/html';
259 }
260 $type .= "; charset=$charset" if $charset && $charset =~ m|^[\w\-\.\:\+]+$|;
261
262 if (my $r = $self->apache_request) {
263 return if $r->bytes_sent;
264 $r->content_type($type);
265 $r->send_http_header if $self->is_mod_perl_1;
266 } else {
267 if (! $ENV{'CONTENT_TYPED'}) {
268 print "Content-Type: $type\r\n\r\n";
269 $ENV{'CONTENT_TYPED'} = '';
270 }
271 $ENV{'CONTENT_TYPED'} .= sprintf("%s, %d\n", (caller)[1,2]);
272 }
273 }
274
275 ### Boolean check if content has been typed
276 # $cgix->content_typed;
277 # content_typed();
278 sub content_typed {
279 my $self = shift || __PACKAGE__->new;
280
281 if (my $r = $self->apache_request) {
282 return $r->bytes_sent;
283 } else {
284 return $ENV{'CONTENT_TYPED'} ? 1 : undef;
285 }
286 }
287
288 ###----------------------------------------------------------------###
289
290 ### location bounce nicely - even if we have already sent content
291 ### may be called as function or a method
292 # $cgix->location_bounce($url);
293 # location_bounce($url);
294 sub location_bounce {
295 my ($self, $loc) = ($#_ == 1) ? (@_) : (undef, shift);
296 $self = __PACKAGE__->new if ! $self;
297
298 if ($self->content_typed) {
299 if ($DEBUG_LOCATION_BOUNCE) {
300 print "<a class=debug href=\"$loc\">Location: $loc</a><br />\n";
301 } else {
302 print "<meta http-equiv=\"refresh\" content=\"0;url=$loc\" />\n";
303 }
304
305 } elsif (my $r = $self->apache_request) {
306 $r->status(302);
307 if ($self->is_mod_perl_1) {
308 $r->header_out("Location", $loc);
309 $r->content_type('text/html');
310 $r->send_http_header;
311 $r->print("Bounced to $loc\n");
312 } else {
313 $r->headers_out->add("Location", $loc);
314 $r->content_type('text/html');
315 $r->rflush;
316 }
317
318 } else {
319 print "Location: $loc\r\n",
320 "Status: 302 Bounce\r\n",
321 "Content-Type: text/html\r\n\r\n",
322 "Bounced to $loc\r\n";
323 }
324 }
325
326 ### set a cookie nicely - even if we have already sent content
327 ### may be called as function or a method - fancy algo to allow for first argument of args hash
328 # $cgix->set_cookie({name => $name, ...});
329 # $cgix->set_cookie( name => $name, ... );
330 # set_cookie({name => $name, ...});
331 # set_cookie( name => $name, ... );
332 sub set_cookie {
333 my $self = UNIVERSAL::isa($_[0], __PACKAGE__) ? shift : __PACKAGE__->new;
334
335 my $args = ref($_[0]) ? shift : {@_};
336 foreach (keys %$args) {
337 next if /^-/;
338 $args->{"-$_"} = delete $args->{$_};
339 }
340
341 ### default path to / and allow for 1hour instead of 1h
342 $args->{-path} ||= '/';
343 $args->{-expires} = time_calc($args->{-expires}) if $args->{-expires};
344
345 my $obj = $self->object;
346 my $cookie = "" . $obj->cookie(%$args);
347
348 if ($self->content_typed) {
349 print "<meta http-equiv=\"Set-Cookie\" content=\"$cookie\" />\n";
350 } else {
351 if (my $r = $self->apache_request) {
352 if ($self->is_mod_perl_1) {
353 $r->header_out("Set-cookie", $cookie);
354 } else {
355 $r->headers_out->add("Set-Cookie", $cookie);
356 }
357 } else {
358 print "Set-Cookie: $cookie\r\n";
359 }
360 }
361 }
362
363 ### print the last modified time
364 ### takes a time or filename and an optional keyname
365 # $cgix->last_modified; # now
366 # $cgix->last_modified((stat $file)[9]); # file's time
367 # $cgix->last_modified(time, 'Expires'); # different header
368 sub last_modified {
369 my $self = shift || die 'Usage: $cgix_obj->last_modified($time)'; # may be called as function or method
370 my $time = shift || time;
371 my $key = shift || 'Last-Modified';
372
373 ### get a time string - looks like:
374 ### Mon Dec 9 18:03:21 2002
375 ### valid RFC (although not prefered)
376 $time = scalar gmtime time_calc($time);
377
378 if ($self->content_typed) {
379 print "<meta http-equiv=\"$key\" content=\"$time\" />\n";
380 } elsif (my $r = $self->apache_request) {
381 if ($self->is_mod_perl_1) {
382 $r->header_out($key, $time);
383 } else {
384 $r->headers_out->add($key, $time);
385 }
386 } else {
387 print "$key: $time\r\n";
388 }
389 }
390
391 ### add expires header
392 sub expires {
393 my $self = ref($_[0]) ? shift : __PACKAGE__->new; # may be called as a function or method
394 my $time = shift || time;
395 return $self->last_modified($time, 'Expires');
396 }
397
398 ### similar to expires_calc from CGI::Util
399 ### allows for lenient calling, hour instead of just h, etc
400 ### takes time or 0 or now or filename or types of -23minutes
401 sub time_calc {
402 my $time = shift; # may only be called as a function
403 if (! $time || lc($time) eq 'now') {
404 return time;
405 } elsif ($time =~ m/^\d+$/) {
406 return $time;
407 } elsif ($time =~ m/^([+-]?)\s*(\d+|\d*\.\d+)\s*([a-z])[a-z]*$/i) {
408 my $m = {
409 's' => 1,
410 'm' => 60,
411 'h' => 60 * 60,
412 'd' => 60 * 60 * 24,
413 'w' => 60 * 60 * 24 * 7,
414 'M' => 60 * 60 * 24 * 30,
415 'y' => 60 * 60 * 24 * 365,
416 };
417 return time + ($m->{lc($3)} || 1) * "$1$2";
418 } else {
419 my @stat = stat $time;
420 die "Could not find file \"$time\" for time_calc" if $#stat == -1;
421 return $stat[9];
422 }
423 }
424
425
426 ### allow for generic status send
427 sub send_status {
428 my $self = shift || die 'Usage: $cgix_obj->send_status(302 => "Bounced")';
429 my $code = shift || die "Missing status";
430 my $mesg = shift;
431 if (! defined $mesg) {
432 $mesg = "HTTP Status of $code received\n";
433 }
434 if ($self->content_typed) {
435 die "Cannot send a status ($code - $mesg) after content has been sent";
436 }
437 if (my $r = $self->apache_request) {
438 $r->status($code);
439 if ($self->is_mod_perl_1) {
440 $r->content_type('text/html');
441 $r->send_http_header;
442 $r->print($mesg);
443 } else {
444 $r->content_type('text/html');
445 $r->print($mesg);
446 $r->rflush;
447 }
448 } else {
449 print "Status: $code\r\n";
450 $self->print_content_type;
451 print $mesg;
452 }
453 }
454
455 ### allow for sending a simple header
456 sub send_header {
457 my $self = shift || die 'Usage: $cgix_obj->send_header';
458 my $key = shift;
459 my $val = shift;
460 if ($self->content_typed) {
461 die "Cannot send a header ($key - $val) after content has been sent";
462 }
463 if (my $r = $self->apache_request) {
464 if ($self->is_mod_perl_1) {
465 $r->header_out($key, $val);
466 } else {
467 $r->headers_out->add($key, $val);
468 }
469 } else {
470 print "$key: $val\r\n";
471 }
472 }
473
474 ###----------------------------------------------------------------###
475
476 ### allow for printing out a static javascript file
477 ### for example $self->print_js("CGI::Ex::validate.js");
478 sub print_js {
479 my $self = shift || die 'Usage: $cgix_obj->print_js($js_file)';
480 my $js_file = shift || '';
481 $self = $self->new if ! ref $self;
482
483 ### fix up the file - force .js on the end
484 $js_file .= '.js' if $js_file && $js_file !~ /\.js$/i;
485 $js_file =~ s|::|/|g;
486
487 ### get file info
488 my $stat;
489 if ($js_file && $js_file =~ m|^/+?(\w+(?:/+\w+)*\.js)$|i) {
490 foreach my $path (@INC) {
491 my $_file = "$path/$1";
492 next if ! -f $_file;
493 $js_file = $_file;
494 $stat = [stat _];
495 last;
496 }
497 }
498
499 ### no file = 404
500 if (! $stat) {
501 if (! $self->content_typed) {
502 $self->send_status(404, "JS File not found for print_js\n");
503 } else {
504 print "<h1>JS File not found for print_js</h1>\n";
505 }
506 return;
507 }
508
509 ### do headers
510 if (! $self->content_typed) {
511 $self->last_modified($stat->[9]);
512 $self->expires('+ 1 year');
513 $self->print_content_type('application/x-javascript');
514 }
515
516 return if $ENV{'REQUEST_METHOD'} && $ENV{'REQUEST_METHOD'} eq 'HEAD';
517
518 ### send the contents
519 local *FH;
520 open(FH, "<$js_file") || die "Couldn't open file $js_file: $!";
521 local $/ = undef;
522 print <FH>;
523 close FH;
524 }
525
526 ###----------------------------------------------------------------###
527
528 ### form filler that will use either HTML::FillInForm, CGI::Ex::Fill
529 ### or another specified filler. Argument style is similar to
530 ### HTML::FillInForm. May be called as a method or a function.
531 sub fill {
532 my $self = shift;
533 my $args = shift;
534 if (ref($args)) {
535 if (! UNIVERSAL::isa($args, 'HASH')) {
536 $args = {text => $args};
537 @$args{'form','target','fill_password','ignore_fields'} = @_;
538 }
539 } else {
540 $args = {$args, @_};
541 }
542
543 my $module = $self->{'fill_module'} || 'CGI::Ex::Fill';
544
545 ### allow for using the standard HTML::FillInForm
546 ### too bad it won't modify our file in place for us
547 if ($module eq 'HTML::FillInForm') {
548 eval { require HTML::FillInForm };
549 if ($@) {
550 die "Couldn't require HTML::FillInForm: $@";
551 }
552 $args->{scalarref} = $args->{text} if $args->{text};
553 $args->{fdat} = $args->{form} if $args->{form};
554 my $filled = HTML::FillInForm->new->fill(%$args);
555 if ($args->{text}) {
556 my $ref = $args->{text};
557 $$ref = $filled;
558 return 1;
559 }
560 return $filled;
561
562 } else {
563 require CGI::Ex::Fill;
564
565 ### get the text to work on
566 my $ref;
567 if ($args->{text}) { # preferred method - gets modified in place
568 $ref = $args->{text};
569 } elsif ($args->{scalarref}) { # copy to mimic HTML::FillInForm
570 my $str = ${ $args->{scalarref} };
571 $ref = \$str;
572 } elsif ($args->{arrayref}) { # joined together (copy)
573 my $str = join "", @{ $args->{arrayref} };
574 $ref = \$str;
575 } elsif ($args->{file}) { # read it in
576 open (IN, $args->{file}) || die "Couldn't open $args->{file}: $!";
577 my $str = '';
578 read(IN, $str, -s _) || die "Couldn't read $args->{file}: $!";
579 close IN;
580 $ref = \$str;
581 } else {
582 die "No suitable text found for fill.";
583 }
584
585 ### allow for data to be passed many ways
586 my $form = $args->{form} || $args->{fobject}
587 || $args->{fdat} || $self->object;
588
589 CGI::Ex::Fill::form_fill($ref,
590 $form,
591 $args->{target},
592 $args->{fill_password},
593 $args->{ignore_fields},
594 );
595 return ! $args->{text} ? $$ref : 1;
596 }
597
598 }
599
600 ###----------------------------------------------------------------###
601
602 sub validate {
603 my $self = shift || die 'Usage: my $er = $cgix_obj->validate($form, $val_hash_or_file)';
604 my ($form, $file) = (@_ == 2) ? (shift, shift) : ($self->object, shift);
605
606 require CGI::Ex::Validate;
607
608 my $args = {};
609 $args->{raise_error} = 1 if $self->{raise_error};
610 return CGI::Ex::Validate->new($args)->validate($form, $file);
611 }
612
613 ###----------------------------------------------------------------###
614
615 sub conf_obj {
616 my $self = shift || die 'Usage: my $ob = $cgix_obj->conf_obj($args)';
617 return $self->{conf_obj} ||= do {
618 require CGI::Ex::Conf;
619 CGI::Ex::Conf->new(@_);
620 };
621 }
622
623 sub conf_read {
624 my $self = shift || die 'Usage: my $conf = $cgix_obj->conf_read($file)';
625 return $self->conf_obj->read(@_);
626 }
627
628 ###----------------------------------------------------------------###
629
630 sub swap_template {
631 my $self = shift || die 'Usage: my $out = $cgix_obj->swap_template($file, \%vars, $template_args)';
632 my $str = shift;
633 my $form = shift;
634 my $args = shift || {};
635 $form = $self if ! $form && ref($self);
636 $form = $self->get_form if UNIVERSAL::isa($form, __PACKAGE__);
637
638 my ($ref, $return) = ref($str) ? ($str, 0) : (\$str, 1);
639
640 ### look up the module
641 my $module = $self->{'template_module'} || 'CGI::Ex::Template';
642 my $pkg = "$module.pm";
643 $pkg =~ s|::|/|g;
644 require $pkg;
645
646 ### swap it
647 my $out = '';
648 $module->new($args)->process($ref, $form, \$out);
649
650 if (! $return) {
651 $$ref = $out;
652 return 1;
653 } else {
654 return $out;
655 }
656 }
657
658 ###----------------------------------------------------------------###
659
660 1;
661
662 __END__
663
664 =head1 CGI::Ex SYNOPSIS
665
666 ### You probably don't want to use CGI::Ex directly
667 ### You probably should use CGI::Ex::App instead.
668
669 my $cgix = CGI::Ex->new;
670
671 $cgix->print_content_type;
672
673 my $hash = $cgix->form;
674
675 if ($hash->{'bounce'}) {
676
677 $cgix->set_cookie({
678 name => ...,
679 value => ...,
680 });
681
682 $cgix->location_bounce($new_url_location);
683 exit;
684 }
685
686 if (scalar keys %$form) {
687 my $val_hash = $cgix->conf_read($pathtovalidation);
688 my $err_obj = $cgix->validate($hash, $val_hash);
689 if ($err_obj) {
690 my $errors = $err_obj->as_hash;
691 my $input = "Some content";
692 my $content = "";
693 $cgix->swap_template(\$input, $errors, $content);
694 $cgix->fill({text => \$content, form => $hashref});
695 print $content;
696 exit;
697 } else {
698 print "Success";
699 }
700 } else {
701 print "Main page";
702 }
703
704 =head1 DESCRIPTION
705
706 CGI::Ex provides a suite of utilities to make writing CGI scripts
707 more enjoyable. Although they can all be used separately, the
708 main functionality of each of the modules is best represented in
709 the CGI::Ex::App module. CGI::Ex::App takes CGI application building
710 to the next step. CGI::Ex::App is not quite a framework (which normally
711 includes pre-built html) instead CGI::Ex::App is an extended application
712 flow that dramatically reduces CGI build time in most cases. It does so
713 using as little magic as possible. See L<CGI::Ex::App>.
714
715 The main functionality is provided by several other modules that
716 may be used separately, or together through the CGI::Ex interface.
717
718 =over 4
719
720 =item C<CGI::Ex::Template>
721
722 A Template::Toolkit compatible processing engine. With a few limitations,
723 CGI::Ex::Template can be a drop in replacement for Template::Toolkit.
724
725 =item C<CGI::Ex::Fill>
726
727 A regular expression based form filler inner (accessed through B<-E<gt>fill>
728 or directly via its own functions). Can be a drop in replacement for
729 HTML::FillInForm. See L<CGI::Ex::Fill> for more information.
730
731 =item C<CGI::Ex::Validate>
732
733 A form field / cgi parameter / any parameter validator (accessed through
734 B<-E<gt>validate> or directly via its own methods). Not quite a drop in
735 for most validators, although it has most of the functionality of most
736 of the validators but with the key additions of conditional validation.
737 Has a tightly integrated JavaScript portion that allows for duplicate client
738 side validation. See L<CGI::Ex::Validate> for more information.
739
740 =item C<CGI::Ex::Conf>
741
742 A general use configuration, or settings, or key / value file reader. Has
743 ability for providing key fallback as well as immutable key definitions. Has
744 default support for yaml, storable, perl, ini, and xml and open architecture
745 for definition of others. See L<CGI::Ex::Conf> for more information.
746
747 =item C<CGI::Ex::Auth>
748
749 A highly configurable web based authentication system. See L<CGI::Ex::Auth> for
750 more information.
751
752 =back
753
754 =head1 CGI::Ex METHODS
755
756 =over 4
757
758 =item C<-E<gt>fill>
759
760 fill is used for filling hash or cgi object values into an existing
761 html document (it doesn't deal at all with how you got the document).
762 Arguments may be given as a hash, or a hashref or positional. Some
763 of the following arguments will only work using CGI::Ex::Fill - most
764 will work with either CGI::Ex::Fill or HTML::FillInForm (assume they
765 are available unless specified otherwise). (See L<CGI::Ex::Fill> for
766 a full explanation of functionality). The arguments to fill are as
767 follows (and in order of position):
768
769 =over 4
770
771 =item C<text>
772
773 Text should be a reference to a scalar string containing the html to
774 be modified (actually it could be any reference or object reference
775 that can be modified as a string). It will be modified in place.
776 Another named argument B<scalarref> is available if you would like to
777 copy rather than modify.
778
779 =item C<form>
780
781 Form may be a hashref, a cgi style object, a coderef, or an array of
782 multiple hashrefs, cgi objects, and coderefs. Hashes should be key
783 value pairs. CGI objects should be able
784 to call the method B<param> (This can be overrided). Coderefs should
785 expect the field name as an argument and should return a value.
786 Values returned by form may be undef, scalar, arrayref, or coderef
787 (coderef values should expect an argument of field name and should
788 return a value). The code ref options are available to delay or add
789 options to the bringing in of form information - without having to
790 tie the hash. Coderefs are not available in HTML::FillInForm. Also
791 HTML::FillInForm only allows CGI objects if an arrayref is used.
792
793 NOTE: Only one of the form, fdat, and fobject arguments are allowed at
794 a time.
795
796 =item C<target>
797
798 The name of the form that the fields should be filled to. The default
799 value of undef, means to fill in all forms in the html.
800
801 =item C<fill_passwords>
802
803 Boolean value defaults to 1. If set to zero - password fields will
804 not be filled.
805
806 =item C<ignore_fields>
807
808 Specify which fields to not fill in. It takes either array ref of
809 names, or a hashref with the names as keys. The hashref option is
810 not available in CGI::Ex::Fill.
811
812 =back
813
814 Other named arguments are available for compatibility with HTML::FillInForm.
815 They may only be used as named arguments.
816
817 =over 4
818
819 =item C<scalarref>
820
821 Almost the same as the argument text. If scalarref is used, the filled
822 html will be returned. If text is used the html passed is filled in place.
823
824 =item C<arrayref>
825
826 An array ref of lines of the document. Forces a returned filled html
827 document.
828
829 =item C<file>
830
831 An filename that will be opened, filled, and returned.
832
833 =item C<fdat>
834
835 A hashref of key value pairs.
836
837 =item C<fobject>
838
839 A cgi style object or arrayref of cgi style objects used for getting
840 the key value pairs. Should be capable of the ->param method and
841 ->cookie method as document in L<CGI>.
842
843 =back
844
845 See L<CGI::Ex::Fill> for more information about the filling process.
846
847 =item C<-E<gt>object>
848
849 Returns the CGI object that is currently being used by CGI::Ex. If none
850 has been set it will automatically generate an object of type
851 $PREFERRED_CGI_MODULE which defaults to B<CGI>.
852
853 =item C<-E<gt>validate>
854
855 Validate has a wide range of options available. (See L<CGI::Ex::Validate>
856 for a full explanation of functionality). Validate has two arguments:
857
858 =over 4
859
860 =item C<form>
861
862 Can be either a hashref to be validated, or a CGI style object (which
863 has the param method).
864
865 =item C<val_hash>
866
867 The val_hash can be one of three items. First, it can be a straight
868 perl hashref containing the validation to be done. Second, it can
869 be a YAML document string. Third, it can be the path to a file
870 containing the validation. The validation in a validation file will
871 be read in depending upon file extension.
872
873 =back
874
875 =item C<-E<gt>get_form>
876
877 Very similar to CGI->new->Vars except that arrays are returned as
878 arrays. Not sure why CGI didn't do this anyway (well - yes -
879 legacy Perl 4 - but at some point things need to be updated).
880
881 my $hash = $cgix->get_form;
882 my $hash = $cgix->get_form(CGI->new);
883 my $hash = get_form();
884 my $hash = get_form(CGI->new);
885
886 =item C<-E<gt>set_form>
887
888 Allow for setting a custom form hash. Useful for testing, or other
889 purposes.
890
891 $cgix->set_form(\%new_form);
892
893 =item C<-E<gt>get_cookies>
894
895 Returns a hash of all cookies.
896
897 my $hash = $cgix->get_cookies;
898 my $hash = $cgix->get_cookies(CGI->new);
899 my $hash = get_cookies();
900 my $hash = get_cookies(CGI->new);
901
902 =item C<-E<gt>set_cookies>
903
904 Allow for setting a custom cookies hash. Useful for testing, or other
905 purposes.
906
907 $cgix->set_cookies(\%new_cookies);
908
909 =item C<-E<gt>make_form>
910
911 Takes a hash and returns a query_string. A second optional argument
912 may contain an arrayref of keys to use from the hash in building the
913 query_string. First argument is undef, it will use the form stored
914 in itself as the hash.
915
916 =item C<-E<gt>content_type>
917
918 Can be called multiple times during the same session. Will only
919 print content-type once. (Useful if you don't know if something
920 else already printed content-type). Calling this sends the Content-type
921 header. Trying to print -E<gt>content_type is an error. For clarity,
922 the method -E<gt>print_content_type is available.
923
924 $cgix->print_content_type;
925
926 # OR
927 $cgix->print_content_type('text/html');
928
929 # OR
930 $cgix->print_content_type('text/html', 'utf-8');
931
932 =item C<-E<gt>set_cookie>
933
934 Arguments are the same as those to CGI->new->cookie({}).
935 Uses CGI's cookie method to create a cookie, but then, depending on
936 if content has already been sent to the browser will either print
937 a Set-cookie header, or will add a <meta http-equiv='set-cookie'>
938 tag (this is supported on most major browsers). This is useful if
939 you don't know if something else already printed content-type.
940
941 =item C<-E<gt>location_bounce>
942
943 Depending on if content has already been sent to the browser will either print
944 a Location header, or will add a <meta http-equiv='refresh'>
945 tag (this is supported on all major browsers). This is useful if
946 you don't know if something else already printed content-type. Takes
947 single argument of a url.
948
949 =item C<-E<gt>last_modified>
950
951 Depending on if content has already been sent to the browser will either print
952 a Last-Modified header, or will add a <meta http-equiv='Last-Modified'>
953 tag (this is supported on most major browsers). This is useful if
954 you don't know if something else already printed content-type. Takes an
955 argument of either a time (may be a CGI -expires style time) or a filename.
956
957 =item C<-E<gt>expires>
958
959 Depending on if content has already been sent to the browser will either print
960 a Expires header, or will add a <meta http-equiv='Expires'>
961 tag (this is supported on most major browsers). This is useful if
962 you don't know if something else already printed content-type. Takes an
963 argument of a time (may be a CGI -expires style time).
964
965 =item C<-E<gt>send_status>
966
967 Send a custom status. Works in both CGI and mod_perl. Arguments are
968 a status code and the content (optional).
969
970 =item C<-E<gt>send_header>
971
972 Send a http header. Works in both CGI and mod_perl. Arguments are
973 a header name and the value for that header.
974
975 =item C<-E<gt>print_js>
976
977 Prints out a javascript file. Does everything it can to make sure
978 that the javascript will cache. Takes either a full filename,
979 or a shortened name which will be looked for in @INC. (ie /full/path/to/my.js
980 or CGI/Ex/validate.js or CGI::Ex::validate)
981
982 #!/usr/bin/perl
983 use CGI::Ex;
984 CGI::Ex->print_js($ENV{'PATH_INFO'});
985
986 =item C<-E<gt>swap_template>
987
988 This is intended as a simple yet strong subroutine to swap
989 in tags to a document. It is intended to be very basic
990 for those who may not want the full features of a Templating
991 system such as Template::Toolkit (even though they should
992 investigate them because they are pretty nice). The default allows
993 for basic template toolkit variable swapping. There are two arguments.
994 First is a string or a reference to a string. If a string is passed,
995 a copy of that string is swapped and returned. If a reference to a
996 string is passed, it is modified in place. The second argument is
997 a form, or a CGI object, or a cgiex object, or a coderef (if the second
998 argument is missing, the cgiex object which called the method will be
999 used). If it is a coderef, it should accept key as its only argument and
1000 return the proper value.
1001
1002 my $cgix = CGI::Ex->new;
1003 my $form = {foo => 'bar',
1004 this => {is => {nested => ['wow', 'wee']}}
1005 };
1006
1007 my $str = $cgix->swap_template("<html>[% foo %]<br>[% foo %]</html>", $form));
1008 # $str eq '<html>bar<br>bar</html>'
1009
1010 $str = $cgix->swap_template("[% this.is.nested.1 %]", $form));
1011 # $str eq 'wee'
1012
1013 $str = "[% this.is.nested.0 %]";
1014 $cgix->swap_template(\$str, $form);
1015 # $str eq 'wow'
1016
1017 # may also be called with only one argument as follows:
1018 # assuming $cgix had a query string of ?foo=bar&baz=wow&this=wee
1019 $str = "<html>([% foo %]) <br>
1020 ([% baz %]) <br>
1021 ([% this %]) </html>";
1022 $cgix->swap_template(\$str);
1023 #$str eq "<html>(bar) <br>
1024 # (wow) <br>
1025 # (wee) </html>";
1026
1027 For further examples, please see the code contained in t/samples/cgi_ex_*
1028 of this distribution.
1029
1030 If at a later date, the developer upgrades to Template::Toolkit, the
1031 templates that were being swapped by CGI::Ex::swap_template should
1032 be compatible with Template::Toolkit.
1033
1034 =back
1035
1036 =head1 MODULES
1037
1038 See also L<CGI::Ex::App>.
1039
1040 See also L<CGI::Ex::Auth>.
1041
1042 See also L<CGI::Ex::Conf>.
1043
1044 See also L<CGI::Ex::Die>.
1045
1046 See also L<CGI::Ex::Dump>.
1047
1048 See also L<CGI::Ex::Fill>.
1049
1050 See also L<CGI::Ex::Template>.
1051
1052 See also L<CGI::Ex::Validate>.
1053
1054 =head1 LICENSE
1055
1056 This module may be distributed under the same terms as Perl itself.
1057
1058 =head1 AUTHOR
1059
1060 Paul Seamons <perl at seamons dot com>
1061
1062 =cut
This page took 0.11331 seconds and 4 git commands to generate.