File Coverage

blib/lib/CGI/Untaint/set.pm
Criterion Covered Total %
statement 9 17 52.9
branch 0 4 0.0
condition n/a
subroutine 3 4 75.0
pod n/a
total 12 25 48.0


line stmt bran cond sub pod time code
1             package CGI::Untaint::set;
2              
3 1     1   22113 use warnings;
  1         3  
  1         28  
4 1     1   5 use strict;
  1         2  
  1         35  
5              
6 1     1   4 use base 'CGI::Untaint::printable';
  1         6  
  1         781  
7              
8             our $VERSION = 0.01;
9              
10             =head1 NAME
11              
12             CGI::Untaint::set - untaint sets of values
13              
14             =head1 SYNOPSIS
15              
16             use CGI::Untaint;
17             my $handler = CGI::Untaint->new($q->Vars);
18            
19             $value = $handler->extract(-as_set => 'films' );
20              
21              
22             =head1 DESCRIPTION
23              
24             Untaints an arrayref (as might be submitted by an HTML multiple select form field, or multiple
25             selections from a checkbox group) as a comma separated string suitable for use as a value for
26             a MySQL (maybe others?) SET column.
27              
28             Values are validated against the L
29             regex. To validate against a specific set of allowed values, subclass this
30             package and provide a custom C<_untaint_re> method.
31              
32             =cut
33              
34             sub _untaint
35             {
36 0     0     my ( $self ) = @_;
37            
38 0           my $value = $self->value;
39            
40 0 0         return $self->SUPER::_untaint unless ref $value;
41            
42 0           my $re = $self->_untaint_re;
43              
44 0 0         $self->value( join ',', map { $_ =~ $re or die; $1 } @$value );
  0            
  0            
45            
46 0           return 1;
47             }
48              
49              
50              
51             =head1 AUTHOR
52              
53             David Baird, C<< >>
54              
55             =head1 BUGS
56              
57             Please report any bugs or feature requests to
58             C, or through the web interface at
59             L.
60             I will be notified, and then you'll automatically be notified of progress on
61             your bug as I make changes.
62              
63             =head1 ACKNOWLEDGEMENTS
64              
65             =head1 COPYRIGHT & LICENSE
66              
67             Copyright 2005 David Baird, All Rights Reserved.
68              
69             This program is free software; you can redistribute it and/or modify it
70             under the same terms as Perl itself.
71              
72             =cut
73              
74             1; # End of CGI::Untaint::set