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