Permalink
Browse files

initial FPMD version

git-svn-id: https://code.cyberion.net/svn/Form-Processor-Model-DOD/trunk@131 39e7695f-6334-0410-93e4-bc82e47781bf
  • Loading branch information...
0 parents commit 513b20f215a414a422c2c0aa24f8747c491f59e1 yann committed Jul 25, 2007
Showing with 552 additions and 0 deletions.
  1. +10 −0 .cvsignore
  2. +16 −0 Build.PL
  3. +5 −0 Changes
  4. +15 −0 MANIFEST
  5. +10 −0 MANIFEST.bak
  6. +19 −0 META.yml
  7. +44 −0 README
  8. +196 −0 lib/Form/Processor/Model/DOD.pm
  9. +9 −0 t/00-load.t
  10. +56 −0 t/01-basic.t
  11. +48 −0 t/boilerplate.t
  12. +39 −0 t/lib/Form/User.pm
  13. +21 −0 t/lib/Model/User.pm
  14. +44 −0 t/lib/db-common.pl
  15. +6 −0 t/pod-coverage.t
  16. +6 −0 t/pod.t
  17. +8 −0 t/schemas/user.sql
@@ -0,0 +1,10 @@
+blib*
+Makefile
+Makefile.old
+Build
+_build*
+pm_to_blib*
+*.tar.gz
+.lwpcookies
+Form-Processor-Model-DOD-*
+cover_db
@@ -0,0 +1,16 @@
+use strict;
+use warnings;
+use Module::Build;
+
+my $builder = Module::Build->new(
+ module_name => 'Form::Processor::Model::DOD',
+ license => 'perl',
+ dist_author => 'Yann Kerherve <yann.kerherve@gmail.com>',
+ dist_version_from => 'lib/Form/Processor/Model/DOD.pm',
+ build_requires => {
+ 'Test::More' => 0,
+ },
+ add_to_cleanup => [ 'Form-Processor-Model-DOD-*' ],
+);
+
+$builder->create_build_script();
@@ -0,0 +1,5 @@
+Revision history for Form-Processor-Model-DOD
+
+0.01 2007-07-24 23:00:00
+ First version, released on an unsuspecting world.
+
@@ -0,0 +1,15 @@
+Build.PL
+Changes
+lib/Form/Processor/Model/DOD.pm
+MANIFEST
+META.yml # Will be created by "make dist"
+README
+t/00-load.t
+t/01-basic.t
+t/boilerplate.t
+t/lib/db-common.pl
+t/lib/Form/User.pm
+t/lib/Model/User.pm
+t/pod-coverage.t
+t/pod.t
+t/schemas/user.sql
@@ -0,0 +1,10 @@
+Build.PL
+Changes
+MANIFEST
+META.yml # Will be created by "make dist"
+README
+lib/Form/Processor/Model/DOD.pm
+t/00-load.t
+t/boilerplate.t
+t/pod-coverage.t
+t/pod.t
@@ -0,0 +1,19 @@
+---
+name: Form-Processor-Model-DOD
+version: 0.01
+author:
+ - 'Yann Kerherve <yann.kerherve@gmail.com>'
+abstract: Model Class for Form::Processor based on Data::ObjectDriver
+license: perl
+resources:
+ license: http://dev.perl.org/licenses/
+build_requires:
+ Test::More: 0
+provides:
+ Form::Processor::Model::DOD:
+ file: lib/Form/Processor/Model/DOD.pm
+ version: 0.01
+generated_by: Module::Build version 0.2808
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.2.html
+ version: 1.2
44 README
@@ -0,0 +1,44 @@
+Form-Processor-Model-DOD version 0.01
+
+INSTALLATION
+
+To install this module, run the following commands:
+
+ perl Build.PL
+ ./Build
+ ./Build test
+ ./Build install
+
+DEPENDENCIES
+
+This module requires these other modules and libraries:
+
+ Form::Processor
+ Data::ObjectDriver
+
+SUPPORT AND DOCUMENTATION
+
+After installing, you can find documentation for this module with the perldoc command.
+
+ perldoc Form::Processor::Model::DOD
+
+You can also look for information at:
+
+ Search CPAN
+ http://search.cpan.org/dist/Form-Processor-Model-DOD
+
+ CPAN Request Tracker:
+ http://rt.cpan.org/NoAuth/Bugs.html?Dist=Form-Processor-Model-DOD
+
+ AnnoCPAN, annotated CPAN documentation:
+ http://annocpan.org/dist/Form-Processor-Model-DOD
+
+ CPAN Ratings:
+ http://cpanratings.perl.org/d/Form-Processor-Model-DOD
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2007 Yann Kerherve
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
@@ -0,0 +1,196 @@
+package Form::Processor::Model::DOD;
+
+use strict;
+use warnings;
+use base 'Form::Processor';
+
+=head1 NAME
+
+Form::Processor::Model::DOD - Model Class for Form::Processor based on Data::ObjectDriver
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+=head1 SYNOPSIS
+
+ ## define a form class to use with DOD items
+ package MyApplication::Form::User;
+ use strict;
+ use base 'Form::Processor::Model::DOD';
+
+ # Associate this form with a L<Data::ObjectDriver::BaseObject> class
+ sub object_class { 'MyApplication::Model::User' }
+
+ sub profile {
+ ...
+ }
+ 1;
+
+=head1 DESCRIPTION
+
+This is a Form::Processor::Model add-on module. This module is for use with
+L<Data::ObjectDriver> based objects. By declaring a C<object_class> method
+in the Form class, a form is tied to the data in the database (typically
+a row in one table).
+
+The form object can be prefilled with the data from the object in database,
+and similarily on C<update_from_form()> the object can be inserted or updated
+in the database (If validation passes).
+
+=head1 METHODS
+
+=head2 object_class
+
+(pod from cdbi model)
+This method is typically overridden in your form class and relates the form
+to a specific Class::DBI table class. This is the mapping between the form and
+the columns in the table the form operates on.
+
+The module uses this information to lookup options in related tables for both
+select and multiple select (many-to-many) relationships.
+
+If not defined will attempt to use the class of $form->item, if set.
+
+Typically, this method is overridden as shown above, and is all you need to do to
+use this module. This can also be a parameter when creating a form instance.
+
+=head2 init_item
+
+By default, just lookup the item_id associated with that model in the database.
+
+=cut
+
+sub init_item {
+ my $model = shift;
+ my $item_id = $model->item_id or return;
+ return $model->object_class->lookup( $item_id );
+}
+
+# use column_defs here XXX
+# sub guess_field_type { }
+
+=head2 update_from_form
+
+(some parts of this pod section come from cdbi)
+
+ my $ok = $form->update_from_form( $parameter_hash );
+ my $ok = $form->update_from_form( $c->request->parameters ); # catalyst for instance
+
+Update or create the object from values in the form.
+
+Validation is run unless validation has already been
+run. ($form->clear might need to be called if the $form object stays in memory
+between requests.)
+
+Pass in hash reference of parameters.
+
+Returns false if form does not validate. Very likely dies on database errors.
+
+=cut
+
+sub update_from_form {
+ my($model, $params) = @_;
+
+ return unless $model->validate($params);
+
+ # Grab either the item or the object class.
+ my $item = $model->item;
+ my $class = ref( $item ) || $model->object_class;
+
+ # get a hash of all fields
+ my %fields = map { $_->name, $_ } grep { !$_->noupdate } $model->fields;
+
+ my %data;
+ foreach my $col (@{ $class->column_names }) {
+ next unless exists $fields{$col};
+ my $field = delete $fields{$col};
+
+ # If the field is flagged "clear" then set to NULL.
+ my $value = $field->clear ? undef : $field->value;
+
+ if ($item) {
+ $item->$col( $value );
+ } else {
+ $data{$col} = $value;
+ }
+ }
+
+ if ($item) {
+ $item->update;
+ $model->updated_or_created('updated');
+ } else {
+ $item = $class->new;
+ $item->set_values(\%data);
+ $item->insert;
+ $model->item($item);
+ $model->updated_or_created('created');
+ }
+
+ $model->reset_params; # force reload of parameters from values
+
+ return $item;
+}
+
+=head1 SEE ALSO
+
+L<Form::Processor>, L<Form::Processor::Model::CDBI>, L<Data::ObjectDriver>
+
+=head1 AUTHOR
+
+Yann Kerherve, C<< <yann.kerherve at gmail.com> >>
+
+=head1 BUGS
+
+Please report any bugs or feature requests to
+C<bug-form-processor-model-dod at rt.cpan.org>, or through the web interface at
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Form-Processor-Model-DOD>.
+I will be notified, and then you'll automatically be notified of progress on
+your bug as I make changes.
+
+=head1 ACKNOWLEDGEMENT
+
+This module is based on the work of Bill Moseley.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+ perldoc Form::Processor::Model::DOD
+
+You can also look for information at:
+
+=over 4
+
+=item * AnnoCPAN: Annotated CPAN documentation
+
+L<http://annocpan.org/dist/Form-Processor-Model-DOD>
+
+=item * CPAN Ratings
+
+L<http://cpanratings.perl.org/d/Form-Processor-Model-DOD>
+
+=item * RT: CPAN's request tracker
+
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Form-Processor-Model-DOD>
+
+=item * Search CPAN
+
+L<http://search.cpan.org/dist/Form-Processor-Model-DOD>
+
+=back
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2007 Yann Kerherve, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
+"Oh neat, hot swap!";
@@ -0,0 +1,9 @@
+#!perl -T
+
+use Test::More tests => 1;
+
+BEGIN {
+ use_ok( 'Form::Processor::Model::DOD' );
+}
+
+diag( "Testing Form::Processor::Model::DOD $Form::Processor::Model::DOD::VERSION, Perl $], $^X" );
@@ -0,0 +1,56 @@
+use strict;
+
+use lib 'lib';
+use lib 't/lib';
+require 't/lib/db-common.pl';
+
+use Test::More;
+use Test::Exception;
+
+BEGIN {
+ unless (eval { require DBD::SQLite }) {
+ plan skip_all => 'Tests require DBD::SQLite';
+ }
+}
+
+plan tests => 18;
+
+setup_dbs({ testdb => [ qw( user ) ], });
+
+use Model::User;
+use_ok 'Form::User';
+my $form = Form::User->new;
+ok $form;
+isa_ok $form, 'Form::User';
+isa_ok $form, 'Form::Processor::Model';
+
+my $params = {
+ name => "Yann",
+ married_on => '2006-08-04 17:00:00',
+ state => 'drunk',
+};
+ok $form->update_from_form( $params );
+is $form->updated_or_created, "created";
+my $user = $form->item;
+ok my $id = $user->id;
+is $user->state, 'drunk';
+
+my $form2 = Form::User->new( $user->id );
+ok $form2->update_from_form( { %$params, state => 'sober' } );
+is $form2->updated_or_created, "updated";
+is $form2->item->id, $id;
+is $form2->item->state, 'sober';
+$form2->clear;
+ok ! $form2->update_from_form( { %$params, state => 'high' } );
+ok $form2->has_error;
+
+$user->refresh;
+is $user->state, 'sober', "form didn't validate so no update";
+
+my $form3 = Form::User->new( $user );
+ok $form3->update_from_form( $params );
+is $form3->item->state, 'drunk';
+$user->refresh;
+is $user->state, 'drunk', "form with whole item object passed in new()";
+
+teardown_dbs(qw( testdb ));
Oops, something went wrong.

0 comments on commit 513b20f

Please sign in to comment.