Adding first version of DBIx::Class::Validation.

diff --git a/lib/DBIx/Class/Core.pm b/lib/DBIx/Class/Core.pm
index 85b9fa3..10a776f 100644 (file)
--- a/lib/DBIx/Class/Core.pm
+++ b/lib/DBIx/Class/Core.pm
@@ -13,7 +13,8 @@ __PACKAGE__->load_components(qw/
   Row
   Table
   Exception
-  AccessorGroup/);
+  AccessorGroup
+  Validation/);
 
 1;
 

diff --git a/lib/DBIx/Class/Validation.pm b/lib/DBIx/Class/Validation.pm
new file mode 100644 (file)
index 0000000..623766c
--- /dev/null
+++ b/lib/DBIx/Class/Validation.pm
@@ -0,0 +1,151 @@
+package DBIx::Class::Validation;
+
+use strict;
+use warnings;
+
+use base qw( DBIx::Class );
+use Carp qw( croak );
+use English qw( -no_match_vars );
+
+local $^W = 0; # Silence C:D:I redefined sub errors.
+
+our $VERSION = '0.01';
+
+__PACKAGE__->mk_classdata( 'validation_module' => 'FormValidator::Simple' );
+__PACKAGE__->mk_classdata( 'validation_profile'  );
+__PACKAGE__->mk_classdata( 'validation_auto' => 1 );
+
+sub validation_module {
+    my $class = shift;
+    my $module = shift;
+    
+    eval("use $module");
+    croak("Unable to load the validation module '$module' because $EVAL_ERROR") if ($EVAL_ERROR);
+    croak("The '$module' module does not support the check method") if (!$module->can('check'));
+    
+    $class->_validation_module_accessor( $module );
+}
+
+sub validation {
+    my $class = shift;
+    my %args = @_;
+    
+    $class->validation_module( $args{module} ) if (exists $args{module});
+    $class->validation_profile( $args{profile} ) if (exists $args{profile});
+    $class->validatio_auto( $args{auto} ) if (exists $args{auto});
+}
+
+sub validate {
+    my $self = shift;
+    my %data = $self->get_columns();
+    my $module = $self->validation_module();
+    my $profile = $self->validation_profile();
+    my $result = $module->check( \%data => $profile );
+    return $result if ($result->success());
+    croak( $result );
+}
+
+sub insert {
+    my $self = shift;
+    $self->validate if ($self->validation_auto());
+    $self->next::method(@_);
+}
+
+sub update {
+    my $self = shift;
+    $self->validate if ($self->validation_auto());
+    $self->next::method(@_);
+}
+
+1;
+__END__
+
+=head1 NAME
+
+DBIx::Class::Validation - Validate all data before submitting to your database.
+
+=head1 SYNOPSIS
+
+In your base DBIC package:
+
+  __PACKAGE__->load_components(qw/... Validation/);
+
+And in your subclasses:
+
+  __PACKAGE__->validation(
+    module => 'FormValidator::Simple',
+    profile => { ... },
+    auto => 1,
+  );
+
+And then somewhere else:
+
+  eval{ $obj->validate() };
+  if( my $results = $EVAL_ERROR ){
+    ...
+  }
+
+=head1 METHODS
+
+=head2 validation
+
+  __PACKAGE__->validation(
+    module => 'FormValidator::Simple',
+    profile => { ... },
+    auto => 1,
+  );
+
+Calls validation_module(), validation_profile(), and validation_auto() if the corresponding 
+argument is defined.
+
+=head2 validation_module
+
+  __PACKAGE__->validation_module('Data::FormValidator');
+
+Sets the validation module to use.  Any module that supports a check() method just like 
+Data::FormValidator's can be used here, such as FormValidator::Simple.
+
+Defaults to FormValidator::Simple.
+
+=head2 validation_profile
+
+  __PACKAGE__->validation_profile(
+    { ... }
+  );
+
+Sets the profile that will be passed to the validation module.
+
+=head2 validation_auto
+
+  __PACKAGE__->validation_auto( 1 );
+
+This flag, when enabled, causes any updates or inserts of the class 
+to call validate() before actually executing.
+
+=head2 validate
+
+  $obj->validate();
+
+Validates all the data in the object against the pre-defined validation 
+module and profile.  If there is a problem then a hard error will be 
+thrown.  If you put the validation in an eval you can capture whatever 
+the module's check() method returned.
+
+=head2 auto_validate
+
+  __PACKAGE__->auto_validate( 0 );
+
+Turns on and off auto-validation.  This feature makes all UPDATEs and 
+INSERTs call the validate() method before doing anything.  The default 
+is for auto-validation to be on.
+
+Defaults to on.
+
+=head1 AUTHOR
+
+Aran C. Deltac <bluefeet@cpan.org>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+