File Coverage

blib/lib/Catalyst/Plugin/CGI/Untaint.pm
Criterion Covered Total %
statement 15 27 55.5
branch 0 2 0.0
condition n/a
subroutine 5 7 71.4
pod 0 2 0.0
total 20 38 52.6


line stmt bran cond sub pod time code
1             package Catalyst::Plugin::CGI::Untaint;
2              
3 1     1   28427 use 5.008001;
  1         3  
  1         34  
4 1     1   5 use strict;
  1         1  
  1         30  
5 1     1   6 use warnings;
  1         5  
  1         37  
6 1     1   2389 use NEXT;
  1         8143  
  1         87  
7 1     1   1514 use CGI::Untaint;
  1         3597  
  1         11  
8              
9             our $VERSION = '0.05';
10              
11             sub prepare {
12 0     0 0   my $class = shift;
13 0           my $c = $class->NEXT::prepare( @_ );
14              
15             # $c->log->debug("Creating CGI::Untaint instance");
16 0           my $untaint = CGI::Untaint->new( $c->req->parameters );
17 0           $c->config->{__PACKAGE__}->{handler} = $untaint;
18 0           $c->config->{__PACKAGE__}->{errors} = {};
19              
20 0           return $c;
21             }
22              
23             sub untaint {
24 0     0 0   my ($c, @params) = @_;
25              
26 0 0         if ($params[0] eq '-last_error') {
27 0           return $c->config->{__PACKAGE__}{error}{$params[1]};
28             }
29              
30 0           my $value = $c->config->{__PACKAGE__}{handler}->extract(@params);
31              
32 0           $c->config->{__PACKAGE__}{errors}{$params[1]} =
33             $c->config->{__PACKAGE__}{handler}->error;
34              
35 0           return $value;
36             }
37              
38             1;
39             __END__
40              
41             =head1 NAME
42              
43             Catalyst::Plugin::CGI::Untaint - Plugin for Catalyst
44              
45             =head1 SYNOPSIS
46              
47             # In your MainApp.pm:
48             use Catalyst qw/CGI::Untaint/;
49            
50             # Put into your form handler:
51             my $email = $c->untaint(-as_email => 'email');
52             # Will extract only a valid email address from $c->req->params->{email}
53              
54             # Use -last_error to get the rejection reason:
55             if (not $email) {
56             $error = $c->untaint(-last_error => 'email');
57             }
58              
59             # (note, you will need to have CGI::Untaint and CGI::Untaint::email installed
60             # in order for the above example to work)
61              
62             =head1 DESCRIPTION
63              
64             This module wraps CGI::Untaint up into a Catalyst plugin.
65              
66             For info on using CGI::Untaint, see its own documentation.
67              
68             =head1 SEE ALSO
69              
70             L<Catalyst>
71              
72             L<CGI::Untaint>
73              
74             =head1 AUTHOR
75              
76             Toby Corkindale, E<lt>cpan@corkindale.netE<gt>
77              
78             =head1 COPYRIGHT AND LICENSE
79              
80             Copyright (C) 2006 by Toby Corkindale
81              
82             This library is free software; you can redistribute it and/or modify
83             it under the same terms as Perl itself, either Perl version 5.8.7 or,
84             at your option, any later version of Perl 5 you may have available.
85              
86             =cut