HTML-FormHandler-Model-DBIC-0.29 000755 000770 000024 0 12372776436 15720 5 ustar 00gshank staff 000000 000000 TODO 100644 000770 000024 130 12372776436 16443 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29 Put todo items here
Improve repeatable example in User controller to do delete and adds
README 100644 000770 000024 474 12372776436 16646 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29
This archive contains the distribution HTML-FormHandler-Model-DBIC,
version 0.29:
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.
Changes 100644 000770 000024 5037 12372776436 17301 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29 0.29
Fix tests broken because item is now cleared
0.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
t 000755 000770 000024 0 12372776436 16104 5 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29 fif.t 100644 000770 000024 5713 12372776436 17203 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t use 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;
LICENSE 100644 000770 000024 43650 12372776436 17036 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29 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.
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, Suite 500, Boston, MA 02110-1335 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
INSTALL 100644 000770 000024 2053 12372776436 17032 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29
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
dist.ini 100644 000770 000024 2412 12372776436 17444 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29 ; 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.29
[@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
book.t 100644 000770 000024 10524 12372776436 17405 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t use 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;
META.yml 100644 000770 000024 1571 12372776436 17256 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29 ---
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 5.006, CPAN::Meta::Converter version 2.132830'
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.29
MANIFEST 100644 000770 000024 3637 12372776436 17143 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29 Changes
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
01app.t 100644 000770 000024 322 12372776436 17327 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t use 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' );
}
META.json 100644 000770 000024 3320 12372776436 17420 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29 {
"abstract" : "base class that holds DBIC model role",
"author" : [
"FormHandler Contributors - see HTML::FormHandler"
],
"dynamic_config" : 0,
"generated_by" : "Dist::Zilla version 5.006, CPAN::Meta::Converter version 2.132830",
"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"
}
},
"develop" : {
"requires" : {
"Test::More" : "0",
"Test::NoTabs" : "0"
}
},
"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.29"
}
SIGNATURE 100644 000770 000024 14524 12372776436 17313 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29 This file contains message digests of all files listed in MANIFEST,
signed via the Module::Signature module, version 0.73.
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 fe21ef57fd8b1966c6725b8b604ffca56d96dd4a Changes
SHA1 674ec091357ed31599f8081acb61b17054e1650e INSTALL
SHA1 967770b7299781100fc6c94a225abbf8f3bce5c3 LICENSE
SHA1 ce9b8c00e5f9b8abee54abdd1a3f07f2b8277bba MANIFEST
SHA1 b0b59313a7bacd4764d9a0f4d4c222a6c943b65f META.json
SHA1 1d8a25710075430e548cd2089b421f6e87ef880c META.yml
SHA1 4f014b53564cce3862467797b73ec250f2cba0e9 Makefile.PL
SHA1 de3cfd3346fdea5edfafee42c5e68b12be2948db README
SHA1 a8d73c860cf746b8a1a74ff351719f9c53a3f560 TODO
SHA1 5782034a434578ffbef9d558fc6384e373ee127b dist.ini
SHA1 8c5f1f8e33ceca70f1ed97b718c35a860e4a0a80 lib/HTML/FormHandler/Generator/DBIC.pm
SHA1 64edeff55f1c5c6f5780519d430f1ce243230714 lib/HTML/FormHandler/Model/DBIC.pm
SHA1 10f083d614ddd2a2340d7261f86b6c7f6eebf0fb lib/HTML/FormHandler/Model/DBIC/TypeMap.pm
SHA1 70f6d5fc419cd22c7066867527f84db9bd4e5711 lib/HTML/FormHandler/TraitFor/DBICFields.pm
SHA1 4b1f634a1bec844a1318205f357f01e5f529bc3b lib/HTML/FormHandler/TraitFor/Model/DBIC.pm
SHA1 1825d59f01834a02b1e1efdc0b5c5b0ad232c373 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 8953c764134a5357628253d6489c350f0dcd7eb7 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 1bed26a49caf08976e1de8fbd0fec0998d8bbbf7 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 ffc28f0afa6b9c0b2022b64cafc36780eab8d131 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 b3fe32c03277bf18bb496fa736bf9e1bdb3416cb 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/MacGPG2 v2.0.22 (Darwin)
iF4EAREIAAYFAlPr/R4ACgkQlX0ZOkgCucjUAAD/a4pFoi0mFvVa6+I/V9xNKcDy
uOyDuircHkrdllvMR7oA/1kLim5RD11vE8l+hQPgvg44k6BOgVJLYqDuuGfBlbhd
=CoHS
-----END PGP SIGNATURE-----
author.t 100644 000770 000024 1211 12372776436 17726 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t use 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;
db_fif.t 100644 000770 000024 4245 12372776436 17647 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t use 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;
unique.t 100644 000770 000024 3406 12372776436 17742 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t use 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;
book2pk.t 100644 000770 000024 1363 12372776436 20003 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t use 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;
mult_pk.t 100644 000770 000024 3137 12372776436 20110 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t use 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;
process.t 100644 000770 000024 6251 12372776436 20113 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t use 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;
reflect.t 100644 000770 000024 2616 12372776436 20062 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t use 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;
related.t 100644 000770 000024 10556 12372776436 20100 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t use 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;
xt 000755 000770 000024 0 12372776436 16537 5 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t dump.t 100644 000770 000024 1534 12372776436 20034 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/xt use 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;
Makefile.PL 100644 000770 000024 3206 12372776436 17754 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29
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" => {},
"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"
},
"TEST_REQUIRES" => {
"DateTime::Format::MySQL" => 0,
"DateTime::Format::SQLite" => 0,
"DateTime::Format::W3CDTF" => 0,
"Test::Exception" => 0,
"Test::More" => "0.94"
},
"VERSION" => "0.29",
"test" => {
"TESTS" => "t/*.t t/xt/*.t"
}
);
my %FallbackPrereqs = (
"DBIx::Class" => "0.08250",
"DBIx::Class::ResultSet::RecursiveUpdate" => "0.25",
"DateTime::Format::MySQL" => 0,
"DateTime::Format::SQLite" => 0,
"DateTime::Format::W3CDTF" => 0,
"HTML::FormHandler" => "0.40016",
"Moose" => "2.0007",
"Test::Exception" => 0,
"Test::More" => "0.94",
"namespace::autoclean" => "0.09"
);
unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) {
delete $WriteMakefileArgs{TEST_REQUIRES};
delete $WriteMakefileArgs{BUILD_REQUIRES};
$WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs;
}
delete $WriteMakefileArgs{CONFIGURE_REQUIRES}
unless eval { ExtUtils::MakeMaker->VERSION(6.52) };
WriteMakefile(%WriteMakefileArgs);
datetime.t 100644 000770 000024 1304 12372776436 20223 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t use 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;
db 000755 000770 000024 0 12372776436 16471 5 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t book.db 100644 000770 000024 430000 12372776436 20127 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/db SQLite format 3 @ 3 # 3 -â) û û
2à
v
" Ô ‰ L’¿Uû—¬^4ûÿ™©j¶ 5I# indexsqlite_autoindex_roles_pages_1roles_pagespƒ?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'
)>‚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
)-A indexsqlite_autoindex_country_1country`)!indexunique_foo_barauthor_oldCREATE UNIQUE INDEX unique_foo_bar ON author_old (foo, bar)‚!!ƒ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_oldvKtablegenregenreCREATE TABLE genre (
id INTEGER PRIMARY KEY,
name varchar(100),
is_active INTEGER
)/%%‚!tablebooks_genresbooks_genresCREATE TABLE books_genres (
book_id INTEGER REFERENCES book,
genre_id INTEGER REFERENCES genre,
primary key (book_id, genre_id)
)7K% indexsqlite_autoindex_books_genres_1books_genresbtableformatformatCREATE TABLE format (
id INTEGER PRIMARY KEY,
name varchar(100)
)A‚UtableborrowerborrowerCREATE TABLE borrower (
id INTEGER PRIMARY KEY,
name varchar(100),
phone varchar(20),
url varchar(100),
email varchar(100),
active integer
)
%%itableauthor_booksauthor_booksCREATE TABLE author_books (
author_id INTEGER,
book_id INTEGER,
PRIMARY KEY (author_id, book_id)
)7K% indexsqlite_autoindex_author_books_1author_books 7‚Itableauthorauthor
CREATE TABLE author (
author_id INTEGER PRIMARY KEY,
first_name VARCHAR(100),
last_name VARCHAR(100),
country_iso char(2),
birthdate DATETIME
);[indexisbnbookCREATE UNIQUE INDEX isbn ON book (isbn)I
)cindexbook_idx_ownerbookCREATE INDEX book_idx_owner ON book (owner)L +gindexbook_idx_formatbook
CREATE INDEX book_idx_format ON book (format)R/oindexbook_idx_borrowerbook CREATE INDEX book_idx_borrower ON book (borrower)‚g…1tablebookbookCREATE 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)
)-‚1tableaddressaddressCREATE TABLE address (
address_id INTEGER PRIMARY KEY,
user_id INTEGER,
street VARCHAR(32),
city VARCHAR(32),
country_iso char(2)
)‚tableemployeremployerCREATE TABLE employer (
employer_id INTEGER PRIMARY KEY,
name VARCHAR(32),
category VARCHAR(32),
country VARCHAR(24)
)p''tableuser_employeruser_employerCREATE TABLE user_employer (
user_id INTEGER,
employer_id INTEGER
)
gtablelicenseslicensesCREATE TABLE licenses (
license_id INTEGER,
name VARCHAR(32),
label VARCHAR(32),
active 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
)‚ƒ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 INTE
¬ ¾~5è¬z ¾ G%!3Joe Smith 2 ! 3 Joe 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
€ ìÑ´—€ ì yellowredgreen graybrownblack turquoisetealpumpkin greensky bluefuchsia orangepurpleyellow 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 PerlProgrammingUK Best 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
Y
G ¬m/«^
¼
G
{
abc c-M1 \-=5 R-M1 A M1 How 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-14 I
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þÑ
Õ Ð ëÐüÚöðßåå
Õ ÏëÏüÚöðåßß Õ
Ó Î ÎðûõØêÞää
t o o›ï‰ÎÀÜÜ 12 143022
'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
Ë ûõîçàÙÒËÄ
Ä ûôìäÜÔÌÄÄ
- ï¦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 Novel Trade Comic Hardcover Paperback
Ò úôíæàÙÒËÄ
Ì óúëÜãÌÔÄÄ
¬ ôåØÈ»¬
Technical Fantasy ! Historical Mystery
Computers
Sci-Fi
d Ϙd 2!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
ROPTPL
DE FRDKCZAUATGFUT GK
ü ü Ë
X
Êl
†
Ú(s°jz³ w Û
Æ>BwÙ
š
É¼É ‚ƒ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)
)-‚1tableaddressaddressCREATE TABLE address (
address_id INTEGER PRIMARY KEY,
user_id INTEGER,
street VARCHAR(32),
city VARCHAR(32),
country_iso char(2)
)‚g…1tablebookbookCREATE 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_ownerbookCREATE INDEX book_idx_owner ON book (owner);[indexisbnbookCREATE UNIQUE INDEX isbn ON book (isbn)7‚Itableauthorauthor
CREATE TABLE author (
author_id INTEGER PRIMARY KEY,
first_name VARCHAR(100),
last_name VARCHAR(100),
country_iso char(2),
birthdate DATETIME
)
%%itableauthor_bo‚ƒ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)
)-‚1tableaddressaddressCREATE TABLE address (
address_id INTEGER PRIMARY KEY,
user_id INTEGER,
street VARCHAR(32),
city VARCHAR(32),
country_iso char(2)
)‚g…1tablebookbookCREATE 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_ownerbookCREATE INDEX book_idx_owner ON book (owner);[indexisbnbookCREATE UNIQUE INDEX isbn ON book (isbn)7‚Itableauthorauthor
CREATE 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)
)
“ c E m
X
ÐÔ k
,
[N[’í—cd ~ƒ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)
)- A indexsqlite_autoindex_book2pk_1book2pk# T#}indexunique_roleroles!CREATE UNIQUE INDEX unique_role ON roles (display_value)‚„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'
)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)
)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
)-A indexsqlite_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_pagesCREATE 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_pagesl;#indexroles_pages_idx_page_fkroles_pagesCREATE INDEX roles_pages_idx_page_fk ON roles_pages (page_fk)
³†XÚžV A '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| I 782128254The 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þÑ
Ñ ûôíæßØÑ 02pod.t 100644 000770 000024 276 12372776436 17775 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/xt use 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();
generator.t 100644 000770 000024 1234 12372776436 20417 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t use 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;
resultset.t 100644 000770 000024 4567 12372776436 20477 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t use 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;
db_has_one.t 100644 000770 000024 2673 12372776436 20522 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t use 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;
db_options.t 100644 000770 000024 3120 12372776436 20565 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t use 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;
model_dbic.t 100644 000770 000024 5100 12372776436 20506 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t use 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 );
$book3 = $form3->item;
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;
bad_item_id.t 100644 000770 000024 3166 12372776436 20657 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t use 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;
db_has_many.t 100644 000770 000024 10456 12372776436 20723 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t use 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;
db_init_obj.t 100644 000770 000024 3534 12372776436 20700 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t use 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;
db_validate.t 100644 000770 000024 1307 12372776436 20670 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t use 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;
$book = $form->item;
is( $book->year, 1999, 'book has been updated with correct data' );
done_testing;
bookdb.sql 100644 000770 000024 30032 12372776436 20630 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/db BEGIN 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;
lib 000755 000770 000024 0 12372776436 16652 5 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t BookDB.pm 100644 000770 000024 1452 12372776436 20452 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/lib package 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;
release-eol.t 100644 000770 000024 476 12372776436 20615 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t
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 });
active_column.t 100644 000770 000024 1377 12372776436 21271 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t use 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;
dbic_accessor.t 100644 000770 000024 1405 12372776436 21214 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t use 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;
reload_options.t 100644 000770 000024 3566 12372776436 21464 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t use 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;
release-no-tabs.t 100644 000770 000024 1164 12372776436 21414 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t
BEGIN {
unless ($ENV{RELEASE_TESTING}) {
require Test::More;
Test::More::plan(skip_all => 'these tests are for release candidate testing');
}
}
use strict;
use warnings;
# this test was generated with Dist::Zilla::Plugin::NoTabsTests 0.05
use Test::More 0.88;
use Test::NoTabs;
my @files = (
'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'
);
notabs_ok($_) foreach @files;
done_testing;
unique-composite.t 100644 000770 000024 2172 12372776436 21741 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t use 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;
BookDB 000755 000770 000024 0 12372776436 17752 5 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/lib Schema.pm 100644 000770 000024 170 12372776436 21626 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/lib/BookDB package BookDB::Schema;
use strict;
use warnings;
use base 'DBIx::Class::Schema';
__PACKAGE__->load_namespaces;
1;
script 000755 000770 000024 0 12372776436 17145 5 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29 form_generator.pl 100755 000770 000024 1225 12372776436 22656 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/script #!/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
=encoding UTF-8
=head1 NAME
form_generator - form generator
=head1 VERSION
version 0.29
=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
Form 000755 000770 000024 0 12372776436 20655 5 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/lib/BookDB Book.pm 100644 000770 000024 4214 12372776436 22246 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/lib/BookDB/Form package 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;
User.pm 100644 000770 000024 3005 12372776436 22267 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/lib/BookDB/Form package 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;
Author.pm 100644 000770 000024 1004 12372776436 22610 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/lib/BookDB/Form package 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;
Book2PK.pm 100644 000770 000024 2755 12372776436 22573 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/lib/BookDB/Form package 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;
BookM2M.pm 100644 000770 000024 4026 12372776436 22563 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/lib/BookDB/Form package 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;
Profile.pm 100644 000770 000024 375 12372776436 22740 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/lib/BookDB/Form package 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;
BookHTML.pm 100644 000770 000024 662 12372776436 22716 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/lib/BookDB/Form package 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;
BookView.pm 100644 000770 000024 1157 12372776436 23104 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/lib/BookDB/Form package 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;
Borrower.pm 100644 000770 000024 2527 12372776436 23162 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/lib/BookDB/Form package 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;
AuthorOld.pm 100644 000770 000024 665 12372776436 23243 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/lib/BookDB/Form package 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;
BorrowerX.pm 100644 000770 000024 2223 12372776436 23303 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/lib/BookDB/Form package 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;
Field 000755 000770 000024 0 12372776436 21700 5 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/lib/BookDB/Form Book.pm 100644 000770 000024 2666 12372776436 23302 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/lib/BookDB/Form/Field package 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;
Model 000755 000770 000024 0 12372776436 22414 5 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/lib/HTML/FormHandler DBIC.pm 100644 000770 000024 1407 12372776436 23615 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/lib/HTML/FormHandler/Model package 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.29';
use namespace::autoclean;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
HTML::FormHandler::Model::DBIC - base class that holds DBIC model role
=head1 VERSION
version 0.29
=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
BookWithOwner.pm 100644 000770 000024 1625 12372776436 24120 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/lib/BookDB/Form {
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;
AltText.pm 100644 000770 000024 702 12372776436 23742 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/lib/BookDB/Form/Field package 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;
Result 000755 000770 000024 0 12372776436 22430 5 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/lib/BookDB/Schema Book.pm 100644 000770 000024 5113 12372776436 24020 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/lib/BookDB/Schema/Result package 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;
User.pm 100644 000770 000024 3305 12372776436 24045 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/lib/BookDB/Schema/Result package 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;
Role 000755 000770 000024 0 12372776436 21556 5 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/lib/BookDB/Form BookOwner.pm 100644 000770 000024 663 12372776436 24146 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/lib/BookDB/Form/Role package 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');
}
}
Genre.pm 100644 000770 000024 1332 12372776436 24165 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/lib/BookDB/Schema/Result package 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;
Author.pm 100644 000770 000024 2105 12372776436 24366 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/lib/BookDB/Schema/Result package 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;
Format.pm 100644 000770 000024 741 12372776436 24340 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/lib/BookDB/Schema/Result package 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;
BookWithOwnerAlt.pm 100644 000770 000024 1242 12372776436 24554 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/lib/BookDB/Form {
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;
Address.pm 100644 000770 000024 1524 12372776436 24515 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/lib/BookDB/Schema/Result package 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;
Book2PK.pm 100644 000770 000024 1660 12372776436 24340 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/lib/BookDB/Schema/Result package 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;
Country.pm 100644 000770 000024 1220 12372776436 24564 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/lib/BookDB/Schema/Result package 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;
License.pm 100644 000770 000024 1204 12372776436 24505 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/lib/BookDB/Schema/Result package 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;
Options.pm 100644 000770 000024 1732 12372776436 24564 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/lib/BookDB/Schema/Result package 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;
Generator 000755 000770 000024 0 12372776436 23302 5 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/lib/HTML/FormHandler DBIC.pm 100644 000770 000024 25631 12372776436 24530 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/lib/HTML/FormHandler/Generator package 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
=encoding UTF-8
=head1 NAME
HTML::FormHandler::Generator::DBIC - form generator for DBIC
=head1 VERSION
version 0.29
=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
Borrower.pm 100644 000770 000024 1541 12372776436 24730 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/lib/BookDB/Schema/Result package 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;
Employer.pm 100644 000770 000024 1270 12372776436 24722 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/lib/BookDB/Schema/Result package 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;
AuthorOld.pm 100644 000770 000024 1456 12372776436 25035 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/lib/BookDB/Schema/Result package 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;
Wrapper 000755 000770 000024 0 12372776436 23520 5 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/lib/BookDB/Form/Widget Para.pm 100644 000770 000024 1444 12372776436 25104 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/lib/BookDB/Form/Widget/Wrapper package 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;
AuthorBooks.pm 100644 000770 000024 1274 12372776436 25372 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/lib/BookDB/Schema/Result package 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;
BooksGenres.pm 100644 000770 000024 1500 12372776436 25343 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/lib/BookDB/Schema/Result package 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;
DBIC 000755 000770 000024 0 12372776436 23115 5 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/lib/HTML/FormHandler/Model TypeMap.pm 100644 000770 000024 3432 12372776436 25174 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/lib/HTML/FormHandler/Model/DBIC package 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
=encoding UTF-8
=head1 NAME
HTML::FormHandler::Model::DBIC::TypeMap - type mape for DBICFields
=head1 VERSION
version 0.29
=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
UserEmployer.pm 100644 000770 000024 1201 12372776436 25553 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/t/lib/BookDB/Schema/Result package 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;
TraitFor 000755 000770 000024 0 12372776436 23106 5 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/lib/HTML/FormHandler DBICFields.pm 100644 000770 000024 11305 12372776436 25454 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/lib/HTML/FormHandler/TraitFor package 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
=encoding UTF-8
=head1 NAME
HTML::FormHandler::TraitFor::DBICFields - role to get fields from DBIx::Class result source
=head1 VERSION
version 0.29
=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
Model 000755 000770 000024 0 12372776436 24146 5 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/lib/HTML/FormHandler/TraitFor DBIC.pm 100644 000770 000024 45710 12372776436 25374 0 ustar 00gshank staff 000000 000000 HTML-FormHandler-Model-DBIC-0.29/lib/HTML/FormHandler/TraitFor/Model package 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
=encoding UTF-8
=head1 NAME
HTML::FormHandler::TraitFor::Model::DBIC - model role that interfaces with DBIx::Class
=head1 VERSION
version 0.29
=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 initial value. it is set when values are
initially loaded from an item, init_object or field defaults.
=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