TableInstance
ResultSetInstance
Exception
- AccessorGroup/);
+ AccessorGroup
+ Validation/);
1;
# book2author table equals the bookID of the books (using the bookID
# relationship table
+=head2 Setting default values
+
+It's as simple as overriding the C<new> method. Note the use of C<next::method>.
+
+ sub new {
+ my( $class, $attrs ) = @_;
+
+ $attrs->{ foo } = 'bar' unless defined $attrs->{ foo };
+
+ $class->next::method( $attrs );
+ }
+
=back
=head1 SYNOPSIS
+ # In your table classes (replace PK::Auto::SQLite with your
+ # database)
+ __PACKAGE__->load_components(qw/PK::Auto::SQLite Core/);
+ __PACKAGE__->set_primary_key('id');
+
=head1 DESCRIPTION
This class overrides the insert method to get automatically
incremented primary keys.
-You don't want to be using this directly - instead load the appropriate
-one for your database, e.g. PK::Auto::SQLite
+You don't want to be using this directly - instead load the
+appropriate one for your database, e.g. C<PK::Auto::SQLite>, in your
+table classes:
+
+ __PACKAGE__->load_components(qw/PK::Auto::SQLite Core/);
+
+Note that C<PK::Auto::SQLite> is specified as the leftmost argument.
+
+Alternatively, you can load the components separately:
+
+ __PACKAGE__->load_components(qw/Core/);
+ __PACKAGE__->load_components(qw/PK::Auto::SQLite/);
+
+This can be used, for example, if you have different databases and
+need to determine the appropriate C<PK::Auto> class at runtime.
+
+=head1 LOGIC
+
+C<PK::Auto> does this by letting the database assign the primary key
+field and fetching the assigned value afterwards.
=head1 METHODS
\r
=head1 SYNOPSIS\r
\r
+ # In your table classes\r
+ __PACKAGE__->load_components(qw/PK::Auto::MSSQL Core/);\r
+ __PACKAGE__->set_primary_key('id');\r
+\r
=head1 DESCRIPTION\r
\r
This class implements autoincrements for MSSQL.\r
\r
You may distribute this code under the same terms as Perl itself.\r
\r
-=cut
\ No newline at end of file
+=cut\r
=head1 SYNOPSIS
+ # In your table classes
+ __PACKAGE__->load_components(qw/PK::Auto::MySQL Core/);
+ __PACKAGE__->set_primary_key('id');
+
=head1 DESCRIPTION
This class implements autoincrements for MySQL.
sub last_insert_id {
my $self = shift;
$self->get_autoinc_seq unless $self->{_autoinc_seq};
- my $sql = "SELECT " . $self->{_autoinc_seq} . ".nextval FROM DUAL";
+ my $sql = "SELECT " . $self->{_autoinc_seq} . ".currval FROM DUAL";
my ($id) = $self->storage->dbh->selectrow_array($sql);
return $id;
}
=head1 SYNOPSIS
+ # In your table classes
+ __PACKAGE__->load_components(qw/PK::Auto::Oracle Core/);
+ __PACKAGE__->set_primary_key('id');
+
=head1 DESCRIPTION
This class implements autoincrements for Oracle.
=head1 SYNOPSIS
+ # In your table classes
+ __PACKAGE__->load_components(qw/PK::Auto::Pg Core/);
+ __PACKAGE__->set_primary_key('id');
+
=head1 DESCRIPTION
This class implements autoincrements for Postgresql.
=head1 SYNOPSIS
+ # In your table classes
+ __PACKAGE__->load_components(qw/PK::Auto::SQLite Core/);
+ __PACKAGE__->set_primary_key('id');
+
=head1 DESCRIPTION
This class implements autoincrements for SQLite.
use DBIx::Class::ResultSet;
+use Carp qw/croak/;
+
use base qw/DBIx::Class/;
__PACKAGE__->load_components(qw/AccessorGroup/);
sub column_info {
my ($self, $column) = @_;
- die "No such column $column" unless exists $self->_columns->{$column};
+ croak "No such column $column" unless exists $self->_columns->{$column};
return $self->_columns->{$column};
}
=cut
sub columns {
- die "columns() is a read-only accessor, did you mean add_columns()?" if (@_ > 1);
+ croak "columns() is a read-only accessor, did you mean add_columns()?" if (@_ > 1);
return keys %{shift->_columns};
}
--- /dev/null
+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.
+
# test primary key handling
my $new = OraTest::Artist->create({ name => 'foo' });
-ok($new->artistid, "Oracle Auto-PK worked");
+is($new->artistid, 1, "Oracle Auto-PK worked");
# test LIMIT support
for (1..6) {
projects / dbsrgits/DBIx-Class.git / commitdiff