HTML-FormHandler-Model-DBIC-0.28/0000755000077000007700000000000012217614372015462 5ustar gshankgshankHTML-FormHandler-Model-DBIC-0.28/Changes0000644000077000007700000000475112217614372016764 0ustar gshankgshank0.28 Remove unnecessary use of Business::ISBN 0.27 Bug: dies with multiple pk table with unique field/column 0.26 Sun Jul 21, 2013 Enable use of 'messages' hashref for setting unique message 0.25 Wed Jul 3, 2013 Fix bug using result source method for select labels Bump prereq of DBIx::Class::ResultSet::RecursiveUpdate 0.24 Sun May 5, 2013 Bump prereq version of DBIC to avoid a regression 0.23 Mon Oct 15, 2012 Bump pre-req to non-broken HTML::FormHandler 0.22 Sat Oct 13, 2012 Ensure field is active and has a result before checking for errors. Allow using arrayref for sort column Remove Catalyst example (see github formhandler-example) 0.21 Mon May 14, 2012 Bump prereq version for HTML::FormHandler 0.20 Mon May 14, 2012 Update t/related.t test for compatibility with FH changes 0.19 Thu Apr 12, 2012 Name conflict between DBICFields and HFH. Rename 'include' & 'exclude' in DBICFields. 0.18 Thu Mar 8, 2012 Remove TestCompile from dist.ini 0.17 Wed Mar 7, 2012 Remove unnecessary broken DateTime tests Added functionality to optionally generate class_prefix, label and label_column 0.16 Sat Oct 4, 2011 Update test to match changes in HTML::FormHandler Fix form_generator package 0.15 Mon May 16, 2011 Tweak t/related.t test for changes to HFH 0.34001 0.14 Mon Oct 25, 2010 RU 0.20 throws errors on fields not in db; use new RU 0.21 attr 'ru_flags' to display warnings for fields not in db 0.13 Wed Oct 20, 2010 use Dist::Zilla fix testcase for new RecursiveUpdate Split model code into role 0.12 Fri June 25, 2010 Updated to match tests to new HFH version 0.11 Tues May 18, 2010 Wrong version number pre-req'd 0.10 Fri May 07, 2010 Adjust tests for changing precedence of defaults over item/init_object 0.09 Sun Feb 19, 2010 Initial implementation of automatic fields from DBIC (add DBIC::Model::TypeMap & TraitFor::DBICFields) Remove tests for auto fields 0.08 Mon Feb 1, 2010 Add txn_do to model_update Add skipping unique validation if field has unique => 0 Fix tests for empty repeatable element 0.07 Tues Dec 15, 2009 Add handling of composite unique keys 0.06 Wed Dec 2, 2009 Test changes for HFH 0.29 0.05 Tues Sep 15, 2009 Test changes for HFH 0.28 bump RU prereq 0.04002 Tues July 28, 2009 Add missing test database (!!!) 0.04001 Mon July, 27 2009 Fix dependency errors 0.04 Sun July 26, 2009 Split from HTML::FormHandler distribution HTML-FormHandler-Model-DBIC-0.28/dist.ini0000644000077000007700000000241212217614372017125 0ustar gshankgshank; Everything starting with ';' is a comment name = HTML-FormHandler-Model-DBIC author = FormHandler Contributors - see HTML::FormHandler license = Perl_5 copyright_holder = Gerda Shank copyright_year = 2013 version = 0.28 [@Git] tag_format = %v [@Basic] [InstallGuide] [MetaJSON] [MetaResources] bugtracker.web = https://rt.cpan.org/Public/Dist/Display.html?Name=HTML-FormHandler-Model-DBIC bugtracker.mailto = bug-HTML-FormHandler-Model-DBIC@rt.cpan.org ; If you have a repository... repository.url = git://github.com/gshank/html-formhandler-model-dbic.git repository.web = http://github.com/gshank/html-formhandler-model-dbic repository.type = git ; You have to have Dist::Zilla::Plugin:: for these to work [PodWeaver] [NoTabsTests] [EOLTests] [Signature] [CheckChangeLog] [ExecDir] dir = script [Prereqs] HTML::FormHandler = 0.40016 Moose = 2.0007 DBIx::Class = 0.08250 DBIx::Class::ResultSet::RecursiveUpdate = 0.25 namespace::autoclean = 0.09 [Prereqs / TestRequires] Test::More = 0.94 Test::Exception = 0 DateTime::Format::MySQL = 0 DateTime::Format::W3CDTF = 0 DateTime::Format::SQLite = 0 HTML-FormHandler-Model-DBIC-0.28/INSTALL0000644000077000007700000000205312217614372016513 0ustar gshankgshank This is the Perl distribution HTML-FormHandler-Model-DBIC. Installing HTML-FormHandler-Model-DBIC is straightforward. ## Installation with cpanm If you have cpanm, you only need one line: % cpanm HTML::FormHandler::Model::DBIC If you are installing into a system-wide directory, you may need to pass the "-S" flag to cpanm, which uses sudo to install the module: % cpanm -S HTML::FormHandler::Model::DBIC ## Installing with the CPAN shell Alternatively, if your CPAN shell is set up, you should just be able to do: % cpan HTML::FormHandler::Model::DBIC ## Manual installation As a last resort, you can manually install it. Download the tarball, untar it, then build it: % perl Makefile.PL % make && make test Then install it: % make install If you are installing into a system-wide directory, you may need to run: % sudo make install ## Documentation HTML-FormHandler-Model-DBIC documentation is available as POD. You can run perldoc from a shell to read the documentation: % perldoc HTML::FormHandler::Model::DBIC HTML-FormHandler-Model-DBIC-0.28/lib/0000755000077000007700000000000012217614372016230 5ustar gshankgshankHTML-FormHandler-Model-DBIC-0.28/lib/HTML/0000755000077000007700000000000012217614372016774 5ustar gshankgshankHTML-FormHandler-Model-DBIC-0.28/lib/HTML/FormHandler/0000755000077000007700000000000012217614372021175 5ustar gshankgshankHTML-FormHandler-Model-DBIC-0.28/lib/HTML/FormHandler/Generator/0000755000077000007700000000000012217614372023123 5ustar gshankgshankHTML-FormHandler-Model-DBIC-0.28/lib/HTML/FormHandler/Generator/DBIC.pm0000644000077000007700000002561012217614372024166 0ustar gshankgshankpackage HTML::FormHandler::Generator::DBIC; # ABSTRACT: form generator for DBIC use Moose; use DBIx::Class; use Template; our $VERSION = '0.04'; has db_dsn => ( is => 'ro', isa => 'Str', ); has db_user => ( is => 'ro', isa => 'Str', ); has db_password => ( is => 'ro', isa => 'Str', ); has 'schema_name' => ( is => 'ro', isa => 'Str', ); has 'rs_name' => ( is => 'ro', isa => 'Str', required => 1, ); has 'schema' => ( is => 'rw', lazy_build => 1, isa => 'DBIx::Class::Schema', required => 1, ); sub _build_schema { my $self = shift; my $schema_name = $self->schema_name; eval "require $schema_name"; die $@ if $@; return $schema_name->connect( $self->db_dsn, $self->db_user, $self->db_password, ); } has 'tt' => ( is => 'ro', default => sub { Template->new() }, ); has 'label' => ( is => 'ro', isa => 'Bool', default => 0, ); has 'label_column' => ( is => 'ro', isa => 'Bool', default => 0, ); has 'class_prefix' => ( is => 'ro', isa => 'Str', ); has 'style' => ( is => 'ro' ); has 'm2m' => ( is => 'ro', ); has 'packages' => ( traits => ['Hash'], isa => 'HashRef[Str]', is => 'rw', default => sub { {} }, auto_deref => 1, handles => { used_packages => 'keys', _add_package => 'set' }, ); sub add_package { my ( $self, $package ) = @_; $self->_add_package( $package, 1 ); } has 'field_classes' => ( traits => ['Hash'], isa => 'HashRef[HashRef]', is => 'rw', default => sub { {} }, auto_deref => 1, handles => { list_field_classes => 'keys', get_field_class_data => 'get', exists_field_class => 'exists', set_field_class_data => 'set', }, ); my $form_template = <<'END'; # Generated automatically with HTML::FormHandler::Generator::DBIC # Using following commandline: # form_generator.pl --rs_name=[% rs_name %][% IF label==1 %] --label[% END %][% IF label_column==1 %] --label_column[% END %] --schema_name=[% schema_name %][% IF class_prefix != '' %] --class_prefix=[% class_prefix %][% END %] --db_dsn=[% db_dsn %] { package [% config.class %]Form; use HTML::FormHandler::Moose; extends 'HTML::FormHandler::Model::DBIC'; use namespace::autoclean; [% FOR package = self.used_packages %] use [% package %]; [% END %] has '+item_class' => ( default => '[% rs_name %]' ); [% FOR field = config.fields -%] [% field %] [% END -%] has_field 'submit' => ( widget => 'Submit', [% IF label==1 %]label =>'Submit'[% END %]); __PACKAGE__->meta->make_immutable; no HTML::FormHandler::Moose; } [% FOR field_class = self.list_field_classes %] [% SET cf = self.get_field_class_data( field_class ) %] { package [% cf.class %]Field; use HTML::FormHandler::Moose; extends 'HTML::FormHandler::Field::Compound'; use namespace::autoclean; [% FOR field = cf.fields -%] [% field %] [% END %] __PACKAGE__->meta->make_immutable; no HTML::FormHandler::Moose; } [% END %] END sub generate_form { my ( $self ) = @_; my $config = $self->get_config; my $output; # warn Dumper( $config ); use Data::Dumper; my $tmpl_params = { self => $self, config => $config, rs_name => $self->rs_name, label => $self->label, label_column => $self->label_column, schema_name => $self->schema_name, class_prefix => $self->class_prefix, db_dsn => $self->db_dsn, }; $tmpl_params->{single} = 1 if defined $self->style && $self->style eq 'single'; $self->tt->process( \$form_template, $tmpl_params, \$output ) || die $self->tt->error(), "\n"; return $output; } sub _strip_class { my $fullclass = shift; my @parts = split /::/, $fullclass; my $class = pop @parts; return $class; } sub get_config { my( $self ) = @_; my $config = $self->get_elements ( $self->rs_name, 0, ); # push @{$config->{fields}}, { # type => 'submit', # name => 'foo', # }; my $target_class = $self->rs_name; $target_class = $self->class_prefix . '::' . $self->rs_name if $self->class_prefix; $config->{class} = $target_class; return $config; } sub m2m_for_class { my( $self, $class ) = @_; return if not $self->m2m; return if not $self->m2m->{$class}; return @{$self->m2m->{$class}}; } my %types = ( text => 'TextArea', int => 'Integer', integer => 'Integer', num => 'Number', number => 'Number', numeric => 'Number', ); sub field_def { my( $self, $name, $info ) = @_; my $output = ''; $output .= "has_field '$name' => ( "; if( lc $info->{data_type} eq 'date' or lc $info->{data_type} eq 'datetime' ){ $self->add_package( 'DateTime' ); $output .= <<'END'; type => 'Compound', apply => [ { transform => sub{ DateTime->new( $_[0] ) }, message => "Not a valid DateTime", } ], ); END $output .= " has_field '$name.$_';" for qw( year month day ); return $output; } my $type = $types{ $info->{data_type} } || 'Text'; $type = 'TextArea' if defined($info->{size}) && $info->{size} > 60; $output .= "type => '$type', "; $output .= "size => $info->{size}, " if $type eq 'Text' && $info->{size}; $output .= 'required => 1, ' if not $info->{is_nullable}; $output .= "label => '".$name."', " if $self->label; return $output . ');'; } sub get_elements { my( $self, $class, $level, @exclude ) = @_; my $source = $self->schema->source( $class ); my %primary_columns = map {$_ => 1} $source->primary_columns; my @fields; my @fieldsets; for my $rel( $source->relationships ) { next if grep { $_ eq $rel } @exclude; next if grep { $_->[1] eq $rel } $self->m2m_for_class($class); my $info = $source->relationship_info($rel); push @exclude, get_self_cols( $info->{cond} ); my $rel_class = _strip_class( $info->{class} ); my $elem_conf; if ( ! ( $info->{attrs}{accessor} eq 'multi' ) ) { my $field = "has_field '$rel' => ( type => 'Select', "; $field .= "label => '".$rel."', " if $self->label; $field .= "label_column => 'TO_BE_DONE', " if $self->label_column; $field .= ");"; push @fields, $field; } elsif( $level < 1 ) { my @new_exclude = get_foreign_cols ( $info->{cond} ); my $config = $self->get_elements ( $rel_class, 1, ); my $target_class = $rel_class; $target_class = $self->class_prefix . '::' . $rel_class if $self->class_prefix; $config->{class} = $target_class; $config->{name} = $rel; $self->set_field_class_data( $target_class => $config ) if !$self->exists_field_class( $target_class ); my $field_def = ''; if( defined $self->style && $self->style eq 'single' ){ $field_def .= '# '; } $field_def .= "has_field '$rel' => ( type => '+${target_class}Field', );"; push @fields, $field_def; } } for my $col ( $source->columns ) { my $new_element = { name => $col }; my $info = $source->column_info($col); if( $primary_columns{$col} && ( $info->{is_auto_increment} # in SQLite integer primary key is computed automatically just like auto increment || $self->is_SQLite_auto_pk( $source, $info ) ) ){ # for PK in the root use item_id, here only PKs for related rows unshift @fields, "has_field '$col' => ( type => 'Hidden' );" if $level > 1; } else{ next if grep { $_ eq $col } @exclude; unshift @fields, $self->field_def( $col, $info ); } } for my $many( $self->m2m_for_class($class) ){ unshift @fields, "has_field '$many->[0]' => ( type => 'Select', multiple => 1 );" } return { fields => \@fields }; } sub is_SQLite_auto_pk{ my ( $self, $source, $info ) = @_; return if $self->schema->storage->sqlt_type ne 'SQLite'; return if ! grep $info->{data_type}, qw/INTEGER Integer integer INT Int int/; my @pks = $source->primary_columns; return if scalar @pks > 1; return 1; } sub get_foreign_cols{ my $cond = shift; my @cols; if ( ref $cond eq 'ARRAY' ){ for my $c1 ( @$cond ){ push @cols, get_foreign_cols( $c1 ); } } elsif ( ref $cond eq 'HASH' ){ for my $key ( keys %{$cond} ){ if( $key =~ /foreign\.(.*)/ ){ push @cols, $1; } } } return @cols; } sub get_self_cols{ my $cond = shift; my @cols; if ( ref $cond eq 'ARRAY' ){ for my $c1 ( @$cond ){ push @cols, get_self_cols( $c1 ); } } elsif ( ref $cond eq 'HASH' ){ for my $key ( values %{$cond} ){ if( $key =~ /self\.(.*)/ ){ push @cols, $1; } } } return @cols; } { package HTML::FormHandler::Generator::DBIC::Cmd; use Moose; extends 'HTML::FormHandler::Generator::DBIC'; with 'MooseX::Getopt'; has '+db_dsn' => ( required => 1 ); has '+schema_name' => ( required => 1 ); has '+schema' => ( metaclass => 'NoGetopt' ); has '+tt' => ( metaclass => 'NoGetopt' ); has '+m2m' => ( metaclass => 'NoGetopt' ); } __PACKAGE__->meta->make_immutable; use namespace::autoclean; 1; __END__ =pod =head1 NAME HTML::FormHandler::Generator::DBIC - form generator for DBIC =head1 VERSION version 0.28 =head1 SYNOPSIS form_generator.pl --rs_name=Book --schema_name=BookDB::Schema::DB --db_dsn=dbi:SQLite:t/db/book.db > BookForm.pm =head1 DESCRIPTION Options: rs_name -- Resultset Name schema_name -- Schema Name db_dsn -- dsn connect info class_prefix -- [OPTIONAL] Prefix for generated classes (Default: '') label -- [OPTIONAL] Flag to toggle generation of form labels (Default: 0) label_column -- [OPTIONAL] Flag to toggle generation of dummy form labels_columns for type: 'select' (Default: 0) This package should be considered still experimental since the output, of the generated classes will be changed from time to time. This should not impact the main usage for this module that we had in mind, that is generating the initial version of a FormHandler form class, copying it to the project and modifying it. This script is installed into the system with the rest of FormHandler. =head1 AUTHOR FormHandler Contributors - see HTML::FormHandler =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Gerda Shank. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut HTML-FormHandler-Model-DBIC-0.28/lib/HTML/FormHandler/Model/0000755000077000007700000000000012217614372022235 5ustar gshankgshankHTML-FormHandler-Model-DBIC-0.28/lib/HTML/FormHandler/Model/DBIC/0000755000077000007700000000000012217614372022736 5ustar gshankgshankHTML-FormHandler-Model-DBIC-0.28/lib/HTML/FormHandler/Model/DBIC/TypeMap.pm0000644000077000007700000000341112217614372024652 0ustar gshankgshankpackage HTML::FormHandler::Model::DBIC::TypeMap; # ABSTRACT: type mape for DBICFields use Moose; use namespace::autoclean; has 'data_type_map' => ( is => 'ro', isa => 'HashRef', lazy => 1, builder => 'build_data_type_map', traits => ['Hash'], handles => { get_field_type => 'get' }, ); sub build_data_type_map { my $self = shift; return { 'varchar' => 'Text', 'text' => 'TextArea', 'integer' => 'Integer', 'int' => 'Integer', 'numeric' => 'Integer', 'datetime' => 'DateTime', 'timestamp' => 'DateTime', 'bool' => 'Boolean', 'decimal' => 'Float', 'bigint' => 'Integer', 'enum' => 'Select', }; } sub type_for_column { my ( $self, $info ) = @_; my %field_def; my $type; if( my $def = $info->{extra}->{field_def} ) { return $def; } if( $info->{data_type} ) { $type = $self->get_field_type( lc($info->{data_type}) ); } $type ||= 'Text'; $field_def{type} = $type; $field_def{size} = $info->{size} if( $type eq 'Textarea' && $info->{size} ); $field_def{required} = 1 if not $info->{is_nullable}; return \%field_def; } # stub sub type_for_rel { my ( $self, $rel ) = @_; return; } 1; __END__ =pod =head1 NAME HTML::FormHandler::Model::DBIC::TypeMap - type mape for DBICFields =head1 VERSION version 0.28 =head1 SYNOPSIS Use by L. =head1 AUTHOR FormHandler Contributors - see HTML::FormHandler =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Gerda Shank. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut HTML-FormHandler-Model-DBIC-0.28/lib/HTML/FormHandler/Model/DBIC.pm0000644000077000007700000000136612217614372023302 0ustar gshankgshankpackage HTML::FormHandler::Model::DBIC; # ABSTRACT: base class that holds DBIC model role use Moose; extends 'HTML::FormHandler'; with 'HTML::FormHandler::TraitFor::Model::DBIC'; our $VERSION = '0.28'; use namespace::autoclean; 1; __END__ =pod =head1 NAME HTML::FormHandler::Model::DBIC - base class that holds DBIC model role =head1 VERSION version 0.28 =head1 SUMMARY Empty base class - see L for documentation. =head1 AUTHOR FormHandler Contributors - see HTML::FormHandler =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Gerda Shank. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut HTML-FormHandler-Model-DBIC-0.28/lib/HTML/FormHandler/TraitFor/0000755000077000007700000000000012217614372022727 5ustar gshankgshankHTML-FormHandler-Model-DBIC-0.28/lib/HTML/FormHandler/TraitFor/DBICFields.pm0000644000077000007700000001126412217614372025121 0ustar gshankgshankpackage HTML::FormHandler::TraitFor::DBICFields; # ABSTRACT: role to get fields from DBIx::Class result source use Moose::Role; requires ('source', 'schema'); use HTML::FormHandler::Model::DBIC::TypeMap; has 'fields_from_model' => ( is => 'ro', default => 1 ); has 'includes' => ( is => 'ro', traits => ['Array'], isa => 'ArrayRef[Str]', default => sub {[]}, handles => { all_includes => 'elements', has_includes => 'count', } ); has 'excludes' => ( is => 'ro', traits => ['Array'], isa => 'ArrayRef[Str]', default => sub {[]}, handles => { has_excludes => 'count', } ); has 'rels' => ( is => 'ro', traits => ['Array'], isa => 'ArrayRef[Str]', default => sub {[]}, handles => { has_rels => 'count', } ); has 'type_map_class' => ( is => 'ro', isa => 'Str', default => 'HTML::FormHandler::Model::DBIC::TypeMap' ); has 'type_map_args' => ( is => 'ro', isa => 'HashRef', default => sub {{}} ); has 'type_map' => ( is => 'ro', lazy => 1, builder => 'build_type_map', handles => ['type_for_column', 'type_for_rel'], ); sub build_type_map { my $self = shift; my $class = $self->type_map_class; return $class->new( $self->type_map_args ); } sub model_fields { my $self = shift; my $fields = $self->get_fields( $self->source_name, 0, @{$self->excludes} ); return $fields; } sub get_fields { my( $self, $class, $level, @exclude ) = @_; my $source = $self->schema->source( $class ); my %primary_columns = map {$_ => 1} $source->primary_columns; my @fields; my @columns = $self->has_includes ? $self->all_includes : $source->columns; for my $col ( @columns ) { next if grep { $_ eq $col } @exclude; my $info = $source->column_info($col); my @field; if( $primary_columns{$col} && ( $info->{is_auto_increment} || $self->is_SQLite_auto_pk( $source, $info ))){ # for PK in the root use item_id, here only PKs for related rows push @field, ( $col => { type => 'Hidden' } ) if $level > 1; } else{ unshift @field, ( $col => $self->type_for_column( $info ) ); } push @fields, @field; } return \@fields; } # in SQLite integer primary key is computed automatically just like auto increment sub is_SQLite_auto_pk { my ( $self, $source, $info ) = @_; return if $self->schema->storage->sqlt_type ne 'SQLite'; return if ( ! lc( $info->{data_type} ) =~ /^int/ ); my @pks = $source->primary_columns; return if scalar @pks > 1; return 1; } # not yet implemented sub field_for_rel { my ( $self, $name, $info ) = @_; } 1; __END__ =pod =head1 NAME HTML::FormHandler::TraitFor::DBICFields - role to get fields from DBIx::Class result source =head1 VERSION version 0.28 =head1 SYNOPSIS This is a role to pull fields from a DBIx::Class result source. Requires existence of a 'source' attribute. This feature is new. It doesn't handle relationships yet, and the interfaces are still subject to change. my $form = HTML::FormHandler::Model::DBIC->new_with_traits( traits => ['HTML::FormHandler::TraitFor::DBICFields'], item => $book ); for my $rel( $source->relationships ) { next if grep { $_ eq $rel } @exclude; next if grep { $_->[1] eq $rel } $self->m2m_for_class($class); my $info = $source->relationship_info($rel); push @exclude, get_self_cols( $info->{cond} ); my $rel_class = _strip_class( $info->{class} ); my $elem_conf; if ( ! ( $info->{attrs}{accessor} eq 'multi' ) ) { push @fields, "has_field '$rel' => ( type => 'Select', );" } elsif( $level < 1 ) { my @new_exclude = get_foreign_cols ( $info->{cond} ); my $config = $self->get_fields ( $rel_class, 1, ); my $target_class = $rel_class; $target_class = $self->class_prefix . '::' . $rel_class if $self->class_prefix; $config->{class} = $target_class; $config->{name} = $rel; # $self->set_field_class_data( $target_class => $config ) if !$self->exists_field_class( $target_class ); my $field_def = ''; # if( defined $self->style && $self->style eq 'single' ){ # $field_def .= '# '; # } $field_def .= "has_field '$rel' => ( type => '+${target_class}Field', );"; push @fields, $field_def; } } =head1 AUTHOR FormHandler Contributors - see HTML::FormHandler =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Gerda Shank. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut HTML-FormHandler-Model-DBIC-0.28/lib/HTML/FormHandler/TraitFor/Model/0000755000077000007700000000000012217614372023767 5ustar gshankgshankHTML-FormHandler-Model-DBIC-0.28/lib/HTML/FormHandler/TraitFor/Model/DBIC.pm0000644000077000007700000004574712217614372025047 0ustar gshankgshankpackage HTML::FormHandler::TraitFor::Model::DBIC; # ABSTRACT: model role that interfaces with DBIx::Class use Moose::Role; use Carp; use DBIx::Class::ResultClass::HashRefInflator; use DBIx::Class::ResultSet::RecursiveUpdate; use Scalar::Util ('blessed'); our $VERSION = '0.26'; has 'schema' => ( is => 'rw', ); has 'source_name' => ( isa => 'Str', is => 'rw', lazy => 1, builder => 'build_source_name' ); has unique_constraints => ( is => 'ro', isa => 'ArrayRef', lazy_build => 1, ); sub _build_unique_constraints { my $self = shift; return [ grep { $_ ne 'primary' } $self->resultset->result_source->unique_constraint_names ]; } has unique_messages => ( is => 'ro', isa => 'HashRef', default => sub { +{} }, ); has 'ru_flags' => ( is => 'rw', isa => 'HashRef', traits => ['Hash'], builder => '_build_ru_flags', handles => { set_ru_flag => 'set', } ); sub _build_ru_flags { { unknown_params_ok => 1 }; } sub validate_model { my ($self) = @_; return unless $self->validate_unique; return 1; } sub clear_model { my $self = shift; $self->item(undef); $self->item_id(undef); } sub update_model { my $self = shift; my $item = $self->item; my $source = $self->source; warn "HFH: update_model for ", $self->name, "\n" if $self->verbose; #warn "fif: " . Dumper ( $self->fif ); use Data::Dumper; my %update_params = ( resultset => $self->resultset, updates => $self->values, %{ $self->ru_flags }, ); $update_params{object} = $self->item if $self->item; my $new_item; # perform update in a transaction, since RecursiveUpdate may do multiple # updates if there are compound or multiple fields $self->schema->txn_do( sub { $new_item = DBIx::Class::ResultSet::RecursiveUpdate::Functions::recursive_update( %update_params); $new_item->discard_changes; } ); $self->item($new_item) if $new_item; return $self->item; } # undocumented because this is going to be replaced # by a better method sub guess_field_type { my ( $self, $column ) = @_; my $source = $self->source; my @return; # TODO: Should be able to use $source->column_info # Is it a direct has_a relationship? if ( $source->has_relationship($column) && ( $source->relationship_info($column)->{attrs}->{accessor} eq 'single' || $source->relationship_info($column)->{attrs}->{accessor} eq 'filter' ) ) { my $f_class = $source->related_class($column); @return = $f_class->isa('DateTime') ? ('DateTime') : ('Select'); } # Else is it has_many? elsif ( $source->has_relationship($column) && $source->relationship_info($column)->{attrs}->{accessor} eq 'multi' ) { @return = ('Multiple'); } elsif ( $column =~ /_time$/ ) # ends in time, must be time value { @return = ('DateTime'); } else # default: Text { @return = ('Text'); } return wantarray ? @return : $return[0]; } sub lookup_options { my ( $self, $field, $accessor_path ) = @_; return unless $self->schema; my $self_source = $self->get_source($accessor_path); my $accessor = $field->accessor; # if this field doesn't refer to a foreign key, return my $f_class; my $source; # belongs_to single select if ( $self_source->has_relationship($accessor) ) { $f_class = $self_source->related_class($accessor); $source = $self->schema->source($f_class); } else { # check for many_to_many multiple select my $resultset = $self_source->resultset; my $new_result = $resultset->new_result( {} ); if ( $new_result && $new_result->can("add_to_$accessor") ) { $source = $new_result->$accessor->result_source; } } return unless $source; my $label_column = $field->label_column; return unless ( $source->has_column($label_column) || $source->result_class->can($label_column) ); my $active_col = $self->active_column || $field->active_column; $active_col = '' unless $source->has_column($active_col); my $sort_col = $field->sort_column; my ($primary_key) = $source->primary_columns; # if no sort_column and label_column is a source method, not a real column, must # use some other column for sort. There's probably some other column that should # be specified, but this will prevent breakage if ( !defined $sort_col ) { $sort_col = $source->has_column($label_column) ? $label_column : $primary_key; } # If there's an active column, only select active OR items already selected my $criteria = {}; if ($active_col) { my @or = ( $active_col => 1 ); # But also include any existing non-active push @or, ( "$primary_key" => $field->init_value ) if $self->item && defined $field->init_value; $criteria->{'-or'} = \@or; } # get an array of row objects my @rows = $self->schema->resultset( $source->source_name ) ->search( $criteria, { order_by => $sort_col } )->all; my @options; foreach my $row (@rows) { my $label = $row->$label_column; next unless defined $label; # this means there's an invalid value push @options, $row->id, $active_col && !$row->$active_col ? "[ $label ]" : "$label"; } return \@options; } sub init_value { my ( $self, $field, $value ) = @_; if ( ref $value eq 'ARRAY' ) { $value = [ map { $self->_fix_value( $field, $_ ) } @$value ]; } else { $value = $self->_fix_value( $field, $value ); } $field->init_value($value); $field->value($value); } sub _fix_value { my ( $self, $field, $value ) = @_; if ( blessed $value && $value->isa('DBIx::Class') ) { return $value->id; } return $value; } sub _get_related_source { my ( $self, $source, $name ) = @_; if ( $source->has_relationship($name) ) { return $source->related_source($name); } # many to many case my $row = $source->resultset->new( {} ); if ( $row->can($name) and $row->can( 'add_to_' . $name ) and $row->can( 'set_' . $name ) ) { return $row->$name->result_source; } return; } # this needs to be rewritten to be called at the field level # right now it will only work on fields immediately contained # by the form sub validate_unique { my ($self) = @_; my $rs = $self->resultset; my $found_error = 0; my $fields = $self->fields; my @id_clause = (); @id_clause = _id_clause( $rs, $self->item_id ) if defined $self->item; my $value = $self->value; for my $field (@$fields) { next unless $field->unique; next if ( $field->is_inactive || !$field->has_result ); next if $field->has_errors; my $value = $field->value; next unless defined $value; my $accessor = $field->accessor; my $count = $rs->search( { $accessor => $value, @id_clause } )->count; next if $count < 1; my $field_error = $field->get_message('unique') || $field->unique_message || 'Duplicate value for [_1]'; $field->add_error( $field_error, $field->loc_label ); $found_error++; } # validate unique constraints in the model for my $constraint ( @{ $self->unique_constraints } ) { my @columns = $rs->result_source->unique_constraint_columns($constraint); # check for matching field in the form my $field; for my $col (@columns) { ($field) = grep { $_->accessor eq $col } @$fields; last if $field; } next unless defined $field; next if ( $field->has_unique ); # already handled or don't do my @values = map { exists( $value->{$_} ) ? $value->{$_} : undef || ( $self->item ? $self->item->get_column($_) : undef ) } @columns; next if @columns != @values; # don't check unique constraints for which we don't have all the values next if grep { !defined $_ } @values; # don't check unique constraints with NULL values my %where; @where{@columns} = @values; my $count = $rs->search( \%where )->search( {@id_clause} )->count; next if $count < 1; my $field_error = $self->unique_message_for_constraint($constraint); $field->add_error( $field_error, $constraint ); $found_error++; } return $found_error; } sub unique_message_for_constraint { my $self = shift; my $constraint = shift; return $self->unique_messages->{$constraint} ||= "Duplicate value for [_1] unique constraint"; } sub _id_clause { my ( $resultset, $id ) = @_; my @pks = $resultset->result_source->primary_columns; my %clause; # multiple primary key if ( scalar @pks > 1 ) { die "multiple primary key invalid" if ref $id ne 'ARRAY'; my $cond = $id->[0]; my @phrase; foreach my $col ( keys %$cond ) { $clause{$col} = { '!=' => $cond->{$col} }; } } else { %clause = ( $pks[0] => { '!=' => $id } ); } return %clause; } sub build_item { my $self = shift; my $item_id = $self->item_id or return; my $item = $self->resultset->find( ref $item_id eq 'ARRAY' ? @{$item_id} : $item_id ); $self->item_id(undef) unless $item; return $item; } sub set_item { my ( $self, $item ) = @_; return unless $item; # when the item (DBIC row) is set, set the item_id, item_class # and schema from the item my @primary_columns = $item->result_source->primary_columns; my $item_id; if ( @primary_columns == 1 ) { $item_id = $item->get_column( $primary_columns[0] ); } elsif ( @primary_columns > 1 ) { my @pks = map { $_ => $item->get_column($_) } @primary_columns; $item_id = [ { @pks }, { key => 'primary' } ]; } if ($item_id) { $self->item_id($item_id); } else { $self->clear_item_id; } $self->item_class( $item->result_source->source_name ); $self->schema( $item->result_source->schema ); } sub set_item_id { my ( $self, $item_id ) = @_; # if a new item_id has been set # clear an existing item if ( defined $self->item ) { $self->clear_item if ( !defined $item_id || ( ref $item_id eq 'ARRAY' && join( '', @{$item_id} ) ne join( '', $self->item->id ) ) || ( ref \$item_id eq 'SCALAR' && $item_id ne $self->item->id ) ); } } sub build_source_name { my $self = shift; return $self->item_class; } sub source { my ( $self, $f_class ) = @_; return $self->schema->source( $self->source_name || $self->item_class ); } sub resultset { my ( $self, $f_class ) = @_; die "You must supply a schema for your FormHandler form" unless $self->schema; return $self->schema->resultset( $self->source_name || $self->item_class ); } sub get_source { my ( $self, $accessor_path ) = @_; return unless $self->schema; my $source = $self->source; return $source unless $accessor_path; my @accessors = split /\./, $accessor_path; for my $accessor (@accessors) { $source = $self->_get_related_source( $source, $accessor ); die "unable to get source for $accessor" unless $source; } return $source; } use namespace::autoclean; 1; __END__ =pod =head1 NAME HTML::FormHandler::TraitFor::Model::DBIC - model role that interfaces with DBIx::Class =head1 VERSION version 0.28 =head1 SYNOPSIS Subclass your form from HTML::FormHandler::Model::DBIC: package MyApp::Form::User; use HTML::FormHandler::Moose; extends 'HTML::FormHandler::Model::DBIC'; or apply as a role to FormHandler class: package MyApp::Form::User; use HTML::FormHandler::Moose; extends 'HTML::FormHandler'; with 'HTML::FormHandler::TraitFor::Model::DBIC'; =head1 DESCRIPTION This is a separate L model role for L. It will handle normal DBIC column accessors and a number of DBIC relationships. It will save form fields automatically to the database. The distribution contains a form generator (L). An example application can be found on github at http://github.com/gshank/formhandler-example. L can be used to auto-generate forms from a DBIC result. my $book = $schema->resultset('Book')->find(1); my $form = HTML::FormHandler::Model::DBIC->new_with_traits( traits => ['HTML::FormHandler::TraitFor::DBICFields'], field_list => [ 'submit' => { type => 'Submit', value => 'Save', order => 99 } ], item => $book ); This model supports using DBIx::Class result_source accessors just as if they were standard columns. Forms that need to do custom updating usually will subclass or use an 'around' method modifier on the 'update_model' method. There are two ways to get a valid DBIC model. The first way is to set: item_id (primary key) item_class (source name) schema The 'item_class' is usually set in the form class: # Associate this form with a DBIx::Class result class has '+item_class' => ( default => 'User' ); # 'User' is the DBIC source_name The 'item_id' and 'schema' must be passed in when the form is used in your controller. $form->process( item_id => $id, schema => $c->model('DB')->schema, params => $c->req->params ); If the item_id is not defined, then a new record will be created. The second way is to pass in a DBIx::Class row, or 'item'; $form->process( item => $row, params => $c->req->params ); The 'item_id', 'item_class', and 'schema' will be derived from the 'item'. For a new row (such as on a 'create' ), you can use new_result: my $item = $c->model('DB::Book')->new_result({}); $form->process( item => $item, params => $c->req->params ); The accessor names of the fields in your form should match column, relationship, or accessor names in your DBIx::Class result source. Usually the field name and accessor are the same, but they may be different. =head1 DBIC Relationships =head2 belongs_to Single Select fields will handle 'belongs_to' relationships, where the related table is used to construct a selection list from the database. =head2 many_to_many Multiple Select fields use a 'many_to_many' pseudo-relation to retrieve the selection list from the database. has_field 'roles' => ( type => 'Multiple', label_column => 'role', ); You need to supply 'label_column' to indicate which column should be used as label. A Compound field can represent a single relation. A Repeatable field will map onto a multiple relationship. More information is available from: L L L =head1 METHODS =head2 schema Stores the schema that is either passed in, created from the model name in the controller, or created from the Catalyst context and the item_class in the plugin. =head2 validate_model The place to put validation that requires database-specific lookups. Subclass this method in your form. Validation of unique fields is called from this method. =head2 update_model Updates the database. If you want to do some extra database processing (such as updating a related table) this is the method to subclass in your form. This routine allows the use of non-database (non-column, non-relationship) accessors in your result source class. It identifies form fields as column, relationship, select, multiple, or other. Column and other fields are processed and update is called on the row. Then relationships are processed. If the row doesn't exist (no primary key or row object was passed in), then a row is created. =head2 lookup_options This method is used with "Single" and "Multiple" field select lists ("single", "filter", and "multi" relationships). It returns an array reference of key/value pairs for the column passed in. The column name defined in $field->label_column will be used as the label. The default label_column is "name". The labels are sorted by Perl's cmp sort. If there is an "active" column then only active values are included, except if the form (item) has currently selected the inactive item. This allows existing records that reference inactive items to still have those as valid select options. The inactive labels are formatted with brackets to indicate in the select list that they are inactive. The active column name is determined by calling: $active_col = $form->can( 'active_column' ) ? $form->active_column : $field->active_column; This allows setting the name of the active column globally if your tables are consistantly named (all lookup tables have the same column name to indicate they are active), or on a per-field basis. The column to use for sorting the list is specified with "sort_column". The currently selected values in a Multiple list are grouped at the top (by the Multiple field class). =head2 init_value This method sets a field's value (for $field->value). This method is not called if a method "init_value_$field_name" is found in the form class - that method is called instead. =head2 validate_unique For fields that are marked "unique", checks the database for uniqueness. The unique constraints registered in the DBIC result source (see L) will also be inspected for uniqueness unless the field's 'unique' attribute is set to false. Alternatively, you can use the C attribute to limit uniqueness checking to only a select group of unique constraints. Error messages can be specified in the C attribute. Here's an example where you might want to specify a unique widget name for a given department: has '+unique_constraints' => ( default => sub { ['department_widget_name'] } ); has '+unique_messages' => ( default => sub { { department_widget_name => "Please choose a unique widget name for this department" }; } ); =head2 source Returns a DBIx::Class::ResultSource object for this Result Class. =head2 resultset This method returns a resultset from the "item_class" specified in the form (C<< $schema->resultset( $form->item_class ) >>) =head1 Attributes =over =item schema =item source_name =item unique_constraints =item unique_messages =item ru_flags L is used to interface with L. By default, the flag 'unknown_params_ok' is passed in. The 'ru_flags' attribute is a hashref, and also provides 'set_ru_flag'. =back =head1 AUTHOR FormHandler Contributors - see HTML::FormHandler =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Gerda Shank. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut HTML-FormHandler-Model-DBIC-0.28/LICENSE0000644000077000007700000004367512217614372016506 0ustar gshankgshankThis software is copyright (c) 2013 by Gerda Shank. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2013 by Gerda Shank. This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2013 by Gerda Shank. This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End HTML-FormHandler-Model-DBIC-0.28/Makefile.PL0000644000077000007700000000261012217614372017433 0ustar gshankgshank use strict; use warnings; use ExtUtils::MakeMaker 6.30; my %WriteMakefileArgs = ( "ABSTRACT" => "base class that holds DBIC model role", "AUTHOR" => "FormHandler Contributors - see HTML::FormHandler", "BUILD_REQUIRES" => { "DateTime::Format::MySQL" => 0, "DateTime::Format::SQLite" => 0, "DateTime::Format::W3CDTF" => 0, "Test::Exception" => 0, "Test::More" => "0.94" }, "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => "6.30" }, "DISTNAME" => "HTML-FormHandler-Model-DBIC", "EXE_FILES" => [ "script/form_generator.pl" ], "LICENSE" => "perl", "NAME" => "HTML::FormHandler::Model::DBIC", "PREREQ_PM" => { "DBIx::Class" => "0.08250", "DBIx::Class::ResultSet::RecursiveUpdate" => "0.25", "HTML::FormHandler" => "0.40016", "Moose" => "2.0007", "namespace::autoclean" => "0.09" }, "VERSION" => "0.28", "test" => { "TESTS" => "t/*.t t/xt/*.t" } ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.56) } ) { my $br = delete $WriteMakefileArgs{BUILD_REQUIRES}; my $pp = $WriteMakefileArgs{PREREQ_PM}; for my $mod ( keys %$br ) { if ( exists $pp->{$mod} ) { $pp->{$mod} = $br->{$mod} if $br->{$mod} > $pp->{$mod}; } else { $pp->{$mod} = $br->{$mod}; } } } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); HTML-FormHandler-Model-DBIC-0.28/MANIFEST0000644000077000007700000000363712217614372016624 0ustar gshankgshankChanges INSTALL LICENSE MANIFEST META.json META.yml Makefile.PL README SIGNATURE TODO dist.ini lib/HTML/FormHandler/Generator/DBIC.pm lib/HTML/FormHandler/Model/DBIC.pm lib/HTML/FormHandler/Model/DBIC/TypeMap.pm lib/HTML/FormHandler/TraitFor/DBICFields.pm lib/HTML/FormHandler/TraitFor/Model/DBIC.pm script/form_generator.pl t/01app.t t/active_column.t t/author.t t/bad_item_id.t t/book.t t/book2pk.t t/datetime.t t/db/book.db t/db/bookdb.sql t/db_fif.t t/db_has_many.t t/db_has_one.t t/db_init_obj.t t/db_options.t t/db_validate.t t/dbic_accessor.t t/fif.t t/generator.t t/lib/BookDB.pm t/lib/BookDB/Form/Author.pm t/lib/BookDB/Form/AuthorOld.pm t/lib/BookDB/Form/Book.pm t/lib/BookDB/Form/Book2PK.pm t/lib/BookDB/Form/BookHTML.pm t/lib/BookDB/Form/BookM2M.pm t/lib/BookDB/Form/BookView.pm t/lib/BookDB/Form/BookWithOwner.pm t/lib/BookDB/Form/BookWithOwnerAlt.pm t/lib/BookDB/Form/Borrower.pm t/lib/BookDB/Form/BorrowerX.pm t/lib/BookDB/Form/Field/AltText.pm t/lib/BookDB/Form/Field/Book.pm t/lib/BookDB/Form/Profile.pm t/lib/BookDB/Form/Role/BookOwner.pm t/lib/BookDB/Form/User.pm t/lib/BookDB/Form/Widget/Wrapper/Para.pm t/lib/BookDB/Schema.pm t/lib/BookDB/Schema/Result/Address.pm t/lib/BookDB/Schema/Result/Author.pm t/lib/BookDB/Schema/Result/AuthorBooks.pm t/lib/BookDB/Schema/Result/AuthorOld.pm t/lib/BookDB/Schema/Result/Book.pm t/lib/BookDB/Schema/Result/Book2PK.pm t/lib/BookDB/Schema/Result/BooksGenres.pm t/lib/BookDB/Schema/Result/Borrower.pm t/lib/BookDB/Schema/Result/Country.pm t/lib/BookDB/Schema/Result/Employer.pm t/lib/BookDB/Schema/Result/Format.pm t/lib/BookDB/Schema/Result/Genre.pm t/lib/BookDB/Schema/Result/License.pm t/lib/BookDB/Schema/Result/Options.pm t/lib/BookDB/Schema/Result/User.pm t/lib/BookDB/Schema/Result/UserEmployer.pm t/model_dbic.t t/mult_pk.t t/process.t t/reflect.t t/related.t t/release-eol.t t/release-no-tabs.t t/reload_options.t t/resultset.t t/unique-composite.t t/unique.t t/xt/02pod.t t/xt/dump.t HTML-FormHandler-Model-DBIC-0.28/META.json0000644000077000007700000000312212217614372017101 0ustar gshankgshank{ "abstract" : "base class that holds DBIC model role", "author" : [ "FormHandler Contributors - see HTML::FormHandler" ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 4.300020, CPAN::Meta::Converter version 2.120921", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "HTML-FormHandler-Model-DBIC", "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "6.30" } }, "runtime" : { "requires" : { "DBIx::Class" : "0.08250", "DBIx::Class::ResultSet::RecursiveUpdate" : "0.25", "HTML::FormHandler" : "0.40016", "Moose" : "2.0007", "namespace::autoclean" : "0.09" } }, "test" : { "requires" : { "DateTime::Format::MySQL" : "0", "DateTime::Format::SQLite" : "0", "DateTime::Format::W3CDTF" : "0", "Test::Exception" : "0", "Test::More" : "0.94" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "mailto" : "bug-HTML-FormHandler-Model-DBIC@rt.cpan.org", "web" : "https://rt.cpan.org/Public/Dist/Display.html?Name=HTML-FormHandler-Model-DBIC" }, "repository" : { "type" : "git", "url" : "git://github.com/gshank/html-formhandler-model-dbic.git", "web" : "http://github.com/gshank/html-formhandler-model-dbic" } }, "version" : "0.28" } HTML-FormHandler-Model-DBIC-0.28/META.yml0000644000077000007700000000157412217614372016742 0ustar gshankgshank--- abstract: 'base class that holds DBIC model role' author: - 'FormHandler Contributors - see HTML::FormHandler' build_requires: DateTime::Format::MySQL: 0 DateTime::Format::SQLite: 0 DateTime::Format::W3CDTF: 0 Test::Exception: 0 Test::More: 0.94 configure_requires: ExtUtils::MakeMaker: 6.30 dynamic_config: 0 generated_by: 'Dist::Zilla version 4.300020, CPAN::Meta::Converter version 2.120921' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: HTML-FormHandler-Model-DBIC requires: DBIx::Class: 0.08250 DBIx::Class::ResultSet::RecursiveUpdate: 0.25 HTML::FormHandler: 0.40016 Moose: 2.0007 namespace::autoclean: 0.09 resources: bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=HTML-FormHandler-Model-DBIC repository: git://github.com/gshank/html-formhandler-model-dbic.git version: 0.28 HTML-FormHandler-Model-DBIC-0.28/README0000644000077000007700000000047412217614372016347 0ustar gshankgshank This archive contains the distribution HTML-FormHandler-Model-DBIC, version 0.28: base class that holds DBIC model role This software is copyright (c) 2013 by Gerda Shank. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. HTML-FormHandler-Model-DBIC-0.28/script/0000755000077000007700000000000012217614372016766 5ustar gshankgshankHTML-FormHandler-Model-DBIC-0.28/script/form_generator.pl0000755000077000007700000000120512217614372022335 0ustar gshankgshank#!/usr/bin/perl package form_generator; # ABSTRACT: form generator use strict; use warnings; use HTML::FormHandler::Generator::DBIC; use lib ('lib'); my $generator = HTML::FormHandler::Generator::DBIC::Cmd->new_with_options(); print $generator->generate_form; __END__ =pod =head1 NAME form_generator - form generator =head1 VERSION version 0.28 =head1 AUTHOR FormHandler Contributors - see HTML::FormHandler =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Gerda Shank. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut HTML-FormHandler-Model-DBIC-0.28/SIGNATURE0000644000077000007700000001451412217614372016753 0ustar gshankgshankThis file contains message digests of all files listed in MANIFEST, signed via the Module::Signature module, version 0.68. To verify the content in this distribution, first make sure you have Module::Signature installed, then type: % cpansign -v It will check each file's integrity, as well as the signature's validity. If "==> Signature verified OK! <==" is not displayed, the distribution may already have been compromised, and you should not run its Makefile.PL or Build.PL. -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA256 SHA1 061f1d6cd9382d74b0513424ddae2300d98705df Changes SHA1 674ec091357ed31599f8081acb61b17054e1650e INSTALL SHA1 b666e0455e9fd5ccdcadd7cc9750644700fc8c22 LICENSE SHA1 ce9b8c00e5f9b8abee54abdd1a3f07f2b8277bba MANIFEST SHA1 d6217b04aa38cfafd757da532c4061d9bc4b3f40 META.json SHA1 b1ea5ee8fcb4f7b51401b988c4829b399e3a0a16 META.yml SHA1 626915e99049870ef5dffd4fb71f7ea528538b16 Makefile.PL SHA1 5e1226dfa7fb6986e9efeb6193d7a5734dba0140 README SHA1 a8d73c860cf746b8a1a74ff351719f9c53a3f560 TODO SHA1 9c2c8fb6b1ac164e9789a7e1abc7e8558b47163b dist.ini SHA1 1bd5200858474e3b039a0ecab4833c0c6dee69de lib/HTML/FormHandler/Generator/DBIC.pm SHA1 812b244f4fe5d41e7fed9ff310c6bb67302be8bc lib/HTML/FormHandler/Model/DBIC.pm SHA1 856c765f56d3419c4f1c98f57909fe0e65ff4fda lib/HTML/FormHandler/Model/DBIC/TypeMap.pm SHA1 91a74ffbfb45215e9b8dceda43a0eea6d95ab3a2 lib/HTML/FormHandler/TraitFor/DBICFields.pm SHA1 3b58421a40d5c6179ac0cbfb2602f5cd0130e1b9 lib/HTML/FormHandler/TraitFor/Model/DBIC.pm SHA1 1a59733c25c1df1fc81270e7fccfc957f7a3c081 script/form_generator.pl SHA1 e141c74dbb016fc0b4e2ff548cb113e0e6cbeac9 t/01app.t SHA1 c910b1623c4b03c14d280a01d42979e28ec8f102 t/active_column.t SHA1 b19a7d514320858a9f58455635c346aa4da663d8 t/author.t SHA1 b03b8d035f37e3b2789fa33657b28fa909bd014c t/bad_item_id.t SHA1 e05624f03890ccc13b0433864c21af1db0f763c2 t/book.t SHA1 cd2214898eb4484fd5d515b85a34c060312a9e2a t/book2pk.t SHA1 ffdd1e69a43a80a797d7765146e86dd99f61ae63 t/datetime.t SHA1 4ab0b326d2fc6d1d55f3d9bdf33bfb5a53ea1659 t/db/book.db SHA1 dc44fb3bb1b947d18d4d3b2b859ac4cd5ae24439 t/db/bookdb.sql SHA1 553c4d810e9fc902273195f5661386def69a72f4 t/db_fif.t SHA1 2e318f0ec4d69ce9622b31071c73189cbd0d1562 t/db_has_many.t SHA1 653c2c4049390afdad5c773a1399c689adc4b7f4 t/db_has_one.t SHA1 26a8c60b598eb22e83bdeee7157577e11e62d93b t/db_init_obj.t SHA1 2f64d47a773825667cf5d86b33edc540c1385d84 t/db_options.t SHA1 3b7450422ca4644db2edfc770654754823c2f304 t/db_validate.t SHA1 f53b0d40db8b918eccd29267d7d0f269890b5bfa t/dbic_accessor.t SHA1 6cb226a1240bec6c188279b0ed041ddc265c59d4 t/fif.t SHA1 6503092531bd4ad63ed835763be21662eaa13c03 t/generator.t SHA1 14989b01195d51bfe165bda524799c5ad84919de t/lib/BookDB.pm SHA1 71ed372b5f2cb0040c98b333e242878e3bc917c4 t/lib/BookDB/Form/Author.pm SHA1 0d2b18d1c28bbdd9611033ec44648333539e1c1d t/lib/BookDB/Form/AuthorOld.pm SHA1 57ac298e6e3abc17f2bc5e48220c7c1c462a7bb2 t/lib/BookDB/Form/Book.pm SHA1 d08154338f45a07137f85d6ae0c7cb54a1ef95ca t/lib/BookDB/Form/Book2PK.pm SHA1 b5ce1b76ee76505069efa62d4f201fae7b2d457c t/lib/BookDB/Form/BookHTML.pm SHA1 d426249c86ae939b3032846bc82d9ec903c57cc5 t/lib/BookDB/Form/BookM2M.pm SHA1 cbe1dd7bcedd279e943e81a4f1bd89e8f6890c7e t/lib/BookDB/Form/BookView.pm SHA1 6d1b7df8508891980e7325f16066e451fdb3a45d t/lib/BookDB/Form/BookWithOwner.pm SHA1 e945ca281a96165e1b542e87c0e67fc2ec688683 t/lib/BookDB/Form/BookWithOwnerAlt.pm SHA1 55c26211bd5859eb54573158661e6ad913ccad83 t/lib/BookDB/Form/Borrower.pm SHA1 b1d89bc3684b26fc4678f57580c9d396c08449ba t/lib/BookDB/Form/BorrowerX.pm SHA1 b201ee288c67a44751dc48832dfb0ff405239246 t/lib/BookDB/Form/Field/AltText.pm SHA1 19e2bf714db84a6120e38357c6b5b5c00c2fe60b t/lib/BookDB/Form/Field/Book.pm SHA1 15f91756fee51fe615ff7b0c82f37546dbfccf61 t/lib/BookDB/Form/Profile.pm SHA1 b2d3f780148e70207f312436f11bed1ec024e26f t/lib/BookDB/Form/Role/BookOwner.pm SHA1 476d556d4fcb2acfdf013901443951634edf24fc t/lib/BookDB/Form/User.pm SHA1 6f59b959717ea61499038f05f21999650edb5241 t/lib/BookDB/Form/Widget/Wrapper/Para.pm SHA1 a6ee6f269e6024d675d22c40b0a5bb4aa859ca40 t/lib/BookDB/Schema.pm SHA1 4856e496246686ef913209a49a4dc57904dce5a7 t/lib/BookDB/Schema/Result/Address.pm SHA1 742e87180a2599893a806f2d03cc57f5f705088e t/lib/BookDB/Schema/Result/Author.pm SHA1 66660fb22bcb833e82609ac33ba4183261be2f66 t/lib/BookDB/Schema/Result/AuthorBooks.pm SHA1 47bc39eb211a3e8be2ec2c7b5281dddc001ca13f t/lib/BookDB/Schema/Result/AuthorOld.pm SHA1 f7e3a768098f9ee0b197e0b2276b90cabfef6c83 t/lib/BookDB/Schema/Result/Book.pm SHA1 e17c92e2a4cf1c5e7988f75f1161644daf0b263e t/lib/BookDB/Schema/Result/Book2PK.pm SHA1 0b13f30efa9317c7def84e10a007ed8a2e900d0e t/lib/BookDB/Schema/Result/BooksGenres.pm SHA1 8fdeb42fdfc15f2692fdc141ca4853ea3997b276 t/lib/BookDB/Schema/Result/Borrower.pm SHA1 025fa1a06df3677d577311cdf88190fca9c2ec9a t/lib/BookDB/Schema/Result/Country.pm SHA1 85dd3c2065ad98adb46ba52f1d02e1f5305d7dd1 t/lib/BookDB/Schema/Result/Employer.pm SHA1 42f9533e65597837b19389aef03b87096b3060b4 t/lib/BookDB/Schema/Result/Format.pm SHA1 30f613369f25dcb5c7799acedb2efbc1d5713422 t/lib/BookDB/Schema/Result/Genre.pm SHA1 4efc958e6acf9822a75d27bf24d8cd1b08dc9e2a t/lib/BookDB/Schema/Result/License.pm SHA1 7b72cbd79220d74553e66d662b17e1136e1c85b1 t/lib/BookDB/Schema/Result/Options.pm SHA1 caea8cb79f441d37d54e192d1bcc16763819a7ed t/lib/BookDB/Schema/Result/User.pm SHA1 c2b07809d8b836565eb70105704867668dfb7011 t/lib/BookDB/Schema/Result/UserEmployer.pm SHA1 60f791ad0cd523be869b9f1994a89e8f3e5d7285 t/model_dbic.t SHA1 6f7b36a0ecf0c47817f460a974c9cb62d004dbbd t/mult_pk.t SHA1 f7bd133652cf896d80d26912a2f96e9ca56a0e31 t/process.t SHA1 82bfaff07150d7a4e45d31bde7146c0622d44217 t/reflect.t SHA1 d994766acb3f7185f996d7c2b2a6a8a1e02e802b t/related.t SHA1 a032c41ef6887fab1b900669c2d304fab46680e2 t/release-eol.t SHA1 455d1dd1867212a665ad5ea4126b572411de300c t/release-no-tabs.t SHA1 a1731d1ac9e3a5218db578bc8557a0b0c068ac47 t/reload_options.t SHA1 f6d485d4fc868421b5f76a77cbe18e2b3068f95f t/resultset.t SHA1 8e637403943525aa9fa41ae35e02c52225424220 t/unique-composite.t SHA1 e5186c67e65b7c1658cdf2c362a05b3cea172d87 t/unique.t SHA1 86d255a7c9f065a13049108362c949b3e35a4c24 t/xt/02pod.t SHA1 6c8c9e4255f3a7e58a2508bb779ec013ac48706f t/xt/dump.t -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.13 (Darwin) iF4EAREIAAYFAlI/GPYACgkQlX0ZOkgCucirvQD+PNsqijr2aSXbTr0R/3EYWHvZ TrVM/vtdlL7SmQOYe8kA+QH+BlP8zZI4EW/tMsuPQ5cGEREbu9N9fE3NIIqBpoS2 =zewy -----END PGP SIGNATURE----- HTML-FormHandler-Model-DBIC-0.28/t/0000755000077000007700000000000012217614372015725 5ustar gshankgshankHTML-FormHandler-Model-DBIC-0.28/t/01app.t0000644000077000007700000000032212217614372017030 0ustar gshankgshankuse Test::More tests => 2; use_ok( 'HTML::FormHandler::Model::DBIC' ); SKIP: { eval "use Template"; skip "Template Toolkit not installed", 1 if $@; use_ok( 'HTML::FormHandler::Generator::DBIC' ); } HTML-FormHandler-Model-DBIC-0.28/t/active_column.t0000644000077000007700000000137712217614372020752 0ustar gshankgshankuse strict; use warnings; use Test::More; use lib 't/lib'; use BookDB::Schema; { package MyApp::Form::Test; use HTML::FormHandler::Moose; extends 'HTML::FormHandler::Model::DBIC'; has '+item_class' => ( default => 'Book' ); has_field 'title' => ( type => 'Text', required => 1, ); # has_many relationship pointing to mapping table has_field 'genres' => ( type => 'Multiple', label_column => 'name', active_column => 'is_active', ); } my $schema = BookDB::Schema->connect('dbi:SQLite:t/db/book.db'); my $form = MyApp::Form::Test->new( schema => $schema ); ok( $form ); is( $form->field('genres')->num_options, 3, 'right number of options' ); done_testing; HTML-FormHandler-Model-DBIC-0.28/t/author.t0000644000077000007700000000121112217614372017407 0ustar gshankgshankuse strict; use warnings; use Test::More; use lib 't/lib'; use BookDB::Schema; use_ok('BookDB::Form::Author'); my $schema = BookDB::Schema->connect('dbi:SQLite:t/db/book.db'); ok($schema, 'get db schema'); my $author = $schema->resultset('Author')->find(1); my $form = BookDB::Form::Author->new; ok( $form, 'form built' ); $form->process( item => $author, params => {}); my @options = $form->field('books.0.genres')->options; is(scalar @options, 6, 'got right number of genre options' ); my @formats = $form->field('books.0.format')->options; is(scalar @formats, 6, 'got right number of format options'); my $fif = $form->fif; done_testing; HTML-FormHandler-Model-DBIC-0.28/t/bad_item_id.t0000644000077000007700000000316612217614372020340 0ustar gshankgshankuse Test::More; use lib 't/lib'; use_ok('HTML::FormHandler::Model::DBIC'); use BookDB::Schema; my $schema = BookDB::Schema->connect('dbi:SQLite:t/db/book.db'); my $id = 99; my $record = $schema->resultset('Book')->find($id); $record->delete if $record; { package My::Form; use HTML::FormHandler::Moose; extends 'HTML::FormHandler::Model::DBIC'; has '+item_class' => ( default => 'Book' ); has_field 'title' => ( type => 'Text', required => 1 ); has_field 'author'; no HTML::FormHandler::Moose; } my $form = My::Form->new( item_id => $id, schema => $schema ); ok( $form, 'get form'); my $title_field = $form->field('title'); ok( !$title_field->value, 'did not get title from form'); my $params = { 'title' => 'How to Test Perl Form Processors', 'author' => 'I.M. Author', 'isbn' => '123-02345-0502-2' , 'publisher' => 'EreWhon Publishing', }; ok( $form->process( $params ), 'validate data' ); my $book = $form->item; END { $book->delete } ok($book->id != 99,'book row ID does not match ID passed in object from form'); is( $book->publisher, undef, 'No publisher, because no field'); # make sure that primary keys included by error do not update { package My::Form2; use HTML::FormHandler::Moose; extends 'My::Form'; has_field 'id' => ( type => 'Integer' ); no HTML::FormHandler::Moose; } $id = $book->id; $form = My::Form2->new( $book ); ok( $form, 'get form for Form2' ); $form->process( params => { title => 'How to Test, Volume 2' } ); $book->discard_changes; is( $book->title, 'How to Test, Volume 2', 'get new title'); is( $book->id, $id, 'id is correct' ); done_testing; HTML-FormHandler-Model-DBIC-0.28/t/book.t0000644000077000007700000001052412217614372017046 0ustar gshankgshankuse strict; use warnings; use Test::More; use lib 't/lib'; use_ok( 'HTML::FormHandler' ); use_ok( 'BookDB::Form::Book'); use_ok( 'BookDB::Schema'); my $schema = BookDB::Schema->connect('dbi:SQLite:t/db/book.db'); ok($schema, 'get db schema'); my $item = $schema->resultset('Book')->new_result({}); my $form = BookDB::Form::Book->new; ok( !$form->process( item => $item ), 'Empty data' ); # check authors options my $author_options = $form->field('authors')->options; is( $author_options->[0]->{label}, 'J.K. Rowling', 'right author name'); my $borrower_options = $form->field('borrower')->options; is( $borrower_options->[1]->{label}, 'John Doe ', 'right borrower name'); # This is munging up the equivalent of param data from a form my $good = { 'title' => 'How to Test Perl Form Processors', 'authors' => [5], 'genres' => [2, 4], 'format' => 2, 'isbn' => '123-02345-0502-2' , 'publisher' => 'EreWhon Publishing', 'user_updated' => 1, 'comment' => 'this is a comment', 'borrower' => undef, }; ok( $form->process( item => $item, params => $good ), 'Good data' ); my $book = $form->item; END { $book->delete }; ok ($book, 'get book object from form'); is( $book->extra, 'this is a comment', 'comment exists' ); is_deeply( $form->values, $good, 'values correct' ); $good->{$_} = '' for qw/ year pages borrower/; is_deeply( $form->fif, $good, 'fif correct' ); my $num_genres = $book->genres->count; is( $num_genres, 2, 'multiple select list updated ok'); is( $form->field('format')->value, 2, 'get value for format' ); $good->{genres} = 2; ok( $form->process($good), 'handle one value for multiple select' ); is_deeply( $form->field('genres')->value, [2], 'right value for genres' ); my $id = $book->id; $good->{authors} = []; $good->{genres} = [2,4]; $form->process($good); is_deeply( $form->field('authors')->value, [], 'author value right in form'); is( $form->field('publisher')->value, 'EreWhon Publishing', 'right publisher'); my $value_hash = { %{$good}, authors => [], year => undef, pages => undef, borrower => undef, }; delete $value_hash->{submit}; is_deeply( $form->values, $value_hash, 'get right values from form'); my $bad_1 = { notitle => 'not req', silly_field => 4, }; ok( !$form->process( $bad_1 ), 'bad 1' ); $form = BookDB::Form::Book->new(item => $book, schema => $schema); ok( $form, 'create form from db object'); my $genres_field = $form->field('genres'); is_deeply( sort $genres_field->value, [2, 4], 'value of multiple field is correct'); my $bad_2 = { 'title' => "Another Silly Test Book", 'authors' => [6], 'year' => '1590', 'pages' => 'too few', 'format' => '22', }; ok( !$form->process( $bad_2 ), 'bad 2'); ok( $form->field('year')->has_errors, 'year has error' ); ok( $form->field('pages')->has_errors, 'pages has error' ); ok( !$form->field('authors')->has_errors, 'author has no error' ); ok( $form->field('format')->has_errors, 'format has error' ); my $values = $form->value; $values->{year} = 1999; $values->{pages} = 101; $values->{format} = 2; my $validated = $form->validate( $values ); ok( $validated, 'now form validates' ); $form->process; is( $book->publisher, 'EreWhon Publishing', 'publisher has not changed'); # test that multiple fields (genres) with value of [] deletes genres is( $book->genres->count, 2, 'multiple select list updated ok'); $good->{genres} = []; $form->process( $good ); is( $book->genres->count, 0, 'multiple select list has no selected options'); $form = BookDB::Form::Book->new(schema => $schema, active_column => 'is_active'); is( $form->field( 'genres' )->num_options, 3, 'active_column test' ); { package Test::Book; use HTML::FormHandler::Moose; extends 'HTML::FormHandler::Model::DBIC'; has_field 'title' => ( minlength => 3, maxlength => 40, required => 1 ); has_field 'year'; has_field 'submit' => ( type => 'Submit' ); } # this tests to make sure that result loaded from db object is cleared when # the result is then loaded from the params $form = Test::Book->new; my $new_book = $schema->resultset('Book')->new_result({}); $form->process( item => $new_book, params => {} ); $form->process( item => $new_book, params => { title => 'abc' } ); is( $form->result->num_results, 3, 'right number of results'); done_testing; HTML-FormHandler-Model-DBIC-0.28/t/book2pk.t0000644000077000007700000000136312217614372017464 0ustar gshankgshankuse strict; use warnings; use Test::More; use Test::Exception; use lib 't/lib'; use_ok( 'BookDB::Form::Book2PK'); use_ok( 'BookDB::Schema'); my $schema = BookDB::Schema->connect('dbi:SQLite:t/db/book.db'); my $book = $schema->resultset('Book2PK')->find( { libraryid => 1, id => 1 }, { key => 'primary' }); my $form = BookDB::Form::Book2PK->new; ok( $form ); $form->process( item => $book, params => {} ); my $params = $form->fif; my $orig_pages = $params->{pages}; $params->{pages} = 500; lives_ok( sub { $form->process( item => $book, params => $params ) }, 'multiple pk works' ); $book->discard_changes; is( $book->pages, 500, 'pages changed' ); $params->{pages} = $orig_pages; $form->process( item => $book, params => $params ); done_testing; HTML-FormHandler-Model-DBIC-0.28/t/datetime.t0000644000077000007700000000130412217614372017704 0ustar gshankgshankuse strict; use warnings; use Test::More; use lib './t'; use lib 't/lib'; use BookDB::Schema; use_ok('HTML::FormHandler::Field::DateTime'); my $field = HTML::FormHandler::Field::DateTime->new( name => 'test_field' ); ok( defined $field, 'new() called' ); { package UserForm; use HTML::FormHandler::Moose; extends 'HTML::FormHandler::Model::DBIC'; has_field 'birthdate' => ( type => 'DateTime' ); has_field 'birthdate.year' => ( type => 'Year' ); } my $schema = BookDB::Schema->connect('dbi:SQLite:t/db/book.db'); my $user = $schema->resultset('User')->first; my $form = UserForm->new( item => $user ); ok( $form, 'Form with DateTime field loaded from the db' ); done_testing; HTML-FormHandler-Model-DBIC-0.28/t/db/0000755000077000007700000000000012217614372016312 5ustar gshankgshankHTML-FormHandler-Model-DBIC-0.28/t/db/book.db0000644000077000007700000011600012217614372017551 0ustar gshankgshankSQLite format 3@ 3'3-â$ç%ûöñìç  ¬¾~5è¬z¾G%!3Joe Smith2!3Joe SmithProgrammer1974-04-21 00:00:00: #3 plaxSci-FiFungibilityeditorPL1977-10-24 22:22:22K !5!3jswHistoricalHistory of the WorldunemployedRU1965-03-24 22:22:22G /!3 samTechnicalHigher Order PerlprogrammerUS1973-05-24 22:22:22> '3muffetFantasyCooking FunginoneGB1983-10-24 22:22:22@ %!3jdoeSci-FiNecronomiconmanagementUS1970-04-23 00:00:00 €ìÑ´—€ì yellowredgreengraybrownblackturquoisetealpumpkingreensky bluefuchsiaorangepurpleyellow blueredgreen QײQ:-U Creative CommonsCreative Commons Attribution license#? LGPLGNU Lesser Public License#A GPLGNU General Public License' '7 Perl ArtisticPerl Artistic License áèáûõïÚ   ¬hêÌhŠ_+')Ac )#Convoluted PHPProgrammingDE/Contractor HeavenLosingDE )Convoluted PHPMarketingDE!#Worst PerlProgrammingUKBest PerlPerlUS ¤à#ƒ`>ˤ7 /!1101 Maple StreetSmallvilleAT¤ /!1101 Maple '!1023 Side AveSanta LolaGF 99 Elm StDownTownUT #%991 Star StNowhere CityGK!+399 Cherry ParkJimsvilleUT##142 Main StMiddle CityGK< '!1023 Side AveSaá% ß +999 Main StreetPodunkUT ##101 Main StMiddle CityGK ›_ì^‚ƒstableuseruserCREATE TABLE user ( user_id INTEGER PRIMARY KEY, user_name VARCHAR(32), fav_cat VARCHAR(32), fav_book VARCHAR(32), occupation VARCHAR(32), country_iso char(2), birthdate DATETIME, opt_in INTEGER, license_id INTEGER )A‚YtableoptionsoptionsCREATE TABLE options ( options_id INTEGER PRIMARY KEY, option_one VARCHAR(32), option_two VARCHAR(32), option_three VARCHAR(32), user_id INTEGER ) gtablelicenseslicensesCREATE TABLE licenses ( license_id INTEGER, name VARCHAR(32), label VARCHAR(32), active INTEGER )p''tableuser_employeruser_employerCREATE TABLE user_employer ( user_id INTEGER, employer_id INTEGER )‚tableemployeremployerCREATE TABLE employer ( employer_id INTEGER PRIMARY KEY, name VARCHAR(32), category VARCHAR(32), country VARCHAR(24) ) ¼¼lÖ*xÃ-‚1tableaddressaddressCREATE TABLE address ( address_id INTEGER PRIMARY KEY, user_id INTEGER, street VARCHAR(32), city VARCHAR(32), country_iso char(2) )‚g…1tablebookbook CREATE TABLE book ( id INTEGER PRIMARY KEY, isbn varchar(100), title varchar(100), publisher varchar(100), pages int, year int, format int REFERENCES format, genre int REFERENCES genre, borrower int REFERENCES borrower, borrowed varchar(100), owner int REFERENCES user, extra varchar(100) )R/oindexbook_idx_borrowerbook CREATE INDEX book_idx_borrower ON book (borrower)L +gindexbook_idx_formatbook CREATE INDEX book_idx_format ON book (format)I )cindexbook_idx_ownerbook CREATE INDEX book_idx_owner ON book (owner); [indexisbnbookCREATE UNIQUE INDEX isbn ON book (isbn) YG¬m/«^¼G{ abcc-M1\-=5R-M1AM1How to Test Perl Form ProcessorsEreWhon PublishingG 'I   0-7475-8134-6Harry Potter and the Last GaspBoomsbury!ÕW 'U! 0-596-10092-2Perl Testing: A Developer's NotebookO'Reilly¶Õ2009-01-16K )+-! 123-1234-0-123Winnie The PoohHoughton MifflinY2008-11-14I 782128254The Complete Java 2 Certification Study Guide: Programmer's and Developers Exams (With CD-ROM)Sybex IncÏ< '! 434012386The ConfusionHeinemannYÒ2009-01-16= )! 9 788256006199IdiotenInterbook/m2004-00-10R '_   0-7475-5100-6Harry Potter and the Order of the PhoenixBoomsburyþÑ ÕÐëÐüÚöðßåå    ÕÏëÏüÚöðåßßÕ     ÓÎÎðûõØêÞää     too›ï‰­ÎÀÜÜ 12143022 '0-7475-8134-6'0-596-10092-2)123-1234-0-123 782128254 434012386)9 788256006199' 0-7475-5100-6 ŽØªV-Ý·Ž' 3IanLangworthUK1971-12-22 00:00:00$ 3chromaticUK1969-10-01 00:00:00$3A.A.MilneUK1904-08-09 00:00:00(3MichaelErnestUK1970-10-01 00:00:00'3PhilipHellerUS1976-01-01 00:00:00'3SimonRobertsUK1975-05-01 00:00:00)!3NeilStephensonUS1959-10-31 00:00:00,#3FyodorDostoyevskyRU1821-11-11 00:00:00&3J.K.RowlingGB2003-01-16 00:00:00 Wí&êN7 ‚ItableauthorauthorCREATE TABLE author ( author_id INTEGER PRIMARY KEY, first_name VARCHAR(100), last_name VARCHAR(100), country_iso char(2), birthdate DATETIME ) %%itableauthor_booksauthor_booksCREATE TABLE author_books ( author_id INTEGER, book_id INTEGER, PRIMARY KEY (author_id, book_id) )7K%indexsqlite_autoindex_author_books_1author_booksA‚UtableborrowerborrowerCREATE TABLE borrower ( id INTEGER PRIMARY KEY, name varchar(100), phone varchar(20), url varchar(100), email varchar(100), active integer )btableformatformatCREATE TABLE format ( id INTEGER PRIMARY KEY, name varchar(100) )/%%‚!tablebooks_genresbooks_genresCREATE TABLE books_genres ( book_id INTEGER REFERENCES book, genre_id INTEGER REFERENCES genre, primary key (book_id, genre_id) ) ËûõîçàÙÒËÄ  ÄûôìäÜÔÌÄÄ   -ï¦b-3+%/ Mistress Muffet999-000-2222muffet@tuffet.orgB%?) John Doe607-222-3333http://www.somewhere.com/john@gmail.comG-#9+ Ole Øyvind Hove23 23 14 97http://thefeed.no/oleooleo@trenger.ro In Shelf ³òäÚо³ E-book'Graphic NovelTradeComic Hardcover Paperback ÒúôíæàÙÒËÄ       ÌóúëÜãÌÔÄÄ         ¬ôåØÈ»¬  Technical Fantasy!Historical Mystery  Computers  Sci-Fi óó,¤¨Ý?7K%indexsqlite_autoindex_books_genres_1books_genresvKtablegenregenreCREATE TABLE genre ( id INTEGER PRIMARY KEY, name varchar(100), is_active INTEGER )‚!!ƒMtableauthor_oldauthor_oldCREATE TABLE author_old ( first_name VARCHAR(100), last_name VARCHAR(100), country_iso char(2), birthdate DATETIME, foo VARCHAR(24), bar VARCHAR(24), CONSTRAINT name PRIMARY KEY (first_name, last_name) )3G!indexsqlite_autoindex_author_old_1author_old`)!indexunique_foo_barauthor_oldCREATE UNIQUE INDEX unique_foo_bar ON author_old (foo, bar)>‚StablecountrycountryCREATE TABLE country ( iso CHAR(2) NOT NULL PRIMARY KEY, name VARCHAR(80) NOT NULL, printable_name VARCHAR(80) NOT NULL, iso3 CHAR(3), numcode SMALLINT ) dϘd2!3NeilStephensonUS1959-10-31 00:00:00foo2foo35#3FyodorDostoyevskyRU1821-11-11 00:00:00foo1bar1/3J.K.RowlingGB2003-01-16 00:00:00foo0bar0 ÅÙðÅ!NeilStephenson#FyodorDostoyevsky J.K.Rowling ×óå× foo2foo3 foo1bar1  foo0bar0 ßßÄ›|\1ùÜÁ¢…R'þßZWZIMBABWEZimbabweZWEÌ'''USUNITED STATESUnited StatesUSAH)))GBUNITED KINGDOMUnited KingdomGBR:1 11RURUSSIAN FEDERATIONRussian FederationRUSƒ ROROMANIARomaniaROM‚ PTPORTUGALPortugalPRTl PLPOLANDPolandPOLh DEGERMANYGermanyDEUFRFRANCEFranceFRAúDKDENMARKDenmarkDNKÐ)))CZCZECH REPUBLICCzech RepublicCZEËAUAUSTRALIAAustraliaAUS$ATATLANTISAtlantisATLˆ'''GFGRAND FENWICKGrand FenwickGFK‡UTUTOPIAUtopiaUTO†GKGRAUSTARKGraustarkGRA… ‘åÞ×ÂÐÉŸìú»´­¦˜ó‘ZWUSGBRU RO PT PL DE FRDKCZAUATGFUT GK  ššÉ¼É-Aindexsqlite_autoindex_country_1countrypƒ?tablepagespagesCREATE TABLE pages ( id INTEGER PRIMARY KEY NOT NULL, display_value VARCHAR2(30) NOT NULL, description VARCHAR2(200), modified_date TIMESTAMP(11), created_date TIMESTAMP(11) NOT NULL DEFAULT 'systimestamp' )‚ ##ƒ[tableroles_pagesroles_pages CREATE TABLE roles_pages ( role_fk NUMBER(38) NOT NULL, page_fk NUMBER(38) NOT NULL, edit_flag NUMBER(38) NOT NULL DEFAULT '0 ', created_date TIMESTAMP(11) NOT NULL DEFAULT 'systimestamp', PRIMARY KEY (role_fk, page_fk) )5I#indexsqlite_autoindex_roles_pages_1roles_pages!      鋪éê~ƒStablebook2pkbook2pk&CREATE TABLE book2pk ( libraryid INTEGER NOT NULL DEFAULT 1, id INTEGER NOT NULL, isbn varchar(100), title varchar(100), publisher varchar(100), pages int, year int, PRIMARY KEY (libraryid, id) )- Aindexsqlite_autoindex_book2pk_1book2pk'l;#indexroles_pages_idx_page_fkroles_pages"CREATE INDEX roles_pages_idx_page_fk ON roles_pages (page_fk)‚„tablerolesroles#CREATE TABLE roles ( id INTEGER PRIMARY KEY NOT NULL, display_value VARCHAR2(30) NOT NULL, description VARCHAR2(200), active smallint(38) NOT NULL DEFAULT '1 ', modified_date TIMESTAMP(11), created_date DATETIME(11) NOT NULL DEFAULT 'systimestamp' )T#}indexunique_roleroles$CREATE UNIQUE INDEX unique_role ON roles (display_value) ³†XÚžVA 'I0-7475-8134-6Harry Potter and the Last GaspBoomsbury!ÕF 'U0-596-10092-2Perl Testing: A Developer's NotebookO'Reilly¶Õ: )+-123-1234-0-123Winnie The PoohHoughton MifflinY| I782128254The Complete Java 2 Certification Study Guide: Programmer's and Developers Exams (With CD-ROM)Sybex IncÏ, '434012386The ConfusionHeinemannYÒ+ )9 788256006199IdiotenInterbook/mK '_0-7475-5100-6Harry Potter and the Order of the PhoenixBoomsburyþÑ ÑûôíæßØÑ       HTML-FormHandler-Model-DBIC-0.28/t/db/bookdb.sql0000644000077000007700000003003212217614372020271 0ustar gshankgshankBEGIN TRANSACTION; CREATE TABLE user ( user_id INTEGER PRIMARY KEY, user_name VARCHAR(32), fav_cat VARCHAR(32), fav_book VARCHAR(32), occupation VARCHAR(32), country_iso char(2), birthdate DATETIME, opt_in INTEGER, license_id INTEGER ); INSERT INTO "user" VALUES ( 1, 'jdoe', 'Sci-Fi', 'Necronomicon', 'management', 'US', '1970-04-23 21:06:00', 0, 3 ); INSERT INTO "user" VALUES ( 2, 'muffet', 'Fantasy', 'Cooking Fungi', 'none', 'GB', '1983-10-24 22:22:22', 0, 2 ); INSERT INTO "user" VALUES ( 3, 'sam', 'Technical', 'Higher Order Perl', 'programmer', 'US', '1973-05-24 22:22:22', 1, 3 ); INSERT INTO "user" VALUES ( 4, 'jsw', 'Historical', 'History of the World', 'unemployed', 'RU', '1965-03-24 22:22:22', 0, 4 ); INSERT INTO "user" VALUES ( 5, 'plax', 'Sci-Fi', 'Fungibility', 'editor', 'PL', '1977-10-24 22:22:22', 1, 1 ); CREATE TABLE options ( options_id INTEGER PRIMARY KEY, option_one VARCHAR(32), option_two VARCHAR(32), option_three VARCHAR(32), user_id INTEGER ); INSERT INTO "options" VALUES (1, 'blue', 'red', 'green', 1); INSERT INTO "options" VALUES (2, 'orange', 'purple', 'yellow', 2); INSERT INTO "options" VALUES (3, 'green', 'sky blue', 'fuchsia', 3); INSERT INTO "options" VALUES (4, 'turquoise', 'teal', 'pumpkin', 4); INSERT INTO "options" VALUES (5, 'gray', 'brown', 'black', 5); CREATE table licenses ( license_id INTEGER, name VARCHAR(32), label VARCHAR(32), active INTEGER ); INSERT INTO "licenses" VALUES (1, "Perl Artistic", "Perl Artistic License", 1 ); INSERT INTO "licenses" VALUES (2, "GPL", "GNU General Public License", 1 ); INSERT INTO "licenses" VALUES (3, "LGPL", "GNU Lesser Public License", 1 ); INSERT INTO "licenses" VALUES (4, "Creative Commons", "Creative Commons Attribution license", 1 ); CREATE TABLE user_employer ( user_id INTEGER, employer_id INTEGER ); INSERT INTO "user_employer" VALUES ( 1, 1 ); INSERT INTO "user_employer" VALUES ( 1, 2 ); INSERT INTO "user_employer" VALUES ( 1, 3 ); INSERT INTO "user_employer" VALUES ( 2, 4 ); INSERT INTO "user_employer" VALUES ( 4, 3 ); CREATE TABLE employer ( employer_id INTEGER PRIMARY KEY, name VARCHAR(32), category VARCHAR(32), country VARCHAR(24) ); INSERT INTO "employer" VALUES ( 1, "Best Perl", "Perl", "US" ); INSERT INTO "employer" VALUES ( 2, "Worst Perl", "Programming", "UK" ); INSERT INTO "employer" VALUES ( 3, "Convoluted PHP", "Programming", "DE" ); INSERT INTO "employer" VALUES ( 4, "Contractor Heaven", "Losing", "DE" ); CREATE TABLE address ( address_id INTEGER PRIMARY KEY, user_id INTEGER, street VARCHAR(32), city VARCHAR(32), country_iso char(2) ); INSERT INTO "address" VALUES (1, 1, "101 Main St", "Middle City", "GK"); INSERT INTO "address" VALUES (2, 1, "99 Elm St", "DownTown", "UT"); INSERT INTO "address" VALUES (3, 1, "1023 Side Ave", "Santa Lola", "GF"); INSERT INTO "address" VALUES (4, 2, "142 Main St", "Middle City", "GK"); INSERT INTO "address" VALUES (5, 2, "399 Cherry Park", "Jimsville", "UT"); INSERT INTO "address" VALUES (6, 3, "991 Star St", "Nowhere City", "GK"); CREATE TABLE book ( id INTEGER PRIMARY KEY, isbn varchar(100), title varchar(100), publisher varchar(100), pages int, year int, format int REFERENCES format, genre int REFERENCES genre, borrower int REFERENCES borrower, borrowed varchar(100), owner int REFERENCES user, extra varchar(100) ); CREATE INDEX book_idx_borrower ON book (borrower); CREATE INDEX book_idx_format ON book (format); CREATE INDEX book_idx_owner ON book (owner); CREATE UNIQUE INDEX isbn ON book (isbn); INSERT INTO "book" VALUES(1, '0-7475-5100-6', 'Harry Potter and the Order of the Phoenix', 'Boomsbury', 766, 2001, 1, 5, 1, '', 2, ''); INSERT INTO "book" VALUES(2, '9 788256006199', 'Idioten', 'Interbook', 303, 1901, 2, 3, 2, '2004-00-10', 2, ''); INSERT INTO "book" VALUES(3, '434012386', 'The Confusion', 'Heinemann', 345, 2002, 2, NULL, 2, '2009-01-16', 1, ''); INSERT INTO "book" VALUES(4, '782128254', 'The Complete Java 2 Certification Study Guide: Programmer''s and Developers Exams (With CD-ROM)', 'Sybex Inc', NULL, 1999, NULL, NULL, NULL, NULL, 3, ''); INSERT INTO "book" VALUES(5, '123-1234-0-123', 'Winnie The Pooh', 'Houghton Mifflin', 345, 1935, 2, NULL, 4, '2008-11-14', 5, ''); INSERT INTO "book" VALUES(6, '0-596-10092-2', 'Perl Testing: A Developer''s Notebook', 'O''Reilly', 182, 2005, 3, NULL, 2, '2009-01-16', 3, ''); INSERT INTO "book" VALUES(7, '0-7475-8134-6', 'Harry Potter and the Last Gasp', 'Boomsbury', 801, 2005, 1, 5, 1, '', 2, ''); CREATE TABLE author ( author_id INTEGER PRIMARY KEY, first_name VARCHAR(100), last_name VARCHAR(100), country_iso char(2), birthdate DATETIME ); INSERT INTO "author" VALUES (1, "J.K.", "Rowling", "GB", "2003-01-16 00:00:00" ); INSERT INTO "author" VALUES (2, "Fyodor", "Dostoyevsky", "RU", "1821-11-11 00:00:00" ); INSERT INTO "author" VALUES (3, "Neil", "Stephenson", "US", "1959-10-31 00:00:00" ); INSERT INTO "author" VALUES (4, "Simon", "Roberts", "UK", "1975-05-01 00:00:00" ); INSERT INTO "author" VALUES (5, "Philip", "Heller", "US", "1976-01-01 00:00:00" ); INSERT INTO "author" VALUES (6, "Michael", "Ernest", "UK", "1970-10-01 00:00:00" ); INSERT INTO "author" VALUES (7, "A.A.", "Milne", "UK", "1904-08-09 00:00:00" ); INSERT INTO "author" values (8, "", "chromatic", "UK", "1969-10-01 00:00:00" ); INSERT INTO "author" values (9, "Ian", "Langworth", "UK", "1971-12-22 00:00:00" ); CREATE TABLE author_books ( author_id INTEGER, book_id INTEGER, PRIMARY KEY (author_id, book_id) ); INSERT INTO author_books (author_id, book_id) VALUES (1, 1); INSERT INTO author_books (author_id, book_id) VALUES (1, 7); INSERT INTO author_books (author_id, book_id) VALUES (2, 2); INSERT INTO author_books (author_id, book_id) VALUES (3, 3); INSERT INTO author_books (author_id, book_id) VALUES (4, 4); INSERT INTO author_books (author_id, book_id) VALUES (5, 4); INSERT INTO author_books (author_id, book_id) VALUES (6, 4); INSERT INTO author_books (author_id, book_id) VALUES (7, 5); CREATE TABLE borrower ( id INTEGER PRIMARY KEY, name varchar(100), phone varchar(20), url varchar(100), email varchar(100), active integer ); INSERT INTO "borrower" VALUES(1, 'In Shelf', NULL, '', '', 0); INSERT INTO "borrower" VALUES(2, 'Ole Øyvind Hove', '23 23 14 97', 'http://thefeed.no/oleo', 'oleo@trenger.ro', 1); INSERT INTO "borrower" VALUES(3, 'John Doe', '607-222-3333', 'http://www.somewhere.com/', 'john@gmail.com', 1); INSERT INTO "borrower" VALUES(4, 'Mistress Muffet', '999-000-2222', NULL, 'muffet@tuffet.org', 1); CREATE TABLE format ( id INTEGER PRIMARY KEY, name varchar(100) ); INSERT INTO "format" VALUES(1, 'Paperback'); INSERT INTO "format" VALUES(2, 'Hardcover'); INSERT INTO "format" VALUES(3, 'Comic'); INSERT INTO "format" VALUES(4, 'Trade'); INSERT INTO "format" VALUES(5, 'Graphic Novel'); INSERT INTO "format" VALUES(6, 'E-book'); CREATE TABLE books_genres ( book_id INTEGER REFERENCES book, genre_id INTEGER REFERENCES genre, primary key (book_id, genre_id) ); INSERT INTO "books_genres" VALUES(1, 5); INSERT INTO "books_genres" VALUES(1, 3); INSERT INTO "books_genres" VALUES(2, 9); INSERT INTO "books_genres" VALUES(5, 5); INSERT INTO "books_genres" VALUES(3, 1); INSERT INTO "books_genres" VALUES(6, 3); INSERT INTO "books_genres" VALUES(6, 2); CREATE TABLE genre ( id INTEGER PRIMARY KEY, name varchar(100), is_active INTEGER ); INSERT INTO "genre" VALUES(1, 'Sci-Fi', 1); INSERT INTO "genre" VALUES(2, 'Computers', 1); INSERT INTO "genre" VALUES(3, 'Mystery', NULL); INSERT INTO "genre" VALUES(4, 'Historical', NULL); INSERT INTO "genre" VALUES(5, 'Fantasy', NULL); INSERT INTO "genre" VALUES(6, 'Technical', 1); CREATE TABLE author_old ( first_name VARCHAR(100), last_name VARCHAR(100), country_iso char(2), birthdate DATETIME, foo VARCHAR(24), bar VARCHAR(24), CONSTRAINT name PRIMARY KEY (first_name, last_name) ); CREATE UNIQUE INDEX unique_foo_bar ON author_old (foo, bar); INSERT INTO "author_old" VALUES ("J.K.", "Rowling", "GB", "2003-01-16 00:00:00", 'foo0', 'bar0' ); INSERT INTO "author_old" VALUES ("Fyodor", "Dostoyevsky", "RU", "1821-11-11 00:00:00", 'foo1', 'bar1' ); INSERT INTO "author_old" VALUES ("Neil", "Stephenson", "US", "1959-10-31 00:00:00", 'foo2', 'foo3' ); -- iso_country_list.sql -- -- This will create and then populate a MySQL table with a list of the names and -- ISO 3166 codes for countries in existence as of the date below. -- -- Usage: -- mysql -u username -ppassword database_name < ./iso_country_list.sql -- -- For updates to this file, see http://27.org/isocountrylist/ -- For more about ISO 3166, see http://www.iso.ch/iso/en/prods-services/iso3166ma/02iso-3166-code-lists/list-en1.html -- -- Created by getisocountrylist.pl on Sun Nov 2 14:59:20 2003. -- Wm. Rhodes -- CREATE TABLE IF NOT EXISTS country ( iso CHAR(2) NOT NULL PRIMARY KEY, name VARCHAR(80) NOT NULL, printable_name VARCHAR(80) NOT NULL, iso3 CHAR(3), numcode SMALLINT ); DELETE from country; INSERT INTO country VALUES ('GK','GRAUSTARK','Graustark','GRA','901'); INSERT INTO country VALUES ('UT','UTOPIA','Utopia','UTO','902'); INSERT INTO country VALUES ('GF','GRAND FENWICK','Grand Fenwick','GFK','903'); INSERT INTO country VALUES ('AT','ATLANTIS','Atlantis','ATL','904'); INSERT INTO country VALUES ('AU','AUSTRALIA','Australia','AUS','036'); INSERT INTO country VALUES ('CZ','CZECH REPUBLIC','Czech Republic','CZE','203'); INSERT INTO country VALUES ('DK','DENMARK','Denmark','DNK','208'); INSERT INTO country VALUES ('FR','FRANCE','France','FRA','250'); INSERT INTO country VALUES ('DE','GERMANY','Germany','DEU','276'); INSERT INTO country VALUES ('PL','POLAND','Poland','POL','616'); INSERT INTO country VALUES ('PT','PORTUGAL','Portugal','PRT','620'); INSERT INTO country VALUES ('RO','ROMANIA','Romania','ROM','642'); INSERT INTO country VALUES ('RU','RUSSIAN FEDERATION','Russian Federation','RUS','643'); INSERT INTO country VALUES ('GB','UNITED KINGDOM','United Kingdom','GBR','826'); INSERT INTO country VALUES ('US','UNITED STATES','United States','USA','840'); INSERT INTO country VALUES ('ZW','ZIMBABWE','Zimbabwe','ZWE','716'); -- -- Table: pages -- CREATE TABLE pages ( id INTEGER PRIMARY KEY NOT NULL, display_value VARCHAR2(30) NOT NULL, description VARCHAR2(200), modified_date TIMESTAMP(11), created_date TIMESTAMP(11) NOT NULL DEFAULT 'systimestamp' ); -- -- Table: roles_pages -- CREATE TABLE roles_pages ( role_fk NUMBER(38) NOT NULL, page_fk NUMBER(38) NOT NULL, edit_flag NUMBER(38) NOT NULL DEFAULT '0 ', created_date TIMESTAMP(11) NOT NULL DEFAULT 'systimestamp', PRIMARY KEY (role_fk, page_fk) ); CREATE INDEX roles_pages_idx_page_fk ON roles_pages (page_fk); CREATE TABLE roles ( id INTEGER PRIMARY KEY NOT NULL, display_value VARCHAR2(30) NOT NULL, description VARCHAR2(200), active smallint(38) NOT NULL DEFAULT '1 ', modified_date TIMESTAMP(11), created_date DATETIME(11) NOT NULL DEFAULT 'systimestamp' ); CREATE UNIQUE INDEX unique_role ON roles (display_value); CREATE TABLE book2pk ( libraryid INTEGER NOT NULL DEFAULT 1, id INTEGER NOT NULL, isbn varchar(100), title varchar(100), publisher varchar(100), pages int, year int, PRIMARY KEY (libraryid, id) ); CREATE UNIQUE INDEX isbn ON book2pk (libraryid, isbn); INSERT INTO "book2pk" VALUES(1,1, '0-7475-5100-6', 'Harry Potter and the Order of the Phoenix', 'Boomsbury', 766, 2001); INSERT INTO "book2pk" VALUES(1,2, '9 788256006199', 'Idioten', 'Interbook', 303, 1901); INSERT INTO "book2pk" VALUES(1,3, '434012386', 'The Confusion', 'Heinemann', 345, 2002); INSERT INTO "book2pk" VALUES(1,4, '782128254', 'The Complete Java 2 Certification Study Guide: Programmer''s and Developers Exams (With CD-ROM)', 'Sybex Inc', NULL, 1999); INSERT INTO "book2pk" VALUES(1,5, '123-1234-0-123', 'Winnie The Pooh', 'Houghton Mifflin', 345, 1935); INSERT INTO "book2pk" VALUES(1,6, '0-596-10092-2', 'Perl Testing: A Developer''s Notebook', 'O''Reilly', 182, 2005); INSERT INTO "book2pk" VALUES(1,7, '0-7475-8134-6', 'Harry Potter and the Last Gasp', 'Boomsbury', 801, 2005); COMMIT; HTML-FormHandler-Model-DBIC-0.28/t/db_fif.t0000644000077000007700000000424512217614372017330 0ustar gshankgshankuse strict; use warnings; use Test::More; use lib 't/lib'; use BookDB::Form::User; use BookDB::Schema; use BookDB::Form::BookWithOwner; my $schema = BookDB::Schema->connect('dbi:SQLite:t/db/book.db'); my $user = $schema->resultset('User')->find(1); my $form; my $options; $form = BookDB::Form::User->new( item => $user ); is( $form->field('birthdate')->field('year')->fif, 1970, 'Year loaded' ); is( $form->field('birthdate')->field('month')->fif, 4, 'Month loaded' ); is( $form->field('birthdate')->field('day')->fif, 23, 'Day loaded' ); my $birthdate = $user->birthdate; my $db_fif = { 'addresses.0.address_id' => 1, 'addresses.0.city' => 'Middle City', 'addresses.0.country' => 'GK', 'addresses.0.street' => '101 Main St', 'addresses.1.address_id' => 2, 'addresses.1.city' => 'DownTown', 'addresses.1.country' => 'UT', 'addresses.1.street' => '99 Elm St', 'addresses.2.address_id' => 3, 'addresses.2.city' => 'Santa Lola', 'addresses.2.country' => 'GF', 'addresses.2.street' => '1023 Side Ave', 'birthdate.day' => 23, 'birthdate.month' => 4, 'birthdate.year' => 1970, 'country' => 'US', 'fav_book' => 'Necronomicon', 'fav_cat' => 'Sci-Fi', 'license' => 3, 'occupation' => 'management', 'opt_in' => 0, 'user_name' => 'jdoe', 'employers.0.employer_id' => 1, 'employers.0.category' => 'Perl', 'employers.0.country' => 'US', 'employers.0.name' => 'Best Perl', 'employers.1.employer_id' => 2, 'employers.1.category' => 'Programming', 'employers.1.country' => 'UK', 'employers.1.name' => 'Worst Perl', 'employers.2.employer_id' => 3, 'employers.2.category' => 'Programming', 'employers.2.country' => 'DE', 'employers.2.name' => 'Convoluted PHP', }; is_deeply( $form->fif, $db_fif, 'get right fif from db' ); is( $form->field('opt_in')->fif, 0, 'right value for field with 0' ); is( $form->field('license')->fif, 3, 'right value for license field' ); done_testing; HTML-FormHandler-Model-DBIC-0.28/t/db_has_many.t0000644000077000007700000001045612217614372020364 0ustar gshankgshankuse strict; use warnings; use Test::More; use lib 't/lib'; use BookDB::Schema; my $schema = BookDB::Schema->connect('dbi:SQLite:t/db/book.db'); my $user = $schema->resultset('User')->find(1); { package Repeatable::Form::User; use HTML::FormHandler::Moose; extends 'HTML::FormHandler::Model::DBIC'; has_field 'user_name'; has_field 'occupation'; has_field 'addresses' => ( type => 'Repeatable' ); has_field 'addresses.address_id' => ( type => 'PrimaryKey' ); has_field 'addresses.street'; has_field 'addresses.city'; has_field 'addresses.country' => ( type => 'Select' ); } my $form = Repeatable::Form::User->new; ok( $form, 'get db has many form'); ok( !$form->field('addresses')->field('0')->field('country')->has_options, 'addresses has no options because no schema' ); $form = Repeatable::Form::User->new( item => $user ); ok( $form->field('addresses')->field('0')->field('country')->has_options, 'addresses has options from new' ); $form->process( item => $user, params => {} ); ok( $form->field('addresses')->field('0')->field('country')->has_options, 'addresses has options after process' ); # the initial empty element in a repeatable field should # still be there after 'process' my $form2 = Repeatable::Form::User->new; $form2->process( item => $schema->resultset('User')->new_result( {} ), params => {} ); ok( $form2->field('addresses')->field('0'), 'Initial field exists after process' ); my $fif = { 'addresses.0.city' => 'Middle City', 'addresses.0.country' => 'GK', 'addresses.0.address_id' => 1, 'addresses.0.street' => '101 Main St', 'addresses.1.city' => 'DownTown', 'addresses.1.country' => 'UT', 'addresses.1.address_id' => 2, 'addresses.1.street' => '99 Elm St', 'addresses.2.city' => 'Santa Lola', 'addresses.2.country' => 'GF', 'addresses.2.address_id' => 3, 'addresses.2.street' => '1023 Side Ave', 'occupation' => 'management', 'user_name' => 'jdoe', }; my $values = { addresses => [ { city => 'Middle City', country => 'GK', address_id => 1, street => '101 Main St', }, { city => 'DownTown', country => 'UT', address_id => 2, street => '99 Elm St', }, { city => 'Santa Lola', country => 'GF', address_id => 3, street => '1023 Side Ave', }, ], 'occupation' => 'management', 'user_name' => 'jdoe', }; is_deeply( $form->fif, $fif, 'fill in form is correct' ); is_deeply( $form->values, $values, 'values are correct' ); my $params = { user_name => "Joe Smith", occupation => "Programmer", 'addresses.0.street' => "999 Main Street", 'addresses.0.city' => "Podunk", 'addresses.0.country' => "UT", 'addresses.0.address_id' => "1", 'addresses.1.street' => "333 Valencia Street", 'addresses.1.city' => "San Franciso", 'addresses.1.country' => "UT", 'addresses.1.address_id' => "2", 'addresses.2.street' => "1101 Maple Street", 'addresses.2.city' => "Smallville", 'addresses.2.country' => "AT", 'addresses.2.address_id' => "3" }; $form->process($params); ok( $form->field('addresses')->field('0')->field('country')->has_options, 'addresses has options' ); ok( $form->validated, 'has_many form validated'); $form->process($params); ok( $form->validated, 'second pass validated'); $user = $form->item; is( $user->user_name, 'Joe Smith', 'created item'); is( $schema->resultset('Address')->search({ user_id => $user->id })->count, 3, 'the right number of addresses' ); is_deeply( $form->fif, $params, 'fif is correct' ); $form->process($fif); is( $form->item->search_related( 'addresses', {city => 'Middle City'} )->first->country->printable_name, 'Graustark', 'updated addresses'); $params->{'addresses.3.street'} = "1101 Maple Street"; $params->{'addresses.3.city'} = "Smallville"; $params->{'addresses.3.country'} = "AT"; $params->{'addresses.3.address_id'} = undef; $form->process($params); my $new_address = $form->item->search_related('addresses', { address_id => {'>', 3} })->single; is( $new_address->id, 7, 'new address created' ); ok( $form->validated, 'validated with new address'); is( $form->field('addresses.3.address_id')->value, $new_address->id, 'id for new row is correct'); # restore row to beginning state $form->process($values); done_testing; HTML-FormHandler-Model-DBIC-0.28/t/db_has_one.t0000644000077000007700000000267312217614372020203 0ustar gshankgshankuse strict; use warnings; use Test::More; use lib 't/lib'; use BookDB::Schema; my $schema = BookDB::Schema->connect('dbi:SQLite:t/db/book.db'); my $user = $schema->resultset('User')->find(1); { package Options::Field; use HTML::FormHandler::Moose; extends 'HTML::FormHandler::Field::Compound'; has_field 'options_id' => ( type => 'PrimaryKey' ); has_field 'option_one'; has_field 'option_two'; has_field 'option_three'; } { package Form::User; use HTML::FormHandler::Moose; extends 'HTML::FormHandler::Model::DBIC'; has_field 'user_name'; has_field 'occupation'; has_field 'options' => ( type => '+Options::Field' ); } my $form = Form::User->new; ok( $form, 'get db form'); $form->process( item => $user, params => {} ); my $expected = { user_name => 'jdoe', occupation => 'management', options => { options_id => 1, option_one => 'blue', option_two => 'red', option_three => 'green', } }; is_deeply( $form->value, $expected, 'got expected values' ); $expected->{options}->{option_one} = 'yellow'; $form->process( item => $user, params => $expected ); is_deeply( $form->value, $expected, 'got changed expected values' ); $user->discard_changes; my $option_one = $user->options->option_one; is( $option_one, 'yellow', 'user options changed' ); $expected->{options}->{option_one} = 'blue'; $form->process( item => $user, params => $expected ); done_testing; HTML-FormHandler-Model-DBIC-0.28/t/db_init_obj.t0000644000077000007700000000353412217614372020361 0ustar gshankgshankuse Test::More; use lib 't/lib'; use_ok('HTML::FormHandler::Model::DBIC'); use BookDB::Schema; my $schema = BookDB::Schema->connect('dbi:SQLite:t/db/book.db'); { package My::Form; use HTML::FormHandler::Moose; extends 'HTML::FormHandler::Model::DBIC'; has '+item_class' => ( default => 'Book' ); has_field 'title' => ( type => 'Text', required => 1 ); has_field 'author' => ( type => 'Text' ); has_field 'publisher' => ( noupdate => 1 ); sub init_value_author { 'Pick a Better Author' } } my $init_object = { 'title' => 'Fill in the title', 'author' => 'Enter an Author', 'publisher' => 'something', }; my $form = My::Form->new( init_object => $init_object, schema => $schema ); ok( $form, 'get form'); my $title_field = $form->field('title'); is( $title_field->value, 'Fill in the title', 'get title from init_object'); my $author_field = $form->field('author'); is( $author_field->value, 'Enter an Author', 'get init value from init_value_author' ); is( $form->field('publisher')->fif, 'something', 'noupdate fif from init_obj' ); $form->processed(0); # to unset processed flag caused by fif my $params = { 'title' => 'We Love to Test Perl Form Processors', 'author' => 'B.B. Better', 'publisher' => 'anything', }; ok( $form->process( $params ), 'validate data' ); ok( $form->field('title')->value_changed, 'init_value ne value'); is( $form->field('publisher')->value, 'anything', 'value for noupdate field' ); is( $form->field('author')->value, 'B.B. Better', 'right value for author' ); my $values = $form->value; ok( !exists $values->{publisher}, 'no publisher in values' ); ok( $form->update_model, 'update validated data'); my $book = $form->item; is( $book->title, 'We Love to Test Perl Form Processors', 'title updated'); is( $book->publisher, undef, 'no publisher' ); $book->delete; done_testing; HTML-FormHandler-Model-DBIC-0.28/t/db_options.t0000644000077000007700000000312012217614372020246 0ustar gshankgshankuse strict; use warnings; use Test::More; use lib 't/lib'; use_ok( 'BookDB::Form::User'); use_ok( 'BookDB::Schema'); use_ok( 'BookDB::Form::BookWithOwner' ); my $schema = BookDB::Schema->connect('dbi:SQLite:t/db/book.db'); ok($schema, 'get db schema'); my $user = $schema->resultset('User')->find( 1 ); my $form; my $options; $form = BookDB::Form::User->new( item => $user ); ok( $form, 'User form created' ); $options = $form->field( 'country' )->options; is( @$options, 16, 'Options loaded from the model' ); my $fif = $form->fif; $fif->{country} = 'PL'; # update user with new country $form->process($fif); is( $form->item->country_iso, 'PL', 'country updated correctly'); $fif->{country} = 'US'; # change back $form->process($fif); $form = BookDB::Form::User->new( schema => $schema, source_name => 'User' ); ok( $form, 'User form created' ); $options = $form->field( 'country' )->options; is( @$options, 16, 'Options loaded from the model - simple' ); #warn Dumper( $options ); use Data::Dumper; $form = BookDB::Form::BookWithOwner->new( schema => $schema, source_name => 'Book' ); ok( $form, 'Book with Owner form created' ); $options = $form->field( 'owner' )->field( 'country' )->options; is( @$options, 16, 'Options loaded from the model - recursive' ); my $book = $schema->resultset('Book')->find(1); $form = BookDB::Form::BookWithOwner->new( item => $book ); ok( $form, 'Book with Owner form created' ); $options = $form->field( 'owner' )->field( 'country' )->options; is( $form->field( 'owner' )->field( 'country' )->value, 'GB', 'Select value loaded in a related record'); done_testing; HTML-FormHandler-Model-DBIC-0.28/t/db_validate.t0000644000077000007700000000126212217614372020351 0ustar gshankgshankuse Test::More; use lib 't/lib'; use_ok( 'BookDB::Form::Book'); use_ok( 'BookDB::Schema'); my $schema = BookDB::Schema->connect('dbi:SQLite:t/db/book.db'); ok($schema, 'get db schema'); my $bad = { 'title' => "Another Silly Test Book", 'year' => '1590', 'pages' => '101', }; my $book = $schema->resultset('Book')->create( $bad ); END { $book->delete } my $form = BookDB::Form::Book->new( item => $book ); ok( !$form->db_validate, 'Bad db data doesn\'t validate' ); $bad->{year} = 1999; my $validated = $form->process( $bad ); ok( $validated, 'now form validates' ); $form->update_model; is( $book->year, 1999, 'book has been updated with correct data' ); done_testing; HTML-FormHandler-Model-DBIC-0.28/t/dbic_accessor.t0000644000077000007700000000140512217614372020675 0ustar gshankgshankuse Test::More; use lib 't/lib'; use BookDB::Schema; use BookDB::Form::Book; my $schema = BookDB::Schema->connect('dbi:SQLite:t/db/book.db'); ok($schema, 'get db schema'); my $form = BookDB::Form::Book->new(schema => $schema); # set "comment" accessor my $params = { 'title' => 'Humpty Dumpty Processors', 'author' => 'J.M.Smith', 'isbn' => '123-92995-0502-2' , 'publisher' => 'Somewhere Publishing', 'comment' => 'This is a comment', }; ok( $form->process( $params ), 'non-column, non-rel accessor validates' ); ok( $form->update_model, 'Update validated data'); END { $form->item->delete } my $book = $form->item; ok ($book, 'get book object from form'); is( $book->extra, 'This is a comment', 'get data set by accessor'); done_testing; HTML-FormHandler-Model-DBIC-0.28/t/fif.t0000644000077000007700000000571312217614372016664 0ustar gshankgshankuse strict; use warnings; use Test::More; use lib 't/lib'; use_ok( 'HTML::FormHandler' ); use_ok( 'BookDB::Form::Book'); use_ok( 'BookDB::Schema'); my $schema = BookDB::Schema->connect('dbi:SQLite:t/db/book.db'); ok($schema, 'get db schema'); my $book = $schema->resultset('Book')->create( { title => 'Testing form', isbn => '02340994', publisher => 'NoWhere', pages => '702', }); END { $book->delete } ok( $book, 'get book'); my $form = BookDB::Form::Book->new(item => $book ); ok( $form, 'create form from db object'); is( $form->field('pages')->fif, 702, 'get field fif value' ); is( $form->field('publisher')->fif, 'NoWhere', 'get another field fif value' ); my $fif = $form->fif; is_deeply( $fif, { title => 'Testing form', isbn => '02340994', publisher => 'NoWhere', pages => '702', comment => '', format => '', year => '', user_updated => 0, borrower => '', }, 'get form fif' ); $fif->{pages} = '501'; $form = BookDB::Form::Book->new(item => $book, schema => $schema, params => $fif); ok( $form, 'use params parameters on new' ); is( $form->field('pages')->fif, 702, 'get field fif value' ); is( $form->get_param('pages'), '501', 'params contains new value' ); is( $form->field('year')->fif, '', 'get another field fif value' ); $form->processed(0); my $validated = $form->process; ok( $validated, 'validated without params' ); is( $form->field('publisher')->fif, 'NoWhere', 'get field fif value after validate' ); #ok( !$form->field('author')->has_input, 'no input for field'); $form->clear; $fif = $form->fif; delete $fif->{submit}; ok( ! ( grep { $_ ne '' } ( values %{ $fif } ) ), 'clear clears fif' ); my $params = { title => 'Testing form', isbn => '02340234', pages => '699', publisher => '', }; $form = BookDB::Form::Book->new(item => $book, schema => $schema, params => $params); $validated = $form->process( $params ); ok( $validated, 'validated with params' ); is( $form->field('pages')->fif, 699, 'get field fif after validation' ); is( $form->field('isbn')->fif, '02340234', 'get field author after validation' ); $params->{$_} = '' for qw/ comment format year borrower /; $params->{user_updated} = 0; is_deeply( $form->fif, $params, 'get form fif after validation' ); { package My::Form; use HTML::FormHandler::Moose; extends 'HTML::FormHandler'; has_field 'my_compound' => ( type => 'Compound' ); has_field 'my_compound.one'; has_field 'my_compound.two'; has_field 'my_compound.three' => ( type => 'Compound' ); has_field 'my_compound.three.first'; has_field 'my_compound.three.second'; } $form = My::Form->new; ok( $form, 'get form with compound fields' ); $params = { 'my_compound.one' => 'What', 'my_compound.two' => 'Is', 'my_compound.three.first' => 'Up', 'my_compound.three.second' => 'With you?' }; $form->process($params); ok($form->validated, 'form validated'); is_deeply($form->fif, $params, 'fif is correct'); done_testing; HTML-FormHandler-Model-DBIC-0.28/t/generator.t0000644000077000007700000000123412217614372020100 0ustar gshankgshankuse strict; use warnings; use Test::More; use lib 't/lib'; BEGIN { eval "use Template"; plan skip_all => 'Template' if $@; } use_ok( 'HTML::FormHandler::Generator::DBIC' ); use_ok( 'BookDB::Schema'); my $schema = BookDB::Schema->connect('dbi:SQLite:t/db/book.db'); ok($schema, 'get db schema'); my $generator = HTML::FormHandler::Generator::DBIC->new( schema => $schema, rs_name => 'User' ); ok( $generator, 'Generator created' ); my $form_code = $generator->generate_form(); ok( $form_code, 'form code generated' ); #warn $form_code; eval $form_code; ok( !$@, 'Form code compiles' ) or warn $@; ok( UserForm->new, 'Form creation works' ); done_testing; HTML-FormHandler-Model-DBIC-0.28/t/lib/0000755000077000007700000000000012217614372016473 5ustar gshankgshankHTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB/0000755000077000007700000000000012217614372017573 5ustar gshankgshankHTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB/Form/0000755000077000007700000000000012217614372020476 5ustar gshankgshankHTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB/Form/Author.pm0000644000077000007700000000100412217614372022271 0ustar gshankgshankpackage BookDB::Form::Author; use HTML::FormHandler::Moose; extends 'HTML::FormHandler::Model::DBIC'; has '+item_class' => ( default => 'Author' ); has_field 'last_name' => ( type => 'Text', required => 1 ); has_field 'first_name' => ( type => 'Text', required => 1 ); has_field 'country' => ( type => 'Text' ); has_field 'birthdate' => ( type => 'DateTime' ); has_field 'books' => ( type => 'Repeatable' ); has_field 'books.contains' => ( type => '+BookDB::Form::Field::Book' ); no HTML::FormHandler::Moose; 1; HTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB/Form/AuthorOld.pm0000644000077000007700000000066512217614372022744 0ustar gshankgshankpackage BookDB::Form::AuthorOld; use HTML::FormHandler::Moose; extends 'HTML::FormHandler::Model::DBIC'; has '+item_class' => ( default => 'AuthorOld' ); has_field 'last_name' => ( type => 'Text', required => 1 ); has_field 'first_name' => ( type => 'Text', required => 1 ); has_field 'country' => ( type => 'Text' ); has_field 'birthdate' => ( type => 'DateTime' ); has_field 'foo'; has_field 'bar'; no HTML::FormHandler::Moose; 1; HTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB/Form/Book.pm0000644000077000007700000000421412217614372021727 0ustar gshankgshankpackage BookDB::Form::Book; use HTML::FormHandler::Moose; extends 'HTML::FormHandler::Model::DBIC'; =head1 NAME Form object for the Book Controller =head1 SYNOPSIS Form used for book/add and book/edit actions =head1 DESCRIPTION Catalyst Form. =cut has '+item_class' => ( default => 'Book' ); has '+widget_name_space' => ( default => sub { ['BookDB::Form::Widget'] } ); has '+widget_wrapper' => ( default => 'Para' ); has_field 'title' => ( type => 'Text', required => 1, required_message => 'A book must have a title.', label => 'Title', order => '1', ); has_field 'authors' => ( type => 'Multiple', label => 'Authors', label_column => 'full_name', order => '2', ); has_field 'user_updated' => ( type => 'Boolean' ); # has_many relationship pointing to mapping table has_field 'genres' => ( type => 'Multiple', label => 'Genres', label_column => 'name', order => '3', ); has_field 'isbn' => ( type => 'Text', label => 'ISBN', order => '5', unique => 1, ); has_field 'publisher' => ( type => 'Text', label => 'Publisher', order => '4', ); has_field 'format' => ( type => 'Select', label => 'Format', order => '6', ); has_field 'year' => ( type => 'Integer', range_start => '1900', range_end => '2020', label => 'Year', order => '7', ); has_field 'pages' => ( type => 'Integer', label => 'Pages', order => '8', ); has_field 'comment' => ( type => 'Text', order => 9, ); has_field 'borrower' => ( type => 'Select', label_column => 'name_email', ); has_field submit => ( type => 'Submit', value => 'Update' ); sub validate_year { my ( $self, $field ) = @_; $field->add_error('Invalid year') if ( ( $field->value > 3000 ) || ( $field->value < 1600 ) ); } =head1 AUTHOR Gerda Shank =head1 LICENSE AND COPYRIGHT This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L. =cut __PACKAGE__->meta->make_immutable; no HTML::FormHandler::Moose; 1; HTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB/Form/Book2PK.pm0000644000077000007700000000275512217614372022254 0ustar gshankgshankpackage BookDB::Form::Book2PK; use HTML::FormHandler::Moose; extends 'HTML::FormHandler::Model::DBIC'; with 'HTML::FormHandler::Widget::Theme::Bootstrap'; =head1 NAME Form object for the Book Controller =head1 SYNOPSIS Form used for book/add and book/edit actions =head1 DESCRIPTION Catalyst Form. =cut has '+item_class' => ( default => 'Book2PK' ); has_field 'title' => ( type => 'Text', required => 1, required_message => 'A book must have a title.', label => 'Title', ); has_field 'publisher' => ( type => 'Text', label => 'Publisher', ); # has_many relationship pointing to mapping table has_field 'isbn' => ( type => 'Text', label => 'ISBN', unique => 1, required => 1, ); has_field 'year' => ( type => 'Integer', range_start => '1900', range_end => '2020', label => 'Year', required => 1, ); has_field 'pages' => ( type => 'Integer', label => 'Pages', ); has_field submit => ( type => 'Submit', value => 'Update', element_class => ['btn'] ); sub validate_year { my ( $self, $field ) = @_; $field->add_error('Invalid year') if ( ( $field->value > 3000 ) || ( $field->value < 1600 ) ); } =head1 AUTHOR Gerda Shank =head1 LICENSE AND COPYRIGHT This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L. =cut __PACKAGE__->meta->make_immutable; no HTML::FormHandler::Moose; 1; HTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB/Form/BookHTML.pm0000644000077000007700000000066212217614372022417 0ustar gshankgshankpackage BookDB::Form::BookHTML; use Moose; extends 'HTML::FormHandler::Model::DBIC'; has '+item_class' => ( default => 'Book' ); has '+name' => ( default => 'book' ); has '+html_prefix' => ( default => 1 ); sub field_list { [ title => { type => 'Text', required => 1, }, author => 'Text', pages => 'Integer', year => 'Integer', ] } 1; HTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB/Form/BookM2M.pm0000644000077000007700000000402612217614372022244 0ustar gshankgshankpackage BookDB::Form::BookM2M; use Moose; extends 'HTML::FormHandler::Model::DBIC'; =head1 NAME Form object for the Book Controller =head1 SYNOPSIS Form used for book/add and book/edit actions =head1 DESCRIPTION Catalyst Form. =cut has '+item_class' => ( default => 'Book' ); sub field_list { [ title => { type => 'Text', required => 1, required_message => 'A book must have a title.', label => 'Title', order => '1', }, author => { type => 'Text', label => 'Author:', order => '2', }, # has_many relationship pointing to mapping table genres => { type => 'Multiple', label => 'Genres:', label_column => 'name', order => '3', }, isbn => { type => 'Text', label => 'ISBN:', order => '5', unique => 1, }, publisher => { type => 'Text', label => 'Publisher:', order => '4', }, format => { type => 'Select', label => 'Format:', order => '6', }, year => { type => 'Integer', range_start => '1900', range_end => '2020', label => 'Year:', order => '7', }, pages => { type => 'Integer', label => 'Pages:', order => '8', }, comment => { type => 'Text', order => 9, }, ]; } sub validate_year { my ( $self, $field ) = @_; $field->add_error('Invalid year') if ( ( $field->value > 3000 ) || ( $field->value < 1600 ) ); } =head1 AUTHOR Gerda Shank =head1 LICENSE AND COPYRIGHT This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L. =cut 1; HTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB/Form/BookView.pm0000644000077000007700000000115712217614372022565 0ustar gshankgshankpackage BookDB::Form::BookView; use HTML::FormHandler::Moose; extends 'HTML::FormHandler::Model::DBIC'; use DateTime; has '+item_class' => ( default => 'Book' ); has_field 'borrower' => ( type => 'Select' ); has_field 'borrowed'; # List for the "view" part of this form. These are not updated # Not a standard form method. Convenience function sub view_list { my @fields = ('title', 'author', 'genre', 'publisher', 'isbn', 'format', 'pages', 'year'); return wantarray ? @fields : \@fields; } sub init_value_borrowed { my ($self, $field) = @_; return DateTime->now( time_zone => 'local')->ymd; } 1; HTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB/Form/BookWithOwner.pm0000644000077000007700000000162512217614372023601 0ustar gshankgshank{ package BookDB::Form::BookOwner; use HTML::FormHandler::Moose; extends 'HTML::FormHandler::Field::Compound'; has_field 'user_name'; has_field 'fav_cat' => ( label => 'Favorite Book Category' ); has_field 'fav_book' => ( label => 'Favorite Book' ); has_field 'occupation'; has_field 'country' => ( type => 'Select' ); sub validate_occupation { my ( $self, $field ) = @_; if ( $field->value eq 'layabout' ) { $field->add_error('No layabouts allowed'); } } } { package BookDB::Form::BookWithOwner; use HTML::FormHandler::Moose; extends 'HTML::FormHandler::Model::DBIC'; has '+item_class' => ( default => 'Author' ); has_field 'title' => ( type => 'Text', required => 1 ); has_field 'publisher' => ( type => 'Text', required => 1 ); has_field 'owner' => ( type => '+BookDB::Form::BookOwner' ); } 1; HTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB/Form/BookWithOwnerAlt.pm0000644000077000007700000000124212217614372024235 0ustar gshankgshank{ package BookDB::Field::BookOwnerAlt; use Moose; extends 'HTML::FormHandler::Field::Compound'; with 'BookDB::Form::Role::BookOwner'; } { package BookDB::Form::BookWithOwnerAlt; use HTML::FormHandler::Moose; extends 'HTML::FormHandler::Model::DBIC'; has '+item_class' => ( default => 'Author' ); has_field 'title' => ( type => 'Text', required => 1 ); has_field 'publisher' => ( type => 'Text', required => 1 ); has_field 'owner' => ( type => '+BookDB::Field::BookOwner' ); } { package BookDB::Form::BookOwnerAlt; use Moose; extends 'HTML::FormHandler::Form::DBIC'; with 'BookDB::Form::Role::BookOwner'; } 1; HTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB/Form/Borrower.pm0000644000077000007700000000252712217614372022643 0ustar gshankgshankpackage BookDB::Form::Borrower; use HTML::FormHandler::Moose; extends 'HTML::FormHandler::Model::DBIC'; =head1 NAME Form object for Borrower =head1 DESCRIPTION Catalyst Controller. =cut has '+item_class' => ( default => 'Borrower' ); __PACKAGE__->meta->make_immutable; has_field 'name' => ( type => 'Text', required => 1, order => 1, label => "Name", unique => 1, unique_message => 'That name is already in our user directory', ); has_field 'email' => ( type => 'Email', required => 1, order => 4, label => "Email", ); has_field 'phone' => ( type => 'Text', order => 2, label => "Telephone", ); has_field 'url' => ( type => 'Text', order => 3, label => 'URL', ); has_field 'active' => ( type => 'Boolean', label => "Active?" ); has_field 'submit' => ( type => 'Submit', value => 'Save' ); =head1 AUTHOR Gerda Shank =head1 LICENSE AND COPYRIGHT This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L. =cut __PACKAGE__->meta->make_immutable; no HTML::FormHandler::Moose; 1; HTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB/Form/BorrowerX.pm0000644000077000007700000000222312217614372022764 0ustar gshankgshankpackage BookDB::Form::BorrowerX; use Moose; extends 'HTML::FormHandler::Model::DBIC'; =head1 NAME Form object for Borrower =head1 DESCRIPTION Catalyst Controller. =cut has '+item_class' => ( default => 'Borrower' ); __PACKAGE__->meta->make_immutable; sub field_list { [ name => { type => 'Text', required => 1, order => 1, label => "Name", unique => 1, unique_message => 'That name is already in our user directory', }, email => { type => 'Email', required => 1, order => 4, label => "Email", }, phone => { type => 'Text', order => 2, label => "Telephone", }, url => { type => 'Text', order => 3, label => 'URL', }, books => 'Text', ]; } =head1 AUTHOR Gerda Shank =head1 LICENSE AND COPYRIGHT This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L. =cut 1; HTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB/Form/Field/0000755000077000007700000000000012217614372021521 5ustar gshankgshankHTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB/Form/Field/AltText.pm0000644000077000007700000000070212217614372023443 0ustar gshankgshankpackage BookDB::Form::Field::AltText; use Moose; extends 'HTML::FormHandler::Field::Text'; has 'another_attribute' => ( isa => 'Str', is => 'rw' ); sub validate { my $field = shift; return unless $field->SUPER::validate; my $input = $field->input; my $check = $field->another_attribute; # do something silly return $field->add_error('Fails AltText validation') unless $input =~ m/$check/; return 1; } no Moose; 1; HTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB/Form/Field/Book.pm0000644000077000007700000000266612217614372022763 0ustar gshankgshankpackage BookDB::Form::Field::Book; use HTML::FormHandler::Moose; extends 'HTML::FormHandler::Field::Compound'; has_field 'id' => ( type => 'PrimaryKey', ); has_field 'title' => ( type => 'Text', required => 1, required_message => 'A book must have a title.', label => 'Title', ); has_field 'authors' => ( type => 'Multiple', label => 'Authors', ); has_field 'user_updated' => ( type => 'Boolean' ); # has_many relationship pointing to mapping table has_field 'genres' => ( type => 'Multiple', label => 'Genres', label_column => 'name', ); has_field 'isbn' => ( type => 'Text', label => 'ISBN', unique => 1, ); has_field 'publisher' => ( type => 'Text', label => 'Publisher', ); has_field 'format' => ( type => 'Select', label => 'Format', ); has_field 'year' => ( type => 'Integer', range_start => '1900', range_end => '2020', label => 'Year', ); has_field 'pages' => ( type => 'Integer', label => 'Pages', ); has_field 'comment' => ( type => 'Text', ); has_field submit => ( type => 'Submit', value => 'Update' ); sub validate { my $self = shift; my $year_field = $self->field('year'); $year_field->add_error('Invalid year') if ( ( $year_field->value > 3000 ) || ( $year_field->value < 1600 ) ); } __PACKAGE__->meta->make_immutable; no HTML::FormHandler::Moose; 1; HTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB/Form/Profile.pm0000644000077000007700000000037512217614372022441 0ustar gshankgshankpackage BookDB::Form::Profile; extends 'HTML::FormHandler'; has_field 'username'; has_field 'fav_cat' => ( label => 'Favorite Book Category' ); has_field 'fav_book' => ( label => 'Favorite Book' ); has_field 'occupation'; no 'HTML::FormHandler'; 1; HTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB/Form/Role/0000755000077000007700000000000012217614372021377 5ustar gshankgshankHTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB/Form/Role/BookOwner.pm0000644000077000007700000000066312217614372023647 0ustar gshankgshankpackage BookDB::Form::BookOwner; use HTML::FormHandler::Moose::Role; has_field 'user_name'; has_field 'fav_cat' => ( label => 'Favorite Book Category' ); has_field 'fav_book' => ( label => 'Favorite Book' ); has_field 'occupation'; has_field 'country' => ( type => 'Select' ); sub validate_occupation { my ( $self, $field ) = @_; if ( $field->value eq 'layabout' ) { $field->add_error('No layabouts allowed'); } } HTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB/Form/User.pm0000644000077000007700000000300512217614372021750 0ustar gshankgshankpackage BookDB::Form::User; use HTML::FormHandler::Moose; extends 'HTML::FormHandler::Model::DBIC'; use DateTime; has '+item_class' => ( default => 'User'); has_field 'user_name'; has_field 'fav_cat' => ( label => 'Category' ); has_field 'fav_book' => ( label => 'Favorite Book' ); has_field 'occupation'; has_field 'country' => ( type => 'Select' ); has_field 'license' => ( type => 'Select' ); has_field 'opt_in' => ( type => 'Checkbox' ); has_field 'birthdate' => ( type => 'DateTime' ); has_field 'birthdate.year' => ( type => 'Text', ); has_field 'birthdate.month' => ( type => 'Text', ); has_field 'birthdate.day' => ( type => 'Text', ); has_field 'employers' => ( type => 'Repeatable' ); has_field 'employers.employer_id' => ( type => 'PrimaryKey' ); has_field 'employers.name'; has_field 'employers.category'; has_field 'employers.country'; has_field 'addresses' => ( type => 'Repeatable' ); has_field 'addresses.address_id' => ( type => 'PrimaryKey' ); has_field 'addresses.street'; has_field 'addresses.city'; has_field 'addresses.country' => ( type => 'Select' ); sub options_opt_in { return ( 0 => 'Send no emails', 1 => 'Send related emails' ); } sub init_value_license { my ( $self, $field, $item ) = @_; return 0 unless $item && $item->license_id && $item->license_id != 0; return $item->license_id; } sub validate_occupation { my ( $self, $field ) = @_; if ( $field->value eq 'layabout' ) { $field->add_error('No layabouts allowed'); } } no HTML::FormHandler::Moose; 1; HTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB/Form/Widget/0000755000077000007700000000000012217614372021721 5ustar gshankgshankHTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB/Form/Widget/Wrapper/0000755000077000007700000000000012217614372023341 5ustar gshankgshankHTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB/Form/Widget/Wrapper/Para.pm0000644000077000007700000000144412217614372024565 0ustar gshankgshankpackage BookDB::Form::Widget::Wrapper::Para; use Moose::Role; with 'HTML::FormHandler::Widget::Wrapper::Base'; sub wrap_field { my ( $self, $result, $rendered_widget ) = @_; my $class = $self->render_class( $result ); my $output = qq{\n

}; if ( $self->has_flag('is_compound' ) ) { $output .= '

'; $output .= '' . $self->label . ''; } elsif ( !$self->has_flag('no_render_label') && $self->label ) { $output .= $self->render_label; } $output .= $rendered_widget; $output .= qq{\n$_} for $result->all_errors; if ( $self->has_flag( 'is_compound' ) ) { $output .= '
'; } $output .= "

\n"; return $output; } no Moose::Role; 1; HTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB/Schema/0000755000077000007700000000000012217614372020773 5ustar gshankgshankHTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB/Schema/Result/0000755000077000007700000000000012217614372022251 5ustar gshankgshankHTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB/Schema/Result/Address.pm0000644000077000007700000000152412217614372024176 0ustar gshankgshankpackage BookDB::Schema::Result::Address; use strict; use warnings; use base 'DBIx::Class'; __PACKAGE__->load_components("Core"); __PACKAGE__->table("address"); __PACKAGE__->add_columns( "address_id", { data_type => "INTEGER", is_nullable => 0, size => 8 }, "user_id", { data_type => "INTEGER", is_nullable => 0, size => 8 }, "street", { data_type => "VARCHAR", is_nullable => 0, size => 32 }, "city", { data_type => "VARCHAR", is_nullable => 0, size => 32 }, "country_iso", { data_type => "character", default_value => undef, is_nullable => 1, size => 2, }, ); __PACKAGE__->set_primary_key("address_id"); __PACKAGE__->belongs_to( 'user', 'BookDB::Schema::Result::User', { user_id => 'user_id' }, ); __PACKAGE__->belongs_to( 'country', 'BookDB::Schema::Result::Country', { iso => 'country_iso' }, ); 1; HTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB/Schema/Result/Author.pm0000644000077000007700000000210512217614372024047 0ustar gshankgshankpackage BookDB::Schema::Result::Author; use strict; use warnings; use base 'DBIx::Class'; __PACKAGE__->load_components("InflateColumn::DateTime", "Core"); __PACKAGE__->table("author"); __PACKAGE__->add_columns( "author_id" => {}, "last_name", { data_type => "VARCHAR", is_nullable => 0, size => 16 }, "first_name", { data_type => "VARCHAR", is_nullable => 0, size => 16 }, "country_iso", { data_type => "character", default_value => undef, is_nullable => 1, size => 2, }, "birthdate", { data_type => "DATETIME", is_nullable => 0 }, ); __PACKAGE__->set_primary_key("author_id"); #__PACKAGE__->has_many( # "books", # "BookDB::Schema::Result::Book", # { "foreign.author_id" => "self.id" }, #); __PACKAGE__->belongs_to( 'country', 'BookDB::Schema::Result::Country', { iso => 'country_iso' }, ); __PACKAGE__->has_many( 'author_books', 'BookDB::Schema::Result::AuthorBooks', 'author_id', ); __PACKAGE__->many_to_many( 'books' => 'author_books', 'book' ); sub full_name { my $self = shift; return $self->first_name . " " . $self->last_name; } 1; HTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB/Schema/Result/AuthorBooks.pm0000644000077000007700000000127412217614372025053 0ustar gshankgshankpackage BookDB::Schema::Result::AuthorBooks; use strict; use warnings; use base 'DBIx::Class'; __PACKAGE__->load_components("Core"); __PACKAGE__->table("author_books"); __PACKAGE__->add_columns( "book_id", { data_type => "INTEGER", is_foreign_key => 1, is_nullable => 0, size => undef, }, "author_id", { data_type => "INTEGER", is_foreign_key => 1, is_nullable => 0, size => undef, }, ); __PACKAGE__->set_primary_key(('book_id', 'author_id')); __PACKAGE__->belongs_to( "book", "BookDB::Schema::Result::Book", { id => "book_id" }, ); __PACKAGE__->belongs_to( "author", "BookDB::Schema::Result::Author", { author_id => "author_id" }, ); 1; HTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB/Schema/Result/AuthorOld.pm0000644000077000007700000000145612217614372024516 0ustar gshankgshankpackage BookDB::Schema::Result::AuthorOld; use strict; use warnings; use base 'DBIx::Class'; __PACKAGE__->load_components("InflateColumn::DateTime", "Core"); __PACKAGE__->table("author_old"); __PACKAGE__->add_columns( "last_name", { data_type => "VARCHAR", is_nullable => 0, size => 16 }, "first_name", { data_type => "VARCHAR", is_nullable => 0, size => 16 }, "country_iso", { data_type => "character", default_value => undef, is_nullable => 1, size => 2, }, "birthdate", { data_type => "DATETIME", is_nullable => 0 }, "foo" => {}, "bar" => {}, ); __PACKAGE__->set_primary_key("first_name", "last_name"); __PACKAGE__->belongs_to( 'country', 'BookDB::Schema::Result::Country', { iso => 'country_iso' }, ); __PACKAGE__->add_unique_constraint( author_foo_bar => [qw(foo bar) ] ); 1; HTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB/Schema/Result/Book.pm0000644000077000007700000000511312217614372023501 0ustar gshankgshankpackage BookDB::Schema::Result::Book; use Moose; use base 'DBIx::Class'; # following attribute is non useful, since it does # nothing that persists, but shows how you could # do something more complicated has 'comment' => ( isa => 'Str|Undef', is => 'rw', trigger => \&set_extra ); sub set_extra { my ($self, $value) = @_; $self->extra($value); } BookDB::Schema::Result::Book->load_components("Core"); BookDB::Schema::Result::Book->table("book"); BookDB::Schema::Result::Book->add_columns( "id", { data_type => "INTEGER", is_nullable => 0, size => undef }, "isbn", { data_type => "varchar", is_nullable => 0, size => 100 }, "title", { data_type => "varchar", is_nullable => 0, size => 100, extra => { field_def => { type => 'TextArea', size => '64', temp => 'testing' } }, }, "publisher", { data_type => "varchar", is_nullable => 0, size => 100 }, "pages", { data_type => "INTEGER", is_nullable => 0, size => undef }, "year", { data_type => "INTEGER", is_nullable => 0, size => undef }, "format", { data_type => "INTEGER", is_foreign_key => 1, is_nullable => 0, size => undef, }, "borrower", { data_type => "INTEGER", is_foreign_key => 1, is_nullable => 0, size => undef, }, "borrowed", { data_type => "varchar", is_nullable => 0, size => 100 }, "owner", { data_type => "INTEGER", is_foreign_key => 1, is_nullable => 0, size => undef, }, "extra", { data_type => "varchar", is_nullable => 0, size => 100 }, ); BookDB::Schema::Result::Book->set_primary_key("id"); BookDB::Schema::Result::Book->belongs_to( "format", "BookDB::Schema::Result::Format", { id => "format" }, ); BookDB::Schema::Result::Book->belongs_to( "borrower", "BookDB::Schema::Result::Borrower", { id => "borrower" }, ); BookDB::Schema::Result::Book->belongs_to( "owner", "BookDB::Schema::Result::User", { user_id => "owner" }, ); BookDB::Schema::Result::Book->has_many( "books_genres", "BookDB::Schema::Result::BooksGenres", { "foreign.book_id" => "self.id" }, ); BookDB::Schema::Result::Book->many_to_many( genres => 'books_genres', 'genre' ); __PACKAGE__->has_many( "book_authors", "BookDB::Schema::Result::AuthorBooks", { "foreign.book_id" => "self.id" }, ); __PACKAGE__->many_to_many( authors => 'book_authors', 'author' ); __PACKAGE__->add_unique_constraint( 'isbn' => ['isbn'] ); sub author_list { my $self = shift; my @authors = $self->authors->all; my @author_names; foreach my $author (@authors) { push @author_names, $author->name; } return join(', ', @author_names); } 1; HTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB/Schema/Result/Book2PK.pm0000644000077000007700000000166012217614372024021 0ustar gshankgshankpackage BookDB::Schema::Result::Book2PK; use Moose; use MIME::Base64; use base 'DBIx::Class'; __PACKAGE__->load_components("Core"); __PACKAGE__->table("book2pk"); __PACKAGE__->add_columns( "libraryid", { data_type => "INTEGER", is_nullable => 0, default_value => 1, size => undef }, "id", { data_type => "INTEGER", is_nullable => 0, size => undef }, "isbn", { data_type => "varchar", is_nullable => 0, size => 100 }, "title", { data_type => "varchar", is_nullable => 0, size => 100, extra => { field_def => { type => 'TextArea', size => '64', temp => 'testing' } }, }, "publisher", { data_type => "varchar", is_nullable => 0, size => 100 }, "pages", { data_type => "INTEGER", is_nullable => 0, size => undef }, "year", { data_type => "INTEGER", is_nullable => 0, size => undef }, ); __PACKAGE__->set_primary_key("libraryid", "id"); __PACKAGE__->add_unique_constraint( 'isbn' => ['libraryid', 'isbn'] ); 1; HTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB/Schema/Result/BooksGenres.pm0000644000077000007700000000150012217614372025024 0ustar gshankgshankpackage BookDB::Schema::Result::BooksGenres; use strict; use warnings; use base 'DBIx::Class'; BookDB::Schema::Result::BooksGenres->load_components("Core"); BookDB::Schema::Result::BooksGenres->table("books_genres"); BookDB::Schema::Result::BooksGenres->add_columns( "book_id", { data_type => "INTEGER", is_foreign_key => 1, is_nullable => 0, size => undef, }, "genre_id", { data_type => "INTEGER", is_foreign_key => 1, is_nullable => 0, size => undef, }, ); BookDB::Schema::Result::BooksGenres->set_primary_key(('book_id', 'genre_id')); BookDB::Schema::Result::BooksGenres->belongs_to( "book", "BookDB::Schema::Result::Book", { id => "book_id" }, ); BookDB::Schema::Result::BooksGenres->belongs_to( "genre", "BookDB::Schema::Result::Genre", { id => "genre_id" }, ); 1; HTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB/Schema/Result/Borrower.pm0000644000077000007700000000154112217614372024411 0ustar gshankgshankpackage BookDB::Schema::Result::Borrower; use strict; use warnings; use base 'DBIx::Class'; __PACKAGE__->load_components("Core"); __PACKAGE__->table("borrower"); __PACKAGE__->add_columns( "id", { data_type => "INTEGER", is_nullable => 0, size => undef }, "name", { data_type => "varchar", is_nullable => 0, size => 100 }, "phone", { data_type => "varchar", is_nullable => 0, size => 20 }, "url", { data_type => "varchar", is_nullable => 0, size => 100 }, "email", { data_type => "varchar", is_nullable => 0, size => 100 }, "active", { data_type => "integer", is_nullable => 0, size => 1 }, ); __PACKAGE__->set_primary_key("id"); __PACKAGE__->has_many( "books", "BookDB::Schema::Result::Book", { "foreign.borrower" => "self.id" }, ); sub name_email { my $self = shift; return $self->name . " <" . $self->email . ">"; } 1; HTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB/Schema/Result/Country.pm0000644000077000007700000000122012217614372024245 0ustar gshankgshankpackage BookDB::Schema::Result::Country; # Created by DBIx::Class::Schema::Loader v0.03012 @ 2008-01-15 16:54:19 use strict; use warnings; use base 'DBIx::Class'; __PACKAGE__->load_components("PK::Auto", "Core"); __PACKAGE__->table("country"); __PACKAGE__->add_columns( iso => { data_type => 'character', is_nullable => 0, size => 2 }, name => { data_type => 'character varying', is_nullable => 1, size => 80 }, printable_name => { data_type => 'character varying', is_nullable => 0, size => 80 }, iso3 => { data_type => 'character', size => 3 }, numcode => { data_type => 'integer' }, ); __PACKAGE__->set_primary_key("iso"); 1; HTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB/Schema/Result/Employer.pm0000644000077000007700000000127012217614372024403 0ustar gshankgshankpackage BookDB::Schema::Result::Employer; use strict; use warnings; use base 'DBIx::Class'; __PACKAGE__->load_components("Core"); __PACKAGE__->table("employer"); __PACKAGE__->add_columns( "employer_id", { data_type => "INTEGER", is_nullable => 0, size => 8 }, "name", { data_type => "VARCHAR", is_nullable => 0, size => 32 }, "category", "country", { data_type => "VARCHAR", is_nullable => 0, size => 32 }, ); __PACKAGE__->set_primary_key("employer_id"); __PACKAGE__->many_to_many( 'users' => 'user_employer', 'user', ); __PACKAGE__->has_many( 'user_employer', 'BookDB::Schema::Result::UserEmployer', { 'foreign.employer_id' => 'self.employer_id' }, ); 1; HTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB/Schema/Result/Format.pm0000644000077000007700000000074112217614372024041 0ustar gshankgshankpackage BookDB::Schema::Result::Format; use strict; use warnings; use base 'DBIx::Class'; __PACKAGE__->load_components("Core"); __PACKAGE__->table("format"); __PACKAGE__->add_columns( "id", { data_type => "INTEGER", is_nullable => 0, size => undef }, "name", { data_type => "varchar", is_nullable => 0, size => 100 }, ); __PACKAGE__->set_primary_key("id"); __PACKAGE__->has_many( "books", "BookDB::Schema::Result::Book", { "foreign.format" => "self.id" }, ); 1; HTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB/Schema/Result/Genre.pm0000644000077000007700000000133212217614372023646 0ustar gshankgshankpackage BookDB::Schema::Result::Genre; use strict; use warnings; use base 'DBIx::Class'; BookDB::Schema::Result::Genre->load_components("Core"); BookDB::Schema::Result::Genre->table("genre"); BookDB::Schema::Result::Genre->add_columns( "id", { data_type => "INTEGER", is_nullable => 0, size => undef }, "name", { data_type => "varchar", is_nullable => 0, size => 100 }, "is_active", { data_type => 'INTEGER', is_nullable => 1 }, ); BookDB::Schema::Result::Genre->set_primary_key("id"); BookDB::Schema::Result::Genre->has_many( "books_genres", "BookDB::Schema::Result::BooksGenres", { "foreign.genre_id" => "self.id" }, ); BookDB::Schema::Result::Genre->many_to_many( books => 'books_genres', 'book' ); 1; HTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB/Schema/Result/License.pm0000644000077000007700000000120412217614372024166 0ustar gshankgshankpackage BookDB::Schema::Result::License; use strict; use warnings; use base 'DBIx::Class'; __PACKAGE__->load_components("Core"); __PACKAGE__->table("licenses"); __PACKAGE__->add_columns( license_id => { data_type => 'INTEGER', is_nullable => 0 }, name => { data_type => 'VARCHAR', is_nullable => 0, size => 32 }, label => { data_type => 'VARCHAR', is_nullable => 0, size => 32 }, active => { data_type => 'INTEGER', size => 1 }, ); __PACKAGE__->set_primary_key("license_id"); __PACKAGE__->has_many( 'user', 'BookDB::Schema::Result::User', { 'foreign.license_id' => 'self.license_id'}, { cascade_delete => 0 } ); 1; HTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB/Schema/Result/Options.pm0000644000077000007700000000173212217614372024245 0ustar gshankgshankpackage BookDB::Schema::Result::Options; use strict; use warnings; use base 'DBIx::Class::Core'; __PACKAGE__->table("options"); __PACKAGE__->add_columns( "options_id", { data_type => "smallint", default_value => undef, is_auto_increment => 1, is_nullable => 0, size => 38, }, "option_one", { data_type => "VARCHAR2", default_value => undef, is_nullable => 1, size => 32, }, "option_two", { data_type => "VARCHAR2", default_value => undef, is_nullable => 1, size => 32, }, "option_three", { data_type => "VARCHAR2", default_value => undef, is_nullable => 1, size => 32, }, "user_id", { data_type => "INTEGER", is_nullable => 0, size => 8, }, ); __PACKAGE__->set_primary_key("options_id"); __PACKAGE__->add_unique_constraint( "unique_user_id", ["user_id"], ); __PACKAGE__->belongs_to( 'user', 'BookDB::Schema::Result::User', { user_id => 'user_id' }, ); 1; HTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB/Schema/Result/User.pm0000644000077000007700000000330512217614372023526 0ustar gshankgshankpackage BookDB::Schema::Result::User; use strict; use warnings; use base 'DBIx::Class'; __PACKAGE__->load_components("InflateColumn::DateTime", "Core"); __PACKAGE__->table("user"); __PACKAGE__->add_columns( "user_id", { data_type => "INTEGER", is_nullable => 0, size => 8 }, "user_name", { data_type => "VARCHAR", is_nullable => 0, size => 32 }, "fav_cat", { data_type => "VARCHAR", is_nullable => 0, size => 32 }, "fav_book", { data_type => "VARCHAR", is_nullable => 0, size => 32 }, "occupation", { data_type => "VARCHAR", is_nullable => 0, size => 32 }, "country_iso", { data_type => "character", default_value => undef, is_nullable => 1, size => 2, }, "birthdate", { data_type => "DATETIME", is_nullable => 0 }, "opt_in", { data_type => "INTEGER", size => 1 }, "license_id", { data_type => "INTEGER", is_nullable => 0, size => 8 }, ); __PACKAGE__->set_primary_key("user_id"); #__PACKAGE__->has_many( # "books", # "BookDB::Schema::Result::Book", # { "foreign.author_id" => "self.id" }, #); __PACKAGE__->has_many( "user_employers", "BookDB::Schema::Result::UserEmployer", { 'foreign.user_id' => 'self.user_id' } ); __PACKAGE__->many_to_many( "employers" => "user_employers", "employer", ); __PACKAGE__->has_many( "addresses", "BookDB::Schema::Result::Address", { 'foreign.user_id' => 'self.user_id' } ); __PACKAGE__->belongs_to( 'country', 'BookDB::Schema::Result::Country', { iso => 'country_iso' }, ); __PACKAGE__->belongs_to('license' => 'BookDB::Schema::Result::License', { 'foreign.license_id' => 'self.license_id' } ); __PACKAGE__->has_one('options' => 'BookDB::Schema::Result::Options', { 'foreign.user_id' => 'self.user_id' } ); 1; HTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB/Schema/Result/UserEmployer.pm0000644000077000007700000000120112217614372025234 0ustar gshankgshankpackage BookDB::Schema::Result::UserEmployer; use strict; use warnings; use base 'DBIx::Class'; __PACKAGE__->load_components("Core"); __PACKAGE__->table("user_employer"); __PACKAGE__->add_columns( "employer_id", { data_type => "INTEGER", is_nullable => 0, size => 8 }, "user_id", { data_type => "INTEGER", is_nullable => 0, size => 8 }, ); __PACKAGE__->set_primary_key("employer_id", "user_id"); __PACKAGE__->belongs_to( 'user', 'BookDB::Schema::Result::User', { user_id => 'user_id' }, ); __PACKAGE__->belongs_to( 'employer', 'BookDB::Schema::Result::Employer', { employer_id => 'employer_id' }, ); 1; HTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB/Schema.pm0000644000077000007700000000017012217614372021327 0ustar gshankgshankpackage BookDB::Schema; use strict; use warnings; use base 'DBIx::Class::Schema'; __PACKAGE__->load_namespaces; 1; HTML-FormHandler-Model-DBIC-0.28/t/lib/BookDB.pm0000644000077000007700000000145212217614372020133 0ustar gshankgshankpackage BookDB; use strict; use Catalyst ('-Debug', 'Static::Simple', ); our $VERSION = '0.02'; BookDB->config( name => 'BookDB' ); BookDB->setup; =head1 NAME BookDB - Catalyst based application =head1 SYNOPSIS script/bookdb_server.pl =head1 DESCRIPTION Catalyst based application. =head1 METHODS =over 4 =item chained_uri_for =cut sub this_chained_uri { my $c = shift; return $c->uri_for($c->action,$c->req->captures,@_); } sub chained_uri_for { my ($c, $controller, $action, $captures) = @_; return $c->uri_for($c->controller($controller)->action_for($action), $captures ); } =back =head1 AUTHOR Gerda Shank =head1 LICENSE This library is free software . You can redistribute it and/or modify it under the same terms as perl itself. =cut 1; HTML-FormHandler-Model-DBIC-0.28/t/model_dbic.t0000644000077000007700000000505112217614372020174 0ustar gshankgshankuse Test::More; use lib 't/lib'; use_ok('HTML::FormHandler::Model::DBIC'); use BookDB::Schema; my $schema = BookDB::Schema->connect('dbi:SQLite:t/db/book.db'); ok($schema, 'get schema'); { package My::Form; use Moose; extends 'HTML::FormHandler::Model::DBIC'; has '+item_class' => ( default => 'Book' ); has '+field_list' => ( default => sub { [ book_title => { type => 'Text', required => 1, accessor => 'title', }, publisher => 'Text', extra => 'Text', ] } ); } my $form = My::Form->new( item_id => 1, schema => $schema ); ok( $form, 'get form'); my $title_field = $form->field('book_title'); my $publisher_field = $form->field('publisher'); ok( $title_field->value eq 'Harry Potter and the Order of the Phoenix', 'get title from form'); ok( $title_field->order == 1, 'order for title'); ok( $publisher_field->order == 2, 'order for publisher'); { package My::Form2; use Moose; extends 'HTML::FormHandler::Model::DBIC'; has '+field_list' => ( default => sub { [ title => { type => 'Text', }, publisher => 'Text', extra => 'Text', ] } ); } my $book = $schema->resultset('Book')->find(1); my $form2 = My::Form2->new(item => $book ); ok( $form2, 'get form with row object'); is( $form2->field('title')->value, 'Harry Potter and the Order of the Phoenix', 'get title from form'); is( $form2->item_id, 1, 'item_id set from row'); my $book3 = $schema->resultset('Book')->new_result({}); END { $book3->delete } my $form3 = My::Form2->new( item => $book3 ); ok( $form3, 'get form from empty row object'); is( $form3->item_id, undef, 'empty row form has no item_id'); is( $form3->item_class, 'Book', 'item_class set from empty row'); $form3->process(params => {}); ok( !$form3->validated, 'empty form does not validate'); $form3->process(params => { extra => 'testing'}); ok( $form3->validated, 'form with single non-db param validates'); my $params = { title => 'Testing a form created from an empty row', publisher => 'S.Else', extra => 'extra_test' }; $form3->process( params => $params ); is( $book3->publisher, 'S.Else', 'row object updated'); is( $form3->field('extra')->value, 'extra_test', 'value of non-db field'); ok( $form3->item->id, 'get id from new result'); ok( $form3->item_id, 'item_id has been set'); $form3->process( params => $params ); ok( $form3->validated, 'form processed a second time'); done_testing; HTML-FormHandler-Model-DBIC-0.28/t/mult_pk.t0000644000077000007700000000313712217614372017571 0ustar gshankgshankuse Test::More; use lib 't/lib'; use_ok( 'HTML::FormHandler' ); use_ok( 'BookDB::Form::AuthorOld'); use_ok( 'BookDB::Schema'); my $schema = BookDB::Schema->connect('dbi:SQLite:t/db/book.db'); ok($schema, 'get db schema'); my $pk = ['J.K.', 'Rowling']; my $authors = $schema->resultset('AuthorOld'); my $author = $schema->resultset('AuthorOld')->find( @{$pk} ); ok( $author, 'get author from db' ); is( $author->country_iso, 'GB', 'correct value in author'); my $form = BookDB::Form::AuthorOld->new(item_id => $pk, schema => $schema); ok( $form, 'get form with multiple primary key' ); is( $form->item->country_iso, 'GB', 'got right row'); my $pk_hashref = { last_name => 'Rowling', first_name => 'J.K.' }; $author = $schema->resultset('AuthorOld')->find( $pk_hashref ); ok( $author, 'get author from db with hashref'); $form = BookDB::Form::AuthorOld->new(item_id => $pk_hashref, schema => $schema); ok( $form, 'get form with array of hashref primary key' ); is( $form->item->country_iso, 'GB', 'got right row'); my $pk_hashlist = [{ last_name => 'Rowling', first_name => 'J.K.' }, { key => 'primary' }]; $author = $schema->resultset('AuthorOld')->find( @{$pk_hashlist} ); ok( $author, 'get author from db with hashref'); $form = BookDB::Form::AuthorOld->new(item_id => $pk_hashlist, schema => $schema); ok( $form, 'get form with array of hashref primary key' ); is( $form->item->country_iso, 'GB', 'got right row'); $form = BookDB::Form::AuthorOld->new( item => $author ); ok( $form, 'got form with only item passed in' ); is_deeply( $form->item_id, $pk_hashlist, 'got primary key' ); done_testing; HTML-FormHandler-Model-DBIC-0.28/t/process.t0000644000077000007700000000625112217614372017574 0ustar gshankgshankuse strict; use warnings; use Test::More; use lib 't/lib'; use_ok( 'HTML::FormHandler' ); use_ok( 'BookDB::Form::Book'); use_ok( 'BookDB::Schema'); my $schema = BookDB::Schema->connect('dbi:SQLite:t/db/book.db'); ok($schema, 'get db schema'); my $form = BookDB::Form::Book->new; ok( $form, 'no param new' ); $form->process( item_id => 1, schema => $schema, params => {} ); is( $form->item->id, 1, 'get item from item_id and schema'); ok( !$form->process( item_id => undef, schema => $schema ), 'Empty data' ); # This is munging up the equivalent of param data from a form my $good = { 'title' => 'How to Test Perl Form Processors', 'genres' => [2, 4], 'format' => 2, 'isbn' => '123-02345-0502-2' , 'publisher' => 'EreWhon Publishing', }; ok( $form->process( schema => $schema, params => $good ), 'Good data' ); is( $form->field( 'title' )->input, 'How to Test Perl Form Processors', 'Input created from params and not deleted in validate' ); my $book = $form->item; END { $book->delete }; ok( $book->id != 1, 'this is not the same book'); ok ($book, 'get book object from form'); my $num_genres = $book->genres->count; is( $num_genres, 2, 'multiple select list updated ok'); is( $form->field('format')->value, 2, 'get value for format' ); $good = { 'title' => 'How to Test Perl Form Processors', 'genres' => [2, 4], 'format' => 3, 'isbn' => '123-02345-0502-2' , 'publisher' => 'EreWhon Publishing', }; ok( $form->process( item => $book, schema => $schema, params => $good ), 'update book with another request' ); my $bad_1 = { notitle => 'not req', silly_field => 4, }; ok( !$form->process( schema => $schema, params => $bad_1 ), 'bad parameters' ); my $bad_2 = { 'title' => "Another Silly Test Book", 'year' => '1590', 'pages' => 'too few', 'format' => '22', }; ok( !$form->process( schema => $schema, params => $bad_2 ), 'bad 2'); ok( $form->field('year')->has_errors, 'year has error' ); ok( $form->field('pages')->has_errors, 'pages has error' ); ok( $form->field('format')->has_errors, 'format has error' ); $form->process(item => $book, schema => $schema); ok( $form, 'create form from db object'); my $genres_field = $form->field('genres'); is_deeply( sort $genres_field->value, [2, 4], 'value of multiple field is correct'); { package My::Form; use HTML::FormHandler::Moose; extends 'HTML::FormHandler'; has_field 'field_one'; has_field 'field_two'; has_field 'field_three'; sub validate_field_one { my ($self, $field) = @_; $field->add_error( 'Field does not contain ONE' ) unless $field->value eq 'ONE'; } sub validate_field_two { my ( $self, $field ) = @_; $field->add_error( 'Field does not contain TWO' ) unless $field->value eq 'TWO'; } } $form = My::Form->new; ok( $form, 'get non-database form' ); my $bad = { field_one => 'BAD', field_two => 'BAD', }; my $validated = $form->process( params => $bad ); ok( !$validated, 'bad params did not validate' ); $good = { field_one => 'ONE', field_two => 'TWO', }; $validated = $form->process( params => $good ); ok( $validated, 'good params did validate' ); done_testing; HTML-FormHandler-Model-DBIC-0.28/t/reflect.t0000644000077000007700000000261612217614372017543 0ustar gshankgshankuse strict; use warnings; use Test::More; use lib 't/lib'; use_ok('HTML::FormHandler::Model::DBIC'); use_ok('HTML::FormHandler::TraitFor::DBICFields'); use_ok('HTML::FormHandler::Model::DBIC::TypeMap'); use BookDB::Schema; my $schema = BookDB::Schema->connect('dbi:SQLite:t/db/book.db'); ok($schema, 'get schema'); my $book = $schema->resultset('Book')->find(1); my $form = HTML::FormHandler::Model::DBIC->new_with_traits( traits => ['HTML::FormHandler::TraitFor::DBICFields'], field_list => [ 'submit' => { type => 'Submit', value => 'Save', order => 99 } ], item => $book ); ok( $form, 'get form'); ok( $form->can('build_type_map'), 'trait applied' ); is( $form->num_fields, 11, 'right number of fields' ); my $title_field = $form->field('title'); ok( $title_field, 'title field exists'); my $publisher_field = $form->field('publisher'); ok( $publisher_field, 'author field exists'); ok( $title_field->value eq 'Harry Potter and the Order of the Phoenix', 'get title from form'); is( $title_field->temp, 'testing', 'got field def from extra' ); $form = HTML::FormHandler::Model::DBIC->new_with_traits( traits => ['HTML::FormHandler::TraitFor::DBICFields'], includes => ['title', 'publisher' ], field_list => [ 'submit' => { type => 'Submit', value => 'Save', order => 99 } ], item => $book ); ok( $form, 'get form' ); is( $form->num_fields, 3, 'right number of fields' ); done_testing; HTML-FormHandler-Model-DBIC-0.28/t/related.t0000644000077000007700000001055612217614372017541 0ustar gshankgshankuse strict; use warnings; use Test::More; use lib 't/lib'; use BookDB::Form::User; use BookDB::Schema; my $schema = BookDB::Schema->connect('dbi:SQLite:t/db/book.db'); my $user = $schema->resultset('User')->find(1); my $form = BookDB::Form::User->new; $form->process( item_id => 1, schema => $schema ); ok( $form->field('employers.0.name'), 'many_to_many field exists'); # addresses is a has_many relationship # employers is a many_to_many relationship my $fif = { 'addresses.0.address_id' => 1, 'addresses.0.city' => 'Middle City', 'addresses.0.country' => 'GK', 'addresses.0.street' => '101 Main St', 'addresses.1.address_id' => 2, 'addresses.1.city' => 'DownTown', 'addresses.1.country' => 'UT', 'addresses.1.street' => '99 Elm St', 'addresses.2.address_id' => 3, 'addresses.2.city' => 'Santa Lola', 'addresses.2.country' => 'GF', 'addresses.2.street' => '1023 Side Ave', 'birthdate.day' => 23, 'birthdate.month' => 4, 'birthdate.year' => 1970, 'country' => 'US', 'employers.0.employer_id' => 1, 'employers.0.category' => 'Perl', 'employers.0.country' => 'US', 'employers.0.name' => 'Best Perl', 'employers.1.employer_id' => 2, 'employers.1.category' => 'Programming', 'employers.1.country' => 'UK', 'employers.1.name' => 'Worst Perl', 'employers.2.employer_id' => 3, 'employers.2.category' => 'Programming', 'employers.2.country' => 'DE', 'employers.2.name' => 'Convoluted PHP', 'fav_book' => 'Necronomicon', 'fav_cat' => 'Sci-Fi', 'license' => 3, 'occupation' => 'management', 'opt_in' => 0, 'user_name' => 'jdoe', }; is_deeply( $form->fif, $fif, 'fif ok' );; my $old_emp = $schema->resultset('Employer')->search({name => 'Convoluted PHP'})->single; $fif->{'employers.2.category'} = 'Maybe Programming'; $form->process($fif); $old_emp->discard_changes; is( $old_emp->category, 'Maybe Programming', 'field has been updated' ); $fif->{'employers.2.category'} = "Programming"; $form->process($fif); $old_emp->discard_changes; is( $old_emp->category, 'Programming', 'field updated again' ); my $params = { user_name => "Joe Smith", occupation => "Programmer", 'birthdate.year' => '1974', 'birthdate.month' => 4, 'birthdate.day' => 21, 'employers.0.name' => "Acme Software", 'employers.0.category' => "Computers", 'employers.0.country' => "United Kingdom", 'addresses.0.address_id' => '', 'addresses.0.city' => '', 'addresses.0.country' => '', 'addresses.0.street' => '', }; $form->process( item_id => undef, params => $params); my $new_user = $form->item; my $new_employer = $schema->resultset('Employer')->find(5); END { $new_user->delete; $new_employer->delete; } ok( $form->validated, 'new related row validated'); $fif = { 'birthdate.day' => 21, 'birthdate.month' => 4, 'birthdate.year' => 1974, 'country' => '', 'employers.0.employer_id' => 5, 'employers.0.category' => 'Computers', 'employers.0.country' => 'United Kingdom', 'employers.0.name' => 'Acme Software', 'fav_book' => '', 'fav_cat' => '', 'license' => '', 'occupation' => 'Programmer', 'opt_in' => 0, 'user_name' => 'Joe Smith', 'addresses.0.address_id' => '', 'addresses.0.city' => '', 'addresses.0.country' => '', 'addresses.0.street' => '', }; is_deeply( $form->fif, $fif, 'fif for new item'); is( $form->item->id, 6, 'new user' ); $new_employer = $schema->resultset('Employer')->find(5); ok( $new_employer, 'new employer'); my $new_fif = $form->fif; delete $new_fif->{license}; # removeinit_value $form->process($new_fif); ok( $form->validated, 'second pass validated'); $user = $form->item; is( $user->user_name, 'Joe Smith', 'created item'); is( $schema->resultset('UserEmployer')->search({ user_id => $user->id })->count, 1, 'the right number of employers' ); my $employers = [{ employer_id => 5, name => "Acme Software", category => "Computers", country => "United Kingdom" }]; is_deeply( $form->field('employers')->value, $employers, 'value is correct' ); $params->{opt_in} = 0; $params->{license} = ''; $params->{$_} = '' for qw/ country fav_book fav_cat addresses.0.address_id addresses.0.city addresses.0.country addresses.0.street /; $params->{'employers.0.employer_id'} = 5; is_deeply( $form->fif, $params, 'fif is correct' ); $form->process( item => $user ); is_deeply( $form->field('employers')->value, $employers, 'value correct when loaded from db' ); done_testing; HTML-FormHandler-Model-DBIC-0.28/t/release-eol.t0000644000077000007700000000047612217614372020316 0ustar gshankgshank BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } use strict; use warnings; use Test::More; eval 'use Test::EOL'; plan skip_all => 'Test::EOL required' if $@; all_perl_files_ok({ trailing_whitespace => 1 }); HTML-FormHandler-Model-DBIC-0.28/t/release-no-tabs.t0000644000077000007700000000045012217614372021072 0ustar gshankgshank BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } use strict; use warnings; use Test::More; eval 'use Test::NoTabs'; plan skip_all => 'Test::NoTabs required' if $@; all_perl_files_ok(); HTML-FormHandler-Model-DBIC-0.28/t/reload_options.t0000644000077000007700000000356612217614372021145 0ustar gshankgshankuse strict; use warnings; use Test::More; use lib 't/lib'; use_ok( 'HTML::FormHandler' ); use_ok( 'BookDB::Form::Book' ); use_ok( 'BookDB::Schema' ); my $schema = BookDB::Schema->connect('dbi:SQLite:t/db/book.db'); ok( $schema, 'get db schema' ); # Empty form loaded for user to populate, with format options listed my $form1 = page_request( {} ); ok( !$form1->validated, 'not validated because it is a new empty form' ); my $form2 = page_request( { format => '' } ); ok( !$form2->validated, 'submitted, but with errors' ); my $params = { title => 'The Definitive Guide to Catalyst', author => 'Kieren; Trout, Matt Diment', genres => [6,2], isbn => 1430223650, publisher => 'APRESS', format => '', year => 2009, pages => 360, comment => '', }; # Valid submission, without a format set. my $form3 = page_request( $params ); ok( $form3->validated, 'no format - submitted and valid' ); # Check the book was stored, which isn't really essential for this test. # And delete it, so that we can re-insert it in the next step. my $rs = $schema->resultset('Book'); my @matches = $rs->search( { isbn => $params->{isbn} } )->all; is( @matches, 1, 'Found the submitted book in the db' ); $_->delete for @matches; @matches = $rs->search( { isbn => $params->{isbn} } )->all; is( @matches, 0, 'Deleted book from the db' ); # Valid submission, with a format set. $params->{format} = 1; my $form4 = page_request( $params ); ok( $form4->validated, 'format = 1, submitted and valid' ); $form4->item->delete; sub page_request { my $params = shift; my $form = BookDB::Form::Book->new; ok( $form, 'no param new' ); $form->process( item_id => undef, schema => $schema, params => $params ); my $options = $form->field( 'format' )->options; is( @$options, 6, 'Format options loaded from the model' ); return $form; } done_testing; HTML-FormHandler-Model-DBIC-0.28/t/resultset.t0000644000077000007700000000456712217614372020160 0ustar gshankgshankuse strict; use warnings; use Test::More; use lib ('t/lib'); use BookDB::Schema; { package Test::Resultset; use HTML::FormHandler::Moose; extends 'HTML::FormHandler::Model::DBIC'; has '+item_class' => ( default => 'Employer' ); has 'resultset' => ( isa => 'DBIx::Class::ResultSet', is => 'rw', trigger => sub { shift->set_resultset(@_) } ); sub set_resultset { my ( $self, $resultset ) = @_; $self->schema( $resultset->result_source->schema ); } sub init_object { my $self = shift; my $rows = [$self->resultset->all]; return { employers => $rows }; } has_field 'employers' => ( type => 'Repeatable' ); has_field 'employers.employer_id' => ( type => 'PrimaryKey' ); has_field 'employers.name'; has_field 'employers.category'; has_field 'employers.country'; sub update_model { my $self = shift; my $values = $self->values->{employers}; foreach my $row (@$values) { delete $row->{employer_id} unless defined $row->{employer_id}; $self->resultset->update_or_create( $row ); } } } my $schema = BookDB::Schema->connect('dbi:SQLite:t/db/book.db'); my $employers = $schema->resultset('Employer'); my $form = Test::Resultset->new( resultset => $employers ); ok( $form, 'form builds' ); ok( $form->schema, 'form has schema' ); my $fif = { 'employers.0.category' => 'Perl', 'employers.0.country' => 'US', 'employers.0.employer_id' => 1, 'employers.0.name' => 'Best Perl', 'employers.1.category' => 'Programming', 'employers.1.country' => 'UK', 'employers.1.employer_id' => 2, 'employers.1.name' => 'Worst Perl', 'employers.2.category' => 'Programming', 'employers.2.country' => 'DE', 'employers.2.employer_id' => 3, 'employers.2.name' => 'Convoluted PHP', 'employers.3.category' => 'Losing', 'employers.3.country' => 'DE', 'employers.3.employer_id' => 4, 'employers.3.name' => 'Contractor Heaven', }; is_deeply( $form->fif, $fif, 'fif is correct' ); $fif->{'employers.2.category'} = 'Marketing'; $form->process( params => $fif ); ok( $form->validated, 'form validated' ); is( $form->resultset->find(3)->category, 'Marketing', 'row updated ok' ); $fif->{'employers.2.category'} = 'Programming'; $form->process( params => $fif ); is( $form->resultset->find(3)->category, 'Programming', 'row updated ok' ); done_testing; HTML-FormHandler-Model-DBIC-0.28/t/unique-composite.t0000644000077000007700000000217212217614372021422 0ustar gshankgshankuse Test::More; use lib 't/lib'; use_ok( 'BookDB::Form::AuthorOld'); use BookDB::Schema; my $schema = BookDB::Schema->connect('dbi:SQLite:t/db/book.db'); ok($schema, 'get db schema'); my $duplicate = $schema->resultset('AuthorOld')->first; my $form = BookDB::Form::AuthorOld->new(item_id => undef, schema => $schema, unique_messages => { foo => 'a unique constraint error message'} ); ok( !$form->process, 'Empty data' ); # This is munging up the equivalent of param data from a form my $params = { 'first_name' => "Jane", 'last_name' => "Doe", 'foo' => $duplicate->foo, 'bar' => $duplicate->bar, }; ok( !$form->process( $params ), 'duplicate foo/bar fails validation' ); my $error = $form->field('foo')->errors->[0]; is( $error, 'Duplicate value for author_foo_bar unique constraint', 'error message for duplicate unique index'); is($form->unique_message_for_constraint('author_foo_bar'), 'Duplicate value for [_1] unique constraint', 'unique constraint message saved'); is($form->unique_message_for_constraint('foo'), 'a unique constraint error message', 'unique constraint accepted in constructor'); done_testing; HTML-FormHandler-Model-DBIC-0.28/t/unique.t0000644000077000007700000000340612217614372017423 0ustar gshankgshankuse Test::More; use lib 't/lib'; use_ok( 'BookDB::Form::Book'); use BookDB::Schema; my $schema = BookDB::Schema->connect('dbi:SQLite:t/db/book.db'); ok($schema, 'get db schema'); my $duplicate_isbn = $schema->resultset('Book')->find(1)->isbn; my $form = BookDB::Form::Book->new(item_id => undef, schema => $schema); ok( !$form->process, 'Empty data' ); # This is munging up the equivalent of param data from a form my $params = { 'title' => 'How to Test Perl Form Processors', 'author' => 'I.M. Author', 'isbn' => $duplicate_isbn, 'publisher' => 'EreWhon Publishing', }; ok( !$form->process( $params ), 'duplicate isbn fails validation' ); my $error = $form->field('isbn')->errors->[0]; is( $error, 'Duplicate value for ISBN', 'error message for duplicate'); { package My::Form; use Moose; extends 'HTML::FormHandler::Model::DBIC'; has '+item_class' => ( default => 'Book' ); sub field_list { [ title => { type => 'Text', required => 1, }, author => 'Text', isbn => { type => 'Text', unique => 1, messages => { unique => 'Duplicate ISBN number' }, } ] } } my $form2 = My::Form->new( item_id => undef, schema => $schema ); ok( ! $form2->process( $params ), 'duplicate isbn again' ); @errors = $form2->field('isbn')->all_errors; is( $errors[0], 'Duplicate ISBN number', 'field error message for duplicate'); # Tests for fields that are inactive my $item = $schema->resultset('Book')->new({}); ok ( $form->process( item => $item, params => $params, inactive => ['isbn'] ), 'no uniqueness check on inactive fields' ); $item->delete if $item->in_storage; # Cleanup insert done_testing; HTML-FormHandler-Model-DBIC-0.28/t/xt/0000755000077000007700000000000012217614372016360 5ustar gshankgshankHTML-FormHandler-Model-DBIC-0.28/t/xt/02pod.t0000644000077000007700000000027612217614372017476 0ustar gshankgshankuse Test::More; eval "use Test::Pod 1.14"; plan skip_all => 'Test::Pod 1.14 required' if $@; plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD}; all_pod_files_ok(); HTML-FormHandler-Model-DBIC-0.28/t/xt/dump.t0000644000077000007700000000153412217614372017515 0ustar gshankgshankuse strict; use warnings; use Test::More; use lib 't/lib'; BEGIN { plan skip_all => 'Set HFH_DUMP_TEST to run this test' unless $ENV{HFH_DUMP_TEST}; } use_ok( 'HTML::FormHandler' ); use_ok( 'BookDB::Form::Book'); use_ok( 'BookDB::Schema'); my $schema = BookDB::Schema->connect('dbi:SQLite:t/db/book.db'); ok($schema, 'get db schema'); my $form = BookDB::Form::Book->new(verbose => 1); ok( $form, 'get form object with verbose output' ); my $good = { 'title' => 'How to Test Perl Form Processors', 'author' => 'I.M. Author', 'genres' => [2, 4], 'format' => 2, 'isbn' => '123-02345-0502-2' , 'publisher' => 'EreWhon Publishing', }; ok( $form->process( schema => $schema, params => $good ), 'Good data' ); my $book = $form->item; END { $book->delete; } ok( $form->item, 'get new book object' ); done_testing; HTML-FormHandler-Model-DBIC-0.28/TODO0000644000077000007700000000013012217614372016144 0ustar gshankgshankPut todo items here Improve repeatable example in User controller to do delete and adds