create now on resultset as well
[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / Validation.pm
1 package DBIx::Class::Validation;
2
3 use strict;
4 use warnings;
5
6 use base qw( DBIx::Class );
7 use Carp qw( croak );
8 use English qw( -no_match_vars );
9
10 #local $^W = 0; # Silence C:D:I redefined sub errors.
11 # Switched to C::D::Accessor which doesn't do this. Hate hate hate hate.
12
13 our $VERSION = '0.01';
14
15 __PACKAGE__->mk_classdata( 'validation_module' => 'FormValidator::Simple' );
16 __PACKAGE__->mk_classdata( 'validation_profile'  );
17 __PACKAGE__->mk_classdata( 'validation_auto' => 1 );
18
19 sub validation_module {
20     my $class = shift;
21     my $module = shift;
22     
23     eval("use $module");
24     croak("Unable to load the validation module '$module' because $EVAL_ERROR") if ($EVAL_ERROR);
25     croak("The '$module' module does not support the check method") if (!$module->can('check'));
26     
27     $class->_validation_module_accessor( $module );
28 }
29
30 sub validation {
31     my $class = shift;
32     my %args = @_;
33     
34     $class->validation_module( $args{module} ) if (exists $args{module});
35     $class->validation_profile( $args{profile} ) if (exists $args{profile});
36     $class->validation_auto( $args{auto} ) if (exists $args{auto});
37 }
38
39 sub validate {
40     my $self = shift;
41     my %data = $self->get_columns();
42     my $module = $self->validation_module();
43     my $profile = $self->validation_profile();
44     my $result = $module->check( \%data => $profile );
45     return $result if ($result->success());
46     croak( $result );
47 }
48
49 sub insert {
50     my $self = shift;
51     $self->validate if ($self->validation_auto());
52     $self->next::method(@_);
53 }
54
55 sub update {
56     my $self = shift;
57     $self->validate if ($self->validation_auto());
58     $self->next::method(@_);
59 }
60
61 1;
62 __END__
63
64 =head1 NAME
65
66 DBIx::Class::Validation - Validate all data before submitting to your database.
67
68 =head1 SYNOPSIS
69
70 In your base DBIC package:
71
72   __PACKAGE__->load_components(qw/... Validation/);
73
74 And in your subclasses:
75
76   __PACKAGE__->validation(
77     module => 'FormValidator::Simple',
78     profile => { ... },
79     auto => 1,
80   );
81
82 And then somewhere else:
83
84   eval{ $obj->validate() };
85   if( my $results = $EVAL_ERROR ){
86     ...
87   }
88
89 =head1 METHODS
90
91 =head2 validation
92
93   __PACKAGE__->validation(
94     module => 'FormValidator::Simple',
95     profile => { ... },
96     auto => 1,
97   );
98
99 Calls validation_module(), validation_profile(), and validation_auto() if the corresponding 
100 argument is defined.
101
102 =head2 validation_module
103
104   __PACKAGE__->validation_module('Data::FormValidator');
105
106 Sets the validation module to use.  Any module that supports a check() method just like 
107 Data::FormValidator's can be used here, such as FormValidator::Simple.
108
109 Defaults to FormValidator::Simple.
110
111 =head2 validation_profile
112
113   __PACKAGE__->validation_profile(
114     { ... }
115   );
116
117 Sets the profile that will be passed to the validation module.
118
119 =head2 validation_auto
120
121   __PACKAGE__->validation_auto( 1 );
122
123 This flag, when enabled, causes any updates or inserts of the class 
124 to call validate() before actually executing.
125
126 =head2 validate
127
128   $obj->validate();
129
130 Validates all the data in the object against the pre-defined validation 
131 module and profile.  If there is a problem then a hard error will be 
132 thrown.  If you put the validation in an eval you can capture whatever 
133 the module's check() method returned.
134
135 =head2 auto_validate
136
137   __PACKAGE__->auto_validate( 0 );
138
139 Turns on and off auto-validation.  This feature makes all UPDATEs and 
140 INSERTs call the validate() method before doing anything.  The default 
141 is for auto-validation to be on.
142
143 Defaults to on.
144
145 =head1 AUTHOR
146
147 Aran C. Deltac <bluefeet@cpan.org>
148
149 =head1 LICENSE
150
151 You may distribute this code under the same terms as Perl itself.
152