[libhtml-formhandler-perl] 01/01: [svn-upgrade] new version libhtml-formhandler-perl (0.32002)
Damyan Ivanov
dmn at moszumanska.debian.org
Sat Nov 11 23:03:16 UTC 2017
This is an automated email from the git hooks/post-receive script.
dmn pushed a commit to tag upstream/0.32002
in repository libhtml-formhandler-perl.
commit 117125ffcfcafe195e4e196ac9d2effa549ff124
Author: Antony Gelberg <antony at wayforth.co.uk>
Date: Sun Sep 26 14:45:42 2010 +0000
[svn-upgrade] new version libhtml-formhandler-perl (0.32002)
---
Changes | 6 +
INSTALL | 44 +
LICENSE | 377 ++++
MANIFEST | 80 +-
META.json | 63 +
META.yml | 26 +-
Makefile.PL | 115 +-
README | 38 +-
SIGNATURE | 228 +++
dist.ini | 56 +
inc/Module/AutoInstall.pm | 805 ---------
inc/Module/Install.pm | 430 -----
inc/Module/Install/AuthorTests.pm | 59 -
inc/Module/Install/AutoInstall.pm | 61 -
inc/Module/Install/Base.pm | 78 -
inc/Module/Install/Can.pm | 81 -
inc/Module/Install/Fetch.pm | 93 -
inc/Module/Install/Include.pm | 34 -
inc/Module/Install/Makefile.pm | 268 ---
inc/Module/Install/Metadata.pm | 624 -------
inc/Module/Install/Share.pm | 67 -
inc/Module/Install/Win32.pm | 64 -
inc/Module/Install/WriteAll.pm | 60 -
lib/HTML/FormHandler.pm | 1427 +++++++--------
lib/HTML/FormHandler/BuildFields.pm | 56 +-
lib/HTML/FormHandler/Field.pm | 1894 ++++++++++----------
lib/HTML/FormHandler/Field/Boolean.pm | 46 +-
lib/HTML/FormHandler/Field/Captcha.pm | 77 +-
lib/HTML/FormHandler/Field/Checkbox.pm | 64 +-
lib/HTML/FormHandler/Field/Compound.pm | 122 +-
lib/HTML/FormHandler/Field/Date.pm | 99 +-
lib/HTML/FormHandler/Field/DateMDY.pm | 30 +-
lib/HTML/FormHandler/Field/DateTime.pm | 88 +-
lib/HTML/FormHandler/Field/Display.pm | 110 +-
lib/HTML/FormHandler/Field/Duration.pm | 58 +-
lib/HTML/FormHandler/Field/Email.pm | 30 +-
lib/HTML/FormHandler/Field/Hidden.pm | 30 +-
lib/HTML/FormHandler/Field/Hour.pm | 28 +-
lib/HTML/FormHandler/Field/HtmlArea.pm | 30 +-
lib/HTML/FormHandler/Field/IntRange.pm | 30 +-
lib/HTML/FormHandler/Field/Integer.pm | 28 +-
lib/HTML/FormHandler/Field/Minute.pm | 28 +-
lib/HTML/FormHandler/Field/Money.pm | 30 +-
lib/HTML/FormHandler/Field/Month.pm | 30 +-
lib/HTML/FormHandler/Field/MonthDay.pm | 30 +-
lib/HTML/FormHandler/Field/MonthName.pm | 30 +-
lib/HTML/FormHandler/Field/Multiple.pm | 30 +-
lib/HTML/FormHandler/Field/Nested.pm | 29 +-
lib/HTML/FormHandler/Field/NoValue.pm | 43 +-
lib/HTML/FormHandler/Field/Password.pm | 90 +-
lib/HTML/FormHandler/Field/PasswordConf.pm | 56 +-
lib/HTML/FormHandler/Field/PosInteger.pm | 30 +-
lib/HTML/FormHandler/Field/PrimaryKey.pm | 36 +-
lib/HTML/FormHandler/Field/Radio.pm | 39 +-
lib/HTML/FormHandler/Field/Repeatable.pm | 224 +--
lib/HTML/FormHandler/Field/Repeatable/Instance.pm | 41 +-
lib/HTML/FormHandler/Field/Reset.pm | 33 +-
lib/HTML/FormHandler/Field/Result.pm | 43 +-
lib/HTML/FormHandler/Field/Second.pm | 30 +-
lib/HTML/FormHandler/Field/Select.pm | 419 ++---
lib/HTML/FormHandler/Field/Submit.pm | 49 +-
lib/HTML/FormHandler/Field/Text.pm | 36 +-
lib/HTML/FormHandler/Field/TextArea.pm | 34 +-
lib/HTML/FormHandler/Field/Upload.pm | 98 +-
lib/HTML/FormHandler/Field/Weekday.pm | 30 +-
lib/HTML/FormHandler/Field/Year.pm | 30 +-
lib/HTML/FormHandler/Fields.pm | 109 +-
lib/HTML/FormHandler/I18N.pm | 29 +-
lib/HTML/FormHandler/I18N/de_de.pm | 31 +-
lib/HTML/FormHandler/I18N/en_us.pm | 27 +
lib/HTML/FormHandler/I18N/hu_hu.pm | 27 +
lib/HTML/FormHandler/I18N/ru_ru.pm | 27 +
lib/HTML/FormHandler/I18N/tr_tr.pm | 59 +-
lib/HTML/FormHandler/I18N/ua_ua.pm | 27 +
lib/HTML/FormHandler/InitResult.pm | 44 +-
lib/HTML/FormHandler/Manual.pod | 30 +-
lib/HTML/FormHandler/Manual/Catalyst.pod | 38 +-
lib/HTML/FormHandler/Manual/Cookbook.pod | 129 +-
lib/HTML/FormHandler/Manual/Intro.pod | 271 +--
lib/HTML/FormHandler/Manual/Reference.pod | 88 +-
lib/HTML/FormHandler/Manual/Rendering.pod | 61 +-
lib/HTML/FormHandler/Manual/Templates.pod | 47 +-
lib/HTML/FormHandler/Manual/Tutorial.pod | 119 +-
lib/HTML/FormHandler/Meta/Role.pm | 40 +-
lib/HTML/FormHandler/Model.pm | 127 +-
lib/HTML/FormHandler/Model/CDBI.pm | 269 ++-
lib/HTML/FormHandler/Model/Object.pm | 26 +
lib/HTML/FormHandler/Moose.pm | 81 +-
lib/HTML/FormHandler/Moose/Role.pm | 80 +-
lib/HTML/FormHandler/Params.pm | 26 +
lib/HTML/FormHandler/Render/Simple.pm | 266 +--
lib/HTML/FormHandler/Render/Table.pm | 71 +-
lib/HTML/FormHandler/Render/WithTT.pm | 98 +-
lib/HTML/FormHandler/Result.pm | 114 +-
lib/HTML/FormHandler/Result/Role.pm | 50 +-
lib/HTML/FormHandler/TraitFor/Captcha.pm | 78 +-
lib/HTML/FormHandler/TraitFor/I18N.pm | 69 +-
lib/HTML/FormHandler/Types.pm | 236 +--
lib/HTML/FormHandler/Validate.pm | 48 +-
lib/HTML/FormHandler/Validate/Actions.pm | 44 +-
lib/HTML/FormHandler/Widget/ApplyRole.pm | 30 +-
lib/HTML/FormHandler/Widget/Field/Checkbox.pm | 26 +
lib/HTML/FormHandler/Widget/Field/CheckboxGroup.pm | 28 +-
lib/HTML/FormHandler/Widget/Field/Compound.pm | 26 +
lib/HTML/FormHandler/Widget/Field/Hidden.pm | 26 +
lib/HTML/FormHandler/Widget/Field/NoRender.pm | 26 +
lib/HTML/FormHandler/Widget/Field/Password.pm | 26 +
lib/HTML/FormHandler/Widget/Field/RadioGroup.pm | 26 +
lib/HTML/FormHandler/Widget/Field/Reset.pm | 26 +
.../Widget/Field/Role/HTMLAttributes.pm | 28 +-
.../Widget/Field/Role/SelectedOption.pm | 26 +
lib/HTML/FormHandler/Widget/Field/Select.pm | 26 +
lib/HTML/FormHandler/Widget/Field/Submit.pm | 26 +
lib/HTML/FormHandler/Widget/Field/Text.pm | 26 +
lib/HTML/FormHandler/Widget/Field/Textarea.pm | 26 +
lib/HTML/FormHandler/Widget/Field/Upload.pm | 26 +
.../FormHandler/Widget/Form/Role/HTMLAttributes.pm | 55 +
lib/HTML/FormHandler/Widget/Form/Simple.pm | 69 +-
lib/HTML/FormHandler/Widget/Form/Table.pm | 60 +-
lib/HTML/FormHandler/Widget/Wrapper/Base.pm | 26 +
lib/HTML/FormHandler/Widget/Wrapper/Fieldset.pm | 43 +-
lib/HTML/FormHandler/Widget/Wrapper/None.pm | 28 +-
lib/HTML/FormHandler/Widget/Wrapper/Simple.pm | 65 +-
lib/HTML/FormHandler/Widget/Wrapper/Table.pm | 26 +
share/templates/widget/form_start.tt | 3 +-
t/constraints.t | 2 +-
t/dates.t | 2 +-
t/defaults.t | 6 +-
t/deflate.t | 26 +-
t/dependency.t | 3 +
t/field_traits.t | 8 +-
t/field_types.t | 8 +-
t/filters.t | 4 +-
t/form_handler.t | 9 +-
t/form_options.t | 6 +-
t/has_field_arrayref.t | 2 +-
t/has_many.t | 6 +-
t/inactive_fields.t | 6 +-
t/lib/Field/AltText.pm | 4 +-
t/lib/Form/Address.pm | 2 +-
t/lib/Form/AddressRole.pm | 2 +-
t/lib/Form/Person.pm | 2 +-
t/lib/Form/PersonRole.pm | 2 +-
.../Perl/Critic/Policy/FormHandler/Deprecations.pm | 182 --
t/release-eol.t | 16 +
t/release-no-tabs.t | 16 +
t/render.t | 2 +-
t/render_filter.t | 2 +-
t/render_html_attributes.t | 64 +
t/render_widgets.t | 4 +-
t/render_withtt.t | 38 +-
t/result_errors.t | 3 +
t/update_fields.t | 2 +-
t/validate_coderef.t | 2 +-
t/xt/deprecations.t | 15 -
{t/xt => xt}/02pod.t | 0
{t/xt => xt}/add_field.t | 0
{t/xt => xt}/captcha.t | 6 +-
{t/xt => xt}/chbox_group.t | 0
{t/xt => xt}/check_selected_option.t | 22 +-
{t/xt => xt}/custom_fields.t | 2 +-
{t/xt => xt}/display.t | 0
{t/xt => xt}/email.t | 0
{t/xt => xt}/field_list.t | 2 +-
{t/xt => xt}/form_errors.t | 8 +-
{t/xt => xt}/init.t | 4 +-
{t/xt => xt}/load_field.t | 4 +-
{t/xt => xt}/locale.t | 0
{t/xt => xt}/locale_data_localize.t | 4 +-
{t/xt => xt}/mb_form.t | 0
{t/xt => xt}/model_cdbi.t | 0
{t/xt => xt}/multiple_forms.t | 10 +-
{t/xt => xt}/order.t | 0
{t/xt => xt}/params.t | 10 +-
{t/xt => xt}/posted.t | 0
{t/xt => xt}/submit.t | 0
{t/xt => xt}/upload.t | 6 +-
177 files changed, 6761 insertions(+), 7020 deletions(-)
diff --git a/Changes b/Changes
index f5d1f5a..c60318d 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,9 @@
+0.32002 Thu July 29, 2010
+ Update to handle newer Moose (error msg with Moose::Util::MetaRole API)
+ Swich to Dist::Zilla
+ Add customization of form tag attributes
+ Add test prereqs
+
0.32001 Fri June 25, 2010
Add prereqs for DateTime::Format::Strptime and Email::Valid
diff --git a/INSTALL b/INSTALL
new file mode 100644
index 0000000..ea46707
--- /dev/null
+++ b/INSTALL
@@ -0,0 +1,44 @@
+
+This is the Perl distribution HTML-FormHandler.
+
+Installing HTML-FormHandler is straightforward.
+
+## Installation with cpanm
+
+If you have cpanm, you only need one line:
+
+ % cpanm HTML::FormHandler
+
+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
+
+## Installing with the CPAN shell
+
+Alternatively, if your CPAN shell is set up, you should just be able to do:
+
+ % cpan HTML::FormHandler
+
+## 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 documentation is available as POD.
+You can run perldoc from a shell to read the documentation:
+
+ % perldoc HTML::FormHandler
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..537f8ba
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,377 @@
+This software is copyright (c) 2010 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) 2010 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.
+ 59 Temple Place, Suite 330, Boston, MA 02111-1307, 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.
+
+ <one line to give the program's name and a brief idea of what it does.>
+ Copyright (C) 19yy <name of author>
+
+ 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307, 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.
+
+ <signature of Ty Coon>, 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) 2010 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
+
diff --git a/MANIFEST b/MANIFEST
index ec65882..1d92405 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1,17 +1,14 @@
Changes
-inc/Module/AutoInstall.pm
-inc/Module/Install.pm
-inc/Module/Install/AuthorTests.pm
-inc/Module/Install/AutoInstall.pm
-inc/Module/Install/Base.pm
-inc/Module/Install/Can.pm
-inc/Module/Install/Fetch.pm
-inc/Module/Install/Include.pm
-inc/Module/Install/Makefile.pm
-inc/Module/Install/Metadata.pm
-inc/Module/Install/Share.pm
-inc/Module/Install/Win32.pm
-inc/Module/Install/WriteAll.pm
+INSTALL
+LICENSE
+MANIFEST
+META.json
+META.yml
+Makefile.PL
+README
+SIGNATURE
+TODO
+dist.ini
lib/HTML/FormHandler.pm
lib/HTML/FormHandler/BuildFields.pm
lib/HTML/FormHandler/Field.pm
@@ -28,8 +25,8 @@ lib/HTML/FormHandler/Field/Email.pm
lib/HTML/FormHandler/Field/Hidden.pm
lib/HTML/FormHandler/Field/Hour.pm
lib/HTML/FormHandler/Field/HtmlArea.pm
-lib/HTML/FormHandler/Field/Integer.pm
lib/HTML/FormHandler/Field/IntRange.pm
+lib/HTML/FormHandler/Field/Integer.pm
lib/HTML/FormHandler/Field/Minute.pm
lib/HTML/FormHandler/Field/Money.pm
lib/HTML/FormHandler/Field/Month.pm
@@ -105,6 +102,7 @@ lib/HTML/FormHandler/Widget/Field/Submit.pm
lib/HTML/FormHandler/Widget/Field/Text.pm
lib/HTML/FormHandler/Widget/Field/Textarea.pm
lib/HTML/FormHandler/Widget/Field/Upload.pm
+lib/HTML/FormHandler/Widget/Form/Role/HTMLAttributes.pm
lib/HTML/FormHandler/Widget/Form/Simple.pm
lib/HTML/FormHandler/Widget/Form/Table.pm
lib/HTML/FormHandler/Widget/Wrapper/Base.pm
@@ -112,10 +110,6 @@ lib/HTML/FormHandler/Widget/Wrapper/Fieldset.pm
lib/HTML/FormHandler/Widget/Wrapper/None.pm
lib/HTML/FormHandler/Widget/Wrapper/Simple.pm
lib/HTML/FormHandler/Widget/Wrapper/Table.pm
-Makefile.PL
-MANIFEST This list of files
-META.yml
-README
share/templates/form.tt
share/templates/widget/checkbox.tt
share/templates/widget/checkbox_group.tt
@@ -167,14 +161,16 @@ t/lib/Form/PersonRole.pm
t/lib/Form/Test.pm
t/lib/Form/Two.pm
t/lib/MyApp/I18N/abc_de.pm
-t/lib/Perl/Critic/Policy/FormHandler/Deprecations.pm
t/lib/Widget/Field/Omega.pm
t/lib/Widget/Field/TestWidget.pm
t/list.t
t/password.t
+t/release-eol.t
+t/release-no-tabs.t
t/render.t
t/render_escaping.t
t/render_filter.t
+t/render_html_attributes.t
t/render_result.t
t/render_table.t
t/render_widgets.t
@@ -186,27 +182,25 @@ t/structured.t
t/types.t
t/update_fields.t
t/validate_coderef.t
-t/xt/02pod.t
-t/xt/add_field.t
-t/xt/captcha.t
-t/xt/chbox_group.t
-t/xt/check_selected_option.t
-t/xt/custom_fields.t
-t/xt/deprecations.t
-t/xt/display.t
-t/xt/email.t
-t/xt/field_list.t
-t/xt/form_errors.t
-t/xt/init.t
-t/xt/load_field.t
-t/xt/locale.t
-t/xt/locale_data_localize.t
-t/xt/mb_form.t
-t/xt/model_cdbi.t
-t/xt/multiple_forms.t
-t/xt/order.t
-t/xt/params.t
-t/xt/posted.t
-t/xt/submit.t
-t/xt/upload.t
-TODO
+xt/02pod.t
+xt/add_field.t
+xt/captcha.t
+xt/chbox_group.t
+xt/check_selected_option.t
+xt/custom_fields.t
+xt/display.t
+xt/email.t
+xt/field_list.t
+xt/form_errors.t
+xt/init.t
+xt/load_field.t
+xt/locale.t
+xt/locale_data_localize.t
+xt/mb_form.t
+xt/model_cdbi.t
+xt/multiple_forms.t
+xt/order.t
+xt/params.t
+xt/posted.t
+xt/submit.t
+xt/upload.t
diff --git a/META.json b/META.json
new file mode 100644
index 0000000..161f233
--- /dev/null
+++ b/META.json
@@ -0,0 +1,63 @@
+{
+ "abstract" : "HTML forms using Moose",
+ "author" : [
+ "FormHandler Contributors - see HTML::FormHandler"
+ ],
+ "dynamic_config" : 0,
+ "generated_by" : "Dist::Zilla version 4.101900, CPAN::Meta::Converter version 2.101670",
+ "license" : [
+ "perl_5"
+ ],
+ "meta-spec" : {
+ "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+ "version" : "2"
+ },
+ "name" : "HTML-FormHandler",
+ "prereqs" : {
+ "configure" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : "6.31",
+ "File::ShareDir::Install" : "0.03"
+ }
+ },
+ "runtime" : {
+ "requires" : {
+ "Carp" : 0,
+ "DateTime" : 0,
+ "DateTime::Format::Strptime" : 0,
+ "Email::Valid" : 0,
+ "File::ShareDir" : 0,
+ "File::Spec" : 0,
+ "Locale::Maketext" : "1.09",
+ "Moose" : "0.90",
+ "MooseX::Getopt" : "0.16",
+ "MooseX::Traits" : 0,
+ "MooseX::Types" : "0.20",
+ "MooseX::Types::Common" : 0,
+ "Try::Tiny" : 0,
+ "aliased" : 0,
+ "namespace::autoclean" : "0.09"
+ }
+ },
+ "test" : {
+ "requires" : {
+ "Test::Differences" : 0,
+ "Test::Exception" : 0,
+ "Test::More" : "0.94"
+ }
+ }
+ },
+ "release_status" : "stable",
+ "resources" : {
+ "bugtracker" : {
+ "mailto" : "bug-HTML-FormHandler at rt.cpan.org",
+ "web" : "https://rt.cpan.org/Public/Dist/Display.html?Name=HTML-FormHandler"
+ },
+ "repository" : {
+ "type" : "git",
+ "url" : "git://github.com/gshank/html-formhandler.git",
+ "web" : "http://github.com/gshank/html-formhandler"
+ }
+ },
+ "version" : "0.32002"
+}
diff --git a/META.yml b/META.yml
index 205062f..d370428 100644
--- a/META.yml
+++ b/META.yml
@@ -1,26 +1,21 @@
---
-abstract: 'form handler written in Moose'
+abstract: 'HTML forms using Moose'
author:
- - 'Gerda Shank'
+ - 'FormHandler Contributors - see HTML::FormHandler'
build_requires:
- ExtUtils::MakeMaker: 6.42
Test::Differences: 0
Test::Exception: 0
- Test::More: 0.88
+ Test::More: 0.94
configure_requires:
- ExtUtils::MakeMaker: 6.42
-distribution_type: module
-generated_by: 'Module::Install version 0.91'
+ ExtUtils::MakeMaker: 6.31
+ File::ShareDir::Install: 0.03
+dynamic_config: 0
+generated_by: 'Dist::Zilla version 4.101900, CPAN::Meta::Converter version 2.101670'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
name: HTML-FormHandler
-no_index:
- directory:
- - inc
- - share
- - t
requires:
Carp: 0
DateTime: 0
@@ -37,8 +32,7 @@ requires:
Try::Tiny: 0
aliased: 0
namespace::autoclean: 0.09
- perl: 5.8.0
resources:
- license: http://dev.perl.org/licenses/
- repository: http://github.com/gshank/html-formhandler/tree/master
-version: 0.32001
+ bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=HTML-FormHandler
+ repository: git://github.com/gshank/html-formhandler.git
+version: 0.32002
diff --git a/Makefile.PL b/Makefile.PL
index d960f97..a9a5c78 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -1,46 +1,75 @@
+
use strict;
use warnings;
-use inc::Module::Install 0.91;
-
-# Not strictly needed, but reminds idiots like
-# me what M::I extensions I need ;)
-use Module::Install::AuthorTests;
-
-name 'HTML-FormHandler';
-author 'Gerda Shank';
-all_from 'lib/HTML/FormHandler.pm';
-license 'perl';
-
-repository 'http://github.com/gshank/html-formhandler/tree/master';
-
-# prereqs
-requires 'Carp';
-requires 'Moose' => '0.90';
-requires 'Locale::Maketext' => '1.09';
-requires 'DateTime';
-requires 'DateTime::Format::Strptime';
-requires 'MooseX::Getopt' => '0.16';
-requires 'MooseX::Types' => '0.20';
-requires 'MooseX::Types::Common';
-requires 'MooseX::Traits';
-requires 'aliased';
-requires 'File::Spec';
-requires 'File::ShareDir';
-requires 'Try::Tiny';
-requires 'namespace::autoclean' => '0.09';
-requires 'Email::Valid';
-
-# things the tests need
-test_requires 'Test::More' => '0.88';
-test_requires 'Test::Differences';
-test_requires 'Test::Exception';
-
-tests();
-author_tests('t/xt');
-
-install_share 'share';
-
-auto_install();
-
-WriteAll();
+
+
+
+use ExtUtils::MakeMaker 6.31;
+
+use File::ShareDir::Install;
+install_share dist => "share";
+
+
+my %WriteMakefileArgs = (
+ 'ABSTRACT' => 'HTML forms using Moose',
+ 'AUTHOR' => 'FormHandler Contributors - see HTML::FormHandler',
+ 'BUILD_REQUIRES' => {
+ 'Test::Differences' => '0',
+ 'Test::Exception' => '0',
+ 'Test::More' => '0.94'
+ },
+ 'CONFIGURE_REQUIRES' => {
+ 'ExtUtils::MakeMaker' => '6.31',
+ 'File::ShareDir::Install' => '0.03'
+ },
+ 'DISTNAME' => 'HTML-FormHandler',
+ 'EXE_FILES' => [],
+ 'LICENSE' => 'perl',
+ 'NAME' => 'HTML::FormHandler',
+ 'PREREQ_PM' => {
+ 'Carp' => '0',
+ 'DateTime' => '0',
+ 'DateTime::Format::Strptime' => '0',
+ 'Email::Valid' => '0',
+ 'File::ShareDir' => '0',
+ 'File::Spec' => '0',
+ 'Locale::Maketext' => '1.09',
+ 'Moose' => '0.90',
+ 'MooseX::Getopt' => '0.16',
+ 'MooseX::Traits' => '0',
+ 'MooseX::Types' => '0.20',
+ 'MooseX::Types::Common' => '0',
+ 'Try::Tiny' => '0',
+ 'aliased' => '0',
+ 'namespace::autoclean' => '0.09'
+ },
+ 'VERSION' => '0.32002',
+ 'test' => {
+ 'TESTS' => 't/*.t'
+ }
+);
+
+
+unless ( eval { ExtUtils::MakeMaker->VERSION(6.56) } ) {
+ my $br = delete $WriteMakefileArgs{BUILD_REQUIRES};
+ my $pp = $WriteMakefileArgs{PREREQ_PM};
+ for my $mod ( keys %$br ) {
+ if ( exists $pp->{$mod} ) {
+ $pp->{$mod} = $br->{$mod} if $br->{$mod} > $pp->{$mod};
+ }
+ else {
+ $pp->{$mod} = $br->{$mod};
+ }
+ }
+}
+
+delete $WriteMakefileArgs{CONFIGURE_REQUIRES}
+ unless eval { ExtUtils::MakeMaker->VERSION(6.52) };
+
+WriteMakefile(%WriteMakefileArgs);
+
+package
+MY;
+use File::ShareDir::Install qw(postamble);
+
diff --git a/README b/README
index e7c581f..542e7c1 100644
--- a/README
+++ b/README
@@ -1,39 +1,13 @@
-HTML::FormHandler
-This package is a Moose form handler, based on Form::Processor.
-Create Perl form classes, define fields, retrieve and save to the
-database...
+This archive contains the distribution HTML-FormHandler,
+version 0.32002:
-INSTALLATION
+ HTML forms using Moose
-To install this module, run the following commands:
+This software is copyright (c) 2010 by Gerda Shank.
- perl Makefile.PL
- make
- make test
- make install
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
-EXAMPLE
-The test directory contains an example Catalyst application.
-Execute it by executing 't/script/bookdb_server.pl' from the
-distribution root directory.
-
-SUPPORT AND DOCUMENTATION
-
-After installing, you can find documentation for this module with the
-perldoc command.
-
- perldoc HTML::FormHandler::Manual
- perldoc HTML::FormHandler::Info
- perldoc HTML::FormHandler::Tutorial
- perldoc HTML::FormHandler
- perldoc HTML::FormHandler::Model::DBIC
- perldoc HTML::FormHandler::Field
-
-
-COPYRIGHT AND LICENCE
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
diff --git a/SIGNATURE b/SIGNATURE
new file mode 100644
index 0000000..fbd3b69
--- /dev/null
+++ b/SIGNATURE
@@ -0,0 +1,228 @@
+This file contains message digests of all files listed in MANIFEST,
+signed via the Module::Signature module, version 0.64.
+
+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 feb6e1f3593f1966a5fb6f5074e5c8fc87984bab Changes
+SHA1 2972c49b6d6e4d8bcc3360a734ee629ac16c6d8c INSTALL
+SHA1 2f0045ac3d6d539f73a61360de049b2f7fe349d0 LICENSE
+SHA1 0af9127c594e98a5a5b16e56399d9adde2b10fb4 MANIFEST
+SHA1 58b4ffc05840abcabe718bcc4673b20b5a2f65f2 META.json
+SHA1 cdc93c7c491952c5fb7eb68a0c61337c3ed09bc8 META.yml
+SHA1 df18136756c9f1ecb25a0f74881ce07f82be1a29 Makefile.PL
+SHA1 e481498ef7f46af601d06f3395ac1f59d5671d62 README
+SHA1 9c75a76544c78425259a49fd974062c1a0513ffc TODO
+SHA1 307bf1c64347fc77b9dc4c8aafffafcfaa427457 dist.ini
+SHA1 0781d339fca5b49733622f570d677fb20532d509 lib/HTML/FormHandler.pm
+SHA1 a4793e8d2b4140b7dd139f5031026da749bffc21 lib/HTML/FormHandler/BuildFields.pm
+SHA1 c65c56c0559125f727254eeeccfd667e32db26ab lib/HTML/FormHandler/Field.pm
+SHA1 903357ae45db9e26b614c845bd482c9c67f71138 lib/HTML/FormHandler/Field/Boolean.pm
+SHA1 3b376865a74055aa8f68ac1c01a52c0911e4abe7 lib/HTML/FormHandler/Field/Captcha.pm
+SHA1 4796609e9f116b2610a189e38824c15f2bb4fd1f lib/HTML/FormHandler/Field/Checkbox.pm
+SHA1 90bf4c3778324b0921baac5aa73929abed766dfa lib/HTML/FormHandler/Field/Compound.pm
+SHA1 400fd1bfe092c79fe643d7ce65bee6d57e2a6e4e lib/HTML/FormHandler/Field/Date.pm
+SHA1 e2ef337ac4b3d3ed929156fbbee02b667e9c8d1b lib/HTML/FormHandler/Field/DateMDY.pm
+SHA1 4bea2fcb517e943c21d8848af517a0ca612d1e95 lib/HTML/FormHandler/Field/DateTime.pm
+SHA1 dadf32ba0a10a470c0eefae21a1deb9b0bed0957 lib/HTML/FormHandler/Field/Display.pm
+SHA1 3537cf8e60e6f876ab52b891834eb5d35bf59f98 lib/HTML/FormHandler/Field/Duration.pm
+SHA1 168574b59bf2962990367f6e0bd2fbd57af1e93e lib/HTML/FormHandler/Field/Email.pm
+SHA1 01e39d6f7bb3710106f93298f522ede7797182f2 lib/HTML/FormHandler/Field/Hidden.pm
+SHA1 eed077ba942210d231c997f41ba1d3e775dd1eaf lib/HTML/FormHandler/Field/Hour.pm
+SHA1 78649863a06cea3af74500d2b19c550a395ae7dd lib/HTML/FormHandler/Field/HtmlArea.pm
+SHA1 669237b02d31840995833dca9179971c541a0029 lib/HTML/FormHandler/Field/IntRange.pm
+SHA1 d1c178824d291ec2de721a588be9b716633efa92 lib/HTML/FormHandler/Field/Integer.pm
+SHA1 d96df7c04462be0baa4f76f3e6a74fc9f1b9fd35 lib/HTML/FormHandler/Field/Minute.pm
+SHA1 55adf34a6b6b62fd31b821c0d04c585077a7ad48 lib/HTML/FormHandler/Field/Money.pm
+SHA1 67fa840027a98da29887d18d6e2c2e0a1f6b22dd lib/HTML/FormHandler/Field/Month.pm
+SHA1 378c16547800ac29af1a408b197ac05321c68582 lib/HTML/FormHandler/Field/MonthDay.pm
+SHA1 d6125b0d9a40215f0d3cee8f6714ccc708f0ee26 lib/HTML/FormHandler/Field/MonthName.pm
+SHA1 ae14733508693ab5c37b5ff1fafdd2e66861f652 lib/HTML/FormHandler/Field/Multiple.pm
+SHA1 2b505c86740f383e66f0b363769784f617e2c175 lib/HTML/FormHandler/Field/Nested.pm
+SHA1 c89e51bb049326fbf6a738318d8c8bd3576bfbff lib/HTML/FormHandler/Field/NoValue.pm
+SHA1 ea55e69242126f52dcda0154e3b4d3f96c34f331 lib/HTML/FormHandler/Field/Password.pm
+SHA1 0ee95e6ebed1f2344bb0bba2bbdf914656fcdb48 lib/HTML/FormHandler/Field/PasswordConf.pm
+SHA1 615c6b856e8c495be4bd8d566333ec0b7a5e565c lib/HTML/FormHandler/Field/PosInteger.pm
+SHA1 0de6e6ebb583b9f032a829f8014009a2ae956113 lib/HTML/FormHandler/Field/PrimaryKey.pm
+SHA1 05d4ee22723fb2ae5834e0e9bad32b18e0096044 lib/HTML/FormHandler/Field/Radio.pm
+SHA1 16f27f8eaad0abc942768efbfda2169d0d27abe4 lib/HTML/FormHandler/Field/Repeatable.pm
+SHA1 b1f0d9f3cdf48ba8f570f5d6424d0915613238bb lib/HTML/FormHandler/Field/Repeatable/Instance.pm
+SHA1 8cd6221daa190ec08b4183ac95bd8ab9452d0e7a lib/HTML/FormHandler/Field/Reset.pm
+SHA1 a97808314dda104e6675d4cfeba93a9e09d8b628 lib/HTML/FormHandler/Field/Result.pm
+SHA1 3994d252b1bcfde5ed9c00307c66496c645d2ea1 lib/HTML/FormHandler/Field/Second.pm
+SHA1 a97422b2603e3fb38f270786786991c390f7cd83 lib/HTML/FormHandler/Field/Select.pm
+SHA1 cd987e91a27ed748d70c722abca40371436c7ba0 lib/HTML/FormHandler/Field/Submit.pm
+SHA1 16b3f69c95c5c18c0f72792678b7c9ce18201b46 lib/HTML/FormHandler/Field/Text.pm
+SHA1 5673673fe4faf26ab281cdd442f525df6bb05081 lib/HTML/FormHandler/Field/TextArea.pm
+SHA1 a6d3d51360129fb9381038d1ffa8924ac59cfb10 lib/HTML/FormHandler/Field/Upload.pm
+SHA1 b79818fecf5bcf830f5e43f50f10830716ba7bc0 lib/HTML/FormHandler/Field/Weekday.pm
+SHA1 7f3d1d262f0f3180fae64feef9c1ef19100885dd lib/HTML/FormHandler/Field/Year.pm
+SHA1 59e8105e21dcba7482c5f5b1347c9f2a3c05fcea lib/HTML/FormHandler/Fields.pm
+SHA1 4fe33a1c120ef6f8c8d8a96620ccdf67092413b7 lib/HTML/FormHandler/I18N.pm
+SHA1 3420b6d87378ef61a25ce305041ddba0009712fe lib/HTML/FormHandler/I18N/de_de.pm
+SHA1 1cc2a1a163bd94c65bc166a93a717c3cd177fb46 lib/HTML/FormHandler/I18N/en_us.pm
+SHA1 22765405cfe9df0aecff007499a0f65b8bc0b695 lib/HTML/FormHandler/I18N/hu_hu.pm
+SHA1 c06300be8ae61ee9e057fe5143cfcc15f8104326 lib/HTML/FormHandler/I18N/ru_ru.pm
+SHA1 b91cc0e2e88ab56525f6418bf63a12c57cb73a86 lib/HTML/FormHandler/I18N/tr_tr.pm
+SHA1 97dd4ddd6a13fe80c27032f399938a294c2b13c4 lib/HTML/FormHandler/I18N/ua_ua.pm
+SHA1 bb427d9d0f7951a99f654ed65e5264b582c3aff5 lib/HTML/FormHandler/InitResult.pm
+SHA1 689f6551c094e7d06c022822eca754643b7a59e3 lib/HTML/FormHandler/Manual.pod
+SHA1 02f1254fd333fde388f9b903ddccfeed5f48f6d5 lib/HTML/FormHandler/Manual/Catalyst.pod
+SHA1 af1e205b87a3b29045b46eb50822fe060b33a41b lib/HTML/FormHandler/Manual/Cookbook.pod
+SHA1 12c1e76c98387b23d3393c3eb80362a5caeac4d2 lib/HTML/FormHandler/Manual/Intro.pod
+SHA1 57d909d03a4ccfab581e21796bbdf796135c9498 lib/HTML/FormHandler/Manual/Reference.pod
+SHA1 c9f6cb28bafa82b53ceb57ac0d51abcfec13b0cf lib/HTML/FormHandler/Manual/Rendering.pod
+SHA1 977affffed7b2a8a3125c436b8562a560e347858 lib/HTML/FormHandler/Manual/Templates.pod
+SHA1 f419a47636bb22e0b12938ea2cec9c2696bc6862 lib/HTML/FormHandler/Manual/Tutorial.pod
+SHA1 3fe1e1ac2285e1f4a55e3b687fdf070e31d60201 lib/HTML/FormHandler/Meta/Role.pm
+SHA1 5fa25cfe0118deae3a05ba268404d8d587ace2d1 lib/HTML/FormHandler/Model.pm
+SHA1 d2b4af48df328655d3c007fe147ceded3e4f818e lib/HTML/FormHandler/Model/CDBI.pm
+SHA1 3c9bd5591f9652648f0c03dcfd80dadf606e8b02 lib/HTML/FormHandler/Model/Object.pm
+SHA1 ec87399c2f1009b99af8a4ff90d80ddec53c2414 lib/HTML/FormHandler/Moose.pm
+SHA1 03da21623030adedc6903104ce3fea662409bc23 lib/HTML/FormHandler/Moose/Role.pm
+SHA1 7e861a39fc48fb2e421fa29bee9dbf0bdbff8b09 lib/HTML/FormHandler/Params.pm
+SHA1 eb2d6cf68aa213ad0d841e7bd4fa6274f4d48617 lib/HTML/FormHandler/Render/Simple.pm
+SHA1 f7c134cf528363e65722b1795a3121ec21bf8c13 lib/HTML/FormHandler/Render/Table.pm
+SHA1 8361fc4dbaa5f7c4029d369493ba32ace56fb3f0 lib/HTML/FormHandler/Render/WithTT.pm
+SHA1 3a5efd690b959f8bb59b34ca69d03a4b8d948474 lib/HTML/FormHandler/Result.pm
+SHA1 a922a8084e2676a1aeec1ea951c3ad19f8582115 lib/HTML/FormHandler/Result/Role.pm
+SHA1 6b3470947b1a214df59eb3aa61dfcc5e487a1734 lib/HTML/FormHandler/TraitFor/Captcha.pm
+SHA1 c7eeb3a09409da5b2f7f9d7c27a8187d067b798c lib/HTML/FormHandler/TraitFor/I18N.pm
+SHA1 6fcc4d32280169b3e4c4ac47aecebf42852b83b5 lib/HTML/FormHandler/Types.pm
+SHA1 ad8ec7d0c91226a53b706b620e0608b9832c5f06 lib/HTML/FormHandler/Validate.pm
+SHA1 17db3158711114c582d7506409501e4ec4042691 lib/HTML/FormHandler/Validate/Actions.pm
+SHA1 71653fa3fecf0ae59c352c0ede751be0a46d2c6a lib/HTML/FormHandler/Widget/ApplyRole.pm
+SHA1 a80e592b54d731e601fc73952901abf5f2d377e2 lib/HTML/FormHandler/Widget/Field/Checkbox.pm
+SHA1 3b623af5d8827acf630dd45f34c0db399a5f3483 lib/HTML/FormHandler/Widget/Field/CheckboxGroup.pm
+SHA1 448000f2c179d4a3dcf60cfcfddc28bbdb500cae lib/HTML/FormHandler/Widget/Field/Compound.pm
+SHA1 e001e30df024cb8e9ceeef5fbff70f2bdd69c0ce lib/HTML/FormHandler/Widget/Field/Hidden.pm
+SHA1 74fec8dcc260316d73d7523a1feb8525400e762d lib/HTML/FormHandler/Widget/Field/NoRender.pm
+SHA1 5f593a091f58b6990a5d21920dee7571ed8b21e1 lib/HTML/FormHandler/Widget/Field/Password.pm
+SHA1 0e80bd2564fa9a97c69c7e39c28479a809d750d5 lib/HTML/FormHandler/Widget/Field/RadioGroup.pm
+SHA1 db4f51279e90dd25ffd7c82f181be7699a125cbc lib/HTML/FormHandler/Widget/Field/Reset.pm
+SHA1 de0a4b35dd460635b29540f1b8be4d444ea50c87 lib/HTML/FormHandler/Widget/Field/Role/HTMLAttributes.pm
+SHA1 b1d3539a19d11e28a435df711fa6c2503576bb1e lib/HTML/FormHandler/Widget/Field/Role/SelectedOption.pm
+SHA1 5f4391d0a1898b9ebacfc0b87aae993d7b7e1743 lib/HTML/FormHandler/Widget/Field/Select.pm
+SHA1 a6a11f16e930924120895d1b8de5f3560e70c641 lib/HTML/FormHandler/Widget/Field/Submit.pm
+SHA1 cfcd7f2ef1b60d3513ba53198e65c0464ca5c6ca lib/HTML/FormHandler/Widget/Field/Text.pm
+SHA1 1c13ba46f58a0c2dad71f4bd4f1240c6ab908d32 lib/HTML/FormHandler/Widget/Field/Textarea.pm
+SHA1 86106ca28ee26253589b32303d336495e7899493 lib/HTML/FormHandler/Widget/Field/Upload.pm
+SHA1 be92f7254a1fec11ecc7132ee12ef5ca435a97bf lib/HTML/FormHandler/Widget/Form/Role/HTMLAttributes.pm
+SHA1 46c17913a98ded1659de331c6a241016ea09d236 lib/HTML/FormHandler/Widget/Form/Simple.pm
+SHA1 dcc184115aa7b056c0ad8b3822178155c1efc814 lib/HTML/FormHandler/Widget/Form/Table.pm
+SHA1 ac3ad5a7be8bda098d8ace6a8ea6f4f78a65f676 lib/HTML/FormHandler/Widget/Wrapper/Base.pm
+SHA1 475120b6c788d2e720643ad245181fbe0135ef7e lib/HTML/FormHandler/Widget/Wrapper/Fieldset.pm
+SHA1 c11af5b5791e035facc9654828e2f57e7e20e0e7 lib/HTML/FormHandler/Widget/Wrapper/None.pm
+SHA1 b45de0a0dbb923d041812a1a0dd1d863aae8bab8 lib/HTML/FormHandler/Widget/Wrapper/Simple.pm
+SHA1 e5e809eea61b4f8fad2b1116c23dba9d658d17e9 lib/HTML/FormHandler/Widget/Wrapper/Table.pm
+SHA1 2feb6b79d4067908ddbd31bcc3b16b5c985c7317 share/templates/form.tt
+SHA1 23b56c71b85d991822f9aee41b212ff5a771711d share/templates/widget/checkbox.tt
+SHA1 fcb97b2707338a4b5885726e4b4462fd74768b17 share/templates/widget/checkbox_group.tt
+SHA1 90d389dd6cd2ad7431f9172a225eea49975a3712 share/templates/widget/form_end.tt
+SHA1 6988f53072d48710a1b7eb10997e58bc8af220a3 share/templates/widget/form_start.tt
+SHA1 429a481ec5a395959d619cb940954e56fa42eb86 share/templates/widget/hidden.tt
+SHA1 1dc889eb15f211e0663b498083e7ffac41c44ca4 share/templates/widget/password.tt
+SHA1 174e324ccf935ff10889a3de30b59356ef567279 share/templates/widget/radio.tt
+SHA1 370fee1cd39c16bbec2fe1746f476d889e8d7a07 share/templates/widget/radio_group.tt
+SHA1 58b53530fc90f7237897580f47cc02de9a69ae2a share/templates/widget/reset.tt
+SHA1 5405aaa2053d19d44566c1e83466e7c78767d963 share/templates/widget/select.tt
+SHA1 d525ff967a087f6088ae9afeb3ee43a667dd82aa share/templates/widget/submit.tt
+SHA1 8d4ccfa26ab2f9a99cd09c62b9afa3e97414fed1 share/templates/widget/text.tt
+SHA1 b5caf79791036188da09eb6f687fda432f908657 share/templates/widget/textarea.tt
+SHA1 95a5a44cf72244e6abebd50fa7dc666440c625e7 share/templates/widget/upload.tt
+SHA1 d55b2da9ebb18c4da78ae398a555d19728397acd t/01app.t
+SHA1 55d1bdda5802314b2776313c5596457765760a4c t/compound_field.t
+SHA1 63a3bd0ebf48c22b80580855e4d3686d682c9bb2 t/constraints.t
+SHA1 729313e191dfbddf008b5eedfd09da882f90aea7 t/dates.t
+SHA1 36e12a9de094f9904ca317b86b5667c077f5a385 t/defaults.t
+SHA1 f0c7b7e1de8669c7dda7fcbfc88c88ee83e558f9 t/deflate.t
+SHA1 67c6959a7f2136798c11e7b7c13a2dd339108f86 t/dependency.t
+SHA1 f6d1ddf31d2715bc0e0fae057905658bd9234cb1 t/dynamic.t
+SHA1 2a798b1a06c3df4c26da3db0afa5eea62c8ca940 t/errors.t
+SHA1 84cbaf51c785a855f86e09a75810826b013b74ff t/field_item.t
+SHA1 73a9fe74f86d851787f7a6ce2e860b4a17650581 t/field_traits.t
+SHA1 9df70077085901fa5697d58e3929c17c16f367ac t/field_types.t
+SHA1 0bf74106226b8540eca68f73c1e19b06a513a6f3 t/fields.t
+SHA1 e77fc6b8b02f7517e07abbaa963390d58b0d2029 t/filters.t
+SHA1 b8ce2f9814e414da829683045d0d414f0b54363b t/form_handler.t
+SHA1 91971cf0d90f5138c4b77931a4bb8bc6658fbed5 t/form_options.t
+SHA1 1c7e3714c63b6ca0f42bad837b9fde746bcfac2c t/formhandlerx.t
+SHA1 7ff46198ffd967b30d0999b10ff80fc08bef0770 t/has_field.t
+SHA1 8b58baf90cdbb31f699df1b01343bb008e046f82 t/has_field_arrayref.t
+SHA1 2d46deaf5c835cf0f529b652ec636f22922d57c5 t/has_many.t
+SHA1 aa4a9e0874d75eac8c0043c5e0b72dec20fa0d24 t/inactive_fields.t
+SHA1 fb297b94153e3ade8357c818a45e13c72f682388 t/input_param.t
+SHA1 e330f72586852fb7f18c444008ab792c3e04b6c6 t/lib/BookDB/Form/Upload.pm
+SHA1 f5a80fcbc4f14894c274ea1e896067cc45143312 t/lib/Field/Address.pm
+SHA1 df80db13f94fe5044c995228ade46b8cd341045e t/lib/Field/AltText.pm
+SHA1 498e59d660a0b78b32565494484cb75ce9cad9c3 t/lib/Field/MyField.pm
+SHA1 3de5695a354809ff50f2900d257ec7eb195f9db7 t/lib/Form/Address.pm
+SHA1 3fa8edbecc482588a667d4ff0f938da4ab60b3c6 t/lib/Form/AddressRole.pm
+SHA1 37ae2600a3998048b253de1e96ee7b7d7597281c t/lib/Form/Multiple.pm
+SHA1 f01a56814525ff213d829b7499bbfef06fc90538 t/lib/Form/MultipleRole.pm
+SHA1 57980c0769902ece4b82df31477998582842d202 t/lib/Form/MyForm.pm
+SHA1 58469593246683e39a8fa3bdcf07b2669c9cb59a t/lib/Form/Person.pm
+SHA1 51ceda9acbd63d49a81a959adc27285a42e5ff27 t/lib/Form/PersonRole.pm
+SHA1 94cd172b90fd02eab01eb6e528c9e701eb914fd1 t/lib/Form/Test.pm
+SHA1 d6ce4712417f325870983a7e6f7d07e52c10974f t/lib/Form/Two.pm
+SHA1 5239c744281b45b5ee49e4498fe5a04822ea1766 t/lib/MyApp/I18N/abc_de.pm
+SHA1 364e324607d74434dc26938a08fec784de110737 t/lib/Widget/Field/Omega.pm
+SHA1 7d6fdb503d9aee63eb6a79ec86d33997faf8b383 t/lib/Widget/Field/TestWidget.pm
+SHA1 93da15018b5e39aa349e81fcfe9b9dd37e5073b3 t/list.t
+SHA1 25e1dda1023f0848fef1dc558ef2d683b34f405d t/password.t
+SHA1 a032c41ef6887fab1b900669c2d304fab46680e2 t/release-eol.t
+SHA1 455d1dd1867212a665ad5ea4126b572411de300c t/release-no-tabs.t
+SHA1 69dbdb1d8fa47aabd291d35f5b486e718fc19945 t/render.t
+SHA1 c6cdb5c199c670394b1de572c1dabd1dc10261bf t/render_escaping.t
+SHA1 3b93fbc53bee0a83895a9fef1af271e8b829ab4b t/render_filter.t
+SHA1 bef13448710957b177666eff70a58673a1b38b7d t/render_html_attributes.t
+SHA1 d982d9e380c9d73992708f2ed7da728dcbf0812e t/render_result.t
+SHA1 8b405631abeae7f814d923852ff6821eeea6b33f t/render_table.t
+SHA1 b9e56c9c08538a3a0b2d9acbdf6877ff2c51ecd1 t/render_widgets.t
+SHA1 45d0a4731cdcd4bc710666d848651aa262cdd231 t/render_withtt.t
+SHA1 3422cd5aac318955cd48a51439875bcf859e9043 t/result.t
+SHA1 24b760833e98e72c96a41ab615568f825b0c358b t/result_compound.t
+SHA1 012cd90b089d1a5e72cd31888196f83b15a6d6cb t/result_errors.t
+SHA1 4e0c80d184e11d48fcde61196cbad8c3ec01b42c t/structured.t
+SHA1 cae641d84198165b59f0fb64afe9d51e6d6399bf t/types.t
+SHA1 6cce9e7c03f78f5e2a6267b0fde58ee35f43389e t/update_fields.t
+SHA1 60761cd04a6350433097c91e438bef74f5ca53b7 t/validate_coderef.t
+SHA1 86d255a7c9f065a13049108362c949b3e35a4c24 xt/02pod.t
+SHA1 65ca268d24f92823c6a33fcbe7640857315e0d0e xt/add_field.t
+SHA1 600ea74fbeb3c59afad08b7dff438d4f9d5d2450 xt/captcha.t
+SHA1 a536583356d1f37258e77d8bae3491bd3b36793e xt/chbox_group.t
+SHA1 2148bb20efb65181d062d0906e4d10a904735e2f xt/check_selected_option.t
+SHA1 1edadbbec253933b48f5185dc9c367acb8472163 xt/custom_fields.t
+SHA1 4e292478d5ce0ba4b4dc98cfffd15d767e442378 xt/display.t
+SHA1 3124c65018e4812e680ef3f807303da6e1570dda xt/email.t
+SHA1 3478fc0cdcffd303724af959297ee1d14301f7b2 xt/field_list.t
+SHA1 e0bae1206838fa9f79e11899182601e1ede46176 xt/form_errors.t
+SHA1 c08a4366a8d2aad7ac677541352d5ea3cd708043 xt/init.t
+SHA1 d02a4b95dfe88f5b748acdcd1efda6f4c53012d5 xt/load_field.t
+SHA1 0b8a7db1f4dd8e7d0821306ee49b6c694ea9b271 xt/locale.t
+SHA1 183db3551cff148adc7d611af316f3739953afec xt/locale_data_localize.t
+SHA1 db6e66c79f25cdcf6435f021499473475fdb15a1 xt/mb_form.t
+SHA1 1ce3a2c875d974a0f81e1233be575386a1bc5612 xt/model_cdbi.t
+SHA1 a4127156e8dad3f81624bf6b5f5683931f76f88f xt/multiple_forms.t
+SHA1 94f2ae2ffc6b9e178bf144604b2b68d94af2ecb3 xt/order.t
+SHA1 b89aefcbbc7f6fbb350932bdedd031b15c66cb9f xt/params.t
+SHA1 bcdfea6b8c310cc9197cd6ec4490c8928f4bcd04 xt/posted.t
+SHA1 20c7b6c7d010135e36243abf8f7524f1505cf2f7 xt/submit.t
+SHA1 22ea39accc783bdcaf2d27970ffffcbaa5a4744d xt/upload.t
+-----BEGIN PGP SIGNATURE-----
+Version: GnuPG v1.4.10 (Darwin)
+
+iF4EAREIAAYFAkxRoAEACgkQlX0ZOkgCucjixgD/Wwnk2A2m3VMlzkkJcaX20Kh/
+XKKm2LjUKRc60sWf0KYA/A4BNlvQMRdSvUxjw5KVuIOcH5YL5g2t7qNwlw+pT/xa
+=+0Dp
+-----END PGP SIGNATURE-----
diff --git a/dist.ini b/dist.ini
new file mode 100644
index 0000000..cf864f2
--- /dev/null
+++ b/dist.ini
@@ -0,0 +1,56 @@
+; Everything starting with ';' is a comment
+
+name = HTML-FormHandler
+author = FormHandler Contributors - see HTML::FormHandler
+license = Perl_5
+copyright_holder = Gerda Shank
+copyright_year = 2010
+
+version = 0.32002
+
+[@Basic]
+[InstallGuide]
+[MetaJSON]
+
+[MetaResources]
+bugtracker.web = https://rt.cpan.org/Public/Dist/Display.html?Name=HTML-FormHandler
+bugtracker.mailto = bug-HTML-FormHandler at rt.cpan.org
+
+; If you have a repository...
+repository.url = git://github.com/gshank/html-formhandler.git
+repository.web = http://github.com/gshank/html-formhandler
+repository.type = git
+
+; You have to have Dist::Zilla::Plugin::<Name> for these to work
+[PodWeaver]
+[NoTabsTests]
+[EOLTests]
+[Signature]
+[CheckChangeLog]
+
+[Prereq]
+Carp = 0
+Moose = 0.90
+Locale::Maketext = 1.09
+DateTime = 0
+DateTime::Format::Strptime = 0
+MooseX::Getopt = 0.16
+MooseX::Types = 0.20
+MooseX::Types::Common = 0
+MooseX::Traits = 0
+aliased = 0
+File::Spec = 0
+File::ShareDir = 0
+Try::Tiny = 0
+namespace::autoclean = 0.09
+Email::Valid = 0
+
+[Prereq / TestRequires]
+Test::More = 0.94
+Test::Differences = 0
+Test::Exception = 0
+
+; If you're using git, this is interesting
+; You need to install Dist::Zilla::PluginBundle::Git
+[@Git]
+
diff --git a/inc/Module/AutoInstall.pm b/inc/Module/AutoInstall.pm
deleted file mode 100644
index dfb8ef7..0000000
--- a/inc/Module/AutoInstall.pm
+++ /dev/null
@@ -1,805 +0,0 @@
-#line 1
-package Module::AutoInstall;
-
-use strict;
-use Cwd ();
-use ExtUtils::MakeMaker ();
-
-use vars qw{$VERSION};
-BEGIN {
- $VERSION = '1.03';
-}
-
-# special map on pre-defined feature sets
-my %FeatureMap = (
- '' => 'Core Features', # XXX: deprecated
- '-core' => 'Core Features',
-);
-
-# various lexical flags
-my ( @Missing, @Existing, %DisabledTests, $UnderCPAN, $HasCPANPLUS );
-my (
- $Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly, $AllDeps
-);
-my ( $PostambleActions, $PostambleUsed );
-
-# See if it's a testing or non-interactive session
-_accept_default( $ENV{AUTOMATED_TESTING} or ! -t STDIN );
-_init();
-
-sub _accept_default {
- $AcceptDefault = shift;
-}
-
-sub missing_modules {
- return @Missing;
-}
-
-sub do_install {
- __PACKAGE__->install(
- [
- $Config
- ? ( UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
- : ()
- ],
- @Missing,
- );
-}
-
-# initialize various flags, and/or perform install
-sub _init {
- foreach my $arg (
- @ARGV,
- split(
- /[\s\t]+/,
- $ENV{PERL_AUTOINSTALL} || $ENV{PERL_EXTUTILS_AUTOINSTALL} || ''
- )
- )
- {
- if ( $arg =~ /^--config=(.*)$/ ) {
- $Config = [ split( ',', $1 ) ];
- }
- elsif ( $arg =~ /^--installdeps=(.*)$/ ) {
- __PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) );
- exit 0;
- }
- elsif ( $arg =~ /^--default(?:deps)?$/ ) {
- $AcceptDefault = 1;
- }
- elsif ( $arg =~ /^--check(?:deps)?$/ ) {
- $CheckOnly = 1;
- }
- elsif ( $arg =~ /^--skip(?:deps)?$/ ) {
- $SkipInstall = 1;
- }
- elsif ( $arg =~ /^--test(?:only)?$/ ) {
- $TestOnly = 1;
- }
- elsif ( $arg =~ /^--all(?:deps)?$/ ) {
- $AllDeps = 1;
- }
- }
-}
-
-# overrides MakeMaker's prompt() to automatically accept the default choice
-sub _prompt {
- goto &ExtUtils::MakeMaker::prompt unless $AcceptDefault;
-
- my ( $prompt, $default ) = @_;
- my $y = ( $default =~ /^[Yy]/ );
-
- print $prompt, ' [', ( $y ? 'Y' : 'y' ), '/', ( $y ? 'n' : 'N' ), '] ';
- print "$default\n";
- return $default;
-}
-
-# the workhorse
-sub import {
- my $class = shift;
- my @args = @_ or return;
- my $core_all;
-
- print "*** $class version " . $class->VERSION . "\n";
- print "*** Checking for Perl dependencies...\n";
-
- my $cwd = Cwd::cwd();
-
- $Config = [];
-
- my $maxlen = length(
- (
- sort { length($b) <=> length($a) }
- grep { /^[^\-]/ }
- map {
- ref($_)
- ? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} )
- : ''
- }
- map { +{@args}->{$_} }
- grep { /^[^\-]/ or /^-core$/i } keys %{ +{@args} }
- )[0]
- );
-
- # We want to know if we're under CPAN early to avoid prompting, but
- # if we aren't going to try and install anything anyway then skip the
- # check entirely since we don't want to have to load (and configure)
- # an old CPAN just for a cosmetic message
-
- $UnderCPAN = _check_lock(1) unless $SkipInstall;
-
- while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) {
- my ( @required, @tests, @skiptests );
- my $default = 1;
- my $conflict = 0;
-
- if ( $feature =~ m/^-(\w+)$/ ) {
- my $option = lc($1);
-
- # check for a newer version of myself
- _update_to( $modules, @_ ) and return if $option eq 'version';
-
- # sets CPAN configuration options
- $Config = $modules if $option eq 'config';
-
- # promote every features to core status
- $core_all = ( $modules =~ /^all$/i ) and next
- if $option eq 'core';
-
- next unless $option eq 'core';
- }
-
- print "[" . ( $FeatureMap{ lc($feature) } || $feature ) . "]\n";
-
- $modules = [ %{$modules} ] if UNIVERSAL::isa( $modules, 'HASH' );
-
- unshift @$modules, -default => &{ shift(@$modules) }
- if ( ref( $modules->[0] ) eq 'CODE' ); # XXX: bugward combatability
-
- while ( my ( $mod, $arg ) = splice( @$modules, 0, 2 ) ) {
- if ( $mod =~ m/^-(\w+)$/ ) {
- my $option = lc($1);
-
- $default = $arg if ( $option eq 'default' );
- $conflict = $arg if ( $option eq 'conflict' );
- @tests = @{$arg} if ( $option eq 'tests' );
- @skiptests = @{$arg} if ( $option eq 'skiptests' );
-
- next;
- }
-
- printf( "- %-${maxlen}s ...", $mod );
-
- if ( $arg and $arg =~ /^\D/ ) {
- unshift @$modules, $arg;
- $arg = 0;
- }
-
- # XXX: check for conflicts and uninstalls(!) them.
- my $cur = _load($mod);
- if (_version_cmp ($cur, $arg) >= 0)
- {
- print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n";
- push @Existing, $mod => $arg;
- $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
- }
- else {
- if (not defined $cur) # indeed missing
- {
- print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n";
- }
- else
- {
- # no need to check $arg as _version_cmp ($cur, undef) would satisfy >= above
- print "too old. ($cur < $arg)\n";
- }
-
- push @required, $mod => $arg;
- }
- }
-
- next unless @required;
-
- my $mandatory = ( $feature eq '-core' or $core_all );
-
- if (
- !$SkipInstall
- and (
- $CheckOnly
- or ($mandatory and $UnderCPAN)
- or $AllDeps
- or _prompt(
- qq{==> Auto-install the }
- . ( @required / 2 )
- . ( $mandatory ? ' mandatory' : ' optional' )
- . qq{ module(s) from CPAN?},
- $default ? 'y' : 'n',
- ) =~ /^[Yy]/
- )
- )
- {
- push( @Missing, @required );
- $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
- }
-
- elsif ( !$SkipInstall
- and $default
- and $mandatory
- and
- _prompt( qq{==> The module(s) are mandatory! Really skip?}, 'n', )
- =~ /^[Nn]/ )
- {
- push( @Missing, @required );
- $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
- }
-
- else {
- $DisabledTests{$_} = 1 for map { glob($_) } @tests;
- }
- }
-
- if ( @Missing and not( $CheckOnly or $UnderCPAN ) ) {
- require Config;
- print
-"*** Dependencies will be installed the next time you type '$Config::Config{make}'.\n";
-
- # make an educated guess of whether we'll need root permission.
- print " (You may need to do that as the 'root' user.)\n"
- if eval '$>';
- }
- print "*** $class configuration finished.\n";
-
- chdir $cwd;
-
- # import to main::
- no strict 'refs';
- *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';
-}
-
-sub _running_under {
- my $thing = shift;
- print <<"END_MESSAGE";
-*** Since we're running under ${thing}, I'll just let it take care
- of the dependency's installation later.
-END_MESSAGE
- return 1;
-}
-
-# Check to see if we are currently running under CPAN.pm and/or CPANPLUS;
-# if we are, then we simply let it taking care of our dependencies
-sub _check_lock {
- return unless @Missing or @_;
-
- my $cpan_env = $ENV{PERL5_CPAN_IS_RUNNING};
-
- if ($ENV{PERL5_CPANPLUS_IS_RUNNING}) {
- return _running_under($cpan_env ? 'CPAN' : 'CPANPLUS');
- }
-
- require CPAN;
-
- if ($CPAN::VERSION > '1.89') {
- if ($cpan_env) {
- return _running_under('CPAN');
- }
- return; # CPAN.pm new enough, don't need to check further
- }
-
- # last ditch attempt, this -will- configure CPAN, very sorry
-
- _load_cpan(1); # force initialize even though it's already loaded
-
- # Find the CPAN lock-file
- my $lock = MM->catfile( $CPAN::Config->{cpan_home}, ".lock" );
- return unless -f $lock;
-
- # Check the lock
- local *LOCK;
- return unless open(LOCK, $lock);
-
- if (
- ( $^O eq 'MSWin32' ? _under_cpan() : <LOCK> == getppid() )
- and ( $CPAN::Config->{prerequisites_policy} || '' ) ne 'ignore'
- ) {
- print <<'END_MESSAGE';
-
-*** Since we're running under CPAN, I'll just let it take care
- of the dependency's installation later.
-END_MESSAGE
- return 1;
- }
-
- close LOCK;
- return;
-}
-
-sub install {
- my $class = shift;
-
- my $i; # used below to strip leading '-' from config keys
- my @config = ( map { s/^-// if ++$i; $_ } @{ +shift } );
-
- my ( @modules, @installed );
- while ( my ( $pkg, $ver ) = splice( @_, 0, 2 ) ) {
-
- # grep out those already installed
- if ( _version_cmp( _load($pkg), $ver ) >= 0 ) {
- push @installed, $pkg;
- }
- else {
- push @modules, $pkg, $ver;
- }
- }
-
- return @installed unless @modules; # nothing to do
- return @installed if _check_lock(); # defer to the CPAN shell
-
- print "*** Installing dependencies...\n";
-
- return unless _connected_to('cpan.org');
-
- my %args = @config;
- my %failed;
- local *FAILED;
- if ( $args{do_once} and open( FAILED, '.#autoinstall.failed' ) ) {
- while (<FAILED>) { chomp; $failed{$_}++ }
- close FAILED;
-
- my @newmod;
- while ( my ( $k, $v ) = splice( @modules, 0, 2 ) ) {
- push @newmod, ( $k => $v ) unless $failed{$k};
- }
- @modules = @newmod;
- }
-
- if ( _has_cpanplus() and not $ENV{PERL_AUTOINSTALL_PREFER_CPAN} ) {
- _install_cpanplus( \@modules, \@config );
- } else {
- _install_cpan( \@modules, \@config );
- }
-
- print "*** $class installation finished.\n";
-
- # see if we have successfully installed them
- while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
- if ( _version_cmp( _load($pkg), $ver ) >= 0 ) {
- push @installed, $pkg;
- }
- elsif ( $args{do_once} and open( FAILED, '>> .#autoinstall.failed' ) ) {
- print FAILED "$pkg\n";
- }
- }
-
- close FAILED if $args{do_once};
-
- return @installed;
-}
-
-sub _install_cpanplus {
- my @modules = @{ +shift };
- my @config = _cpanplus_config( @{ +shift } );
- my $installed = 0;
-
- require CPANPLUS::Backend;
- my $cp = CPANPLUS::Backend->new;
- my $conf = $cp->configure_object;
-
- return unless $conf->can('conf') # 0.05x+ with "sudo" support
- or _can_write($conf->_get_build('base')); # 0.04x
-
- # if we're root, set UNINST=1 to avoid trouble unless user asked for it.
- my $makeflags = $conf->get_conf('makeflags') || '';
- if ( UNIVERSAL::isa( $makeflags, 'HASH' ) ) {
- # 0.03+ uses a hashref here
- $makeflags->{UNINST} = 1 unless exists $makeflags->{UNINST};
-
- } else {
- # 0.02 and below uses a scalar
- $makeflags = join( ' ', split( ' ', $makeflags ), 'UNINST=1' )
- if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } );
-
- }
- $conf->set_conf( makeflags => $makeflags );
- $conf->set_conf( prereqs => 1 );
-
-
-
- while ( my ( $key, $val ) = splice( @config, 0, 2 ) ) {
- $conf->set_conf( $key, $val );
- }
-
- my $modtree = $cp->module_tree;
- while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
- print "*** Installing $pkg...\n";
-
- MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall;
-
- my $success;
- my $obj = $modtree->{$pkg};
-
- if ( $obj and _version_cmp( $obj->{version}, $ver ) >= 0 ) {
- my $pathname = $pkg;
- $pathname =~ s/::/\\W/;
-
- foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) {
- delete $INC{$inc};
- }
-
- my $rv = $cp->install( modules => [ $obj->{module} ] );
-
- if ( $rv and ( $rv->{ $obj->{module} } or $rv->{ok} ) ) {
- print "*** $pkg successfully installed.\n";
- $success = 1;
- } else {
- print "*** $pkg installation cancelled.\n";
- $success = 0;
- }
-
- $installed += $success;
- } else {
- print << ".";
-*** Could not find a version $ver or above for $pkg; skipping.
-.
- }
-
- MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall;
- }
-
- return $installed;
-}
-
-sub _cpanplus_config {
- my @config = ();
- while ( @_ ) {
- my ($key, $value) = (shift(), shift());
- if ( $key eq 'prerequisites_policy' ) {
- if ( $value eq 'follow' ) {
- $value = CPANPLUS::Internals::Constants::PREREQ_INSTALL();
- } elsif ( $value eq 'ask' ) {
- $value = CPANPLUS::Internals::Constants::PREREQ_ASK();
- } elsif ( $value eq 'ignore' ) {
- $value = CPANPLUS::Internals::Constants::PREREQ_IGNORE();
- } else {
- die "*** Cannot convert option $key = '$value' to CPANPLUS version.\n";
- }
- } else {
- die "*** Cannot convert option $key to CPANPLUS version.\n";
- }
- }
- return @config;
-}
-
-sub _install_cpan {
- my @modules = @{ +shift };
- my @config = @{ +shift };
- my $installed = 0;
- my %args;
-
- _load_cpan();
- require Config;
-
- if (CPAN->VERSION < 1.80) {
- # no "sudo" support, probe for writableness
- return unless _can_write( MM->catfile( $CPAN::Config->{cpan_home}, 'sources' ) )
- and _can_write( $Config::Config{sitelib} );
- }
-
- # if we're root, set UNINST=1 to avoid trouble unless user asked for it.
- my $makeflags = $CPAN::Config->{make_install_arg} || '';
- $CPAN::Config->{make_install_arg} =
- join( ' ', split( ' ', $makeflags ), 'UNINST=1' )
- if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } );
-
- # don't show start-up info
- $CPAN::Config->{inhibit_startup_message} = 1;
-
- # set additional options
- while ( my ( $opt, $arg ) = splice( @config, 0, 2 ) ) {
- ( $args{$opt} = $arg, next )
- if $opt =~ /^force$/; # pseudo-option
- $CPAN::Config->{$opt} = $arg;
- }
-
- local $CPAN::Config->{prerequisites_policy} = 'follow';
-
- while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
- MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall;
-
- print "*** Installing $pkg...\n";
-
- my $obj = CPAN::Shell->expand( Module => $pkg );
- my $success = 0;
-
- if ( $obj and _version_cmp( $obj->cpan_version, $ver ) >= 0 ) {
- my $pathname = $pkg;
- $pathname =~ s/::/\\W/;
-
- foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) {
- delete $INC{$inc};
- }
-
- my $rv = $args{force} ? CPAN::Shell->force( install => $pkg )
- : CPAN::Shell->install($pkg);
- $rv ||= eval {
- $CPAN::META->instance( 'CPAN::Distribution', $obj->cpan_file, )
- ->{install}
- if $CPAN::META;
- };
-
- if ( $rv eq 'YES' ) {
- print "*** $pkg successfully installed.\n";
- $success = 1;
- }
- else {
- print "*** $pkg installation failed.\n";
- $success = 0;
- }
-
- $installed += $success;
- }
- else {
- print << ".";
-*** Could not find a version $ver or above for $pkg; skipping.
-.
- }
-
- MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall;
- }
-
- return $installed;
-}
-
-sub _has_cpanplus {
- return (
- $HasCPANPLUS = (
- $INC{'CPANPLUS/Config.pm'}
- or _load('CPANPLUS::Shell::Default')
- )
- );
-}
-
-# make guesses on whether we're under the CPAN installation directory
-sub _under_cpan {
- require Cwd;
- require File::Spec;
-
- my $cwd = File::Spec->canonpath( Cwd::cwd() );
- my $cpan = File::Spec->canonpath( $CPAN::Config->{cpan_home} );
-
- return ( index( $cwd, $cpan ) > -1 );
-}
-
-sub _update_to {
- my $class = __PACKAGE__;
- my $ver = shift;
-
- return
- if _version_cmp( _load($class), $ver ) >= 0; # no need to upgrade
-
- if (
- _prompt( "==> A newer version of $class ($ver) is required. Install?",
- 'y' ) =~ /^[Nn]/
- )
- {
- die "*** Please install $class $ver manually.\n";
- }
-
- print << ".";
-*** Trying to fetch it from CPAN...
-.
-
- # install ourselves
- _load($class) and return $class->import(@_)
- if $class->install( [], $class, $ver );
-
- print << '.'; exit 1;
-
-*** Cannot bootstrap myself. :-( Installation terminated.
-.
-}
-
-# check if we're connected to some host, using inet_aton
-sub _connected_to {
- my $site = shift;
-
- return (
- ( _load('Socket') and Socket::inet_aton($site) ) or _prompt(
- qq(
-*** Your host cannot resolve the domain name '$site', which
- probably means the Internet connections are unavailable.
-==> Should we try to install the required module(s) anyway?), 'n'
- ) =~ /^[Yy]/
- );
-}
-
-# check if a directory is writable; may create it on demand
-sub _can_write {
- my $path = shift;
- mkdir( $path, 0755 ) unless -e $path;
-
- return 1 if -w $path;
-
- print << ".";
-*** You are not allowed to write to the directory '$path';
- the installation may fail due to insufficient permissions.
-.
-
- if (
- eval '$>' and lc(`sudo -V`) =~ /version/ and _prompt(
- qq(
-==> Should we try to re-execute the autoinstall process with 'sudo'?),
- ((-t STDIN) ? 'y' : 'n')
- ) =~ /^[Yy]/
- )
- {
-
- # try to bootstrap ourselves from sudo
- print << ".";
-*** Trying to re-execute the autoinstall process with 'sudo'...
-.
- my $missing = join( ',', @Missing );
- my $config = join( ',',
- UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
- if $Config;
-
- return
- unless system( 'sudo', $^X, $0, "--config=$config",
- "--installdeps=$missing" );
-
- print << ".";
-*** The 'sudo' command exited with error! Resuming...
-.
- }
-
- return _prompt(
- qq(
-==> Should we try to install the required module(s) anyway?), 'n'
- ) =~ /^[Yy]/;
-}
-
-# load a module and return the version it reports
-sub _load {
- my $mod = pop; # class/instance doesn't matter
- my $file = $mod;
-
- $file =~ s|::|/|g;
- $file .= '.pm';
-
- local $@;
- return eval { require $file; $mod->VERSION } || ( $@ ? undef: 0 );
-}
-
-# Load CPAN.pm and it's configuration
-sub _load_cpan {
- return if $CPAN::VERSION and $CPAN::Config and not @_;
- require CPAN;
- if ( $CPAN::HandleConfig::VERSION ) {
- # Newer versions of CPAN have a HandleConfig module
- CPAN::HandleConfig->load;
- } else {
- # Older versions had the load method in Config directly
- CPAN::Config->load;
- }
-}
-
-# compare two versions, either use Sort::Versions or plain comparison
-# return values same as <=>
-sub _version_cmp {
- my ( $cur, $min ) = @_;
- return -1 unless defined $cur; # if 0 keep comparing
- return 1 unless $min;
-
- $cur =~ s/\s+$//;
-
- # check for version numbers that are not in decimal format
- if ( ref($cur) or ref($min) or $cur =~ /v|\..*\./ or $min =~ /v|\..*\./ ) {
- if ( ( $version::VERSION or defined( _load('version') )) and
- version->can('new')
- ) {
-
- # use version.pm if it is installed.
- return version->new($cur) <=> version->new($min);
- }
- elsif ( $Sort::Versions::VERSION or defined( _load('Sort::Versions') ) )
- {
-
- # use Sort::Versions as the sorting algorithm for a.b.c versions
- return Sort::Versions::versioncmp( $cur, $min );
- }
-
- warn "Cannot reliably compare non-decimal formatted versions.\n"
- . "Please install version.pm or Sort::Versions.\n";
- }
-
- # plain comparison
- local $^W = 0; # shuts off 'not numeric' bugs
- return $cur <=> $min;
-}
-
-# nothing; this usage is deprecated.
-sub main::PREREQ_PM { return {}; }
-
-sub _make_args {
- my %args = @_;
-
- $args{PREREQ_PM} = { %{ $args{PREREQ_PM} || {} }, @Existing, @Missing }
- if $UnderCPAN or $TestOnly;
-
- if ( $args{EXE_FILES} and -e 'MANIFEST' ) {
- require ExtUtils::Manifest;
- my $manifest = ExtUtils::Manifest::maniread('MANIFEST');
-
- $args{EXE_FILES} =
- [ grep { exists $manifest->{$_} } @{ $args{EXE_FILES} } ];
- }
-
- $args{test}{TESTS} ||= 't/*.t';
- $args{test}{TESTS} = join( ' ',
- grep { !exists( $DisabledTests{$_} ) }
- map { glob($_) } split( /\s+/, $args{test}{TESTS} ) );
-
- my $missing = join( ',', @Missing );
- my $config =
- join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
- if $Config;
-
- $PostambleActions = (
- ($missing and not $UnderCPAN)
- ? "\$(PERL) $0 --config=$config --installdeps=$missing"
- : "\$(NOECHO) \$(NOOP)"
- );
-
- return %args;
-}
-
-# a wrapper to ExtUtils::MakeMaker::WriteMakefile
-sub Write {
- require Carp;
- Carp::croak "WriteMakefile: Need even number of args" if @_ % 2;
-
- if ($CheckOnly) {
- print << ".";
-*** Makefile not written in check-only mode.
-.
- return;
- }
-
- my %args = _make_args(@_);
-
- no strict 'refs';
-
- $PostambleUsed = 0;
- local *MY::postamble = \&postamble unless defined &MY::postamble;
- ExtUtils::MakeMaker::WriteMakefile(%args);
-
- print << "." unless $PostambleUsed;
-*** WARNING: Makefile written with customized MY::postamble() without
- including contents from Module::AutoInstall::postamble() --
- auto installation features disabled. Please contact the author.
-.
-
- return 1;
-}
-
-sub postamble {
- $PostambleUsed = 1;
-
- return <<"END_MAKE";
-
-config :: installdeps
-\t\$(NOECHO) \$(NOOP)
-
-checkdeps ::
-\t\$(PERL) $0 --checkdeps
-
-installdeps ::
-\t$PostambleActions
-
-END_MAKE
-
-}
-
-1;
-
-__END__
-
-#line 1056
diff --git a/inc/Module/Install.pm b/inc/Module/Install.pm
deleted file mode 100644
index 51eda5d..0000000
--- a/inc/Module/Install.pm
+++ /dev/null
@@ -1,430 +0,0 @@
-#line 1
-package Module::Install;
-
-# For any maintainers:
-# The load order for Module::Install is a bit magic.
-# It goes something like this...
-#
-# IF ( host has Module::Install installed, creating author mode ) {
-# 1. Makefile.PL calls "use inc::Module::Install"
-# 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install
-# 3. The installed version of inc::Module::Install loads
-# 4. inc::Module::Install calls "require Module::Install"
-# 5. The ./inc/ version of Module::Install loads
-# } ELSE {
-# 1. Makefile.PL calls "use inc::Module::Install"
-# 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install
-# 3. The ./inc/ version of Module::Install loads
-# }
-
-use 5.005;
-use strict 'vars';
-
-use vars qw{$VERSION $MAIN};
-BEGIN {
- # All Module::Install core packages now require synchronised versions.
- # This will be used to ensure we don't accidentally load old or
- # different versions of modules.
- # This is not enforced yet, but will be some time in the next few
- # releases once we can make sure it won't clash with custom
- # Module::Install extensions.
- $VERSION = '0.91';
-
- # Storage for the pseudo-singleton
- $MAIN = undef;
-
- *inc::Module::Install::VERSION = *VERSION;
- @inc::Module::Install::ISA = __PACKAGE__;
-
-}
-
-
-
-
-
-# Whether or not inc::Module::Install is actually loaded, the
-# $INC{inc/Module/Install.pm} is what will still get set as long as
-# the caller loaded module this in the documented manner.
-# If not set, the caller may NOT have loaded the bundled version, and thus
-# they may not have a MI version that works with the Makefile.PL. This would
-# result in false errors or unexpected behaviour. And we don't want that.
-my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
-unless ( $INC{$file} ) { die <<"END_DIE" }
-
-Please invoke ${\__PACKAGE__} with:
-
- use inc::${\__PACKAGE__};
-
-not:
-
- use ${\__PACKAGE__};
-
-END_DIE
-
-
-
-
-
-# If the script that is loading Module::Install is from the future,
-# then make will detect this and cause it to re-run over and over
-# again. This is bad. Rather than taking action to touch it (which
-# is unreliable on some platforms and requires write permissions)
-# for now we should catch this and refuse to run.
-if ( -f $0 ) {
- my $s = (stat($0))[9];
-
- # If the modification time is only slightly in the future,
- # sleep briefly to remove the problem.
- my $a = $s - time;
- if ( $a > 0 and $a < 5 ) { sleep 5 }
-
- # Too far in the future, throw an error.
- my $t = time;
- if ( $s > $t ) { die <<"END_DIE" }
-
-Your installer $0 has a modification time in the future ($s > $t).
-
-This is known to create infinite loops in make.
-
-Please correct this, then run $0 again.
-
-END_DIE
-}
-
-
-
-
-
-# Build.PL was formerly supported, but no longer is due to excessive
-# difficulty in implementing every single feature twice.
-if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" }
-
-Module::Install no longer supports Build.PL.
-
-It was impossible to maintain duel backends, and has been deprecated.
-
-Please remove all Build.PL files and only use the Makefile.PL installer.
-
-END_DIE
-
-
-
-
-
-# To save some more typing in Module::Install installers, every...
-# use inc::Module::Install
-# ...also acts as an implicit use strict.
-$^H |= strict::bits(qw(refs subs vars));
-
-
-
-
-
-use Cwd ();
-use File::Find ();
-use File::Path ();
-use FindBin;
-
-sub autoload {
- my $self = shift;
- my $who = $self->_caller;
- my $cwd = Cwd::cwd();
- my $sym = "${who}::AUTOLOAD";
- $sym->{$cwd} = sub {
- my $pwd = Cwd::cwd();
- if ( my $code = $sym->{$pwd} ) {
- # Delegate back to parent dirs
- goto &$code unless $cwd eq $pwd;
- }
- $$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym";
- my $method = $1;
- if ( uc($method) eq $method ) {
- # Do nothing
- return;
- } elsif ( $method =~ /^_/ and $self->can($method) ) {
- # Dispatch to the root M:I class
- return $self->$method(@_);
- }
-
- # Dispatch to the appropriate plugin
- unshift @_, ( $self, $1 );
- goto &{$self->can('call')};
- };
-}
-
-sub import {
- my $class = shift;
- my $self = $class->new(@_);
- my $who = $self->_caller;
-
- unless ( -f $self->{file} ) {
- require "$self->{path}/$self->{dispatch}.pm";
- File::Path::mkpath("$self->{prefix}/$self->{author}");
- $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
- $self->{admin}->init;
- @_ = ($class, _self => $self);
- goto &{"$self->{name}::import"};
- }
-
- *{"${who}::AUTOLOAD"} = $self->autoload;
- $self->preload;
-
- # Unregister loader and worker packages so subdirs can use them again
- delete $INC{"$self->{file}"};
- delete $INC{"$self->{path}.pm"};
-
- # Save to the singleton
- $MAIN = $self;
-
- return 1;
-}
-
-sub preload {
- my $self = shift;
- unless ( $self->{extensions} ) {
- $self->load_extensions(
- "$self->{prefix}/$self->{path}", $self
- );
- }
-
- my @exts = @{$self->{extensions}};
- unless ( @exts ) {
- @exts = $self->{admin}->load_all_extensions;
- }
-
- my %seen;
- foreach my $obj ( @exts ) {
- while (my ($method, $glob) = each %{ref($obj) . '::'}) {
- next unless $obj->can($method);
- next if $method =~ /^_/;
- next if $method eq uc($method);
- $seen{$method}++;
- }
- }
-
- my $who = $self->_caller;
- foreach my $name ( sort keys %seen ) {
- *{"${who}::$name"} = sub {
- ${"${who}::AUTOLOAD"} = "${who}::$name";
- goto &{"${who}::AUTOLOAD"};
- };
- }
-}
-
-sub new {
- my ($class, %args) = @_;
-
- # ignore the prefix on extension modules built from top level.
- my $base_path = Cwd::abs_path($FindBin::Bin);
- unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) {
- delete $args{prefix};
- }
-
- return $args{_self} if $args{_self};
-
- $args{dispatch} ||= 'Admin';
- $args{prefix} ||= 'inc';
- $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author');
- $args{bundle} ||= 'inc/BUNDLES';
- $args{base} ||= $base_path;
- $class =~ s/^\Q$args{prefix}\E:://;
- $args{name} ||= $class;
- $args{version} ||= $class->VERSION;
- unless ( $args{path} ) {
- $args{path} = $args{name};
- $args{path} =~ s!::!/!g;
- }
- $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm";
- $args{wrote} = 0;
-
- bless( \%args, $class );
-}
-
-sub call {
- my ($self, $method) = @_;
- my $obj = $self->load($method) or return;
- splice(@_, 0, 2, $obj);
- goto &{$obj->can($method)};
-}
-
-sub load {
- my ($self, $method) = @_;
-
- $self->load_extensions(
- "$self->{prefix}/$self->{path}", $self
- ) unless $self->{extensions};
-
- foreach my $obj (@{$self->{extensions}}) {
- return $obj if $obj->can($method);
- }
-
- my $admin = $self->{admin} or die <<"END_DIE";
-The '$method' method does not exist in the '$self->{prefix}' path!
-Please remove the '$self->{prefix}' directory and run $0 again to load it.
-END_DIE
-
- my $obj = $admin->load($method, 1);
- push @{$self->{extensions}}, $obj;
-
- $obj;
-}
-
-sub load_extensions {
- my ($self, $path, $top) = @_;
-
- unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
- unshift @INC, $self->{prefix};
- }
-
- foreach my $rv ( $self->find_extensions($path) ) {
- my ($file, $pkg) = @{$rv};
- next if $self->{pathnames}{$pkg};
-
- local $@;
- my $new = eval { require $file; $pkg->can('new') };
- unless ( $new ) {
- warn $@ if $@;
- next;
- }
- $self->{pathnames}{$pkg} = delete $INC{$file};
- push @{$self->{extensions}}, &{$new}($pkg, _top => $top );
- }
-
- $self->{extensions} ||= [];
-}
-
-sub find_extensions {
- my ($self, $path) = @_;
-
- my @found;
- File::Find::find( sub {
- my $file = $File::Find::name;
- return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is;
- my $subpath = $1;
- return if lc($subpath) eq lc($self->{dispatch});
-
- $file = "$self->{path}/$subpath.pm";
- my $pkg = "$self->{name}::$subpath";
- $pkg =~ s!/!::!g;
-
- # If we have a mixed-case package name, assume case has been preserved
- # correctly. Otherwise, root through the file to locate the case-preserved
- # version of the package name.
- if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) {
- my $content = Module::Install::_read($subpath . '.pm');
- my $in_pod = 0;
- foreach ( split //, $content ) {
- $in_pod = 1 if /^=\w/;
- $in_pod = 0 if /^=cut/;
- next if ($in_pod || /^=cut/); # skip pod text
- next if /^\s*#/; # and comments
- if ( m/^\s*package\s+($pkg)\s*;/i ) {
- $pkg = $1;
- last;
- }
- }
- }
-
- push @found, [ $file, $pkg ];
- }, $path ) if -d $path;
-
- @found;
-}
-
-
-
-
-
-#####################################################################
-# Common Utility Functions
-
-sub _caller {
- my $depth = 0;
- my $call = caller($depth);
- while ( $call eq __PACKAGE__ ) {
- $depth++;
- $call = caller($depth);
- }
- return $call;
-}
-
-sub _read {
- local *FH;
- if ( $] >= 5.006 ) {
- open( FH, '<', $_[0] ) or die "open($_[0]): $!";
- } else {
- open( FH, "< $_[0]" ) or die "open($_[0]): $!";
- }
- my $string = do { local $/; <FH> };
- close FH or die "close($_[0]): $!";
- return $string;
-}
-
-sub _readperl {
- my $string = Module::Install::_read($_[0]);
- $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
- $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s;
- $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg;
- return $string;
-}
-
-sub _readpod {
- my $string = Module::Install::_read($_[0]);
- $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
- return $string if $_[0] =~ /\.pod\z/;
- $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg;
- $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg;
- $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg;
- $string =~ s/^\n+//s;
- return $string;
-}
-
-sub _write {
- local *FH;
- if ( $] >= 5.006 ) {
- open( FH, '>', $_[0] ) or die "open($_[0]): $!";
- } else {
- open( FH, "> $_[0]" ) or die "open($_[0]): $!";
- }
- foreach ( 1 .. $#_ ) {
- print FH $_[$_] or die "print($_[0]): $!";
- }
- close FH or die "close($_[0]): $!";
-}
-
-# _version is for processing module versions (eg, 1.03_05) not
-# Perl versions (eg, 5.8.1).
-sub _version ($) {
- my $s = shift || 0;
- my $d =()= $s =~ /(\.)/g;
- if ( $d >= 2 ) {
- # Normalise multipart versions
- $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
- }
- $s =~ s/^(\d+)\.?//;
- my $l = $1 || 0;
- my @v = map {
- $_ . '0' x (3 - length $_)
- } $s =~ /(\d{1,3})\D?/g;
- $l = $l . '.' . join '', @v if @v;
- return $l + 0;
-}
-
-sub _cmp ($$) {
- _version($_[0]) <=> _version($_[1]);
-}
-
-# Cloned from Params::Util::_CLASS
-sub _CLASS ($) {
- (
- defined $_[0]
- and
- ! ref $_[0]
- and
- $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s
- ) ? $_[0] : undef;
-}
-
-1;
-
-# Copyright 2008 - 2009 Adam Kennedy.
diff --git a/inc/Module/Install/AuthorTests.pm b/inc/Module/Install/AuthorTests.pm
deleted file mode 100644
index c44931b..0000000
--- a/inc/Module/Install/AuthorTests.pm
+++ /dev/null
@@ -1,59 +0,0 @@
-#line 1
-package Module::Install::AuthorTests;
-
-use 5.005;
-use strict;
-use Module::Install::Base;
-use Carp ();
-
-#line 16
-
-use vars qw{$VERSION $ISCORE @ISA};
-BEGIN {
- $VERSION = '0.002';
- $ISCORE = 1;
- @ISA = qw{Module::Install::Base};
-}
-
-#line 42
-
-sub author_tests {
- my ($self, @dirs) = @_;
- _add_author_tests($self, \@dirs, 0);
-}
-
-#line 56
-
-sub recursive_author_tests {
- my ($self, @dirs) = @_;
- _add_author_tests($self, \@dirs, 1);
-}
-
-sub _wanted {
- my $href = shift;
- sub { /\.t$/ and -f $_ and $href->{$File::Find::dir} = 1 }
-}
-
-sub _add_author_tests {
- my ($self, $dirs, $recurse) = @_;
- return unless $Module::Install::AUTHOR;
-
- my @tests = $self->tests ? (split / /, $self->tests) : 't/*.t';
-
- # XXX: pick a default, later -- rjbs, 2008-02-24
- my @dirs = @$dirs ? @$dirs : Carp::confess "no dirs given to author_tests";
- @dirs = grep { -d } @dirs;
-
- if ($recurse) {
- require File::Find;
- my %test_dir;
- File::Find::find(_wanted(\%test_dir), @dirs);
- $self->tests( join ' ', @tests, map { "$_/*.t" } sort keys %test_dir );
- } else {
- $self->tests( join ' ', @tests, map { "$_/*.t" } sort @dirs );
- }
-}
-
-#line 107
-
-1;
diff --git a/inc/Module/Install/AutoInstall.pm b/inc/Module/Install/AutoInstall.pm
deleted file mode 100644
index 58dd026..0000000
--- a/inc/Module/Install/AutoInstall.pm
+++ /dev/null
@@ -1,61 +0,0 @@
-#line 1
-package Module::Install::AutoInstall;
-
-use strict;
-use Module::Install::Base ();
-
-use vars qw{$VERSION @ISA $ISCORE};
-BEGIN {
- $VERSION = '0.91';
- @ISA = 'Module::Install::Base';
- $ISCORE = 1;
-}
-
-sub AutoInstall { $_[0] }
-
-sub run {
- my $self = shift;
- $self->auto_install_now(@_);
-}
-
-sub write {
- my $self = shift;
- $self->auto_install(@_);
-}
-
-sub auto_install {
- my $self = shift;
- return if $self->{done}++;
-
- # Flatten array of arrays into a single array
- my @core = map @$_, map @$_, grep ref,
- $self->build_requires, $self->requires;
-
- my @config = @_;
-
- # We'll need Module::AutoInstall
- $self->include('Module::AutoInstall');
- require Module::AutoInstall;
-
- Module::AutoInstall->import(
- (@config ? (-config => \@config) : ()),
- (@core ? (-core => \@core) : ()),
- $self->features,
- );
-
- $self->makemaker_args( Module::AutoInstall::_make_args() );
-
- my $class = ref($self);
- $self->postamble(
- "# --- $class section:\n" .
- Module::AutoInstall::postamble()
- );
-}
-
-sub auto_install_now {
- my $self = shift;
- $self->auto_install(@_);
- Module::AutoInstall::do_install();
-}
-
-1;
diff --git a/inc/Module/Install/Base.pm b/inc/Module/Install/Base.pm
deleted file mode 100644
index 60a74d2..0000000
--- a/inc/Module/Install/Base.pm
+++ /dev/null
@@ -1,78 +0,0 @@
-#line 1
-package Module::Install::Base;
-
-use strict 'vars';
-use vars qw{$VERSION};
-BEGIN {
- $VERSION = '0.91';
-}
-
-# Suspend handler for "redefined" warnings
-BEGIN {
- my $w = $SIG{__WARN__};
- $SIG{__WARN__} = sub { $w };
-}
-
-#line 42
-
-sub new {
- my $class = shift;
- unless ( defined &{"${class}::call"} ) {
- *{"${class}::call"} = sub { shift->_top->call(@_) };
- }
- unless ( defined &{"${class}::load"} ) {
- *{"${class}::load"} = sub { shift->_top->load(@_) };
- }
- bless { @_ }, $class;
-}
-
-#line 61
-
-sub AUTOLOAD {
- local $@;
- my $func = eval { shift->_top->autoload } or return;
- goto &$func;
-}
-
-#line 75
-
-sub _top {
- $_[0]->{_top};
-}
-
-#line 90
-
-sub admin {
- $_[0]->_top->{admin}
- or
- Module::Install::Base::FakeAdmin->new;
-}
-
-#line 106
-
-sub is_admin {
- $_[0]->admin->VERSION;
-}
-
-sub DESTROY {}
-
-package Module::Install::Base::FakeAdmin;
-
-my $fake;
-
-sub new {
- $fake ||= bless(\@_, $_[0]);
-}
-
-sub AUTOLOAD {}
-
-sub DESTROY {}
-
-# Restore warning handler
-BEGIN {
- $SIG{__WARN__} = $SIG{__WARN__}->();
-}
-
-1;
-
-#line 154
diff --git a/inc/Module/Install/Can.pm b/inc/Module/Install/Can.pm
deleted file mode 100644
index e65e4f6..0000000
--- a/inc/Module/Install/Can.pm
+++ /dev/null
@@ -1,81 +0,0 @@
-#line 1
-package Module::Install::Can;
-
-use strict;
-use Config ();
-use File::Spec ();
-use ExtUtils::MakeMaker ();
-use Module::Install::Base ();
-
-use vars qw{$VERSION @ISA $ISCORE};
-BEGIN {
- $VERSION = '0.91';
- @ISA = 'Module::Install::Base';
- $ISCORE = 1;
-}
-
-# check if we can load some module
-### Upgrade this to not have to load the module if possible
-sub can_use {
- my ($self, $mod, $ver) = @_;
- $mod =~ s{::|\\}{/}g;
- $mod .= '.pm' unless $mod =~ /\.pm$/i;
-
- my $pkg = $mod;
- $pkg =~ s{/}{::}g;
- $pkg =~ s{\.pm$}{}i;
-
- local $@;
- eval { require $mod; $pkg->VERSION($ver || 0); 1 };
-}
-
-# check if we can run some command
-sub can_run {
- my ($self, $cmd) = @_;
-
- my $_cmd = $cmd;
- return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd));
-
- for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
- next if $dir eq '';
- my $abs = File::Spec->catfile($dir, $_[1]);
- return $abs if (-x $abs or $abs = MM->maybe_command($abs));
- }
-
- return;
-}
-
-# can we locate a (the) C compiler
-sub can_cc {
- my $self = shift;
- my @chunks = split(/ /, $Config::Config{cc}) or return;
-
- # $Config{cc} may contain args; try to find out the program part
- while (@chunks) {
- return $self->can_run("@chunks") || (pop(@chunks), next);
- }
-
- return;
-}
-
-# Fix Cygwin bug on maybe_command();
-if ( $^O eq 'cygwin' ) {
- require ExtUtils::MM_Cygwin;
- require ExtUtils::MM_Win32;
- if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) {
- *ExtUtils::MM_Cygwin::maybe_command = sub {
- my ($self, $file) = @_;
- if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) {
- ExtUtils::MM_Win32->maybe_command($file);
- } else {
- ExtUtils::MM_Unix->maybe_command($file);
- }
- }
- }
-}
-
-1;
-
-__END__
-
-#line 156
diff --git a/inc/Module/Install/Fetch.pm b/inc/Module/Install/Fetch.pm
deleted file mode 100644
index 05f2079..0000000
--- a/inc/Module/Install/Fetch.pm
+++ /dev/null
@@ -1,93 +0,0 @@
-#line 1
-package Module::Install::Fetch;
-
-use strict;
-use Module::Install::Base ();
-
-use vars qw{$VERSION @ISA $ISCORE};
-BEGIN {
- $VERSION = '0.91';
- @ISA = 'Module::Install::Base';
- $ISCORE = 1;
-}
-
-sub get_file {
- my ($self, %args) = @_;
- my ($scheme, $host, $path, $file) =
- $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
-
- if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) {
- $args{url} = $args{ftp_url}
- or (warn("LWP support unavailable!\n"), return);
- ($scheme, $host, $path, $file) =
- $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
- }
-
- $|++;
- print "Fetching '$file' from $host... ";
-
- unless (eval { require Socket; Socket::inet_aton($host) }) {
- warn "'$host' resolve failed!\n";
- return;
- }
-
- return unless $scheme eq 'ftp' or $scheme eq 'http';
-
- require Cwd;
- my $dir = Cwd::getcwd();
- chdir $args{local_dir} or return if exists $args{local_dir};
-
- if (eval { require LWP::Simple; 1 }) {
- LWP::Simple::mirror($args{url}, $file);
- }
- elsif (eval { require Net::FTP; 1 }) { eval {
- # use Net::FTP to get past firewall
- my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600);
- $ftp->login("anonymous", 'anonymous at example.com');
- $ftp->cwd($path);
- $ftp->binary;
- $ftp->get($file) or (warn("$!\n"), return);
- $ftp->quit;
- } }
- elsif (my $ftp = $self->can_run('ftp')) { eval {
- # no Net::FTP, fallback to ftp.exe
- require FileHandle;
- my $fh = FileHandle->new;
-
- local $SIG{CHLD} = 'IGNORE';
- unless ($fh->open("|$ftp -n")) {
- warn "Couldn't open ftp: $!\n";
- chdir $dir; return;
- }
-
- my @dialog = split(/\n/, <<"END_FTP");
-open $host
-user anonymous anonymous\@example.com
-cd $path
-binary
-get $file $file
-quit
-END_FTP
- foreach (@dialog) { $fh->print("$_\n") }
- $fh->close;
- } }
- else {
- warn "No working 'ftp' program available!\n";
- chdir $dir; return;
- }
-
- unless (-f $file) {
- warn "Fetching failed: $@\n";
- chdir $dir; return;
- }
-
- return if exists $args{size} and -s $file != $args{size};
- system($args{run}) if exists $args{run};
- unlink($file) if $args{remove};
-
- print(((!exists $args{check_for} or -e $args{check_for})
- ? "done!" : "failed! ($!)"), "\n");
- chdir $dir; return !$?;
-}
-
-1;
diff --git a/inc/Module/Install/Include.pm b/inc/Module/Install/Include.pm
deleted file mode 100644
index 7e792e0..0000000
--- a/inc/Module/Install/Include.pm
+++ /dev/null
@@ -1,34 +0,0 @@
-#line 1
-package Module::Install::Include;
-
-use strict;
-use Module::Install::Base ();
-
-use vars qw{$VERSION @ISA $ISCORE};
-BEGIN {
- $VERSION = '0.91';
- @ISA = 'Module::Install::Base';
- $ISCORE = 1;
-}
-
-sub include {
- shift()->admin->include(@_);
-}
-
-sub include_deps {
- shift()->admin->include_deps(@_);
-}
-
-sub auto_include {
- shift()->admin->auto_include(@_);
-}
-
-sub auto_include_deps {
- shift()->admin->auto_include_deps(@_);
-}
-
-sub auto_include_dependent_dists {
- shift()->admin->auto_include_dependent_dists(@_);
-}
-
-1;
diff --git a/inc/Module/Install/Makefile.pm b/inc/Module/Install/Makefile.pm
deleted file mode 100644
index 98779db..0000000
--- a/inc/Module/Install/Makefile.pm
+++ /dev/null
@@ -1,268 +0,0 @@
-#line 1
-package Module::Install::Makefile;
-
-use strict 'vars';
-use ExtUtils::MakeMaker ();
-use Module::Install::Base ();
-
-use vars qw{$VERSION @ISA $ISCORE};
-BEGIN {
- $VERSION = '0.91';
- @ISA = 'Module::Install::Base';
- $ISCORE = 1;
-}
-
-sub Makefile { $_[0] }
-
-my %seen = ();
-
-sub prompt {
- shift;
-
- # Infinite loop protection
- my @c = caller();
- if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) {
- die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])";
- }
-
- # In automated testing, always use defaults
- if ( $ENV{AUTOMATED_TESTING} and ! $ENV{PERL_MM_USE_DEFAULT} ) {
- local $ENV{PERL_MM_USE_DEFAULT} = 1;
- goto &ExtUtils::MakeMaker::prompt;
- } else {
- goto &ExtUtils::MakeMaker::prompt;
- }
-}
-
-sub makemaker_args {
- my $self = shift;
- my $args = ( $self->{makemaker_args} ||= {} );
- %$args = ( %$args, @_ );
- return $args;
-}
-
-# For mm args that take multiple space-seperated args,
-# append an argument to the current list.
-sub makemaker_append {
- my $self = sShift;
- my $name = shift;
- my $args = $self->makemaker_args;
- $args->{name} = defined $args->{$name}
- ? join( ' ', $args->{name}, @_ )
- : join( ' ', @_ );
-}
-
-sub build_subdirs {
- my $self = shift;
- my $subdirs = $self->makemaker_args->{DIR} ||= [];
- for my $subdir (@_) {
- push @$subdirs, $subdir;
- }
-}
-
-sub clean_files {
- my $self = shift;
- my $clean = $self->makemaker_args->{clean} ||= {};
- %$clean = (
- %$clean,
- FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_),
- );
-}
-
-sub realclean_files {
- my $self = shift;
- my $realclean = $self->makemaker_args->{realclean} ||= {};
- %$realclean = (
- %$realclean,
- FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_),
- );
-}
-
-sub libs {
- my $self = shift;
- my $libs = ref $_[0] ? shift : [ shift ];
- $self->makemaker_args( LIBS => $libs );
-}
-
-sub inc {
- my $self = shift;
- $self->makemaker_args( INC => shift );
-}
-
-my %test_dir = ();
-
-sub _wanted_t {
- /\.t$/ and -f $_ and $test_dir{$File::Find::dir} = 1;
-}
-
-sub tests_recursive {
- my $self = shift;
- if ( $self->tests ) {
- die "tests_recursive will not work if tests are already defined";
- }
- my $dir = shift || 't';
- unless ( -d $dir ) {
- die "tests_recursive dir '$dir' does not exist";
- }
- %test_dir = ();
- require File::Find;
- File::Find::find( \&_wanted_t, $dir );
- $self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir );
-}
-
-sub write {
- my $self = shift;
- die "&Makefile->write() takes no arguments\n" if @_;
-
- # Check the current Perl version
- my $perl_version = $self->perl_version;
- if ( $perl_version ) {
- eval "use $perl_version; 1"
- or die "ERROR: perl: Version $] is installed, "
- . "but we need version >= $perl_version";
- }
-
- # Make sure we have a new enough MakeMaker
- require ExtUtils::MakeMaker;
-
- if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) {
- # MakeMaker can complain about module versions that include
- # an underscore, even though its own version may contain one!
- # Hence the funny regexp to get rid of it. See RT #35800
- # for details.
- $self->build_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ );
- $self->configure_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ );
- } else {
- # Allow legacy-compatibility with 5.005 by depending on the
- # most recent EU:MM that supported 5.005.
- $self->build_requires( 'ExtUtils::MakeMaker' => 6.42 );
- $self->configure_requires( 'ExtUtils::MakeMaker' => 6.42 );
- }
-
- # Generate the MakeMaker params
- my $args = $self->makemaker_args;
- $args->{DISTNAME} = $self->name;
- $args->{NAME} = $self->module_name || $self->name;
- $args->{VERSION} = $self->version;
- $args->{NAME} =~ s/-/::/g;
- if ( $self->tests ) {
- $args->{test} = { TESTS => $self->tests };
- }
- if ( $] >= 5.005 ) {
- $args->{ABSTRACT} = $self->abstract;
- $args->{AUTHOR} = $self->author;
- }
- if ( eval($ExtUtils::MakeMaker::VERSION) >= 6.10 ) {
- $args->{NO_META} = 1;
- }
- if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 and $self->sign ) {
- $args->{SIGN} = 1;
- }
- unless ( $self->is_admin ) {
- delete $args->{SIGN};
- }
-
- # Merge both kinds of requires into prereq_pm
- my $prereq = ($args->{PREREQ_PM} ||= {});
- %$prereq = ( %$prereq,
- map { @$_ }
- map { @$_ }
- grep $_,
- ($self->configure_requires, $self->build_requires, $self->requires)
- );
-
- # Remove any reference to perl, PREREQ_PM doesn't support it
- delete $args->{PREREQ_PM}->{perl};
-
- # merge both kinds of requires into prereq_pm
- my $subdirs = ($args->{DIR} ||= []);
- if ($self->bundles) {
- foreach my $bundle (@{ $self->bundles }) {
- my ($file, $dir) = @$bundle;
- push @$subdirs, $dir if -d $dir;
- delete $prereq->{$file};
- }
- }
-
- if ( my $perl_version = $self->perl_version ) {
- eval "use $perl_version; 1"
- or die "ERROR: perl: Version $] is installed, "
- . "but we need version >= $perl_version";
- }
-
- $args->{INSTALLDIRS} = $self->installdirs;
-
- my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args;
-
- my $user_preop = delete $args{dist}->{PREOP};
- if (my $preop = $self->admin->preop($user_preop)) {
- foreach my $key ( keys %$preop ) {
- $args{dist}->{$key} = $preop->{$key};
- }
- }
-
- my $mm = ExtUtils::MakeMaker::WriteMakefile(%args);
- $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile');
-}
-
-sub fix_up_makefile {
- my $self = shift;
- my $makefile_name = shift;
- my $top_class = ref($self->_top) || '';
- my $top_version = $self->_top->VERSION || '';
-
- my $preamble = $self->preamble
- ? "# Preamble by $top_class $top_version\n"
- . $self->preamble
- : '';
- my $postamble = "# Postamble by $top_class $top_version\n"
- . ($self->postamble || '');
-
- local *MAKEFILE;
- open MAKEFILE, "< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
- my $makefile = do { local $/; <MAKEFILE> };
- close MAKEFILE or die $!;
-
- $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /;
- $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g;
- $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g;
- $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m;
- $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m;
-
- # Module::Install will never be used to build the Core Perl
- # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks
- # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist
- $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m;
- #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m;
-
- # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well.
- $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g;
-
- # XXX - This is currently unused; not sure if it breaks other MM-users
- # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg;
-
- open MAKEFILE, "> $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
- print MAKEFILE "$preamble$makefile$postamble" or die $!;
- close MAKEFILE or die $!;
-
- 1;
-}
-
-sub preamble {
- my ($self, $text) = @_;
- $self->{preamble} = $text . $self->{preamble} if defined $text;
- $self->{preamble};
-}
-
-sub postamble {
- my ($self, $text) = @_;
- $self->{postamble} ||= $self->admin->postamble;
- $self->{postamble} .= $text if defined $text;
- $self->{postamble}
-}
-
-1;
-
-__END__
-
-#line 394
diff --git a/inc/Module/Install/Metadata.pm b/inc/Module/Install/Metadata.pm
deleted file mode 100644
index 653193d..0000000
--- a/inc/Module/Install/Metadata.pm
+++ /dev/null
@@ -1,624 +0,0 @@
-#line 1
-package Module::Install::Metadata;
-
-use strict 'vars';
-use Module::Install::Base ();
-
-use vars qw{$VERSION @ISA $ISCORE};
-BEGIN {
- $VERSION = '0.91';
- @ISA = 'Module::Install::Base';
- $ISCORE = 1;
-}
-
-my @boolean_keys = qw{
- sign
-};
-
-my @scalar_keys = qw{
- name
- module_name
- abstract
- author
- version
- distribution_type
- tests
- installdirs
-};
-
-my @tuple_keys = qw{
- configure_requires
- build_requires
- requires
- recommends
- bundles
- resources
-};
-
-my @resource_keys = qw{
- homepage
- bugtracker
- repository
-};
-
-my @array_keys = qw{
- keywords
-};
-
-sub Meta { shift }
-sub Meta_BooleanKeys { @boolean_keys }
-sub Meta_ScalarKeys { @scalar_keys }
-sub Meta_TupleKeys { @tuple_keys }
-sub Meta_ResourceKeys { @resource_keys }
-sub Meta_ArrayKeys { @array_keys }
-
-foreach my $key ( @boolean_keys ) {
- *$key = sub {
- my $self = shift;
- if ( defined wantarray and not @_ ) {
- return $self->{values}->{$key};
- }
- $self->{values}->{$key} = ( @_ ? $_[0] : 1 );
- return $self;
- };
-}
-
-foreach my $key ( @scalar_keys ) {
- *$key = sub {
- my $self = shift;
- return $self->{values}->{$key} if defined wantarray and !@_;
- $self->{values}->{$key} = shift;
- return $self;
- };
-}
-
-foreach my $key ( @array_keys ) {
- *$key = sub {
- my $self = shift;
- return $self->{values}->{$key} if defined wantarray and !@_;
- $self->{values}->{$key} ||= [];
- push @{$self->{values}->{$key}}, @_;
- return $self;
- };
-}
-
-foreach my $key ( @resource_keys ) {
- *$key = sub {
- my $self = shift;
- unless ( @_ ) {
- return () unless $self->{values}->{resources};
- return map { $_->[1] }
- grep { $_->[0] eq $key }
- @{ $self->{values}->{resources} };
- }
- return $self->{values}->{resources}->{$key} unless @_;
- my $uri = shift or die(
- "Did not provide a value to $key()"
- );
- $self->resources( $key => $uri );
- return 1;
- };
-}
-
-foreach my $key ( grep { $_ ne "resources" } @tuple_keys) {
- *$key = sub {
- my $self = shift;
- return $self->{values}->{$key} unless @_;
- my @added;
- while ( @_ ) {
- my $module = shift or last;
- my $version = shift || 0;
- push @added, [ $module, $version ];
- }
- push @{ $self->{values}->{$key} }, @added;
- return map {@$_} @added;
- };
-}
-
-# Resource handling
-my %lc_resource = map { $_ => 1 } qw{
- homepage
- license
- bugtracker
- repository
-};
-
-sub resources {
- my $self = shift;
- while ( @_ ) {
- my $name = shift or last;
- my $value = shift or next;
- if ( $name eq lc $name and ! $lc_resource{$name} ) {
- die("Unsupported reserved lowercase resource '$name'");
- }
- $self->{values}->{resources} ||= [];
- push @{ $self->{values}->{resources} }, [ $name, $value ];
- }
- $self->{values}->{resources};
-}
-
-# Aliases for build_requires that will have alternative
-# meanings in some future version of META.yml.
-sub test_requires { shift->build_requires(@_) }
-sub install_requires { shift->build_requires(@_) }
-
-# Aliases for installdirs options
-sub install_as_core { $_[0]->installdirs('perl') }
-sub install_as_cpan { $_[0]->installdirs('site') }
-sub install_as_site { $_[0]->installdirs('site') }
-sub install_as_vendor { $_[0]->installdirs('vendor') }
-
-sub dynamic_config {
- my $self = shift;
- unless ( @_ ) {
- warn "You MUST provide an explicit true/false value to dynamic_config\n";
- return $self;
- }
- $self->{values}->{dynamic_config} = $_[0] ? 1 : 0;
- return 1;
-}
-
-sub perl_version {
- my $self = shift;
- return $self->{values}->{perl_version} unless @_;
- my $version = shift or die(
- "Did not provide a value to perl_version()"
- );
-
- # Normalize the version
- $version = $self->_perl_version($version);
-
- # We don't support the reall old versions
- unless ( $version >= 5.005 ) {
- die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n";
- }
-
- $self->{values}->{perl_version} = $version;
-}
-
-#Stolen from M::B
-my %license_urls = (
- perl => 'http://dev.perl.org/licenses/',
- apache => 'http://apache.org/licenses/LICENSE-2.0',
- artistic => 'http://opensource.org/licenses/artistic-license.php',
- artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php',
- lgpl => 'http://opensource.org/licenses/lgpl-license.php',
- lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php',
- lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html',
- bsd => 'http://opensource.org/licenses/bsd-license.php',
- gpl => 'http://opensource.org/licenses/gpl-license.php',
- gpl2 => 'http://opensource.org/licenses/gpl-2.0.php',
- gpl3 => 'http://opensource.org/licenses/gpl-3.0.html',
- mit => 'http://opensource.org/licenses/mit-license.php',
- mozilla => 'http://opensource.org/licenses/mozilla1.1.php',
- open_source => undef,
- unrestricted => undef,
- restrictive => undef,
- unknown => undef,
-);
-
-sub license {
- my $self = shift;
- return $self->{values}->{license} unless @_;
- my $license = shift or die(
- 'Did not provide a value to license()'
- );
- $self->{values}->{license} = $license;
-
- # Automatically fill in license URLs
- if ( $license_urls{$license} ) {
- $self->resources( license => $license_urls{$license} );
- }
-
- return 1;
-}
-
-sub all_from {
- my ( $self, $file ) = @_;
-
- unless ( defined($file) ) {
- my $name = $self->name or die(
- "all_from called with no args without setting name() first"
- );
- $file = join('/', 'lib', split(/-/, $name)) . '.pm';
- $file =~ s{.*/}{} unless -e $file;
- unless ( -e $file ) {
- die("all_from cannot find $file from $name");
- }
- }
- unless ( -f $file ) {
- die("The path '$file' does not exist, or is not a file");
- }
-
- # Some methods pull from POD instead of code.
- # If there is a matching .pod, use that instead
- my $pod = $file;
- $pod =~ s/\.pm$/.pod/i;
- $pod = $file unless -e $pod;
-
- # Pull the different values
- $self->name_from($file) unless $self->name;
- $self->version_from($file) unless $self->version;
- $self->perl_version_from($file) unless $self->perl_version;
- $self->author_from($pod) unless $self->author;
- $self->license_from($pod) unless $self->license;
- $self->abstract_from($pod) unless $self->abstract;
-
- return 1;
-}
-
-sub provides {
- my $self = shift;
- my $provides = ( $self->{values}->{provides} ||= {} );
- %$provides = (%$provides, @_) if @_;
- return $provides;
-}
-
-sub auto_provides {
- my $self = shift;
- return $self unless $self->is_admin;
- unless (-e 'MANIFEST') {
- warn "Cannot deduce auto_provides without a MANIFEST, skipping\n";
- return $self;
- }
- # Avoid spurious warnings as we are not checking manifest here.
- local $SIG{__WARN__} = sub {1};
- require ExtUtils::Manifest;
- local *ExtUtils::Manifest::manicheck = sub { return };
-
- require Module::Build;
- my $build = Module::Build->new(
- dist_name => $self->name,
- dist_version => $self->version,
- license => $self->license,
- );
- $self->provides( %{ $build->find_dist_packages || {} } );
-}
-
-sub feature {
- my $self = shift;
- my $name = shift;
- my $features = ( $self->{values}->{features} ||= [] );
- my $mods;
-
- if ( @_ == 1 and ref( $_[0] ) ) {
- # The user used ->feature like ->features by passing in the second
- # argument as a reference. Accomodate for that.
- $mods = $_[0];
- } else {
- $mods = \@_;
- }
-
- my $count = 0;
- push @$features, (
- $name => [
- map {
- ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_
- } @$mods
- ]
- );
-
- return @$features;
-}
-
-sub features {
- my $self = shift;
- while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) {
- $self->feature( $name, @$mods );
- }
- return $self->{values}->{features}
- ? @{ $self->{values}->{features} }
- : ();
-}
-
-sub no_index {
- my $self = shift;
- my $type = shift;
- push @{ $self->{values}->{no_index}->{$type} }, @_ if $type;
- return $self->{values}->{no_index};
-}
-
-sub read {
- my $self = shift;
- $self->include_deps( 'YAML::Tiny', 0 );
-
- require YAML::Tiny;
- my $data = YAML::Tiny::LoadFile('META.yml');
-
- # Call methods explicitly in case user has already set some values.
- while ( my ( $key, $value ) = each %$data ) {
- next unless $self->can($key);
- if ( ref $value eq 'HASH' ) {
- while ( my ( $module, $version ) = each %$value ) {
- $self->can($key)->($self, $module => $version );
- }
- } else {
- $self->can($key)->($self, $value);
- }
- }
- return $self;
-}
-
-sub write {
- my $self = shift;
- return $self unless $self->is_admin;
- $self->admin->write_meta;
- return $self;
-}
-
-sub version_from {
- require ExtUtils::MM_Unix;
- my ( $self, $file ) = @_;
- $self->version( ExtUtils::MM_Unix->parse_version($file) );
-}
-
-sub abstract_from {
- require ExtUtils::MM_Unix;
- my ( $self, $file ) = @_;
- $self->abstract(
- bless(
- { DISTNAME => $self->name },
- 'ExtUtils::MM_Unix'
- )->parse_abstract($file)
- );
-}
-
-# Add both distribution and module name
-sub name_from {
- my ($self, $file) = @_;
- if (
- Module::Install::_read($file) =~ m/
- ^ \s*
- package \s*
- ([\w:]+)
- \s* ;
- /ixms
- ) {
- my ($name, $module_name) = ($1, $1);
- $name =~ s{::}{-}g;
- $self->name($name);
- unless ( $self->module_name ) {
- $self->module_name($module_name);
- }
- } else {
- die("Cannot determine name from $file\n");
- }
-}
-
-sub perl_version_from {
- my $self = shift;
- if (
- Module::Install::_read($_[0]) =~ m/
- ^
- (?:use|require) \s*
- v?
- ([\d_\.]+)
- \s* ;
- /ixms
- ) {
- my $perl_version = $1;
- $perl_version =~ s{_}{}g;
- $self->perl_version($perl_version);
- } else {
- warn "Cannot determine perl version info from $_[0]\n";
- return;
- }
-}
-
-sub author_from {
- my $self = shift;
- my $content = Module::Install::_read($_[0]);
- if ($content =~ m/
- =head \d \s+ (?:authors?)\b \s*
- ([^\n]*)
- |
- =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s*
- .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s*
- ([^\n]*)
- /ixms) {
- my $author = $1 || $2;
- $author =~ s{E<lt>}{<}g;
- $author =~ s{E<gt>}{>}g;
- $self->author($author);
- } else {
- warn "Cannot determine author info from $_[0]\n";
- }
-}
-
-sub license_from {
- my $self = shift;
- if (
- Module::Install::_read($_[0]) =~ m/
- (
- =head \d \s+
- (?:licen[cs]e|licensing|copyright|legal)\b
- .*?
- )
- (=head\\d.*|=cut.*|)
- \z
- /ixms ) {
- my $license_text = $1;
- my @phrases = (
- 'under the same (?:terms|license) as (?:perl|the perl programming language) itself' => 'perl', 1,
- 'GNU general public license' => 'gpl', 1,
- 'GNU public license' => 'gpl', 1,
- 'GNU lesser general public license' => 'lgpl', 1,
- 'GNU lesser public license' => 'lgpl', 1,
- 'GNU library general public license' => 'lgpl', 1,
- 'GNU library public license' => 'lgpl', 1,
- 'BSD license' => 'bsd', 1,
- 'Artistic license' => 'artistic', 1,
- 'GPL' => 'gpl', 1,
- 'LGPL' => 'lgpl', 1,
- 'BSD' => 'bsd', 1,
- 'Artistic' => 'artistic', 1,
- 'MIT' => 'mit', 1,
- 'proprietary' => 'proprietary', 0,
- );
- while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
- $pattern =~ s{\s+}{\\s+}g;
- if ( $license_text =~ /\b$pattern\b/i ) {
- $self->license($license);
- return 1;
- }
- }
- }
-
- warn "Cannot determine license info from $_[0]\n";
- return 'unknown';
-}
-
-sub _extract_bugtracker {
- my @links = $_[0] =~ m#L<(\Qhttp://rt.cpan.org/\E[^>]+)>#g;
- my %links;
- @links{@links}=();
- @links=keys %links;
- return @links;
-}
-
-sub bugtracker_from {
- my $self = shift;
- my $content = Module::Install::_read($_[0]);
- my @links = _extract_bugtracker($content);
- unless ( @links ) {
- warn "Cannot determine bugtracker info from $_[0]\n";
- return 0;
- }
- if ( @links > 1 ) {
- warn "Found more than on rt.cpan.org link in $_[0]\n";
- return 0;
- }
-
- # Set the bugtracker
- bugtracker( $links[0] );
- return 1;
-}
-
-sub requires_from {
- my $self = shift;
- my $content = Module::Install::_readperl($_[0]);
- my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg;
- while ( @requires ) {
- my $module = shift @requires;
- my $version = shift @requires;
- $self->requires( $module => $version );
- }
-}
-
-sub test_requires_from {
- my $self = shift;
- my $content = Module::Install::_readperl($_[0]);
- my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg;
- while ( @requires ) {
- my $module = shift @requires;
- my $version = shift @requires;
- $self->test_requires( $module => $version );
- }
-}
-
-# Convert triple-part versions (eg, 5.6.1 or 5.8.9) to
-# numbers (eg, 5.006001 or 5.008009).
-# Also, convert double-part versions (eg, 5.8)
-sub _perl_version {
- my $v = $_[-1];
- $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e;
- $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e;
- $v =~ s/(\.\d\d\d)000$/$1/;
- $v =~ s/_.+$//;
- if ( ref($v) ) {
- # Numify
- $v = $v + 0;
- }
- return $v;
-}
-
-
-
-
-
-######################################################################
-# MYMETA Support
-
-sub WriteMyMeta {
- die "WriteMyMeta has been deprecated";
-}
-
-sub write_mymeta_yaml {
- my $self = shift;
-
- # We need YAML::Tiny to write the MYMETA.yml file
- unless ( eval { require YAML::Tiny; 1; } ) {
- return 1;
- }
-
- # Generate the data
- my $meta = $self->_write_mymeta_data or return 1;
-
- # Save as the MYMETA.yml file
- print "Writing MYMETA.yml\n";
- YAML::Tiny::DumpFile('MYMETA.yml', $meta);
-}
-
-sub write_mymeta_json {
- my $self = shift;
-
- # We need JSON to write the MYMETA.json file
- unless ( eval { require JSON; 1; } ) {
- return 1;
- }
-
- # Generate the data
- my $meta = $self->_write_mymeta_data or return 1;
-
- # Save as the MYMETA.yml file
- print "Writing MYMETA.json\n";
- Module::Install::_write(
- 'MYMETA.json',
- JSON->new->pretty(1)->canonical->encode($meta),
- );
-}
-
-sub _write_mymeta_data {
- my $self = shift;
-
- # If there's no existing META.yml there is nothing we can do
- return undef unless -f 'META.yml';
-
- # We need Parse::CPAN::Meta to load the file
- unless ( eval { require Parse::CPAN::Meta; 1; } ) {
- return undef;
- }
-
- # Merge the perl version into the dependencies
- my $val = $self->Meta->{values};
- my $perl = delete $val->{perl_version};
- if ( $perl ) {
- $val->{requires} ||= [];
- my $requires = $val->{requires};
-
- # Canonize to three-dot version after Perl 5.6
- if ( $perl >= 5.006 ) {
- $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e
- }
- unshift @$requires, [ perl => $perl ];
- }
-
- # Load the advisory META.yml file
- my @yaml = Parse::CPAN::Meta::LoadFile('META.yml');
- my $meta = $yaml[0];
-
- # Overwrite the non-configure dependency hashs
- delete $meta->{requires};
- delete $meta->{build_requires};
- delete $meta->{recommends};
- if ( exists $val->{requires} ) {
- $meta->{requires} = { map { @$_ } @{ $val->{requires} } };
- }
- if ( exists $val->{build_requires} ) {
- $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } };
- }
-
- return $meta;
-}
-
-1;
diff --git a/inc/Module/Install/Share.pm b/inc/Module/Install/Share.pm
deleted file mode 100644
index f7e877c..0000000
--- a/inc/Module/Install/Share.pm
+++ /dev/null
@@ -1,67 +0,0 @@
-#line 1
-package Module::Install::Share;
-
-use strict;
-use Module::Install::Base ();
-
-use vars qw{$VERSION @ISA $ISCORE};
-BEGIN {
- $VERSION = '0.91';
- @ISA = 'Module::Install::Base';
- $ISCORE = 1;
-}
-
-sub install_share {
- my $self = shift;
- my $dir = @_ ? pop : 'share';
- my $type = @_ ? shift : 'dist';
- unless ( defined $type and $type eq 'module' or $type eq 'dist' ) {
- die "Illegal or invalid share dir type '$type'";
- }
- unless ( defined $dir and -d $dir ) {
- die "Illegal or missing directory install_share param";
- }
-
- # Split by type
- my $S = ($^O eq 'MSWin32') ? "\\" : "\/";
- if ( $type eq 'dist' ) {
- die "Too many parameters to install_share" if @_;
-
- # Set up the install
- $self->postamble(<<"END_MAKEFILE");
-config ::
-\t\$(NOECHO) \$(MOD_INSTALL) \\
-\t\t"$dir" \$(INST_LIB)${S}auto${S}share${S}dist${S}\$(DISTNAME)
-
-END_MAKEFILE
- } else {
- my $module = Module::Install::_CLASS($_[0]);
- unless ( defined $module ) {
- die "Missing or invalid module name '$_[0]'";
- }
- $module =~ s/::/-/g;
-
- # Set up the install
- $self->postamble(<<"END_MAKEFILE");
-config ::
-\t\$(NOECHO) \$(MOD_INSTALL) \\
-\t\t"$dir" \$(INST_LIB)${S}auto${S}share${S}module${S}$module
-
-END_MAKEFILE
- }
-
- # The above appears to behave incorrectly when used with old versions
- # of ExtUtils::Install (known-bad on RHEL 3, with 5.8.0)
- # So when we need to install a share directory, make sure we add a
- # dependency on a moderately new version of ExtUtils::MakeMaker.
- $self->build_requires( 'ExtUtils::MakeMaker' => '6.11' );
-
- # 99% of the time we don't want to index a shared dir
- $self->no_index( directory => $dir );
-}
-
-1;
-
-__END__
-
-#line 125
diff --git a/inc/Module/Install/Win32.pm b/inc/Module/Install/Win32.pm
deleted file mode 100644
index f2f99df..0000000
--- a/inc/Module/Install/Win32.pm
+++ /dev/null
@@ -1,64 +0,0 @@
-#line 1
-package Module::Install::Win32;
-
-use strict;
-use Module::Install::Base ();
-
-use vars qw{$VERSION @ISA $ISCORE};
-BEGIN {
- $VERSION = '0.91';
- @ISA = 'Module::Install::Base';
- $ISCORE = 1;
-}
-
-# determine if the user needs nmake, and download it if needed
-sub check_nmake {
- my $self = shift;
- $self->load('can_run');
- $self->load('get_file');
-
- require Config;
- return unless (
- $^O eq 'MSWin32' and
- $Config::Config{make} and
- $Config::Config{make} =~ /^nmake\b/i and
- ! $self->can_run('nmake')
- );
-
- print "The required 'nmake' executable not found, fetching it...\n";
-
- require File::Basename;
- my $rv = $self->get_file(
- url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe',
- ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe',
- local_dir => File::Basename::dirname($^X),
- size => 51928,
- run => 'Nmake15.exe /o > nul',
- check_for => 'Nmake.exe',
- remove => 1,
- );
-
- die <<'END_MESSAGE' unless $rv;
-
--------------------------------------------------------------------------------
-
-Since you are using Microsoft Windows, you will need the 'nmake' utility
-before installation. It's available at:
-
- http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe
- or
- ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe
-
-Please download the file manually, save it to a directory in %PATH% (e.g.
-C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to
-that directory, and run "Nmake15.exe" from there; that will create the
-'nmake.exe' file needed by this module.
-
-You may then resume the installation process described in README.
-
--------------------------------------------------------------------------------
-END_MESSAGE
-
-}
-
-1;
diff --git a/inc/Module/Install/WriteAll.pm b/inc/Module/Install/WriteAll.pm
deleted file mode 100644
index 12471e5..0000000
--- a/inc/Module/Install/WriteAll.pm
+++ /dev/null
@@ -1,60 +0,0 @@
-#line 1
-package Module::Install::WriteAll;
-
-use strict;
-use Module::Install::Base ();
-
-use vars qw{$VERSION @ISA $ISCORE};
-BEGIN {
- $VERSION = '0.91';;
- @ISA = qw{Module::Install::Base};
- $ISCORE = 1;
-}
-
-sub WriteAll {
- my $self = shift;
- my %args = (
- meta => 1,
- sign => 0,
- inline => 0,
- check_nmake => 1,
- @_,
- );
-
- $self->sign(1) if $args{sign};
- $self->admin->WriteAll(%args) if $self->is_admin;
-
- $self->check_nmake if $args{check_nmake};
- unless ( $self->makemaker_args->{PL_FILES} ) {
- $self->makemaker_args( PL_FILES => {} );
- }
-
- # Until ExtUtils::MakeMaker support MYMETA.yml, make sure
- # we clean it up properly ourself.
- $self->realclean_files('MYMETA.yml');
-
- if ( $args{inline} ) {
- $self->Inline->write;
- } else {
- $self->Makefile->write;
- }
-
- # The Makefile write process adds a couple of dependencies,
- # so write the META.yml files after the Makefile.
- if ( $args{meta} ) {
- $self->Meta->write;
- }
-
- # Experimental support for MYMETA
- if ( $ENV{X_MYMETA} ) {
- if ( $ENV{X_MYMETA} eq 'JSON' ) {
- $self->Meta->write_mymeta_json;
- } else {
- $self->Meta->write_mymeta_yaml;
- }
- }
-
- return 1;
-}
-
-1;
diff --git a/lib/HTML/FormHandler.pm b/lib/HTML/FormHandler.pm
index c2acfcc..5afe754 100644
--- a/lib/HTML/FormHandler.pm
+++ b/lib/HTML/FormHandler.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler;
+# ABSTRACT: HTML forms using Moose
use Moose;
with 'HTML::FormHandler::Model', 'HTML::FormHandler::Fields',
@@ -17,122 +18,600 @@ use Try::Tiny;
use 5.008;
# always use 5 digits after decimal because of toolchain issues
-our $VERSION = '0.32001';
+our $VERSION = '0.32002';
-=head1 NAME
-
-HTML::FormHandler - form handler written in Moose
-=head1 SYNOPSIS
+# Moose attributes
+has 'name' => (
+ isa => 'Str',
+ is => 'rw',
+ default => sub { return 'form' . int( rand 1000 ) }
+);
+# for consistency in api with field nodes
+has 'form' => (
+ isa => 'HTML::FormHandler',
+ is => 'rw',
+ weak_ref => 1,
+ predicate => 'has_form',
+ lazy => 1,
+ default => sub { shift }
+);
+has 'parent' => ( is => 'rw' );
+has 'result' => (
+ isa => 'HTML::FormHandler::Result',
+ is => 'ro',
+ writer => '_set_result',
+ clearer => 'clear_result',
+ lazy => 1,
+ builder => 'build_result',
+ predicate => 'has_result',
+ handles => [
+ 'input', '_set_input', '_clear_input', 'has_input',
+ 'value', '_set_value', '_clear_value', 'has_value',
+ 'add_result', 'results', 'validated', 'ran_validation',
+ 'is_valid',
+ 'form_errors', 'all_form_errors', 'push_form_errors', 'clear_form_errors',
+ 'has_form_errors', 'num_form_errors',
+ ],
+);
- use HTML::FormHandler; # or a custom form: use MyApp::Form::User;
- my $form = HTML::FormHandler->new( .... );
- $form->process( params => $params );
- my $rendered_form = $form->render;
- if( $form->validated ) {
- # perform validated form actions
- }
- else {
- # perform non-validated actions
+sub build_result {
+ my $self = shift;
+ my $result = HTML::FormHandler::Result->new( name => $self->name, form => $self );
+ if ( $self->widget_form ) {
+ $self->apply_widget_role( $result, $self->widget_form, 'Form' );
}
-
-Or, if you want to use a form 'result' (which contains only the form
-values and error messages) instead:
+ return $result;
+}
- use MyApp::Form; # or a generic form: use HTML::FormHandler;
- my $form = MyApp::Form->new( .... );
- my $result = $form->run( params => $params );
- if( $result->validated ) {
- # perform validated form actions
- }
- else {
- # perform non-validated actions
- $result->render;
+has 'field_traits' => ( is => 'ro', traits => ['Array'], isa => 'ArrayRef',
+ default => sub {[]}, handles => { 'has_field_traits' => 'count' } );
+has 'widget_name_space' => ( is => 'ro', isa => 'ArrayRef[Str]', default => sub {[]} );
+has 'widget_form' => ( is => 'ro', isa => 'Str', default => 'Simple' );
+has 'widget_wrapper' => ( is => 'ro', isa => 'Str', default => 'Simple' );
+has 'active' => (
+ is => 'rw',
+ traits => ['Array'],
+ isa => 'ArrayRef[Str]',
+ default => sub {[]},
+ handles => {
+ add_active => 'push',
+ has_active => 'count',
+ clear_active => 'clear',
}
+);
-An example of a custom form class (you could also use a 'field_list'
-like the dynamic form example if you don't want to use the 'has_field'
-field declaration sugar):
-
- package MyApp::Form::User;
+# object with which to initialize
+has 'init_object' => ( is => 'rw', clearer => 'clear_init_object' );
+has 'update_field_list' => ( is => 'rw',
+ isa => 'HashRef',
+ default => sub {{}},
+ traits => ['Hash'],
+ handles => {
+ clear_update_field_list => 'clear',
+ has_update_field_list => 'count',
+ },
+);
+has 'reload_after_update' => ( is => 'rw', isa => 'Bool' );
+# flags
+has [ 'verbose', 'processed', 'did_init_obj' ] => ( isa => 'Bool', is => 'rw' );
+has 'user_data' => ( isa => 'HashRef', is => 'rw' );
+has 'ctx' => ( is => 'rw', weak_ref => 1, clearer => 'clear_ctx' );
+has 'html_prefix' => ( isa => 'Bool', is => 'ro' );
+has 'active_column' => ( isa => 'Str', is => 'ro' );
+has 'http_method' => ( isa => 'Str', is => 'ro', default => 'post' );
+has 'enctype' => ( is => 'rw', isa => 'Str' );
+has 'css_class' => ( isa => 'Str', is => 'ro' );
+has 'style' => ( isa => 'Str', is => 'rw' );
- use HTML::FormHandler::Moose;
- extends 'HTML::FormHandler';
+has 'widget_tags' => (
+ traits => ['Hash'],
+ isa => 'HashRef',
+ is => 'ro',
+ default => sub {{}},
+ handles => {
+ get_tag => 'get',
+ set_tag => 'set',
+ tag_exists => 'exists',
+ },
+);
+has 'action' => ( is => 'rw' );
+has 'posted' => ( is => 'rw', isa => 'Bool', clearer => 'clear_posted' );
+has 'params' => (
+ traits => ['Hash'],
+ isa => 'HashRef',
+ is => 'rw',
+ default => sub { {} },
+ trigger => sub { shift->_munge_params(@_) },
+ handles => {
+ set_param => 'set',
+ get_param => 'get',
+ clear_params => 'clear',
+ has_params => 'count',
+ },
+);
+sub submitted { shift->has_params }
+has 'dependency' => ( isa => 'ArrayRef', is => 'rw' );
+has '_required' => (
+ traits => ['Array'],
+ isa => 'ArrayRef[HTML::FormHandler::Field]',
+ is => 'rw',
+ default => sub { [] },
+ handles => {
+ clear_required => 'clear',
+ add_required => 'push',
+ }
+);
- has '+item_class' => ( default => 'User' );
+{
+ use Moose::Util::TypeConstraints;
- has_field 'name' => ( type => 'Text' );
- has_field 'age' => ( type => 'PosInteger', apply => [ 'MinimumAge' ] );
- has_field 'birthdate' => ( type => 'DateTime' );
- has_field 'birthdate.month' => ( type => 'Month' ); # Explicitly split
- has_field 'birthdate.day' => ( type => 'MonthDay' ); # fields for renderer
- has_field 'birthdate.year' => ( type => 'Year' );
- has_field 'hobbies' => ( type => 'Multiple' );
- has_field 'address' => ( type => 'Text' );
- has_field 'city' => ( type => 'Text' );
- has_field 'state' => ( type => 'Select' );
- has_field 'email' => ( type => 'Email' );
+ my $tc = subtype as 'ClassName';
+ coerce $tc, from 'Str', via { Class::MOP::load_class($_); $_ };
- has '+dependency' => ( default => sub {
- [ ['address', 'city', 'state'], ]
- }
+ has 'params_class' => (
+ is => 'ro',
+ isa => $tc,
+ coerce => 1,
+ default => 'HTML::FormHandler::Params',
);
- subtype 'MinimumAge'
- => as 'Int'
- => where { $_ > 13 }
- => message { "You are not old enough to register" };
+ no Moose::Util::TypeConstraints;
+}
- no HTML::FormHandler::Moose;
- 1;
+has 'params_args' => ( is => 'ro', isa => 'ArrayRef' );
+sub BUILDARGS {
+ my $class = shift;
-A dynamic form - one that does not use a custom form class - may be
-created in using the 'field_list' attribute to set fields:
+ if ( scalar @_ == 1 && ref( $_[0]) ne 'HASH' ) {
+ my $arg = $_[0];
+ return blessed($arg) ? { item => $arg } : { item_id => $arg };
+ }
+ return $class->SUPER::BUILDARGS(@_);
+}
- my $form = HTML::FormHandler->new(
- name => 'user_form',
- item => $user,
- field_list => [
- 'username' => {
- type => 'Text',
- apply => [ { check => qr/^[0-9a-z]*/,
- message => 'Contains invalid characters' } ],
- },
- 'select_bar' => {
- type => 'Select',
- options => \@select_options,
- multiple => 1,
- size => 4,
- },
- ],
- );
+sub BUILD {
+ my $self = shift;
-FormHandler does not provide a custom controller for Catalyst because
-it isn't necessary. Interfacing to FormHandler is only a couple of
-lines of code. See L<HTML::FormHandler::Manual::Catalyst> for more
-details, or L<Catalyst::Manual::Tutorial::09_AdvancedCRUD::09_FormHandler>.
+ $self->apply_field_traits if $self->has_field_traits;
+ $self->apply_widget_role( $self, $self->widget_form, 'Form' )
+ if ( $self->widget_form && !$self->can('render') );
+ $self->_build_fields; # create the form fields (BuildFields.pm)
+ $self->build_active if $self->has_active; # set optional fields active
+ return if defined $self->item_id && !$self->item;
+ # load values from object (if any)
+ if ( my $init_object = $self->item || $self->init_object ) {
+ $self->_result_from_object( $self->result, $init_object );
+ }
+ else {
+ $self->_result_from_fields( $self->result );
+ }
+ $self->dump_fields if $self->verbose;
+ return;
+}
+sub process {
+ my $self = shift;
-=head1 DESCRIPTION
+ warn "HFH: process ", $self->name, "\n" if $self->verbose;
+ $self->clear if $self->processed;
+ $self->setup_form(@_);
+ $self->validate_form if $self->has_params;
+ $self->update_model if $self->validated;
+ $self->after_update_model if $self->validated;
+ $self->dump_fields if $self->verbose;
+ $self->processed(1);
+ return $self->validated;
+}
-HTML::FormHandler maintains a clean separation between form construction
-and form rendering. It allows you to define your forms and fields in a
-number of flexible ways. Although it provides renderers for HTML, you
-can define custom renderers for any kind of presentation.
+sub run {
+ my $self = shift;
+ $self->setup_form(@_);
+ $self->validate_form if $self->has_params;
+ $self->update_model if $self->validated;
+ $self->after_update_model if $self->validated;
+ my $result = $self->result;
+ $self->clear;
+ return $result;
+}
-Although documentation in this file provides some overview, it is mainly
-intended for API documentation. See L<HTML::FormHandler::Manual::Intro>
-for a more detailed introduction.
+sub db_validate {
+ my $self = shift;
+ my $fif = $self->fif;
+ $self->process($fif);
+ return $self->validated;
+}
-HTML::FormHandler allows you to define form fields and validators. It can
+sub clear {
+ my $self = shift;
+ $self->clear_data;
+ $self->clear_params;
+ $self->clear_ctx;
+ $self->processed(0);
+ $self->did_init_obj(0);
+ $self->clear_result;
+}
+
+sub values { shift->value }
+
+# deprecated?
+sub error_field_names {
+ my $self = shift;
+ my @error_fields = $self->error_fields;
+ return map { $_->name } @error_fields;
+}
+
+sub errors {
+ my $self = shift;
+ my @error_fields = $self->error_fields;
+ my @errors = $self->all_form_errors;
+ push @errors, map { $_->all_errors } @error_fields;
+ return @errors;
+}
+
+sub uuid {
+ my $form = shift;
+ require Data::UUID;
+ my $uuid = Data::UUID->new->create_str;
+ return qq[<input type="hidden" name="form_uuid" value="$uuid">];
+}
+
+sub validate_form {
+ my $self = shift;
+ my $params = $self->params;
+ $self->_set_dependency; # set required dependencies
+ $self->_fields_validate;
+ $self->_apply_actions;
+ $self->validate; # empty method for users
+ $self->validate_model; # model specific validation
+ $self->fields_set_value;
+ $self->_clear_dependency;
+ $self->get_error_fields;
+ $self->ran_validation(1);
+ $self->dump_validated if $self->verbose;
+ return $self->validated;
+}
+
+sub validate { 1 }
+
+sub has_errors {
+ my $self = shift;
+ return $self->has_error_fields || $self->has_form_errors;
+}
+sub num_errors {
+ my $self = shift;
+ return $self->num_error_fields + $self->num_form_errors;
+}
+
+sub after_update_model {
+ my $self = shift;
+ $self->_result_from_object( $self->result, $self->item )
+ if ( $self->reload_after_update && $self->item );
+}
+
+sub setup_form {
+ my ( $self, @args ) = @_;
+ if ( @args == 1 ) {
+ $self->params( $args[0] );
+ }
+ elsif ( @args > 1 ) {
+ my $hashref = {@args};
+ while ( my ( $key, $value ) = each %{$hashref} ) {
+ confess "invalid attribute '$key' passed to setup_form"
+ unless $self->can($key);
+ $self->$key($value);
+ }
+ }
+ if( $self->posted ) {
+ $self->set_param('__posted' => 1);
+ $self->clear_posted;
+ }
+ if ( $self->item_id && !$self->item ) {
+ $self->item( $self->build_item );
+ }
+ $self->clear_result;
+ $self->set_active;
+ $self->update_fields;
+ # initialization of Repeatable fields and Select options
+ # will be done in _result_from_object when there's an initial object
+ # in _result_from_input when there are params
+ # and by _result_from_fields for empty forms
+
+ if ( !$self->did_init_obj ) {
+ if ( my $init_object = $self->item || $self->init_object ) {
+ $self->_result_from_object( $self->result, $init_object );
+ }
+ elsif ( !$self->has_params ) {
+ # no initial object. empty form form must be initialized
+ $self->_result_from_fields( $self->result );
+ }
+ }
+ # There's some weirdness here because of trying to support supplying
+ # the db object in the ->new. May change to not support that?
+ my %params = ( %{ $self->params } );
+ if ( $self->has_params ) {
+ $self->clear_result;
+ $self->_result_from_input( $self->result, \%params, 1 );
+ }
+
+}
+
+# if active => [...] is set at process time, set 'active' flag
+sub set_active {
+ my $self = shift;
+ return unless $self->has_active;
+ foreach my $fname (@{$self->active}) {
+ my $field = $self->field($fname);
+ if ( $field ) {
+ $field->_active(1);
+ }
+ else {
+ warn "field $fname not found to set active";
+ }
+ }
+ $self->clear_active;
+}
+
+# if active => [...] is set at build time, remove 'inactive' flags
+sub build_active {
+ my $self = shift;
+ foreach my $fname (@{$self->active}) {
+ my $field = $self->field($fname);
+ if( $field ) {
+ $field->clear_inactive;
+ }
+ else {
+ warn "field $fname not found to set active";
+ }
+ }
+ $self->clear_active;
+}
+
+sub fif { shift->fields_fif(@_) }
+
+# this is subclassed by the model, which may
+# do a lot more than this
+sub init_value {
+ my ( $self, $field, $value ) = @_;
+ $field->init_value($value);
+ $field->_set_value($value);
+}
+
+sub _set_dependency {
+ my $self = shift;
+
+ my $depends = $self->dependency || return;
+ my $params = $self->params;
+ for my $group (@$depends) {
+ next if @$group < 2;
+ # process a group of fields
+ for my $name (@$group) {
+ # is there a value?
+ my $value = $params->{$name};
+ next unless defined $value;
+ # The exception is a boolean can be zero which we count as not set.
+ # This is to allow requiring a field when a boolean is true.
+ my $field = $self->field($name);
+ next if $self->field($name)->type eq 'Boolean' && $value == 0;
+ next unless has_some_value($value);
+ # one field was found non-blank, so set all to required
+ for (@$group) {
+ my $field = $self->field($_);
+ next unless $field && !$field->required;
+ $self->add_required($field); # save for clearing later.
+ $field->required(1);
+ }
+ last;
+ }
+ }
+}
+
+sub _clear_dependency {
+ my $self = shift;
+
+ $_->required(0) for @{$self->_required};
+ $self->clear_required;
+}
+
+sub peek {
+ my $self = shift;
+ my $string = "Form " . $self->name . "\n";
+ my $indent = ' ';
+ foreach my $field ( $self->sorted_fields ) {
+ $string .= $field->peek( $indent );
+ }
+ return $string;
+}
+
+sub _munge_params {
+ my ( $self, $params, $attr ) = @_;
+ my $_fix_params = $self->params_class->new( @{ $self->params_args || [] } );
+ my $new_params = $_fix_params->expand_hash($params);
+ if ( $self->html_prefix ) {
+ $new_params = $new_params->{ $self->name };
+ }
+ $new_params = {} if !defined $new_params;
+ $self->{params} = $new_params;
+}
+
+after 'get_error_fields' => sub {
+ my $self = shift;
+ foreach my $err_res (@{$self->result->error_results}) {
+ $self->result->push_errors($err_res->all_errors);
+ }
+};
+
+sub add_form_error {
+ my ( $self, @message ) = @_;
+
+ unless ( defined $message[0] ) {
+ @message = ('form is invalid');
+ }
+ my $out;
+ try {
+ $out = $self->_localize(@message);
+ }
+ catch {
+ die "Error occurred localizing error message for " . $self->name . ". $_";
+ };
+ $self->push_form_errors($out);
+ return;
+}
+
+sub apply_field_traits {
+ my $self = shift;
+ my $fmeta = HTML::FormHandler::Field->meta;
+ $fmeta->make_mutable;
+ Moose::Util::apply_all_roles( $fmeta, @{$self->field_traits});
+ $fmeta->make_immutable;
+}
+
+sub get_default_value { }
+sub _can_deflate { }
+
+sub update_fields {
+ my $self = shift;
+ return unless $self->has_update_field_list;
+ my $fields = $self->update_field_list;
+ foreach my $key ( keys %$fields ) {
+ my $field = $self->field($key);
+ unless( $field ) {
+ die "Field $key is not found and cannot be updated by update_fields";
+ }
+ while ( my ( $attr_name, $attr_value ) = each %{$fields->{$key}} ) {
+ confess "invalid attribute '$attr_name' passed to update_field_list"
+ unless $field->can($attr_name);
+ $field->$attr_name($attr_value);
+ }
+ }
+ $self->clear_update_field_list;
+}
+
+
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler - HTML forms using Moose
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 SYNOPSIS
+
+ use HTML::FormHandler; # or a custom form: use MyApp::Form::User;
+ my $form = HTML::FormHandler->new( .... );
+ $form->process( params => $params );
+ my $rendered_form = $form->render;
+ if( $form->validated ) {
+ # perform validated form actions
+ }
+ else {
+ # perform non-validated actions
+ }
+
+Or, if you want to use a form 'result' (which contains only the form
+values and error messages) instead:
+
+ use MyApp::Form; # or a generic form: use HTML::FormHandler;
+ my $form = MyApp::Form->new( .... );
+ my $result = $form->run( params => $params );
+ if( $result->validated ) {
+ # perform validated form actions
+ }
+ else {
+ # perform non-validated actions
+ $result->render;
+ }
+
+An example of a custom form class (you could also use a 'field_list'
+like the dynamic form example if you don't want to use the 'has_field'
+field declaration sugar):
+
+ package MyApp::Form::User;
+
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has '+item_class' => ( default => 'User' );
+
+ has_field 'name' => ( type => 'Text' );
+ has_field 'age' => ( type => 'PosInteger', apply => [ 'MinimumAge' ] );
+ has_field 'birthdate' => ( type => 'DateTime' );
+ has_field 'birthdate.month' => ( type => 'Month' ); # Explicitly split
+ has_field 'birthdate.day' => ( type => 'MonthDay' ); # fields for renderer
+ has_field 'birthdate.year' => ( type => 'Year' );
+ has_field 'hobbies' => ( type => 'Multiple' );
+ has_field 'address' => ( type => 'Text' );
+ has_field 'city' => ( type => 'Text' );
+ has_field 'state' => ( type => 'Select' );
+ has_field 'email' => ( type => 'Email' );
+
+ has '+dependency' => ( default => sub {
+ [ ['address', 'city', 'state'], ]
+ }
+ );
+
+ subtype 'MinimumAge'
+ => as 'Int'
+ => where { $_ > 13 }
+ => message { "You are not old enough to register" };
+
+ no HTML::FormHandler::Moose;
+ 1;
+
+A dynamic form - one that does not use a custom form class - may be
+created in using the 'field_list' attribute to set fields:
+
+ my $form = HTML::FormHandler->new(
+ name => 'user_form',
+ item => $user,
+ field_list => [
+ 'username' => {
+ type => 'Text',
+ apply => [ { check => qr/^[0-9a-z]*/,
+ message => 'Contains invalid characters' } ],
+ },
+ 'select_bar' => {
+ type => 'Select',
+ options => \@select_options,
+ multiple => 1,
+ size => 4,
+ },
+ ],
+ );
+
+FormHandler does not provide a custom controller for Catalyst because
+it isn't necessary. Interfacing to FormHandler is only a couple of
+lines of code. See L<HTML::FormHandler::Manual::Catalyst> for more
+details, or L<Catalyst::Manual::Tutorial::09_AdvancedCRUD::09_FormHandler>.
+
+=head1 DESCRIPTION
+
+HTML::FormHandler maintains a clean separation between form construction
+and form rendering. It allows you to define your forms and fields in a
+number of flexible ways. Although it provides renderers for HTML, you
+can define custom renderers for any kind of presentation.
+
+Although documentation in this file provides some overview, it is mainly
+intended for API documentation. See L<HTML::FormHandler::Manual::Intro>
+for a more detailed introduction.
+
+HTML::FormHandler allows you to define form fields and validators. It can
be used for both database and non-database forms, and will
automatically update or create rows in a database. It can be used
to process structured data that doesn't come from an HTML form.
-One of its goals is to keep the controller/application program interface as
-simple as possible, and to minimize the duplication of code. In most cases,
+One of its goals is to keep the controller/application program interface as
+simple as possible, and to minimize the duplication of code. In most cases,
interfacing your controller to your form is only a few lines of code.
With FormHandler you'll never spend hours trying to figure out how to make a
@@ -151,16 +630,15 @@ a lot of flexibility in what you can do.
HTML::FormHandler provides rendering through roles which are applied to
form and field classes (although there's no reason you couldn't write
-a renderer as an external object either). There are currently two flavors:
-all-in-one solutions like L<HTML::FormHandler::Render::Simple> and
-L<HTML::FormHandler::Render::Table> that contain methods for rendering
-field widget classes, and the L<HTML::FormHandler::Widget> roles, which are
-more atomic roles which are automatically applied to fields and form if a
+a renderer as an external object either). There are currently two flavors:
+all-in-one solutions like L<HTML::FormHandler::Render::Simple> and
+L<HTML::FormHandler::Render::Table> that contain methods for rendering
+field widget classes, and the L<HTML::FormHandler::Widget> roles, which are
+more atomic roles which are automatically applied to fields and form if a
'render' method does not already exist. See
L<HTML::FormHandler::Manual::Rendering> for more details.
(And you can easily use hand-build forms - FormHandler doesn't care.)
-
The typical application for FormHandler would be in a Catalyst, DBIx::Class,
Template Toolkit web application, but use is not limited to that. FormHandler
can be used in any Perl application.
@@ -378,8 +856,8 @@ add fields to the form depending on some other state.
Used to dynamically set particular field attributes on the 'process' (or
'run') call.
- $form->process( update_field_list => {
- foo_date => { format => '%m/%e/%Y', date_start => '10-01-01' } },
+ $form->process( update_field_list => {
+ foo_date => { format => '%m/%e/%Y', date_start => '10-01-01' } },
params => $params );
The 'update_field_list' is processed by the 'update_fields' form method,
@@ -444,654 +922,187 @@ Pass a second true value to die on errors.
Most validation is performed on a per-field basis, and there are a number
of different places in which validation can be performed.
-=head3 Apply actions
-
-The 'actions' array contains a sequence of transformations and constraints
-(including Moose type constraints) which will be applied in order. The 'apply'
-sugar is used to add to the actions array in field classes. In a field definition
-elements of the 'apply' array will added to the 'actions' array.
-
-The current value of the field is passed in to the subroutines, but it has
-no access to other field information. If you need more information to
-perform validation, you should use one of the other validation methods.
-
-L<HTML::FormHandler::Field::Compound> fields receive as value
-a hash containing values of their child fields - this may be used for
-easy creation of objects (like DateTime).
-See L<HTML::FormHandler::Field/apply> for more documentation.
-
- has_field 'test' => ( apply => [ 'MyConstraint',
- { check => sub {... },
- message => '....' },
- { transform => sub { ... },
- message => '....' }
- ] );
-
-=head3 Field class validate method
-
-The 'validate' method can be used in custom field classes to perform additional
-validation. It has access to the field ($self). This method is called after the
-actions are performed.
-
-=head3 Form class validation for individual fields
-
-You can define a method in your form class to perform validation on a field.
-This method is the equivalent of the field class validate method except it is
-in the form class, so you might use this
-validation method if you don't want to create a field subclass.
-
-It has access to the form ($self) and the field.
-This method is called after the field class 'validate' method, and is not
-called if the value for the field is empty ('', undef). (If you want an
-error message when the field is empty, use the 'required' flag and message.)
-The name of this method can be set with 'set_validate' on the field. The
-default is 'validate_' plus the field name:
-
- sub validate_testfield { my ( $self, $field ) = @_; ... }
-
-If the field name has dots they should be replaced with underscores.
-
-=head3 validate
-
-(This method used to be called 'cross_validate'. It was renamed to 'validate'
-to make the api more consistent.)
-This is a form method that is useful for cross checking values after they have
-been saved as their final validated value, and for performing more complex
-dependency validation. It is called after all other field validation is done,
-and whether or not validation has succeeded, so it has access to the
-post-validation values of all the fields.
-
-This is the best place to do validation checks that depend on the values of
-more than one field.
-
-=head2 Accessing errors
-
-Set an error in a field with C<< $field->add_error('some error string'); >>.
-Set a form error not tied to a specific field with
-C<< $self->add_form_error('another error string'); >>.
-
- has_errors - returns true or false
- error_fields - returns list of fields with errors
- errors - returns array of error messages for the entire form
- num_errors - number of errors in form
-
-Each field has an array of error messages. (errors, has_errors, num_errors,
-clear_errors)
-
- $form->field('title')->errors;
-
-Compound fields also have an array of error_fields.
-
-=head2 Clear form state
-
-The clear method is called at the beginning of 'process' if the form
-object is reused, such as when it is persistent in a Moose attribute,
-or in tests. If you add other attributes to your form that are set on
-each request, you may need to clear those yourself.
-
-If you do not call the form's 'process' method on a persistent form,
-such as in a REST controller's non-POST method or if you only call
-process when the form is posted, you will also need to call C<< $form->clear >>.
-
-=head2 Miscellaneous attributes
-
-=head3 name
-
-The form's name. Useful for multiple forms.
-It is used to construct the default 'id' for fields, and is used
-for the HTML field name when 'html_prefix' is set.
-The default is "form" + a one to three digit random number.
-
-=head3 init_object
-
-An 'init_object' may be used instead of the 'item' to pre-populate the values
-in the form. This can be useful when populating a form from default values
-stored in a similar but different object than the one the form is creating.
-The 'init_object' should be either a hash or the same type of object that
-the model uses (a DBIx::Class row for the DBIC model). It can be set in a
-variety of ways:
-
- my $form = MyApp::Form->new( init_object => { .... } );
- $form->process( init_object => {...}, ... );
- has '+init_object' => ( default => sub { { .... } } );
- sub init_object { my $self = shift; .... }
-
-The method version is useful if the organization of data in your form does
-not map to an existing or database object in an automatic way, and you need
-to create a different type of object for initialization. (You might also
-want to do 'update_model' yourself.)
-
-=head3 ctx
-
-Place to store application context for your use in your form's methods.
-
-=head3 language_handle
-
-See 'language_handle' and '_build_language_handle' in
-L<HTML::FormHandler::TraitFor::I18N>.
-
-=head3 dependency
-
-Arrayref of arrayrefs of fields. If one of a group of fields has a
-value, then all of the group are set to 'required'.
-
- has '+dependency' => ( default => sub { [
- ['street', 'city', 'state', 'zip' ],] }
- );
-
-=head2 Flags
-
-=head3 validated, is_valid
-
-Flag that indicates if form has been validated. You might want to use
-this flag if you're doing something in between process and returning,
-such as setting a stash key. ('is_valid' is a synonym for this flag)
-
- $form->process( ... );
- $c->stash->{...} = ...;
- return unless $form->validated;
-
-=head3 ran_validation
-
-Flag to indicate that validation has been run. This flag will be
-false when the form is initially loaded and displayed, since
-validation is not run until FormHandler has params to validate.
-
-=head3 verbose
-
-Flag to dump diagnostic information. See 'dump_fields' and
-'dump_validated'.
-
-=head3 html_prefix
-
-Flag to indicate that the form name is used as a prefix for fields
-in an HTML form. Useful for multiple forms
-on the same HTML page. The prefix is stripped off of the fields
-before creating the internal field name, and added back in when
-returning a parameter hash from the 'fif' method. For example,
-the field name in the HTML form could be "book.borrower", and
-the field name in the FormHandler form (and the database column)
-would be just "borrower".
-
- has '+name' => ( default => 'book' );
- has '+html_prefix' => ( default => 1 );
-
-Also see the Field attribute "html_name", a convenience function which
-will return the form name + "." + field full_name
-
-=head2 For use in HTML
-
- http_method - For storing 'post' or 'get'
- action - Store the form 'action' on submission. No default value.
- enctype - Request enctype
- uuid - generates a string containing an HTML field with UUID
-
-=cut
-
-# Moose attributes
-has 'name' => (
- isa => 'Str',
- is => 'rw',
- default => sub { return 'form' . int( rand 1000 ) }
-);
-# for consistency in api with field nodes
-has 'form' => (
- isa => 'HTML::FormHandler',
- is => 'rw',
- weak_ref => 1,
- predicate => 'has_form',
- lazy => 1,
- default => sub { shift }
-);
-has 'parent' => ( is => 'rw' );
-has 'result' => (
- isa => 'HTML::FormHandler::Result',
- is => 'ro',
- writer => '_set_result',
- clearer => 'clear_result',
- lazy => 1,
- builder => 'build_result',
- predicate => 'has_result',
- handles => [
- 'input', '_set_input', '_clear_input', 'has_input',
- 'value', '_set_value', '_clear_value', 'has_value',
- 'add_result', 'results', 'validated', 'ran_validation',
- 'is_valid',
- 'form_errors', 'all_form_errors', 'push_form_errors', 'clear_form_errors',
- 'has_form_errors', 'num_form_errors',
- ],
-);
+=head3 Apply actions
-sub build_result {
- my $self = shift;
- my $result = HTML::FormHandler::Result->new( name => $self->name, form => $self );
- if ( $self->widget_form ) {
- $self->apply_widget_role( $result, $self->widget_form, 'Form' );
- }
- return $result;
-}
+The 'actions' array contains a sequence of transformations and constraints
+(including Moose type constraints) which will be applied in order. The 'apply'
+sugar is used to add to the actions array in field classes. In a field definition
+elements of the 'apply' array will added to the 'actions' array.
-has 'field_traits' => ( is => 'ro', traits => ['Array'], isa => 'ArrayRef',
- default => sub {[]}, handles => { 'has_field_traits' => 'count' } );
-has 'widget_name_space' => ( is => 'ro', isa => 'ArrayRef[Str]', default => sub {[]} );
-has 'widget_form' => ( is => 'ro', isa => 'Str', default => 'Simple' );
-has 'widget_wrapper' => ( is => 'ro', isa => 'Str', default => 'Simple' );
-has 'active' => (
- is => 'rw',
- traits => ['Array'],
- isa => 'ArrayRef[Str]',
- default => sub {[]},
- handles => {
- add_active => 'push',
- has_active => 'count',
- clear_active => 'clear',
- }
-);
-
+The current value of the field is passed in to the subroutines, but it has
+no access to other field information. If you need more information to
+perform validation, you should use one of the other validation methods.
-# object with which to initialize
-has 'init_object' => ( is => 'rw', clearer => 'clear_init_object' );
-has 'update_field_list' => ( is => 'rw',
- isa => 'HashRef',
- default => sub {{}},
- traits => ['Hash'],
- handles => {
- clear_update_field_list => 'clear',
- has_update_field_list => 'count',
- },
-);
-has 'reload_after_update' => ( is => 'rw', isa => 'Bool' );
-# flags
-has [ 'verbose', 'processed', 'did_init_obj' ] => ( isa => 'Bool', is => 'rw' );
-has 'user_data' => ( isa => 'HashRef', is => 'rw' );
-has 'ctx' => ( is => 'rw', weak_ref => 1, clearer => 'clear_ctx' );
-has 'html_prefix' => ( isa => 'Bool', is => 'ro' );
-has 'active_column' => ( isa => 'Str', is => 'ro' );
-has 'http_method' => ( isa => 'Str', is => 'ro', default => 'post' );
-has 'enctype' => ( is => 'rw', isa => 'Str' );
-has 'widget_tags' => (
- traits => ['Hash'],
- isa => 'HashRef',
- is => 'ro',
- default => sub {{}},
- handles => {
- get_tag => 'get',
- set_tag => 'set',
- tag_exists => 'exists',
- },
-);
-has 'action' => ( is => 'rw' );
-has 'posted' => ( is => 'rw', isa => 'Bool', clearer => 'clear_posted' );
-has 'params' => (
- traits => ['Hash'],
- isa => 'HashRef',
- is => 'rw',
- default => sub { {} },
- trigger => sub { shift->_munge_params(@_) },
- handles => {
- set_param => 'set',
- get_param => 'get',
- clear_params => 'clear',
- has_params => 'count',
- },
-);
-sub submitted { shift->has_params }
-has 'dependency' => ( isa => 'ArrayRef', is => 'rw' );
-has '_required' => (
- traits => ['Array'],
- isa => 'ArrayRef[HTML::FormHandler::Field]',
- is => 'rw',
- default => sub { [] },
- handles => {
- clear_required => 'clear',
- add_required => 'push',
- }
-);
+L<HTML::FormHandler::Field::Compound> fields receive as value
+a hash containing values of their child fields - this may be used for
+easy creation of objects (like DateTime).
+See L<HTML::FormHandler::Field/apply> for more documentation.
-{
- use Moose::Util::TypeConstraints;
+ has_field 'test' => ( apply => [ 'MyConstraint',
+ { check => sub {... },
+ message => '....' },
+ { transform => sub { ... },
+ message => '....' }
+ ] );
- my $tc = subtype as 'ClassName';
- coerce $tc, from 'Str', via { Class::MOP::load_class($_); $_ };
+=head3 Field class validate method
- has 'params_class' => (
- is => 'ro',
- isa => $tc,
- coerce => 1,
- default => 'HTML::FormHandler::Params',
- );
+The 'validate' method can be used in custom field classes to perform additional
+validation. It has access to the field ($self). This method is called after the
+actions are performed.
- no Moose::Util::TypeConstraints;
-}
+=head3 Form class validation for individual fields
-has 'params_args' => ( is => 'ro', isa => 'ArrayRef' );
+You can define a method in your form class to perform validation on a field.
+This method is the equivalent of the field class validate method except it is
+in the form class, so you might use this
+validation method if you don't want to create a field subclass.
-sub BUILDARGS {
- my $class = shift;
+It has access to the form ($self) and the field.
+This method is called after the field class 'validate' method, and is not
+called if the value for the field is empty ('', undef). (If you want an
+error message when the field is empty, use the 'required' flag and message.)
+The name of this method can be set with 'set_validate' on the field. The
+default is 'validate_' plus the field name:
- if ( scalar @_ == 1 && ref( $_[0]) ne 'HASH' ) {
- my $arg = $_[0];
- return blessed($arg) ? { item => $arg } : { item_id => $arg };
- }
- return $class->SUPER::BUILDARGS(@_);
-}
+ sub validate_testfield { my ( $self, $field ) = @_; ... }
-sub BUILD {
- my $self = shift;
+If the field name has dots they should be replaced with underscores.
- $self->apply_field_traits if $self->has_field_traits;
- $self->apply_widget_role( $self, $self->widget_form, 'Form' )
- if ( $self->widget_form && !$self->can('render') );
- $self->_build_fields; # create the form fields (BuildFields.pm)
- $self->build_active if $self->has_active; # set optional fields active
- return if defined $self->item_id && !$self->item;
- # load values from object (if any)
- if ( my $init_object = $self->item || $self->init_object ) {
- $self->_result_from_object( $self->result, $init_object );
- }
- else {
- $self->_result_from_fields( $self->result );
- }
- $self->dump_fields if $self->verbose;
- return;
-}
+=head3 validate
-sub process {
- my $self = shift;
+(This method used to be called 'cross_validate'. It was renamed to 'validate'
+to make the api more consistent.)
+This is a form method that is useful for cross checking values after they have
+been saved as their final validated value, and for performing more complex
+dependency validation. It is called after all other field validation is done,
+and whether or not validation has succeeded, so it has access to the
+post-validation values of all the fields.
- warn "HFH: process ", $self->name, "\n" if $self->verbose;
- $self->clear if $self->processed;
- $self->setup_form(@_);
- $self->validate_form if $self->has_params;
- $self->update_model if $self->validated;
- $self->after_update_model if $self->validated;
- $self->dump_fields if $self->verbose;
- $self->processed(1);
- return $self->validated;
-}
+This is the best place to do validation checks that depend on the values of
+more than one field.
-sub run {
- my $self = shift;
- $self->setup_form(@_);
- $self->validate_form if $self->has_params;
- $self->update_model if $self->validated;
- $self->after_update_model if $self->validated;
- my $result = $self->result;
- $self->clear;
- return $result;
-}
+=head2 Accessing errors
-sub db_validate {
- my $self = shift;
- my $fif = $self->fif;
- $self->process($fif);
- return $self->validated;
-}
+Set an error in a field with C<< $field->add_error('some error string'); >>.
+Set a form error not tied to a specific field with
+C<< $self->add_form_error('another error string'); >>.
-sub clear {
- my $self = shift;
- $self->clear_data;
- $self->clear_params;
- $self->clear_ctx;
- $self->processed(0);
- $self->did_init_obj(0);
- $self->clear_result;
-}
+ has_errors - returns true or false
+ error_fields - returns list of fields with errors
+ errors - returns array of error messages for the entire form
+ num_errors - number of errors in form
-sub values { shift->value }
+Each field has an array of error messages. (errors, has_errors, num_errors,
+clear_errors)
-# deprecated?
-sub error_field_names {
- my $self = shift;
- my @error_fields = $self->error_fields;
- return map { $_->name } @error_fields;
-}
+ $form->field('title')->errors;
-sub errors {
- my $self = shift;
- my @error_fields = $self->error_fields;
- my @errors = $self->all_form_errors;
- push @errors, map { $_->all_errors } @error_fields;
- return @errors;
-}
+Compound fields also have an array of error_fields.
-sub uuid {
- my $form = shift;
- require Data::UUID;
- my $uuid = Data::UUID->new->create_str;
- return qq[<input type="hidden" name="form_uuid" value="$uuid">];
-}
+=head2 Clear form state
-sub validate_form {
- my $self = shift;
- my $params = $self->params;
- $self->_set_dependency; # set required dependencies
- $self->_fields_validate;
- $self->_apply_actions;
- $self->validate; # empty method for users
- $self->validate_model; # model specific validation
- $self->fields_set_value;
- $self->_clear_dependency;
- $self->get_error_fields;
- $self->ran_validation(1);
- $self->dump_validated if $self->verbose;
- return $self->validated;
-}
+The clear method is called at the beginning of 'process' if the form
+object is reused, such as when it is persistent in a Moose attribute,
+or in tests. If you add other attributes to your form that are set on
+each request, you may need to clear those yourself.
+
+If you do not call the form's 'process' method on a persistent form,
+such as in a REST controller's non-POST method or if you only call
+process when the form is posted, you will also need to call C<< $form->clear >>.
+
+=head2 Miscellaneous attributes
+
+=head3 name
-sub validate { 1 }
+The form's name. Useful for multiple forms.
+It is used to construct the default 'id' for fields, and is used
+for the HTML field name when 'html_prefix' is set.
+The default is "form" + a one to three digit random number.
-sub has_errors {
- my $self = shift;
- return $self->has_error_fields || $self->has_form_errors;
-}
-sub num_errors {
- my $self = shift;
- return $self->num_error_fields + $self->num_form_errors;
-}
+=head3 init_object
-sub after_update_model {
- my $self = shift;
- $self->_result_from_object( $self->result, $self->item )
- if ( $self->reload_after_update && $self->item );
-}
+An 'init_object' may be used instead of the 'item' to pre-populate the values
+in the form. This can be useful when populating a form from default values
+stored in a similar but different object than the one the form is creating.
+The 'init_object' should be either a hash or the same type of object that
+the model uses (a DBIx::Class row for the DBIC model). It can be set in a
+variety of ways:
-sub setup_form {
- my ( $self, @args ) = @_;
- if ( @args == 1 ) {
- $self->params( $args[0] );
- }
- elsif ( @args > 1 ) {
- my $hashref = {@args};
- while ( my ( $key, $value ) = each %{$hashref} ) {
- confess "invalid attribute '$key' passed to setup_form"
- unless $self->can($key);
- $self->$key($value);
- }
- }
- if( $self->posted ) {
- $self->set_param('__posted' => 1);
- $self->clear_posted;
- }
- if ( $self->item_id && !$self->item ) {
- $self->item( $self->build_item );
- }
- $self->clear_result;
- $self->set_active;
- $self->update_fields;
- # initialization of Repeatable fields and Select options
- # will be done in _result_from_object when there's an initial object
- # in _result_from_input when there are params
- # and by _result_from_fields for empty forms
+ my $form = MyApp::Form->new( init_object => { .... } );
+ $form->process( init_object => {...}, ... );
+ has '+init_object' => ( default => sub { { .... } } );
+ sub init_object { my $self = shift; .... }
- if ( !$self->did_init_obj ) {
- if ( my $init_object = $self->item || $self->init_object ) {
- $self->_result_from_object( $self->result, $init_object );
- }
- elsif ( !$self->has_params ) {
- # no initial object. empty form form must be initialized
- $self->_result_from_fields( $self->result );
- }
- }
- # There's some weirdness here because of trying to support supplying
- # the db object in the ->new. May change to not support that?
- my %params = ( %{ $self->params } );
- if ( $self->has_params ) {
- $self->clear_result;
- $self->_result_from_input( $self->result, \%params, 1 );
- }
+The method version is useful if the organization of data in your form does
+not map to an existing or database object in an automatic way, and you need
+to create a different type of object for initialization. (You might also
+want to do 'update_model' yourself.)
-}
+=head3 ctx
-# if active => [...] is set at process time, set 'active' flag
-sub set_active {
- my $self = shift;
- return unless $self->has_active;
- foreach my $fname (@{$self->active}) {
- my $field = $self->field($fname);
- if ( $field ) {
- $field->_active(1);
- }
- else {
- warn "field $fname not found to set active";
- }
- }
- $self->clear_active;
-}
+Place to store application context for your use in your form's methods.
-# if active => [...] is set at build time, remove 'inactive' flags
-sub build_active {
- my $self = shift;
- foreach my $fname (@{$self->active}) {
- my $field = $self->field($fname);
- if( $field ) {
- $field->clear_inactive;
- }
- else {
- warn "field $fname not found to set active";
- }
- }
- $self->clear_active;
-}
+=head3 language_handle
-sub fif { shift->fields_fif(@_) }
+See 'language_handle' and '_build_language_handle' in
+L<HTML::FormHandler::TraitFor::I18N>.
-# this is subclassed by the model, which may
-# do a lot more than this
-sub init_value {
- my ( $self, $field, $value ) = @_;
- $field->init_value($value);
- $field->_set_value($value);
-}
+=head3 dependency
-sub _set_dependency {
- my $self = shift;
+Arrayref of arrayrefs of fields. If one of a group of fields has a
+value, then all of the group are set to 'required'.
- my $depends = $self->dependency || return;
- my $params = $self->params;
- for my $group (@$depends) {
- next if @$group < 2;
- # process a group of fields
- for my $name (@$group) {
- # is there a value?
- my $value = $params->{$name};
- next unless defined $value;
- # The exception is a boolean can be zero which we count as not set.
- # This is to allow requiring a field when a boolean is true.
- my $field = $self->field($name);
- next if $self->field($name)->type eq 'Boolean' && $value == 0;
- next unless has_some_value($value);
- # one field was found non-blank, so set all to required
- for (@$group) {
- my $field = $self->field($_);
- next unless $field && !$field->required;
- $self->add_required($field); # save for clearing later.
- $field->required(1);
- }
- last;
- }
- }
-}
+ has '+dependency' => ( default => sub { [
+ ['street', 'city', 'state', 'zip' ],] }
+ );
-sub _clear_dependency {
- my $self = shift;
+=head2 Flags
- $_->required(0) for @{$self->_required};
- $self->clear_required;
-}
+=head3 validated, is_valid
-sub peek {
- my $self = shift;
- my $string = "Form " . $self->name . "\n";
- my $indent = ' ';
- foreach my $field ( $self->sorted_fields ) {
- $string .= $field->peek( $indent );
- }
- return $string;
-}
+Flag that indicates if form has been validated. You might want to use
+this flag if you're doing something in between process and returning,
+such as setting a stash key. ('is_valid' is a synonym for this flag)
-sub _munge_params {
- my ( $self, $params, $attr ) = @_;
- my $_fix_params = $self->params_class->new( @{ $self->params_args || [] } );
- my $new_params = $_fix_params->expand_hash($params);
- if ( $self->html_prefix ) {
- $new_params = $new_params->{ $self->name };
- }
- $new_params = {} if !defined $new_params;
- $self->{params} = $new_params;
-}
+ $form->process( ... );
+ $c->stash->{...} = ...;
+ return unless $form->validated;
-after 'get_error_fields' => sub {
- my $self = shift;
- foreach my $err_res (@{$self->result->error_results}) {
- $self->result->push_errors($err_res->all_errors);
- }
-};
+=head3 ran_validation
-sub add_form_error {
- my ( $self, @message ) = @_;
+Flag to indicate that validation has been run. This flag will be
+false when the form is initially loaded and displayed, since
+validation is not run until FormHandler has params to validate.
- unless ( defined $message[0] ) {
- @message = ('form is invalid');
- }
- my $out;
- try {
- $out = $self->_localize(@message);
- }
- catch {
- die "Error occurred localizing error message for " . $self->name . ". $_";
- };
- $self->push_form_errors($out);
- return;
-}
+=head3 verbose
-sub apply_field_traits {
- my $self = shift;
- my $fmeta = HTML::FormHandler::Field->meta;
- $fmeta->make_mutable;
- Moose::Util::apply_all_roles( $fmeta, @{$self->field_traits});
- $fmeta->make_immutable;
-}
+Flag to dump diagnostic information. See 'dump_fields' and
+'dump_validated'.
-sub get_default_value { }
-sub _can_deflate { }
+=head3 html_prefix
-sub update_fields {
- my $self = shift;
- return unless $self->has_update_field_list;
- my $fields = $self->update_field_list;
- foreach my $key ( keys %$fields ) {
- my $field = $self->field($key);
- unless( $field ) {
- die "Field $key is not found and cannot be updated by update_fields";
- }
- while ( my ( $attr_name, $attr_value ) = each %{$fields->{$key}} ) {
- confess "invalid attribute '$attr_name' passed to update_field_list"
- unless $field->can($attr_name);
- $field->$attr_name($attr_value);
- }
- }
- $self->clear_update_field_list;
-}
+Flag to indicate that the form name is used as a prefix for fields
+in an HTML form. Useful for multiple forms
+on the same HTML page. The prefix is stripped off of the fields
+before creating the internal field name, and added back in when
+returning a parameter hash from the 'fif' method. For example,
+the field name in the HTML form could be "book.borrower", and
+the field name in the FormHandler form (and the database column)
+would be just "borrower".
+
+ has '+name' => ( default => 'book' );
+ has '+html_prefix' => ( default => 1 );
+
+Also see the Field attribute "html_name", a convenience function which
+will return the form name + "." + field full_name
+
+=head2 For use in HTML
+
+ http_method - For storing 'post' or 'get'
+ action - Store the form 'action' on submission. No default value.
+ enctype - Request enctype
+ uuid - generates a string containing an HTML field with UUID
=head1 SUPPORT
@@ -1133,7 +1144,6 @@ L<HTML::FormHandler::Render::Table>
L<HTML::FormHandler::Moose>
-
=head1 CONTRIBUTORS
gshank: Gerda Shank E<lt>gshank at cpan.orgE<gt>
@@ -1158,13 +1168,16 @@ jnapiorkowski: John Napiorkowski
Initially based on the source code of L<Form::Processor> by Bill Moseley
-=head1 COPYRIGHT
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+This software is copyright (c) 2010 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
-__PACKAGE__->meta->make_immutable;
-use namespace::autoclean;
-1;
diff --git a/lib/HTML/FormHandler/BuildFields.pm b/lib/HTML/FormHandler/BuildFields.pm
index 8fcf87c..34b571f 100644
--- a/lib/HTML/FormHandler/BuildFields.pm
+++ b/lib/HTML/FormHandler/BuildFields.pm
@@ -1,20 +1,9 @@
package HTML::FormHandler::BuildFields;
+# ABSTRACT: role to build field array
use Moose::Role;
use Try::Tiny;
-=head1 NAME
-
-HTML::FormHandler::BuildFields - role to build field array
-
-=head1 SYNOPSIS
-
-These are the methods that are necessary to build the fields arrays
-in a form. This is a role which is composed into L<HTML::FormHandler>.
-
-Internal code only. This role has no user interfaces.
-
-=cut
has 'fields_from_model' => ( isa => 'Bool', is => 'rw' );
@@ -177,11 +166,11 @@ sub _make_field {
{
push @classes, $ns . "::" . $type;
}
- # look for Field in possible namespaces
+ # look for Field in possible namespaces
my $loaded;
my $class;
foreach my $try ( @classes ) {
- try {
+ try {
Class::MOP::load_class($try);
$loaded++;
$class = $try;
@@ -281,9 +270,9 @@ sub new_field_with_traits {
push @traits, $widget_role, $wrapper_role;
}
if( @traits ) {
- $field = $class->new_with_traits( traits => \@traits, %{$field_attr} );
+ $field = $class->new_with_traits( traits => \@traits, %{$field_attr} );
}
- else {
+ else {
$field = $class->new( %{$field_attr} );
}
if( $field->form ) {
@@ -295,16 +284,37 @@ sub new_field_with_traits {
return $field;
}
-=head1 AUTHORS
+use namespace::autoclean;
+1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::BuildFields - role to build field array
+
+=head1 VERSION
-HTML::FormHandler Contributors; see HTML::FormHandler
+version 0.32002
-=head1 COPYRIGHT
+=head1 SYNOPSIS
+
+These are the methods that are necessary to build the fields arrays
+in a form. This is a role which is composed into L<HTML::FormHandler>.
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+Internal code only. This role has no user interfaces.
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
-use namespace::autoclean;
-1;
diff --git a/lib/HTML/FormHandler/Field.pm b/lib/HTML/FormHandler/Field.pm
index 0d27ad2..99823ba 100644
--- a/lib/HTML/FormHandler/Field.pm
+++ b/lib/HTML/FormHandler/Field.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Field;
+# ABSTRACT: base class for fields
use HTML::FormHandler::Moose;
use HTML::FormHandler::Field::Result;
@@ -12,1152 +13,1159 @@ with 'HTML::FormHandler::TraitFor::I18N';
our $VERSION = '0.02';
-=head1 NAME
-
-HTML::FormHandler::Field - Base class for HTML::FormHandler Fields
-
-=head1 SYNOPSIS
-
-Instances of Field subclasses are generally built by L<HTML::FormHandler>
-from 'has_field' declarations or the field_list, but they can also be constructed
-using new (usually for test purposes).
-
- use HTML::FormHandler::Field::Text;
- my $field = HTML::FormHandler::Field::Text->new( name => $name, ... );
-
-In your custom field class:
-
- package MyApp::Field::MyText;
- use HTML::FormHandler::Moose;
- extends 'HTML::FormHandler::Field::Text';
-
- has 'my_attribute' => ( isa => 'Str', is => 'rw' );
-
- apply [ { transform => sub { ... } },
- { check => ['fighter', 'bard', 'mage' ], message => '....' }
- ];
- 1;
-
-=head1 DESCRIPTION
-
-This is the base class for form fields. The 'type' of a field class
-is used in the FormHandler field_list or has_field to identify which field class to
-load. If the type is not specified, it defaults to Text.
-
-There are two rough categories of Field classes: those that do extra processing
-and those that are simple validators. The 'Compound', 'Repeatable', and
-'Select' fields are fields that are functional.
-
-A number of field classes are provided by the distribution. The basic
-for-validation (as opposed to 'functional') field types are:
-
- Text
- Integer
- Boolean
-These field types alone would be enough for most applications, since
-the equivalent of the others could be defined using field attributes,
-custom validation methods, and applied actions. There is some benefit
-to having descriptive names, of course, and if you have multiple fields
-requiring the same validation, defining a custom field class may be a
-good idea.
+has 'name' => ( isa => 'Str', is => 'rw', required => 1 );
+has 'type' => ( isa => 'Str', is => 'rw', default => sub { ref shift } );
+has 'parent' => ( is => 'rw', predicate => 'has_parent' );
+sub has_fields { }
+has 'input_without_param' => (
+ is => 'rw',
+ predicate => 'has_input_without_param'
+);
+has 'not_nullable' => ( is => 'rw', isa => 'Bool' );
+has 'init_value' => ( is => 'rw', clearer => 'clear_init_value' );
+has 'default' => ( is => 'rw' );
+has 'default_over_obj' => ( is => 'rw', builder => 'build_default_over_obj' );
+sub build_default_over_obj { }
+has 'result' => (
+ isa => 'HTML::FormHandler::Field::Result',
+ is => 'ro',
+ weak_ref => 1,
+ lazy => 1,
+ builder => 'build_result',
+ clearer => 'clear_result',
+ predicate => 'has_result',
+ writer => '_set_result',
+ handles => [
+ '_set_input', '_clear_input', '_set_value', '_clear_value',
+ 'errors', 'all_errors', 'push_errors', 'num_errors', 'has_errors',
+ 'clear_errors', 'validated',
+ ],
+);
+has '_pin_result' => ( is => 'ro', reader => '_get_pin_result', writer => '_set_pin_result' );
-Inheritance hierarchy of the distribution's field classes:
+sub has_input {
+ my $self = shift;
+ return unless $self->has_result;
+ return $self->result->has_input;
+}
- Compound
- Repeatable
- Text
- Money
- Password
- Integer
- PosInteger
- TextArea
- HtmlArea
- Select
- Multiple
- IntRange
- Hour
- Minute
- MonthDay
- Month
- Second
- Year
- MonthName
- Weekday
- Boolean
- Checkbox
- DateMDY
- DateTime
- Email
- PrimaryKey
+sub has_value {
+ my $self = shift;
+ return unless $self->has_result;
+ return $self->result->has_value;
+}
-See the documentation or source for the individual fields.
+# this should normally only be called for field tests
+sub build_result {
+ my $self = shift;
+ my @parent = ( 'parent' => $self->parent->result )
+ if ( $self->parent && $self->parent->result );
+ my $result = HTML::FormHandler::Field::Result->new(
+ name => $self->name,
+ field_def => $self,
+ @parent
+ );
+ $self->_set_pin_result($result); # to prevent garbage collection of result
+ return $result;
+}
-Many field classes contain only a list of constraints and transformations
-to apply. Some use the 'validate' method, which is called after the actions
-are applied. Some build a custom select list using 'build_options'.
+sub input {
+ my $self = shift;
+ my $result = $self->result;
+ # garbage collection should not happen
+ # but just in case resetting for safety
+ unless ( $result ) {
+ $self->clear_result;
+ $result = $self->result;
+ }
+ return $result->_set_input(@_) if @_;
+ return $result->input;
+}
-=head1 ATTRIBUTES
+sub value {
+ my $self = shift;
+ my $result = $self->result;
+ # garbage collection should not happen
+ # but just in case resetting for safety
+ unless ( $result ) {
+ $self->clear_result;
+ $result = $self->result;
+ }
+ return $result->_set_value(@_) if @_;
+ return $result->value;
+}
+# for compatibility. deprecate and remove at some point
+sub clear_input { shift->_clear_input }
+sub clear_value { shift->_clear_value }
+sub clear_data {
+ my $self = shift;
+ $self->clear_result;
+ $self->clear_active;
+}
+# this is a kludge to allow testing field deflation
+sub _deflate_and_set_value {
+ my ( $self, $value ) = @_;
+ if( $self->_can_deflate ) {
+ $value = $self->_apply_deflation($value);
+ }
+ $self->_set_value($value);
+}
-=head2 Names, types, accessor
+sub is_repeatable { }
+has 'reload_after_update' => ( is => 'rw', isa => 'Bool' );
-=over
+has 'fif_from_value' => ( isa => 'Str', is => 'ro' );
-=item name
+sub fif {
+ my ( $self, $result ) = @_;
-The name of the field. Used in the HTML form. Often a db accessor.
-The only required attribute.
+ return if ( $self->inactive && !$self->_active );
+ return '' if $self->password;
+ return unless $result || $self->has_result;
+ my $lresult = $result || $self->result;
+ if ( ( $self->has_result && $self->has_input && !$self->fif_from_value ) ||
+ ( $self->fif_from_value && !defined $lresult->value ) )
+ {
+ return defined $lresult->input ? $lresult->input : '';
+ }
+ if ( defined $lresult->value ) {
+ if( $self->deflate_to eq 'fif' && $self->_can_deflate ) {
+ return $self->_apply_deflation($lresult->value);
+ }
+ else {
+ return $lresult->value;
+ }
+ }
+ elsif ( defined $self->value ) {
+ # this is because checkboxes and submit buttons have their own 'value'
+ # needs to be fixed in some better way
+ return $self->value;
+ }
+ return '';
+}
-=item type
+has 'accessor' => (
+ isa => 'Str',
+ is => 'rw',
+ lazy => 1,
+ default => sub {
+ my $self = shift;
+ my $accessor = $self->name;
+ $accessor =~ s/^(.*)\.//g if ( $accessor =~ /\./ );
+ return $accessor;
+ }
+);
+has 'temp' => ( is => 'rw' );
-The class or type of the field. The 'type' of L<HTML::FormHandler::Field::Money>
-is 'Money'. Classes that you define yourself are prefixed with '+'.
+sub has_flag {
+ my ( $self, $flag_name ) = @_;
+ return unless $self->can($flag_name);
+ return $self->$flag_name;
+}
-=item accessor
+has 'label' => (
+ isa => 'Str',
+ is => 'rw',
+ lazy => 1,
+ builder => 'build_label',
+);
+sub build_label {
+ my $self = shift;
+ my $label = $self->name;
+ $label =~ s/_/ /g;
+ $label = ucfirst($label);
+ return $label;
+}
+sub loc_label {
+ my $self = shift;
+ return $self->_localize($self->label);
+}
+has 'title' => ( isa => 'Str', is => 'rw' );
+has 'style' => ( isa => 'Str', is => 'rw' );
+has 'css_class' => ( isa => 'Str', is => 'rw' );
+has 'input_class' => ( isa => 'Str', is => 'rw' );
+has 'form' => (
+ isa => 'HTML::FormHandler',
+ is => 'rw',
+ weak_ref => 1,
+ predicate => 'has_form',
+);
+has 'html_name' => (
+ isa => 'Str',
+ is => 'rw',
+ lazy => 1,
+ builder => 'build_html_name'
+);
-If the name of your field is different than your database accessor, use
-this attribute to provide the accessor.
-
-=item full_name
-
-The name of the field with all parents:
+sub build_html_name {
+ my $self = shift;
+ my $prefix = ( $self->form && $self->form->html_prefix ) ? $self->form->name . "." : '';
+ return $prefix . $self->full_name;
+}
+has 'widget' => ( isa => 'Str', is => 'rw' );
+has 'widget_wrapper' => ( isa => 'Str', is => 'rw' );
+has 'widget_tags' => (
+ traits => ['Hash'],
+ isa => 'HashRef',
+ is => 'ro',
+ default => sub {{}},
+ handles => {
+ get_tag => 'get',
+ set_tag => 'set',
+ tag_exists => 'exists',
+ },
+);
+has 'widget_name_space' => (
+ traits => ['Array'],
+ isa => 'ArrayRef[Str]',
+ is => 'ro',
+ default => sub {[]},
+ handles => {
+ add_widget_name_space => 'push',
+ },
+);
+has 'order' => ( isa => 'Int', is => 'rw', default => 0 );
+# 'inactive' is set in the field declaration, and is static. Default status.
+has 'inactive' => ( isa => 'Bool', is => 'rw', clearer => 'clear_inactive' );
+# 'active' is cleared whenever the form is cleared. Ephemeral activation.
+has '_active' => ( isa => 'Bool', is => 'rw', clearer => 'clear_active' );
+has 'id' => ( isa => 'Str', is => 'rw', lazy => 1, builder => 'build_id' );
+sub build_id { shift->html_name }
+has 'javascript' => ( isa => 'Str', is => 'rw' );
+has 'password' => ( isa => 'Bool', is => 'rw' );
+has 'writeonly' => ( isa => 'Bool', is => 'rw' );
+has 'disabled' => ( isa => 'Bool', is => 'rw' );
+has 'readonly' => ( isa => 'Bool', is => 'rw' );
+has 'noupdate' => ( isa => 'Bool', is => 'rw' );
+has 'set_validate' => ( isa => 'Str', is => 'ro',);
+sub _can_validate {
+ my $self = shift;
+ my $set_validate = $self->_set_validate_meth;
+ return
+ unless $self->form &&
+ $set_validate &&
+ $self->form->can( $set_validate );
+ return $set_validate;
+}
+sub _set_validate_meth {
+ my $self = shift;
+ return $self->set_validate if $self->set_validate;
+ my $name = $self->full_name;
+ $name =~ s/\./_/g;
+ $name =~ s/_\d+_/_/g; # remove repeatable field instances
+ return 'validate_' . $name;
+}
+sub _validate {
+ my $self = shift;
+ return unless (my $meth = $self->_can_validate);
+ $self->form->$meth($self);
+}
+has 'set_default' => ( isa => 'Str', is => 'ro', writer => '_set_default');
+sub _can_default {
+ my $self = shift;
+ my $set_default = $self->_set_default_meth;
+ return
+ unless $self->form &&
+ $set_default &&
+ $self->form->can( $set_default );
+ return $set_default;
+}
+sub _comp_default_meth {
+ my $self = shift;
+ my $name = $self->full_name;
+ $name =~ s/\./_/g;
+ $name =~ s/_\d+_/_/g;
+ return 'init_value_' . $name;
+}
+sub _set_default_meth {
+ my $self = shift;
+ return $self->set_default if $self->set_default;
+ my $name = $self->full_name;
+ $name =~ s/\./_/g;
+ $name =~ s/_\d_/_/g;
+ return 'default_' . $name;
+}
+sub get_default_value {
+ my $self = shift;
+ if ( my $meth = $self->_can_default ) {
+ return $self->form->$meth( $self, $self->form->item );
+ }
+ elsif ( defined $self->default ) {
+ return $self->default;
+ }
+ return;
+}
+has 'deflation' => (
+ is => 'rw',
+ predicate => 'has_deflation',
+);
+# deflate_to either 'value' or 'fif'
+has 'deflate_to' => ( is => 'rw', default => 'value' );
+has 'trim' => (
+ is => 'rw',
+ default => sub { { transform => \&default_trim } }
+);
- 'event.start_date.month'
+sub default_trim {
+ my $value = shift;
+ return unless defined $value;
+ my @values = ref $value eq 'ARRAY' ? @$value : ($value);
+ for (@values) {
+ next if ref $_ or !defined;
+ s/^\s+//;
+ s/\s+$//;
+ }
+ return ref $value eq 'ARRAY' ? \@values : $values[0];
+}
+has 'render_filter' => (
+ traits => ['Code'],
+ is => 'ro',
+ isa => 'CodeRef',
+ builder => 'build_render_filter',
+ handles => { html_filter => 'execute' },
+);
-=item full_accessor
+sub build_render_filter {
+ my $self = shift;
+ if( $self->form && $self->form->can('render_filter') ) {
+ return sub {
+ my $name = shift;
+ return $self->form->render_filter($name);
+ }
+ }
+ else {
+ return sub {
+ my $name = shift;
+ return $self->default_render_filter($name);
+ }
+ }
+}
+sub default_render_filter {
+ my ( $self, $string ) = @_;
+ $string =~ s/&/&/g;
+ $string =~ s/</</g;
+ $string =~ s/>/>/g;
+ $string =~ s/"/"/g;
+ return $string;
+}
-The field accessor with all parents
+has 'input_param' => ( is => 'rw', isa => 'Str' );
-=item html_name
+sub BUILDARGS {
+ my $class = shift;
-The full_name plus the form name if 'html_prefix' is set.
+ # for compatibility, change 'set_init' to 'set_default'
+ my @new;
+ push @new, ('set_default', {@_}->{set_init} )
+ if( exists {@_}->{set_init} );
+ return $class->SUPER::BUILDARGS(@_, @new);
+}
-=item input_param
+sub BUILD {
+ my ( $self, $params ) = @_;
-By default we expect an input parameter based on the field name. This allows
-you to look for a different input parameter.
+ $self->_set_default( $self->_comp_default_meth )
+ if( $self->form && $self->form->can( $self->_comp_default_meth ) );
+ $self->add_widget_name_space( @{$self->form->widget_name_space} ) if $self->form;
+ # widgets will already have been applied by BuildFields, but this allows
+ # testing individual fields
+ $self->apply_rendering_widgets unless ($self->can('render') );
+ $self->add_action( $self->trim ) if $self->trim;
+ $self->_build_apply_list;
+ $self->add_action( @{ $params->{apply} } ) if $params->{apply};
+}
-=back
+# this is the recursive routine that is used
+# to initial fields if there is no initial object and no params
+sub _result_from_fields {
+ my ( $self, $result ) = @_;
-=head2 Field data
+ if ( my @values = $self->get_default_value ) {
+ if ( $self->_can_deflate && $self->deflate_to eq 'value' ) {
+ @values = $self->_apply_deflation(@values);
+ }
+ my $value = @values > 1 ? \@values : shift @values;
+ $self->init_value($value) if defined $value;
+ $result->_set_value($value) if defined $value;
+ }
+ $self->_set_result($result);
+ $result->_set_field_def($self);
+ return $result;
+}
-=over
+sub _result_from_input {
+ my ( $self, $result, $input, $exists ) = @_;
-=item inactive
+ if ($exists) {
+ $result->_set_input($input);
+ }
+ elsif ( $self->has_input_without_param ) {
+ $result->_set_input( $self->input_without_param );
+ }
+ $self->_set_result($result);
+ $result->_set_field_def($self);
+ return $result;
+}
-Set this attribute if this field is inactive. This provides a way to define fields
-in the form and selectively set them to inactive. There is also an '_active' attribute,
-for internal use to indicate that the field has been activated by the form's 'active'
-attribute.
+sub _result_from_object {
+ my ( $self, $result, $value ) = @_;
-=item input
+ $self->_set_result($result);
-The input string from the parameters passed in.
+ if ( $self->form ) {
+ $self->form->init_value( $self, $value );
+ }
+ else {
+ $self->init_value($value);
+ $result->_set_value($value);
+ }
+ $result->_set_value(undef) if $self->writeonly;
+ $result->_set_field_def($self);
+ return $result;
+}
-=item value
+sub full_name {
+ my $field = shift;
-The value as it would come from or go into the database, after being
-acted on by transforms. Used to construct the C<< $form->values >>
-hash. Validation and constraints act on 'value'.
+ my $name = $field->name;
+ my $parent = $field->parent || return $name;
+ return $parent->full_name . '.' . $name;
+}
-=item fif
+sub full_accessor {
+ my $field = shift;
-Values used to fill in the form. Read only. Use a deflation to get
-from 'value' to 'fif' if an inflator was used. (Deflations can be
-done in two different places. Set 'deflate_to' => 'fif' to deflate
-in fillinform'.)
+ my $accessor = $field->accessor;
+ my $parent = $field->parent || return $accessor;
+ return $parent->full_accessor . '.' . $accessor;
+}
- [% form.field('title').fif %]
+sub add_error {
+ my ( $self, @message ) = @_;
-=item init_value
-
-Initial value populated by init_from_object. You can tell if a field
-has changed by comparing 'init_value' and 'value'. Read only.
-
-=item input_without_param
-
-Input for this field if there is no param. Needed for checkbox,
-since an unchecked checkbox does not return a parameter.
-
-=back
-
-=head2 Form, parent
-
-=over
-
-=item form
-
-A reference to the containing form.
+ unless ( defined $message[0] ) {
+ @message = ('field is invalid');
+ }
+ @message = @{$message[0]} if ref $message[0] eq 'ARRAY';
+ my $out;
+ try {
+ $out = $self->_localize(@message);
+ }
+ catch {
+ die "Error occurred localizing error message for " . $self->label . ". $_";
+ };
-=item parent
+ $self->push_errors($out);
+ return;
+}
-A reference to the parent of this field. Compound fields are the
-parents for the fields they contain.
+sub _apply_deflation {
+ my ( $self, $value ) = @_;
-=back
+ if ( $self->has_deflation ) {
+ $value = $self->deflation->($value);
+ }
+ elsif ( $self->can('deflate') ) {
+ $value = $self->deflate($value);
+ }
+ return $value;
+}
+sub _can_deflate {
+ my $self = shift;
+ return $self->has_deflation || $self->can('deflate');
+}
-=head2 Errors
+# use Class::MOP to clone
+sub clone {
+ my ( $self, %params ) = @_;
+ $self->meta->clone_object( $self, %params );
+}
-=over
+sub value_changed {
+ my ($self) = @_;
-=item errors
+ my @cmp;
+ for ( 'init_value', 'value' ) {
+ my $val = $self->$_;
+ $val = '' unless defined $val;
+ push @cmp, join '|', sort
+ map { ref($_) && $_->isa('DateTime') ? $_->iso8601 : "$_" }
+ ref($val) eq 'ARRAY' ? @$val : $val;
+ }
+ return $cmp[0] ne $cmp[1];
+}
-Returns the error list for the field. Also provides 'num_errors',
-'has_errors', 'push_errors' and 'clear_errors' from Array
-trait. Use 'add_error' to add an error to the array if you
-want to use a MakeText language handle. Default is an empty list.
+sub required_text { shift->required ? 'required' : 'optional' }
-=item add_error
+sub input_defined {
+ my ($self) = @_;
+ return unless $self->has_input;
+ return has_some_value( $self->input );
+}
-Add an error to the list of errors. If $field->form
-is defined then process error message as Maketext input.
-See $form->language_handle for details. Returns undef.
+sub dump {
+ my $self = shift;
- return $field->add_error( 'bad data' ) if $bad;
+ require Data::Dumper;
+ warn "HFH: ----- ", $self->name, " -----\n";
+ warn "HFH: type: ", $self->type, "\n";
+ warn "HFH: required: ", ( $self->required || '0' ), "\n";
+ warn "HFH: label: ", $self->label, "\n";
+ warn "HFH: widget: ", $self->widget, "\n";
+ my $v = $self->value;
+ warn "HFH: value: ", Data::Dumper::Dumper $v if $v;
+ my $iv = $self->init_value;
+ warn "HFH: init_value: ", Data::Dumper::Dumper $iv if $iv;
+ my $i = $self->input;
+ warn "HFH: input: ", Data::Dumper::Dumper $i if $i;
+ my $fif = $self->fif;
+ warn "HFH: fif: ", Data::Dumper::Dumper $fif if $fif;
-=item error_fields
+ if ( $self->can('options') ) {
+ my $o = $self->options;
+ warn "HFH: options: " . Data::Dumper::Dumper $o;
+ }
+}
-Compound fields will have an array of errors from the subfields.
+sub apply_rendering_widgets {
+ my $self = shift;
-=back
+ if ( $self->widget ) {
+ $self->apply_widget_role( $self, $self->widget, 'Field' );
+ }
+ my $widget_wrapper = $self->widget_wrapper;
+ $widget_wrapper ||= $self->form->widget_wrapper if $self->form;
+ $widget_wrapper ||= 'Simple';
+ unless ( $widget_wrapper eq 'none' ) {
+ $self->apply_widget_role( $self, $widget_wrapper, 'Wrapper' );
+ }
+ return;
-=head2 Attributes for creating HTML
+}
- label - Text label for this field. Defaults to ucfirst field name.
- title - Place to put title for field.
- style - Place to put field style string
- css_class - For a css class name (string; could be several classes,
- separated by spaces or commas). Used in wrapper for input field.
- input_class - class attribute on the 'input' field. applied with
- '_apply_html_attribute' along with disabled/readonly/javascript
- id - Useful for javascript (default is html_name. to prefix with
- form name, use 'html_prefix' in your form)
- disabled - for the HTML flag
- readonly - for the HTML flag
- javascript - for a Javascript string
- order - Used for sorting errors and fields. Built automatically,
- but may also be explicitly set
+sub peek {
+ my ( $self, $indent ) = @_;
-=head2 widget
+ $indent ||= '';
+ my $string = $indent . 'field: "' . $self->name . '" type: ' . $self->type . "\n";
+ if( $self->has_flag('has_contains') ) {
+ $string .= $indent . "contains: \n";
+ my $lindent = $indent . ' ';
+ foreach my $field ( $self->contains->sorted_fields ) {
+ $string .= $field->peek( $lindent );
+ }
+ }
+ if( $self->has_fields ) {
+ $string .= $indent . 'subfields of "' . $self->name . '": ' . $self->num_fields . "\n";
+ my $lindent = $indent . ' ';
+ foreach my $field ( $self->sorted_fields ) {
+ $string .= $field->peek( $lindent );
+ }
+ }
+ return $string;
+}
-The 'widget' attribute is not used by base FormHandler code.
-It is intended for use in generating HTML, in templates and the
-rendering roles, and is used in L<HTML::FormHandler::Render::Simple>.
-Fields of different type can use the same widget.
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
-This attribute is set in the field classes, or in the fields
-defined in the form. If you want a new widget type, use a new
-name and provide a C<< 'widget_<name>' >> method in your copy
-of Render::Simple or in your form class.
-If you are using a template based rendering system you will want
-to create a widget template.
-(see L<HTML::FormHandler::Manual::Templates>)
-If you are using the widget roles, you can specify the widget
-with the short class name instead.
+__END__
+=pod
-Widget types for the provided field classes:
+=head1 NAME
- Widget : Field classes
- ---------------:-----------------------------------
- text (Text) : Text, Integer
- checkbox (Checkbox) : Checkbox, Boolean
- radio_group
- (RadioGroup) : Select, Multiple, IntRange (etc)
- select (Select) : Select, Multiple, IntRange (etc)
- checkbox_group
- (CheckboxGroup) : Multiple select
- textarea (Textarea) : TextArea, HtmlArea
- compound (Compound) : Compound, Repeatable, DateTime
- password (Password) : Password
- hidden (Hidden) : Hidden
- submit (Submit) : Submit
- reset (Reset) : Reset
- no_render (NoRender) :
- upload (Upload) : Upload
+HTML::FormHandler::Field - base class for fields
-Widget roles are automatically applied to field classes
-unless they already have a 'render' method. Render::Simple
-will fall back to doing C<< $field->render >> if the corresponding
-widget method does not exist.
+=head1 VERSION
-=head2 Flags
+version 0.32002
- password - prevents the entered value from being displayed in the form
- writeonly - The initial value is not taken from the database
- noupdate - Do not update this field in the database (does not appear in $form->value)
+=head1 SYNOPSIS
-=head2 Form methods for fields
+Instances of Field subclasses are generally built by L<HTML::FormHandler>
+from 'has_field' declarations or the field_list, but they can also be constructed
+using new (usually for test purposes).
-These provide the name of a method in a form (not the field ) which will act
-on a particular field.
+ use HTML::FormHandler::Field::Text;
+ my $field = HTML::FormHandler::Field::Text->new( name => $name, ... );
-=over
+In your custom field class:
-=item set_validate
+ package MyApp::Field::MyText;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler::Field::Text';
-Specify a form method to be used to validate this field.
-The default is C<< 'validate_' . $field->name >>. Periods in field names
-will be replaced by underscores, so that the field 'addresses.city' will
-use the 'validate_addresses_city' method for validation.
+ has 'my_attribute' => ( isa => 'Str', is => 'rw' );
- has_field 'title' => ( isa => 'Str', set_validate => 'check_title' );
- has_field 'subtitle' => ( isa => 'Str', set_validate => 'check_title' );
+ apply [ { transform => sub { ... } },
+ { check => ['fighter', 'bard', 'mage' ], message => '....' }
+ ];
+ 1;
-=item set_default
+=head1 DESCRIPTION
-The name of the method in the form that provides a field's default value.
-Default is C<< 'default_' . $field->name >>. Periods replaced by underscores.
+This is the base class for form fields. The 'type' of a field class
+is used in the FormHandler field_list or has_field to identify which field class to
+load. If the type is not specified, it defaults to Text.
-=item default
+There are two rough categories of Field classes: those that do extra processing
+and those that are simple validators. The 'Compound', 'Repeatable', and
+'Select' fields are fields that are functional.
-Provide an initial value just like the 'set_default' method, except in the field
-declaration:
+A number of field classes are provided by the distribution. The basic
+for-validation (as opposed to 'functional') field types are:
- has_field 'bax' => ( default => 'Default bax' );
+ Text
+ Integer
+ Boolean
-FormHandler has flipped back and forth a couple of times about whether a default
-specified in the has_field definition should override values provided in an
-initial item or init_object. Sometimes people want one behavior, and sometimes
-the other. Now 'default' does *not* override.
+These field types alone would be enough for most applications, since
+the equivalent of the others could be defined using field attributes,
+custom validation methods, and applied actions. There is some benefit
+to having descriptive names, of course, and if you have multiple fields
+requiring the same validation, defining a custom field class may be a
+good idea.
-If you pass in a model object with C<< item => $row >> or an initial object
-with C<< init_object => {....} >> the values in that object will be used instead
-of values provided in the field definition with 'default' or 'default_fieldname'.
+Inheritance hierarchy of the distribution's field classes:
-If you *want* values that override the item/init_object, you can use the field
-attribute 'default_over_obj'.
-
-However you might want to consider putting your defaults into your row or init_object
-instead.
-
-=item default_over_obj
-
-Allows setting defaults which will override values provided with an item/init_object.
-
- has_field 'quux' => ( default_over_obj => 'default quux' );
+ Compound
+ Repeatable
+ Text
+ Money
+ Password
+ Integer
+ PosInteger
+ TextArea
+ HtmlArea
+ Select
+ Multiple
+ IntRange
+ Hour
+ Minute
+ MonthDay
+ Month
+ Second
+ Year
+ MonthName
+ Weekday
+ Boolean
+ Checkbox
+ DateMDY
+ DateTime
+ Email
+ PrimaryKey
-At this time there is no equivalent of 'set_default', but the type of the attribute
-is not defined so you can provide default values in a variety of other ways,
-including providing a trait which does 'build_default_over_obj'. For examples,
-see tests in the distribution.
+See the documentation or source for the individual fields.
-=back
+Many field classes contain only a list of constraints and transformations
+to apply. Some use the 'validate' method, which is called after the actions
+are applied. Some build a custom select list using 'build_options'.
-=head1 Constraints and Validations
+=head1 ATTRIBUTES
-=head2 Constraints set in attributes
+=head2 Names, types, accessor
=over
-=item required
+=item name
-Flag indicating whether this field must have a value
+The name of the field. Used in the HTML form. Often a db accessor.
+The only required attribute.
-=item required_message
+=item type
-Error message text added to errors if required field is not present
-The default is "Field <field label> is required".
+The class or type of the field. The 'type' of L<HTML::FormHandler::Field::Money>
+is 'Money'. Classes that you define yourself are prefixed with '+'.
-=item unique
+=item accessor
-Flag to initiate checks in the database model for uniqueness.
+If the name of your field is different than your database accessor, use
+this attribute to provide the accessor.
-=item unique_message
+=item full_name
-Error message text added to errors if field is not unique
+The name of the field with all parents:
-=item range_start
+ 'event.start_date.month'
-=item range_end
+=item full_accessor
-Field values are validated against the specified range if one
-or both of range_start and range_end are set and the field
-does not have 'options'.
+The field accessor with all parents
-The IntRange field uses this range to create a select list
-with a range of integers.
+=item html_name
-In a FormHandler field_list
+The full_name plus the form name if 'html_prefix' is set.
- age => {
- type => 'Integer',
- range_start => 18,
- range_end => 120,
- }
+=item input_param
+
+By default we expect an input parameter based on the field name. This allows
+you to look for a different input parameter.
=back
-=head2 apply
+=head2 Field data
-Use the 'apply' keyword to specify an ArrayRef of constraints and coercions to
-be executed on the field at validate_field time.
+=over
- has_field 'test' => (
- apply => [ 'MooseType',
- { check => sub {...}, message => { } },
- { transform => sub { ... lc(shift) ... } }
- ],
- );
+=item inactive
-In general the action can be of three types: a Moose type (which is
-represented by its name), a transformation (which is a callback called on
-the value of the field), or a constraint ('check') which performs a 'smart match'
-on the value of the field. Currently we implement the smart match
-in our code - but in the future when Perl 5.10 is more widely used we'll switch
-to the core
-L<http://search.cpan.org/~rgarcia/perl-5.10.0/pod/perlsyn.pod#Smart_matching_in_detail>
-smart match operator.
+Set this attribute if this field is inactive. This provides a way to define fields
+in the form and selectively set them to inactive. There is also an '_active' attribute,
+for internal use to indicate that the field has been activated by the form's 'active'
+attribute.
-The Moose type action first tries to coerce the value -
-then it checks the result, so you can use it instead of both constraints and
-tranformations - TIMTOWTDI. For most constraints and transformations it is
-your choice as to whether you use a Moose type or use a 'check' or 'transform'.
+=item input
-All three types define a message to be presented to the user in the case of
-failure. Messages are passed to L<Locale::MakeText>, and can either be simple
-strings or an array suitable for MakeText, such as:
+The input string from the parameters passed in.
- message => ['Email should be of the format [_1]',
- 'someuser at example.com' ]
+=item value
-Transformations and coercions are called in an eval
-to catch the errors. Warnings are trapped in a sigwarn handler.
+The value as it would come from or go into the database, after being
+acted on by transforms. Used to construct the C<< $form->values >>
+hash. Validation and constraints act on 'value'.
-All the actions are called in the order that they are defined, so that you can
-check constraints after transformations and vice versa. You can weave all three
-types of actions in any order you need. The actions specified with 'apply' will
-be stored in an 'actions' array.
+=item fif
-To declare actions inside a field class use L<HTML::FormHandler::Moose> and
-'apply' sugar:
+Values used to fill in the form. Read only. Use a deflation to get
+from 'value' to 'fif' if an inflator was used. (Deflations can be
+done in two different places. Set 'deflate_to' => 'fif' to deflate
+in fillinform'.)
- package MyApp::Field::Test;
- use HTML::FormHandler::Moose;
- extends 'HTML::FormHandler::Field;
+ [% form.field('title').fif %]
- apply [ 'SomeConstraint', { check => ..., message => .... } ];
+=item init_value
- 1;
+Initial value populated by init_from_object. You can tell if a field
+has changed by comparing 'init_value' and 'value'. Read only.
-Actions specified with apply are cumulative. Actions may be specified in
-field classes and additional actions added in the 'has_field' declaration.
+=item input_without_param
-You can see examples of field classes with 'apply' actions in the source for
-L<HTML::FormHandler::Field::Money> and L<HTML::FormHandler::Field::Email>.
+Input for this field if there is no param. Needed for checkbox,
+since an unchecked checkbox does not return a parameter.
-=head2 Moose types for constraints and transformations
+=back
-Moose types can be used to do both constraints and transformations. If a coercion
-exists it will be applied, resulting in a transformation. You can use type
-constraints form L<MooseX::Types>> libraries or defined using
-L<Moose::Util::TypeConstraints>.
+=head2 Form, parent
-A Moose type defined with L<Moose::Util::TypeConstraints>:
- subtype 'MyStr'
- => as 'Str'
- => where { /^a/ };
+=over
-This is a simple constraint checking if the value string starts with the letter 'a'.
+=item form
-Another Moose type:
- subtype 'MyInt'
- => as 'Int';
- coerce 'MyInt'
- => from 'MyStr'
- => via { return $1 if /(\d+)/ };
+A reference to the containing form.
-This type contains a coercion.
+=item parent
-You can use them in a field like this (types defined with L<MooseX::Types>
-would not be quoted):
+A reference to the parent of this field. Compound fields are the
+parents for the fields they contain.
- has_field 'some_text_to_int' => (
- apply => [ 'MyStr', 'MyInt' ]
- );
+=back
-This will check if the field contains a string starting with 'a' - and then
-coerce it to an integer by extracting the first continuous string of digits.
+=head2 Errors
-If the error message returned by the Moose type is not suitable for displaying
-in a form, you can define a different error message by using the 'type' and
-'message' keys in a hashref:
+=over
- apply => [ { type => 'MyStr', message => 'Not a valid value' } ];
+=item errors
-=head2 Non-Moose checks and transforms
+Returns the error list for the field. Also provides 'num_errors',
+'has_errors', 'push_errors' and 'clear_errors' from Array
+trait. Use 'add_error' to add an error to the array if you
+want to use a MakeText language handle. Default is an empty list.
-A simple 'check' constraint uses the 'check' keyword pointing to a coderef,
-a regular expression, or an array of valid values, plus a message.
+=item add_error
-A 'check' coderef will be passed the current value of the field. It should
-return true or false:
+Add an error to the list of errors. If $field->form
+is defined then process error message as Maketext input.
+See $form->language_handle for details. Returns undef.
- has_field 'this_num' => (
- apply => [
- {
- check => sub { if ( $_[0] =~ /(\d+)/ ) { return $1 > 10 } },
- message => 'Must contain number greater than 10',
- }
- );
+ return $field->add_error( 'bad data' ) if $bad;
-A 'check' regular expression:
+=item error_fields
- has_field 'some_text' => (
- apply => [ { check => qr/aaa/, message => 'Must contain aaa' } ],
- );
+Compound fields will have an array of errors from the subfields.
-A 'check' array of valid values:
+=back
- has_field 'more_text' => (
- apply => [ { check => ['aaa', 'bbb'], message => 'Must be aaa or bbb' } ]
- );
+=head2 Attributes for creating HTML
-A simple transformation uses the 'transform' keyword and a coderef.
-The coderef will be passed the current value of the field and should return
-a transformed value.
+ label - Text label for this field. Defaults to ucfirst field name.
+ title - Place to put title for field.
+ style - Place to put field style string
+ css_class - For a css class name (string; could be several classes,
+ separated by spaces or commas). Used in wrapper for input field.
+ input_class - class attribute on the 'input' field. applied with
+ '_apply_html_attribute' along with disabled/readonly/javascript
+ id - Useful for javascript (default is html_name. to prefix with
+ form name, use 'html_prefix' in your form)
+ disabled - for the HTML flag
+ readonly - for the HTML flag
+ javascript - for a Javascript string
+ order - Used for sorting errors and fields. Built automatically,
+ but may also be explicitly set
- has_field 'sprintf_filter' => (
- apply => [ { transform => sub{ sprintf '<%.1g>', $_[0] } } ]
- );
+=head2 widget
-=head2 trim
+The 'widget' attribute is not used by base FormHandler code.
+It is intended for use in generating HTML, in templates and the
+rendering roles, and is used in L<HTML::FormHandler::Render::Simple>.
+Fields of different type can use the same widget.
-An action to trim the field. By default
-this contains a transform to strip beginning and trailing spaces.
-Set this attribute to null to skip trimming, or supply a different
-transform.
+This attribute is set in the field classes, or in the fields
+defined in the form. If you want a new widget type, use a new
+name and provide a C<< 'widget_<name>' >> method in your copy
+of Render::Simple or in your form class.
+If you are using a template based rendering system you will want
+to create a widget template.
+(see L<HTML::FormHandler::Manual::Templates>)
+If you are using the widget roles, you can specify the widget
+with the short class name instead.
- trim => { transform => sub {
- my $string = shift;
- $string =~ s/^\s+//;
- $string =~ s/\s+$//;
- return $string;
- } }
- trim => { type => MyTypeConstraint }
+Widget types for the provided field classes:
-Trimming is performed before any other defined actions.
+ Widget : Field classes
+ ---------------:-----------------------------------
+ text (Text) : Text, Integer
+ checkbox (Checkbox) : Checkbox, Boolean
+ radio_group
+ (RadioGroup) : Select, Multiple, IntRange (etc)
+ select (Select) : Select, Multiple, IntRange (etc)
+ checkbox_group
+ (CheckboxGroup) : Multiple select
+ textarea (Textarea) : TextArea, HtmlArea
+ compound (Compound) : Compound, Repeatable, DateTime
+ password (Password) : Password
+ hidden (Hidden) : Hidden
+ submit (Submit) : Submit
+ reset (Reset) : Reset
+ no_render (NoRender) :
+ upload (Upload) : Upload
-=head2 deflation, deflate
+Widget roles are automatically applied to field classes
+unless they already have a 'render' method. Render::Simple
+will fall back to doing C<< $field->render >> if the corresponding
+widget method does not exist.
-A 'deflation' is a coderef that will convert from an inflated value back to a
-flat data representation suitable for displaying in an HTML field.
-If deflation is defined for a field it is automatically used for data that is
-taken from the database.
+=head2 Flags
- has_field 'my_date_time' => (
- type => 'Compound',
- apply => [ { transform => sub{ DateTime->new( $_[0] ) } } ],
- deflation => sub { { year => $_[0]->year, month => $_[0]->month, day => $_[0]->day } },
- fif_from_value => 1,
- );
- has_field 'my_date_time.year';
- has_field 'my_date_time.month';
- has_field 'my_date_time.day';
+ password - prevents the entered value from being displayed in the form
+ writeonly - The initial value is not taken from the database
+ noupdate - Do not update this field in the database (does not appear in $form->value)
-You can also use a 'deflate' method in a custom field class. See the Date field
-for an example. If the deflation requires data that may vary (such as a format)
-string and thus needs access to 'self', you would need to use the deflate method
-since the deflation coderef is only passed the current value of the field
+=head2 Form methods for fields
-Normally if you have a deflation, you will need a matching inflation, which can be
-supplied via a 'transform' action. When using a 'transform', the 'value' hash only
-contains reliably inflated values after validation has been performed, since
-inflation is performed at validation time.
+These provide the name of a method in a form (not the field ) which will act
+on a particular field.
-Deflation can be done at two different places: transforming the value that's saved
-from the initial_object/item, or when retrieving the 'fif' (fill-in-form) value that's
-displayed in the HTML form. The default is C<< deflate_to => 'value' >>. To deflate
-when getting the 'fif' value set 'deflate_to' to 'fif'. (See t/deflate.t for examples.)
+=over
-=head1 Processing and validating the field
+=item set_validate
-=head2 validate_field
+Specify a form method to be used to validate this field.
+The default is C<< 'validate_' . $field->name >>. Periods in field names
+will be replaced by underscores, so that the field 'addresses.city' will
+use the 'validate_addresses_city' method for validation.
-This is the base class validation routine. Most users will not
-do anything with this. It might be useful for method modifiers,
-if you want code that executed before or after the validation
-process.
+ has_field 'title' => ( isa => 'Str', set_validate => 'check_title' );
+ has_field 'subtitle' => ( isa => 'Str', set_validate => 'check_title' );
-=head2 validate
+=item set_default
-This field method can be used in addition to or instead of 'apply' actions
-in custom field classes.
-It should validate the field data and set error messages on
-errors with C<< $field->add_error >>.
+The name of the method in the form that provides a field's default value.
+Default is C<< 'default_' . $field->name >>. Periods replaced by underscores.
- sub validate {
- my $field = shift;
- my $value = $field->value;
- return $field->add_error( ... ) if ( ... );
- }
+=item default
-=cut
+Provide an initial value just like the 'set_default' method, except in the field
+declaration:
-has 'name' => ( isa => 'Str', is => 'rw', required => 1 );
-has 'type' => ( isa => 'Str', is => 'rw', default => sub { ref shift } );
-has 'parent' => ( is => 'rw', predicate => 'has_parent' );
-sub has_fields { }
-has 'input_without_param' => (
- is => 'rw',
- predicate => 'has_input_without_param'
-);
-has 'not_nullable' => ( is => 'rw', isa => 'Bool' );
-has 'init_value' => ( is => 'rw', clearer => 'clear_init_value' );
-has 'default' => ( is => 'rw' );
-has 'default_over_obj' => ( is => 'rw', builder => 'build_default_over_obj' );
-sub build_default_over_obj { }
-has 'result' => (
- isa => 'HTML::FormHandler::Field::Result',
- is => 'ro',
- weak_ref => 1,
- lazy => 1,
- builder => 'build_result',
- clearer => 'clear_result',
- predicate => 'has_result',
- writer => '_set_result',
- handles => [
- '_set_input', '_clear_input', '_set_value', '_clear_value',
- 'errors', 'all_errors', 'push_errors', 'num_errors', 'has_errors',
- 'clear_errors', 'validated',
- ],
-);
-has '_pin_result' => ( is => 'ro', reader => '_get_pin_result', writer => '_set_pin_result' );
+ has_field 'bax' => ( default => 'Default bax' );
-sub has_input {
- my $self = shift;
- return unless $self->has_result;
- return $self->result->has_input;
-}
+FormHandler has flipped back and forth a couple of times about whether a default
+specified in the has_field definition should override values provided in an
+initial item or init_object. Sometimes people want one behavior, and sometimes
+the other. Now 'default' does *not* override.
-sub has_value {
- my $self = shift;
- return unless $self->has_result;
- return $self->result->has_value;
-}
+If you pass in a model object with C<< item => $row >> or an initial object
+with C<< init_object => {....} >> the values in that object will be used instead
+of values provided in the field definition with 'default' or 'default_fieldname'.
-# this should normally only be called for field tests
-sub build_result {
- my $self = shift;
- my @parent = ( 'parent' => $self->parent->result )
- if ( $self->parent && $self->parent->result );
- my $result = HTML::FormHandler::Field::Result->new(
- name => $self->name,
- field_def => $self,
- @parent
- );
- $self->_set_pin_result($result); # to prevent garbage collection of result
- return $result;
-}
+If you *want* values that override the item/init_object, you can use the field
+attribute 'default_over_obj'.
-sub input {
- my $self = shift;
- my $result = $self->result;
- # garbage collection should not happen
- # but just in case resetting for safety
- unless ( $result ) {
- $self->clear_result;
- $result = $self->result;
- }
- return $result->_set_input(@_) if @_;
- return $result->input;
-}
+However you might want to consider putting your defaults into your row or init_object
+instead.
-sub value {
- my $self = shift;
- my $result = $self->result;
- # garbage collection should not happen
- # but just in case resetting for safety
- unless ( $result ) {
- $self->clear_result;
- $result = $self->result;
- }
- return $result->_set_value(@_) if @_;
- return $result->value;
-}
-# for compatibility. deprecate and remove at some point
-sub clear_input { shift->_clear_input }
-sub clear_value { shift->_clear_value }
-sub clear_data {
- my $self = shift;
- $self->clear_result;
- $self->clear_active;
-}
-# this is a kludge to allow testing field deflation
-sub _deflate_and_set_value {
- my ( $self, $value ) = @_;
- if( $self->_can_deflate ) {
- $value = $self->_apply_deflation($value);
- }
- $self->_set_value($value);
-}
+=item default_over_obj
-sub is_repeatable { }
-has 'reload_after_update' => ( is => 'rw', isa => 'Bool' );
+Allows setting defaults which will override values provided with an item/init_object.
-has 'fif_from_value' => ( isa => 'Str', is => 'ro' );
+ has_field 'quux' => ( default_over_obj => 'default quux' );
-sub fif {
- my ( $self, $result ) = @_;
+At this time there is no equivalent of 'set_default', but the type of the attribute
+is not defined so you can provide default values in a variety of other ways,
+including providing a trait which does 'build_default_over_obj'. For examples,
+see tests in the distribution.
- return if ( $self->inactive && !$self->_active );
- return '' if $self->password;
- return unless $result || $self->has_result;
- my $lresult = $result || $self->result;
- if ( ( $self->has_result && $self->has_input && !$self->fif_from_value ) ||
- ( $self->fif_from_value && !defined $lresult->value ) )
- {
- return defined $lresult->input ? $lresult->input : '';
- }
- if ( defined $lresult->value ) {
- if( $self->deflate_to eq 'fif' && $self->_can_deflate ) {
- return $self->_apply_deflation($lresult->value);
- }
- else {
- return $lresult->value;
- }
- }
- elsif ( defined $self->value ) {
- # this is because checkboxes and submit buttons have their own 'value'
- # needs to be fixed in some better way
- return $self->value;
- }
- return '';
-}
+=back
-has 'accessor' => (
- isa => 'Str',
- is => 'rw',
- lazy => 1,
- default => sub {
- my $self = shift;
- my $accessor = $self->name;
- $accessor =~ s/^(.*)\.//g if ( $accessor =~ /\./ );
- return $accessor;
- }
-);
-has 'temp' => ( is => 'rw' );
+=head1 Constraints and Validations
-sub has_flag {
- my ( $self, $flag_name ) = @_;
- return unless $self->can($flag_name);
- return $self->$flag_name;
-}
+=head2 Constraints set in attributes
-has 'label' => (
- isa => 'Str',
- is => 'rw',
- lazy => 1,
- builder => 'build_label',
-);
-sub build_label {
- my $self = shift;
- my $label = $self->name;
- $label =~ s/_/ /g;
- $label = ucfirst($label);
- return $label;
-}
-sub loc_label {
- my $self = shift;
- return $self->_localize($self->label);
-}
-has 'title' => ( isa => 'Str', is => 'rw' );
-has 'style' => ( isa => 'Str', is => 'rw' );
-has 'css_class' => ( isa => 'Str', is => 'rw' );
-has 'input_class' => ( isa => 'Str', is => 'rw' );
-has 'form' => (
- isa => 'HTML::FormHandler',
- is => 'rw',
- weak_ref => 1,
- predicate => 'has_form',
-);
-has 'html_name' => (
- isa => 'Str',
- is => 'rw',
- lazy => 1,
- builder => 'build_html_name'
-);
+=over
-sub build_html_name {
- my $self = shift;
- my $prefix = ( $self->form && $self->form->html_prefix ) ? $self->form->name . "." : '';
- return $prefix . $self->full_name;
-}
-has 'widget' => ( isa => 'Str', is => 'rw' );
-has 'widget_wrapper' => ( isa => 'Str', is => 'rw' );
-has 'widget_tags' => (
- traits => ['Hash'],
- isa => 'HashRef',
- is => 'ro',
- default => sub {{}},
- handles => {
- get_tag => 'get',
- set_tag => 'set',
- tag_exists => 'exists',
- },
-);
-has 'widget_name_space' => (
- traits => ['Array'],
- isa => 'ArrayRef[Str]',
- is => 'ro',
- default => sub {[]},
- handles => {
- add_widget_name_space => 'push',
- },
-);
-has 'order' => ( isa => 'Int', is => 'rw', default => 0 );
-# 'inactive' is set in the field declaration, and is static. Default status.
-has 'inactive' => ( isa => 'Bool', is => 'rw', clearer => 'clear_inactive' );
-# 'active' is cleared whenever the form is cleared. Ephemeral activation.
-has '_active' => ( isa => 'Bool', is => 'rw', clearer => 'clear_active' );
-has 'id' => ( isa => 'Str', is => 'rw', lazy => 1, builder => 'build_id' );
-sub build_id { shift->html_name }
-has 'javascript' => ( isa => 'Str', is => 'rw' );
-has 'password' => ( isa => 'Bool', is => 'rw' );
-has 'writeonly' => ( isa => 'Bool', is => 'rw' );
-has 'disabled' => ( isa => 'Bool', is => 'rw' );
-has 'readonly' => ( isa => 'Bool', is => 'rw' );
-has 'noupdate' => ( isa => 'Bool', is => 'rw' );
-has 'set_validate' => ( isa => 'Str', is => 'ro',);
-sub _can_validate {
- my $self = shift;
- my $set_validate = $self->_set_validate_meth;
- return
- unless $self->form &&
- $set_validate &&
- $self->form->can( $set_validate );
- return $set_validate;
-}
-sub _set_validate_meth {
- my $self = shift;
- return $self->set_validate if $self->set_validate;
- my $name = $self->full_name;
- $name =~ s/\./_/g;
- $name =~ s/_\d+_/_/g; # remove repeatable field instances
- return 'validate_' . $name;
-}
-sub _validate {
- my $self = shift;
- return unless (my $meth = $self->_can_validate);
- $self->form->$meth($self);
-}
-has 'set_default' => ( isa => 'Str', is => 'ro', writer => '_set_default');
-sub _can_default {
- my $self = shift;
- my $set_default = $self->_set_default_meth;
- return
- unless $self->form &&
- $set_default &&
- $self->form->can( $set_default );
- return $set_default;
-}
-sub _comp_default_meth {
- my $self = shift;
- my $name = $self->full_name;
- $name =~ s/\./_/g;
- $name =~ s/_\d+_/_/g;
- return 'init_value_' . $name;
-}
-sub _set_default_meth {
- my $self = shift;
- return $self->set_default if $self->set_default;
- my $name = $self->full_name;
- $name =~ s/\./_/g;
- $name =~ s/_\d_/_/g;
- return 'default_' . $name;
-}
-sub get_default_value {
- my $self = shift;
- if ( my $meth = $self->_can_default ) {
- return $self->form->$meth( $self, $self->form->item );
- }
- elsif ( defined $self->default ) {
- return $self->default;
- }
- return;
-}
-has 'deflation' => (
- is => 'rw',
- predicate => 'has_deflation',
-);
-# deflate_to either 'value' or 'fif'
-has 'deflate_to' => ( is => 'rw', default => 'value' );
-has 'trim' => (
- is => 'rw',
- default => sub { { transform => \&default_trim } }
-);
+=item required
-sub default_trim {
- my $value = shift;
- return unless defined $value;
- my @values = ref $value eq 'ARRAY' ? @$value : ($value);
- for (@values) {
- next if ref $_ or !defined;
- s/^\s+//;
- s/\s+$//;
- }
- return ref $value eq 'ARRAY' ? \@values : $values[0];
-}
-has 'render_filter' => (
- traits => ['Code'],
- is => 'ro',
- isa => 'CodeRef',
- builder => 'build_render_filter',
- handles => { html_filter => 'execute' },
-);
+Flag indicating whether this field must have a value
-sub build_render_filter {
- my $self = shift;
- if( $self->form && $self->form->can('render_filter') ) {
- return sub {
- my $name = shift;
- return $self->form->render_filter($name);
- }
- }
- else {
- return sub {
- my $name = shift;
- return $self->default_render_filter($name);
- }
+=item required_message
+
+Error message text added to errors if required field is not present
+The default is "Field <field label> is required".
+
+=item unique
+
+Flag to initiate checks in the database model for uniqueness.
+
+=item unique_message
+
+Error message text added to errors if field is not unique
+
+=item range_start
+
+=item range_end
+
+Field values are validated against the specified range if one
+or both of range_start and range_end are set and the field
+does not have 'options'.
+
+The IntRange field uses this range to create a select list
+with a range of integers.
+
+In a FormHandler field_list
+
+ age => {
+ type => 'Integer',
+ range_start => 18,
+ range_end => 120,
}
-}
-sub default_render_filter {
- my ( $self, $string ) = @_;
- $string =~ s/&/&/g;
- $string =~ s/</</g;
- $string =~ s/>/>/g;
- $string =~ s/"/"/g;
- return $string;
-}
-has 'input_param' => ( is => 'rw', isa => 'Str' );
+=back
-sub BUILDARGS {
- my $class = shift;
+=head2 apply
- # for compatibility, change 'set_init' to 'set_default'
- my @new;
- push @new, ('set_default', {@_}->{set_init} )
- if( exists {@_}->{set_init} );
- return $class->SUPER::BUILDARGS(@_, @new);
-}
+Use the 'apply' keyword to specify an ArrayRef of constraints and coercions to
+be executed on the field at validate_field time.
-sub BUILD {
- my ( $self, $params ) = @_;
+ has_field 'test' => (
+ apply => [ 'MooseType',
+ { check => sub {...}, message => { } },
+ { transform => sub { ... lc(shift) ... } }
+ ],
+ );
+
+In general the action can be of three types: a Moose type (which is
+represented by its name), a transformation (which is a callback called on
+the value of the field), or a constraint ('check') which performs a 'smart match'
+on the value of the field. Currently we implement the smart match
+in our code - but in the future when Perl 5.10 is more widely used we'll switch
+to the core
+L<http://search.cpan.org/~rgarcia/perl-5.10.0/pod/perlsyn.pod#Smart_matching_in_detail>
+smart match operator.
+
+The Moose type action first tries to coerce the value -
+then it checks the result, so you can use it instead of both constraints and
+tranformations - TIMTOWTDI. For most constraints and transformations it is
+your choice as to whether you use a Moose type or use a 'check' or 'transform'.
+
+All three types define a message to be presented to the user in the case of
+failure. Messages are passed to L<Locale::MakeText>, and can either be simple
+strings or an array suitable for MakeText, such as:
+
+ message => ['Email should be of the format [_1]',
+ 'someuser at example.com' ]
+
+Transformations and coercions are called in an eval
+to catch the errors. Warnings are trapped in a sigwarn handler.
+
+All the actions are called in the order that they are defined, so that you can
+check constraints after transformations and vice versa. You can weave all three
+types of actions in any order you need. The actions specified with 'apply' will
+be stored in an 'actions' array.
+
+To declare actions inside a field class use L<HTML::FormHandler::Moose> and
+'apply' sugar:
+
+ package MyApp::Field::Test;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler::Field;
+
+ apply [ 'SomeConstraint', { check => ..., message => .... } ];
+
+ 1;
+
+Actions specified with apply are cumulative. Actions may be specified in
+field classes and additional actions added in the 'has_field' declaration.
+
+You can see examples of field classes with 'apply' actions in the source for
+L<HTML::FormHandler::Field::Money> and L<HTML::FormHandler::Field::Email>.
+
+=head2 Moose types for constraints and transformations
+
+Moose types can be used to do both constraints and transformations. If a coercion
+exists it will be applied, resulting in a transformation. You can use type
+constraints form L<MooseX::Types>> libraries or defined using
+L<Moose::Util::TypeConstraints>.
+
+A Moose type defined with L<Moose::Util::TypeConstraints>:
+ subtype 'MyStr'
+ => as 'Str'
+ => where { /^a/ };
+
+This is a simple constraint checking if the value string starts with the letter 'a'.
+
+Another Moose type:
+ subtype 'MyInt'
+ => as 'Int';
+ coerce 'MyInt'
+ => from 'MyStr'
+ => via { return $1 if /(\d+)/ };
+
+This type contains a coercion.
+
+You can use them in a field like this (types defined with L<MooseX::Types>
+would not be quoted):
- $self->_set_default( $self->_comp_default_meth )
- if( $self->form && $self->form->can( $self->_comp_default_meth ) );
- $self->add_widget_name_space( @{$self->form->widget_name_space} ) if $self->form;
- # widgets will already have been applied by BuildFields, but this allows
- # testing individual fields
- $self->apply_rendering_widgets unless ($self->can('render') );
- $self->add_action( $self->trim ) if $self->trim;
- $self->_build_apply_list;
- $self->add_action( @{ $params->{apply} } ) if $params->{apply};
-}
+ has_field 'some_text_to_int' => (
+ apply => [ 'MyStr', 'MyInt' ]
+ );
-# this is the recursive routine that is used
-# to initial fields if there is no initial object and no params
-sub _result_from_fields {
- my ( $self, $result ) = @_;
+This will check if the field contains a string starting with 'a' - and then
+coerce it to an integer by extracting the first continuous string of digits.
- if ( my @values = $self->get_default_value ) {
- if ( $self->_can_deflate && $self->deflate_to eq 'value' ) {
- @values = $self->_apply_deflation(@values);
- }
- my $value = @values > 1 ? \@values : shift @values;
- $self->init_value($value) if defined $value;
- $result->_set_value($value) if defined $value;
- }
- $self->_set_result($result);
- $result->_set_field_def($self);
- return $result;
-}
+If the error message returned by the Moose type is not suitable for displaying
+in a form, you can define a different error message by using the 'type' and
+'message' keys in a hashref:
-sub _result_from_input {
- my ( $self, $result, $input, $exists ) = @_;
+ apply => [ { type => 'MyStr', message => 'Not a valid value' } ];
- if ($exists) {
- $result->_set_input($input);
- }
- elsif ( $self->has_input_without_param ) {
- $result->_set_input( $self->input_without_param );
- }
- $self->_set_result($result);
- $result->_set_field_def($self);
- return $result;
-}
+=head2 Non-Moose checks and transforms
-sub _result_from_object {
- my ( $self, $result, $value ) = @_;
+A simple 'check' constraint uses the 'check' keyword pointing to a coderef,
+a regular expression, or an array of valid values, plus a message.
- $self->_set_result($result);
+A 'check' coderef will be passed the current value of the field. It should
+return true or false:
- if ( $self->form ) {
- $self->form->init_value( $self, $value );
- }
- else {
- $self->init_value($value);
- $result->_set_value($value);
- }
- $result->_set_value(undef) if $self->writeonly;
- $result->_set_field_def($self);
- return $result;
-}
+ has_field 'this_num' => (
+ apply => [
+ {
+ check => sub { if ( $_[0] =~ /(\d+)/ ) { return $1 > 10 } },
+ message => 'Must contain number greater than 10',
+ }
+ );
-sub full_name {
- my $field = shift;
+A 'check' regular expression:
- my $name = $field->name;
- my $parent = $field->parent || return $name;
- return $parent->full_name . '.' . $name;
-}
+ has_field 'some_text' => (
+ apply => [ { check => qr/aaa/, message => 'Must contain aaa' } ],
+ );
-sub full_accessor {
- my $field = shift;
+A 'check' array of valid values:
- my $accessor = $field->accessor;
- my $parent = $field->parent || return $accessor;
- return $parent->full_accessor . '.' . $accessor;
-}
+ has_field 'more_text' => (
+ apply => [ { check => ['aaa', 'bbb'], message => 'Must be aaa or bbb' } ]
+ );
-sub add_error {
- my ( $self, @message ) = @_;
+A simple transformation uses the 'transform' keyword and a coderef.
+The coderef will be passed the current value of the field and should return
+a transformed value.
- unless ( defined $message[0] ) {
- @message = ('field is invalid');
- }
- @message = @{$message[0]} if ref $message[0] eq 'ARRAY';
- my $out;
- try {
- $out = $self->_localize(@message);
- }
- catch {
- die "Error occurred localizing error message for " . $self->label . ". $_";
- };
+ has_field 'sprintf_filter' => (
+ apply => [ { transform => sub{ sprintf '<%.1g>', $_[0] } } ]
+ );
- $self->push_errors($out);
- return;
-}
+=head2 trim
-sub _apply_deflation {
- my ( $self, $value ) = @_;
+An action to trim the field. By default
+this contains a transform to strip beginning and trailing spaces.
+Set this attribute to null to skip trimming, or supply a different
+transform.
- if ( $self->has_deflation ) {
- $value = $self->deflation->($value);
- }
- elsif ( $self->can('deflate') ) {
- $value = $self->deflate($value);
- }
- return $value;
-}
-sub _can_deflate {
- my $self = shift;
- return $self->has_deflation || $self->can('deflate');
-}
+ trim => { transform => sub {
+ my $string = shift;
+ $string =~ s/^\s+//;
+ $string =~ s/\s+$//;
+ return $string;
+ } }
+ trim => { type => MyTypeConstraint }
-# use Class::MOP to clone
-sub clone {
- my ( $self, %params ) = @_;
- $self->meta->clone_object( $self, %params );
-}
+Trimming is performed before any other defined actions.
-sub value_changed {
- my ($self) = @_;
+=head2 deflation, deflate
- my @cmp;
- for ( 'init_value', 'value' ) {
- my $val = $self->$_;
- $val = '' unless defined $val;
- push @cmp, join '|', sort
- map { ref($_) && $_->isa('DateTime') ? $_->iso8601 : "$_" }
- ref($val) eq 'ARRAY' ? @$val : $val;
- }
- return $cmp[0] ne $cmp[1];
-}
+A 'deflation' is a coderef that will convert from an inflated value back to a
+flat data representation suitable for displaying in an HTML field.
+If deflation is defined for a field it is automatically used for data that is
+taken from the database.
-sub required_text { shift->required ? 'required' : 'optional' }
+ has_field 'my_date_time' => (
+ type => 'Compound',
+ apply => [ { transform => sub{ DateTime->new( $_[0] ) } } ],
+ deflation => sub { { year => $_[0]->year, month => $_[0]->month, day => $_[0]->day } },
+ fif_from_value => 1,
+ );
+ has_field 'my_date_time.year';
+ has_field 'my_date_time.month';
+ has_field 'my_date_time.day';
-sub input_defined {
- my ($self) = @_;
- return unless $self->has_input;
- return has_some_value( $self->input );
-}
+You can also use a 'deflate' method in a custom field class. See the Date field
+for an example. If the deflation requires data that may vary (such as a format)
+string and thus needs access to 'self', you would need to use the deflate method
+since the deflation coderef is only passed the current value of the field
-sub dump {
- my $self = shift;
+Normally if you have a deflation, you will need a matching inflation, which can be
+supplied via a 'transform' action. When using a 'transform', the 'value' hash only
+contains reliably inflated values after validation has been performed, since
+inflation is performed at validation time.
- require Data::Dumper;
- warn "HFH: ----- ", $self->name, " -----\n";
- warn "HFH: type: ", $self->type, "\n";
- warn "HFH: required: ", ( $self->required || '0' ), "\n";
- warn "HFH: label: ", $self->label, "\n";
- warn "HFH: widget: ", $self->widget, "\n";
- my $v = $self->value;
- warn "HFH: value: ", Data::Dumper::Dumper $v if $v;
- my $iv = $self->init_value;
- warn "HFH: init_value: ", Data::Dumper::Dumper $iv if $iv;
- my $i = $self->input;
- warn "HFH: input: ", Data::Dumper::Dumper $i if $i;
- my $fif = $self->fif;
- warn "HFH: fif: ", Data::Dumper::Dumper $fif if $fif;
+Deflation can be done at two different places: transforming the value that's saved
+from the initial_object/item, or when retrieving the 'fif' (fill-in-form) value that's
+displayed in the HTML form. The default is C<< deflate_to => 'value' >>. To deflate
+when getting the 'fif' value set 'deflate_to' to 'fif'. (See t/deflate.t for examples.)
- if ( $self->can('options') ) {
- my $o = $self->options;
- warn "HFH: options: " . Data::Dumper::Dumper $o;
- }
-}
+=head1 Processing and validating the field
-sub apply_rendering_widgets {
- my $self = shift;
+=head2 validate_field
- if ( $self->widget ) {
- $self->apply_widget_role( $self, $self->widget, 'Field' );
- }
- my $widget_wrapper = $self->widget_wrapper;
- $widget_wrapper ||= $self->form->widget_wrapper if $self->form;
- $widget_wrapper ||= 'Simple';
- unless ( $widget_wrapper eq 'none' ) {
- $self->apply_widget_role( $self, $widget_wrapper, 'Wrapper' );
- }
- return;
+This is the base class validation routine. Most users will not
+do anything with this. It might be useful for method modifiers,
+if you want code that executed before or after the validation
+process.
-}
+=head2 validate
-sub peek {
- my ( $self, $indent ) = @_;
+This field method can be used in addition to or instead of 'apply' actions
+in custom field classes.
+It should validate the field data and set error messages on
+errors with C<< $field->add_error >>.
- $indent ||= '';
- my $string = $indent . 'field: "' . $self->name . '" type: ' . $self->type . "\n";
- if( $self->has_flag('has_contains') ) {
- $string .= $indent . "contains: \n";
- my $lindent = $indent . ' ';
- foreach my $field ( $self->contains->sorted_fields ) {
- $string .= $field->peek( $lindent );
- }
- }
- if( $self->has_fields ) {
- $string .= $indent . 'subfields of "' . $self->name . '": ' . $self->num_fields . "\n";
- my $lindent = $indent . ' ';
- foreach my $field ( $self->sorted_fields ) {
- $string .= $field->peek( $lindent );
- }
+ sub validate {
+ my $field = shift;
+ my $value = $field->value;
+ return $field->add_error( ... ) if ( ... );
}
- return $string;
-}
-=head1 AUTHORS
+=head1 AUTHOR
-HTML::FormHandler Contributors; see HTML::FormHandler
+FormHandler Contributors - see HTML::FormHandler
-Initially based on the original source code of L<Form::Processor::Field> by Bill Moseley
+=head1 COPYRIGHT AND LICENSE
-=head1 COPYRIGHT
+This software is copyright (c) 2010 by Gerda Shank.
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+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
-__PACKAGE__->meta->make_immutable;
-use namespace::autoclean;
-1;
diff --git a/lib/HTML/FormHandler/Field/Boolean.pm b/lib/HTML/FormHandler/Field/Boolean.pm
index c84203f..f679fd4 100644
--- a/lib/HTML/FormHandler/Field/Boolean.pm
+++ b/lib/HTML/FormHandler/Field/Boolean.pm
@@ -1,19 +1,10 @@
package HTML::FormHandler::Field::Boolean;
+# ABSTRACT: a true or false field
use Moose;
extends 'HTML::FormHandler::Field::Checkbox';
our $VERSION = '0.03';
-=head1 NAME
-
-HTML::FormHandler::Field::Boolean - A true or false field
-
-=head1 DESCRIPTION
-
-This field returns 1 if true, 0 if false. The widget type is 'checkbox'.
-Similar to Checkbox, except only returns values of 1 or 0.
-
-=cut
sub value {
my $self = shift;
@@ -23,17 +14,36 @@ sub value {
return $v ? 1 : 0;
}
-=head1 AUTHORS
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Field::Boolean - a true or false field
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 DESCRIPTION
+
+This field returns 1 if true, 0 if false. The widget type is 'checkbox'.
+Similar to Checkbox, except only returns values of 1 or 0.
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
-Gerda Shank
+=head1 COPYRIGHT AND LICENSE
-=head1 COPYRIGHT
+This software is copyright (c) 2010 by Gerda Shank.
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+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
-__PACKAGE__->meta->make_immutable;
-use namespace::autoclean;
-1;
diff --git a/lib/HTML/FormHandler/Field/Captcha.pm b/lib/HTML/FormHandler/Field/Captcha.pm
index 9d9d8f9..c389783 100644
--- a/lib/HTML/FormHandler/Field/Captcha.pm
+++ b/lib/HTML/FormHandler/Field/Captcha.pm
@@ -1,38 +1,11 @@
package HTML::FormHandler::Field::Captcha;
+# ABSTRACT: captcha field with GD::SecurityImage
use Moose;
extends 'HTML::FormHandler::Field';
use GD::SecurityImage;
use HTTP::Date;
-=head1 NAME
-
-HTML::FormHandler::Field::Captcha
-
-=head1 SYNOPSIS
-
-A Captcha class using GD::SecurityImage.
-Requires that that three methods be available from a form object:
-
- $self->form->get_captcha;
- $self->form->set_captcha;
-
-Using Catalyst and the Catalyst session plugin this field can be used
-in a form by using L<HTML::FormHandler::Form::Captcha>.
-
- package MyApp::Form::Post;
- use HTML::FormHandler::Moose;
- with 'HTML::FormHandler::Form::Captcha';
-
-You can set the following attributes on the 'captcha' field:
-
- height, width, scramble, lines, gd_font
-
-Example:
-
- has 'captcha' => ( height => '24', width => '70 );
-
-=cut
has 'height' => ( isa => 'Int', is => 'rw', default => '20' );
has 'width' => ( isa => 'Int', is => 'rw', default => '80' );
@@ -106,3 +79,51 @@ sub gen_captcha {
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Field::Captcha - captcha field with GD::SecurityImage
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 SYNOPSIS
+
+A Captcha class using GD::SecurityImage.
+Requires that that three methods be available from a form object:
+
+ $self->form->get_captcha;
+ $self->form->set_captcha;
+
+Using Catalyst and the Catalyst session plugin this field can be used
+in a form by using L<HTML::FormHandler::Form::Captcha>.
+
+ package MyApp::Form::Post;
+ use HTML::FormHandler::Moose;
+ with 'HTML::FormHandler::Form::Captcha';
+
+You can set the following attributes on the 'captcha' field:
+
+ height, width, scramble, lines, gd_font
+
+Example:
+
+ has 'captcha' => ( height => '24', width => '70 );
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/Field/Checkbox.pm b/lib/HTML/FormHandler/Field/Checkbox.pm
index 2159848..6f01e4c 100644
--- a/lib/HTML/FormHandler/Field/Checkbox.pm
+++ b/lib/HTML/FormHandler/Field/Checkbox.pm
@@ -1,12 +1,42 @@
package HTML::FormHandler::Field::Checkbox;
+# ABSTRACT: a checkbox field type
use HTML::FormHandler::Moose;
extends 'HTML::FormHandler::Field';
our $VERSION = '0.02';
+
+has '+widget' => ( default => 'checkbox' );
+has 'checkbox_value' => ( is => 'rw', default => 1 );
+has '+input_without_param' => ( default => 0 );
+
+sub value {
+ my $field = shift;
+ return $field->next::method(@_) if @_;
+ my $v = $field->next::method();
+ return defined $v ? $v : 0;
+}
+
+sub validate {
+ my $self = shift;
+ $self->add_error($self->required_message) if( $self->required && !$self->value );
+ return;
+}
+
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
+
+__END__
+=pod
+
=head1 NAME
-HTML::FormHandler::Field::Checkbox - A checkbox field type
+HTML::FormHandler::Field::Checkbox - a checkbox field type
+
+=head1 VERSION
+
+version 0.32002
=head1 DESCRIPTION
@@ -37,36 +67,16 @@ fields, will not be ignored if there is no input. If a particular
checkbox should not be processed for a particular form, you must
set 'inactive' to 1 instead.
-=cut
+=head1 AUTHOR
-has '+widget' => ( default => 'checkbox' );
-has 'checkbox_value' => ( is => 'rw', default => 1 );
-has '+input_without_param' => ( default => 0 );
+FormHandler Contributors - see HTML::FormHandler
-sub value {
- my $field = shift;
- return $field->next::method(@_) if @_;
- my $v = $field->next::method();
- return defined $v ? $v : 0;
-}
+=head1 COPYRIGHT AND LICENSE
-sub validate {
- my $self = shift;
- $self->add_error($self->required_message) if( $self->required && !$self->value );
- return;
-}
-
-=head1 AUTHORS
+This software is copyright (c) 2010 by Gerda Shank.
-Gerda Shank
-
-=head1 COPYRIGHT
-
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+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
-__PACKAGE__->meta->make_immutable;
-use namespace::autoclean;
-1;
diff --git a/lib/HTML/FormHandler/Field/Compound.pm b/lib/HTML/FormHandler/Field/Compound.pm
index 8432201..72de515 100644
--- a/lib/HTML/FormHandler/Field/Compound.pm
+++ b/lib/HTML/FormHandler/Field/Compound.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Field::Compound;
+# ABSTRACT: field consisting of subfields
use Moose;
extends 'HTML::FormHandler::Field';
@@ -6,57 +7,6 @@ with 'HTML::FormHandler::Fields';
with 'HTML::FormHandler::BuildFields';
with 'HTML::FormHandler::InitResult';
-=head1 NAME
-
-HTML::FormHandler::Field::Compound - field consisting of subfields
-
-=head1 SYNOPSIS
-
-This field class is designed as the base (parent) class for fields with
-multiple subfields. Examples are L<HTML::FormHandler::Field::DateTime>
-and L<HTML::FormHandler::Field::Duration>.
-
-A compound parent class requires the use of sub-fields prepended
-with the parent class name plus a dot
-
- has_field 'birthdate' => ( type => 'DateTime' );
- has_field 'birthdate.year' => ( type => 'Year' );
- has_field 'birthdate.month' => ( type => 'Month' );
- has_field 'birthdate.day' => ( type => 'MonthDay');
-
-If all validation is performed in the parent class so that no
-validation is necessary in the child classes, then the field class
-'Nested' may be used.
-
-The array of subfields is available in the 'fields' array in
-the compound field:
-
- $form->field('birthdate')->fields
-
-Error messages will be available in the field on which the error
-occurred. You can access 'error_fields' on the form or on Compound
-fields (and subclasses, like Repeatable).
-
-The process method of this field runs the process methods on the child fields
-and then builds a hash of these fields values. This hash is available for
-further processing by L<HTML::FormHandler::Field/actions> and the validate method.
-
-Example:
-
- has_field 'date_time' => (
- type => 'Compound',
- actions => [ { transform => sub{ DateTime->new( $_[0] ) } } ],
- );
- has_field 'date_time.year' => ( type => 'Text', );
- has_field 'date_time.month' => ( type => 'Text', );
- has_field 'date_time.day' => ( type => 'Text', );
-
-
-=head2 widget
-
-Widget type is 'compound'
-
-=cut
has '+widget' => ( default => 'compound' );
has 'is_compound' => ( is => 'ro', isa => 'Bool', default => 1 );
@@ -125,3 +75,73 @@ around '_result_from_input' => sub {
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Field::Compound - field consisting of subfields
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 SYNOPSIS
+
+This field class is designed as the base (parent) class for fields with
+multiple subfields. Examples are L<HTML::FormHandler::Field::DateTime>
+and L<HTML::FormHandler::Field::Duration>.
+
+A compound parent class requires the use of sub-fields prepended
+with the parent class name plus a dot
+
+ has_field 'birthdate' => ( type => 'DateTime' );
+ has_field 'birthdate.year' => ( type => 'Year' );
+ has_field 'birthdate.month' => ( type => 'Month' );
+ has_field 'birthdate.day' => ( type => 'MonthDay');
+
+If all validation is performed in the parent class so that no
+validation is necessary in the child classes, then the field class
+'Nested' may be used.
+
+The array of subfields is available in the 'fields' array in
+the compound field:
+
+ $form->field('birthdate')->fields
+
+Error messages will be available in the field on which the error
+occurred. You can access 'error_fields' on the form or on Compound
+fields (and subclasses, like Repeatable).
+
+The process method of this field runs the process methods on the child fields
+and then builds a hash of these fields values. This hash is available for
+further processing by L<HTML::FormHandler::Field/actions> and the validate method.
+
+Example:
+
+ has_field 'date_time' => (
+ type => 'Compound',
+ actions => [ { transform => sub{ DateTime->new( $_[0] ) } } ],
+ );
+ has_field 'date_time.year' => ( type => 'Text', );
+ has_field 'date_time.month' => ( type => 'Text', );
+ has_field 'date_time.day' => ( type => 'Text', );
+
+=head2 widget
+
+Widget type is 'compound'
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/Field/Date.pm b/lib/HTML/FormHandler/Field/Date.pm
index ad1d786..c297a22 100644
--- a/lib/HTML/FormHandler/Field/Date.pm
+++ b/lib/HTML/FormHandler/Field/Date.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Field::Date;
+# ABSTRACT: a date field with formats
use Moose;
extends 'HTML::FormHandler::Field::Text';
@@ -6,45 +7,6 @@ use DateTime;
use DateTime::Format::Strptime;
our $VERSION = '0.03';
-=head1 NAME
-
-HTML::FormHandler::Field::Date - a date field with formats
-
-=head1 SUMMARY
-
-This field may be used with the jQuery Datepicker plugin.
-
-You can specify the format for the date using jQuery formatDate strings
-or DateTime strftime formats. (Default format is format => '%Y-%m-%d'.)
-
- d - "%e" - day of month (no leading zero)
- dd - "%d" - day of month (two digit)
- o - "%{day_of_year}" - day of the year (no leading zeros)
- oo - "%j" - day of the year (three digit)
- D - "%a" - day name short
- DD - "%A" - day name long
- m - "%{day_of_month" - month of year (no leading zero)
- mm - "%m" - month of year (two digit) "%m"
- M - "%b" - month name short
- MM - "%B" - month name long
- y - "%y" - year (two digit)
- yy - "%Y" - year (four digit)
- @ - "%s" - Unix timestamp (ms since 01/01/1970)
-
-For example:
-
- has_field 'start_date' => ( type => 'Date', format => "dd/mm/y" );
-
-or
-
- has_field 'start_date' => ( type => 'Date', format => "%d/%m/%y" );
-
-You can also set 'date_end' and 'date_start' attributes for validation
-of the date range. Use iso_8601 formats for these dates ("yyyy-mm-dd");
-
- has_field 'start_date' => ( type => 'Date', date_start => "2009-12-25" );
-
-=cut
has 'format' => ( is => 'rw', isa => 'Str', default => "%Y-%m-%d" );
has 'locale' => ( is => 'rw', isa => 'Str' ); # TODO
@@ -129,3 +91,62 @@ sub get_strf_format {
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Field::Date - a date field with formats
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 SUMMARY
+
+This field may be used with the jQuery Datepicker plugin.
+
+You can specify the format for the date using jQuery formatDate strings
+or DateTime strftime formats. (Default format is format => '%Y-%m-%d'.)
+
+ d - "%e" - day of month (no leading zero)
+ dd - "%d" - day of month (two digit)
+ o - "%{day_of_year}" - day of the year (no leading zeros)
+ oo - "%j" - day of the year (three digit)
+ D - "%a" - day name short
+ DD - "%A" - day name long
+ m - "%{day_of_month" - month of year (no leading zero)
+ mm - "%m" - month of year (two digit) "%m"
+ M - "%b" - month name short
+ MM - "%B" - month name long
+ y - "%y" - year (two digit)
+ yy - "%Y" - year (four digit)
+ @ - "%s" - Unix timestamp (ms since 01/01/1970)
+
+For example:
+
+ has_field 'start_date' => ( type => 'Date', format => "dd/mm/y" );
+
+or
+
+ has_field 'start_date' => ( type => 'Date', format => "%d/%m/%y" );
+
+You can also set 'date_end' and 'date_start' attributes for validation
+of the date range. Use iso_8601 formats for these dates ("yyyy-mm-dd");
+
+ has_field 'start_date' => ( type => 'Date', date_start => "2009-12-25" );
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/Field/DateMDY.pm b/lib/HTML/FormHandler/Field/DateMDY.pm
index b2ceb47..4912a53 100644
--- a/lib/HTML/FormHandler/Field/DateMDY.pm
+++ b/lib/HTML/FormHandler/Field/DateMDY.pm
@@ -1,13 +1,26 @@
package HTML::FormHandler::Field::DateMDY;
+# ABSTRACT: m/d/y date field
use HTML::FormHandler::Moose;
extends 'HTML::FormHandler::Field::Date';
has '+format' => ( default => '%m/%d/%Y' );
+
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
+
+__END__
+=pod
+
=head1 NAME
-HTML::FormHandler::Field::DateMDY
+HTML::FormHandler::Field::DateMDY - m/d/y date field
+
+=head1 VERSION
+
+version 0.32002
=head1 SYNOPSIS
@@ -15,17 +28,16 @@ For date fields in the format nn/nn/nnnn. This simply inherits
from L<HTML::FormHandler::Field::Date> and sets the format
to "%m/%d/%Y".
-=head1 AUTHORS
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
-Gerda Shank
+=head1 COPYRIGHT AND LICENSE
-=head1 COPYRIGHT
+This software is copyright (c) 2010 by Gerda Shank.
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+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
-__PACKAGE__->meta->make_immutable;
-use namespace::autoclean;
-1;
diff --git a/lib/HTML/FormHandler/Field/DateTime.pm b/lib/HTML/FormHandler/Field/DateTime.pm
index 0e8bfaf..f3c348f 100644
--- a/lib/HTML/FormHandler/Field/DateTime.pm
+++ b/lib/HTML/FormHandler/Field/DateTime.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Field::DateTime;
+# ABSTRACT: compound DateTime field
use Moose;
extends 'HTML::FormHandler::Field::Compound';
@@ -7,43 +8,6 @@ use DateTime;
use Try::Tiny;
our $VERSION = '0.04';
-=head1 NAME
-
-HTML::FormHandler::Field::DateTime
-
-=head1 DESCRIPTION
-
-This is a compound field that uses modified field names for the
-sub fields instead of using a separate sub-form. Widget type is 'compound'.
-
-If you want to use drop-down select boxes for your DateTime, you
-can use fields like:
-
- has_field 'my_date' => ( type => 'DateTime' );
- has_field 'my_date.month' => ( type => 'Month' );
- has_field 'my_date.day' => ( type => 'MonthDay' );
- has_field 'my_date.year' => ( type => 'Year' );
- has_field 'my_date.hour' => ( type => 'Hour' );
- has_field 'my_date.minute' => ( type => 'Minute' );
-
-If you want simple input fields:
-
- has_field 'my_date' => ( type => 'DateTime' );
- has_field 'my_date.month' => ( type => 'Integer', range_start => 1,
- range_end => 12 );
- has_field 'my_date.day' => ( type => 'Integer', range_start => 1,
- range_end => 31 );
-
-=head1 AUTHORS
-
-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
has '+widget' => ( default => 'compound' );
@@ -74,7 +38,7 @@ sub validate {
catch {
$self->add_error('Not a valid DateTime');
};
- if( $dt ) {
+ if( $dt ) {
$self->_set_value($dt);
}
else {
@@ -86,3 +50,51 @@ __PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Field::DateTime - compound DateTime field
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 DESCRIPTION
+
+This is a compound field that uses modified field names for the
+sub fields instead of using a separate sub-form. Widget type is 'compound'.
+
+If you want to use drop-down select boxes for your DateTime, you
+can use fields like:
+
+ has_field 'my_date' => ( type => 'DateTime' );
+ has_field 'my_date.month' => ( type => 'Month' );
+ has_field 'my_date.day' => ( type => 'MonthDay' );
+ has_field 'my_date.year' => ( type => 'Year' );
+ has_field 'my_date.hour' => ( type => 'Hour' );
+ has_field 'my_date.minute' => ( type => 'Minute' );
+
+If you want simple input fields:
+
+ has_field 'my_date' => ( type => 'DateTime' );
+ has_field 'my_date.month' => ( type => 'Integer', range_start => 1,
+ range_end => 12 );
+ has_field 'my_date.day' => ( type => 'Integer', range_start => 1,
+ range_end => 31 );
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/Field/Display.pm b/lib/HTML/FormHandler/Field/Display.pm
index dd005a2..f804287 100644
--- a/lib/HTML/FormHandler/Field/Display.pm
+++ b/lib/HTML/FormHandler/Field/Display.pm
@@ -1,55 +1,12 @@
package HTML::FormHandler::Field::Display;
+# ABSTRACT: display only field
use Moose;
extends 'HTML::FormHandler::Field::NoValue';
use namespace::autoclean;
-=head1 NAME
-
-HTML::FormHandler::Field::Display
-
-=head1 SYNOPSIS
-
-This class can be used for fields that are display only. It will
-render the value returned by a form's 'html_<field_name>' method,
-or the field's 'html' attribute.
-
- has_field 'explanation' => ( type => 'Display',
- html => '<p>This is an explanation...</p>' );
-
-or in a form:
- has_field 'explanation' => ( type => 'Display' );
- sub html_explanation {
- my ( $self, $field ) = @_;
- if( $self->something ) {
- return '<p>This type of explanation...</p>';
- }
- else {
- return '<p>Another type of explanation...</p>';
- }
- }
- #----
- has_field 'username' => ( type => 'Display' );
- sub html_username {
- my ( $self, $field ) = @_;
- return '<div><b>User: </b>' . $field->value . '</div>';
- }
-
-
-or set the name of the rendering method:
-
- has_field 'explanation' => ( type => 'Display', set_html => 'my_explanation' );
- sub my_explanation {
- ....
- }
-
-You can also supply an 'html' method with a trait or a custom field. See examples
-in t/field_traits.t and t/xt/display.t of the distribution.
-
-=cut
-
-has 'html' => ( is => 'rw', isa => 'Str', builder => 'build_html' );
+has 'html' => ( is => 'rw', isa => 'Str', builder => 'build_html' );
sub build_html {''}
has 'set_html' => ( isa => 'Str', is => 'ro');
sub _set_html_meth {
@@ -106,3 +63,66 @@ after 'clear_data' => sub {
__PACKAGE__->meta->make_immutable;
1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Field::Display - display only field
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 SYNOPSIS
+
+This class can be used for fields that are display only. It will
+render the value returned by a form's 'html_<field_name>' method,
+or the field's 'html' attribute.
+
+ has_field 'explanation' => ( type => 'Display',
+ html => '<p>This is an explanation...</p>' );
+
+or in a form:
+
+ has_field 'explanation' => ( type => 'Display' );
+ sub html_explanation {
+ my ( $self, $field ) = @_;
+ if( $self->something ) {
+ return '<p>This type of explanation...</p>';
+ }
+ else {
+ return '<p>Another type of explanation...</p>';
+ }
+ }
+ #----
+ has_field 'username' => ( type => 'Display' );
+ sub html_username {
+ my ( $self, $field ) = @_;
+ return '<div><b>User: </b>' . $field->value . '</div>';
+ }
+
+or set the name of the rendering method:
+
+ has_field 'explanation' => ( type => 'Display', set_html => 'my_explanation' );
+ sub my_explanation {
+ ....
+ }
+
+You can also supply an 'html' method with a trait or a custom field. See examples
+in t/field_traits.t and t/xt/display.t of the distribution.
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/Field/Duration.pm b/lib/HTML/FormHandler/Field/Duration.pm
index 905f23c..35b21fa 100644
--- a/lib/HTML/FormHandler/Field/Duration.pm
+++ b/lib/HTML/FormHandler/Field/Duration.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Field::Duration;
+# ABSTRACT: DateTime::Duration from HTML form values
use Moose;
extends 'HTML::FormHandler::Field::Compound';
@@ -6,9 +7,39 @@ use DateTime;
our $VERSION = '0.01';
+
+sub validate {
+ my ($self) = @_;
+
+ my @dur_parms;
+ foreach my $child ( $self->all_fields ) {
+ unless ( $child->has_value && $child->value =~ /^\d+$/ ) {
+ $self->add_error( "Invalid value for [_1]: [_2]", $self->loc_label, $child->loc_label );
+ next;
+ }
+ push @dur_parms, ( $child->accessor => $child->value );
+ }
+
+ # set the value
+ my $duration = DateTime::Duration->new(@dur_parms);
+ $self->_set_value($duration);
+}
+
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
+
+
+__END__
+=pod
+
=head1 NAME
-HTML::FormHandler::Field::Duration - DateTime::Duration from HTML form values
+HTML::FormHandler::Field::Duration - DateTime::Duration from HTML form values
+
+=head1 VERSION
+
+version 0.32002
=head1 SubFields
@@ -24,27 +55,16 @@ For example:
has 'duration.minutes' => ( type => 'Int', range_start => 0,
range_end => 59 );
+=head1 AUTHOR
-=cut
+FormHandler Contributors - see HTML::FormHandler
-sub validate {
- my ($self) = @_;
+=head1 COPYRIGHT AND LICENSE
- my @dur_parms;
- foreach my $child ( $self->all_fields ) {
- unless ( $child->has_value && $child->value =~ /^\d+$/ ) {
- $self->add_error( "Invalid value for [_1]: [_2]", $self->loc_label, $child->loc_label );
- next;
- }
- push @dur_parms, ( $child->accessor => $child->value );
- }
+This software is copyright (c) 2010 by Gerda Shank.
- # set the value
- my $duration = DateTime::Duration->new(@dur_parms);
- $self->_set_value($duration);
-}
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
-__PACKAGE__->meta->make_immutable;
-use namespace::autoclean;
-1;
+=cut
diff --git a/lib/HTML/FormHandler/Field/Email.pm b/lib/HTML/FormHandler/Field/Email.pm
index 6369c80..e450bac 100644
--- a/lib/HTML/FormHandler/Field/Email.pm
+++ b/lib/HTML/FormHandler/Field/Email.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Field::Email;
+# ABSTRACT: validates email using Email::Valid
use HTML::FormHandler::Moose;
extends 'HTML::FormHandler::Field::Text';
@@ -17,9 +18,21 @@ apply(
]
);
+
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
+
+__END__
+=pod
+
=head1 NAME
-HTML::FormHandler::Field::Email - Validates email uisng Email::Valid
+HTML::FormHandler::Field::Email - validates email using Email::Valid
+
+=head1 VERSION
+
+version 0.32002
=head1 DESCRIPTION
@@ -30,17 +43,16 @@ Widget type is 'text'.
L<Email::Valid>
-=head1 AUTHORS
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
-Gerda Shank
+=head1 COPYRIGHT AND LICENSE
-=head1 COPYRIGHT
+This software is copyright (c) 2010 by Gerda Shank.
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+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
-__PACKAGE__->meta->make_immutable;
-use namespace::autoclean;
-1;
diff --git a/lib/HTML/FormHandler/Field/Hidden.pm b/lib/HTML/FormHandler/Field/Hidden.pm
index df42fa2..6124b59 100644
--- a/lib/HTML/FormHandler/Field/Hidden.pm
+++ b/lib/HTML/FormHandler/Field/Hidden.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Field::Hidden;
+# ABSTRACT: hidden field
use Moose;
extends 'HTML::FormHandler::Field::Text';
@@ -6,26 +7,37 @@ our $VERSION = '0.01';
has '+widget' => ( default => 'hidden' );
+
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
+
+__END__
+=pod
+
=head1 NAME
-HTML::FormHandler::Field::Hidden
+HTML::FormHandler::Field::Hidden - hidden field
+
+=head1 VERSION
+
+version 0.32002
=head1 DESCRIPTION
This is a text field that uses the 'hidden' widget type, for HTML
of type 'hidden'.
-=head1 AUTHORS
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
-Zbigniew Lukasiak
+=head1 COPYRIGHT AND LICENSE
-=head1 COPYRIGHT
+This software is copyright (c) 2010 by Gerda Shank.
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+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
-__PACKAGE__->meta->make_immutable;
-use namespace::autoclean;
-1;
diff --git a/lib/HTML/FormHandler/Field/Hour.pm b/lib/HTML/FormHandler/Field/Hour.pm
index 7571e31..46f19e5 100644
--- a/lib/HTML/FormHandler/Field/Hour.pm
+++ b/lib/HTML/FormHandler/Field/Hour.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Field::Hour;
+# ABSTRACT: accept integer from 0 to 23
use Moose;
extends 'HTML::FormHandler::Field::IntRange';
@@ -7,25 +8,36 @@ our $VERSION = '0.03';
has '+range_start' => ( default => 0 );
has '+range_end' => ( default => 23 );
+
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
+
+__END__
+=pod
+
=head1 NAME
HTML::FormHandler::Field::Hour - accept integer from 0 to 23
+=head1 VERSION
+
+version 0.32002
+
=head1 DESCRIPTION
Enter an integer from 0 to 23 hours.
-=head1 AUTHORS
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
-Gerda Shank
+=head1 COPYRIGHT AND LICENSE
-=head1 COPYRIGHT
+This software is copyright (c) 2010 by Gerda Shank.
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+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
-__PACKAGE__->meta->make_immutable;
-use namespace::autoclean;
-1;
diff --git a/lib/HTML/FormHandler/Field/HtmlArea.pm b/lib/HTML/FormHandler/Field/HtmlArea.pm
index 91dcbeb..cab1437 100644
--- a/lib/HTML/FormHandler/Field/HtmlArea.pm
+++ b/lib/HTML/FormHandler/Field/HtmlArea.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Field::HtmlArea;
+# ABSTRACT: input HTML in a textarea
use Moose;
extends 'HTML::FormHandler::Field::TextArea';
@@ -67,9 +68,21 @@ EOF
}
+
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
+
+__END__
+=pod
+
=head1 NAME
-HTML::FormHandler::Field::HtmlArea - Input HTML in a textarea
+HTML::FormHandler::Field::HtmlArea - input HTML in a textarea
+
+=head1 VERSION
+
+version 0.32002
=head1 SYNOPSIS
@@ -85,17 +98,16 @@ Widget type is 'textarea'.
L<HTML::Tidy> L<File::Temp>
-=head1 AUTHORS
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
-Gerda Shank
+=head1 COPYRIGHT AND LICENSE
-=head1 COPYRIGHT
+This software is copyright (c) 2010 by Gerda Shank.
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+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
-__PACKAGE__->meta->make_immutable;
-use namespace::autoclean;
-1;
diff --git a/lib/HTML/FormHandler/Field/IntRange.pm b/lib/HTML/FormHandler/Field/IntRange.pm
index dd5165b..97ad3bb 100644
--- a/lib/HTML/FormHandler/Field/IntRange.pm
+++ b/lib/HTML/FormHandler/Field/IntRange.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Field::IntRange;
+# ABSTRACT: integer range in select list
use Moose;
extends 'HTML::FormHandler::Field::Select';
@@ -27,9 +28,21 @@ sub build_options {
$self->range_start .. $self->range_end ];
}
+
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
+
+__END__
+=pod
+
=head1 NAME
-HTML::FormHandler::Field::IntRange - Select an integer range in a select list
+HTML::FormHandler::Field::IntRange - integer range in select list
+
+=head1 VERSION
+
+version 0.32002
=head1 DESCRIPTION
@@ -41,17 +54,16 @@ range_start and range_end for a select list with a different range.
Widget type is 'select'.
-=head1 AUTHORS
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
-Gerda Shank
+=head1 COPYRIGHT AND LICENSE
-=head1 COPYRIGHT
+This software is copyright (c) 2010 by Gerda Shank.
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+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
-__PACKAGE__->meta->make_immutable;
-use namespace::autoclean;
-1;
diff --git a/lib/HTML/FormHandler/Field/Integer.pm b/lib/HTML/FormHandler/Field/Integer.pm
index 8bfec7b..f0066e5 100644
--- a/lib/HTML/FormHandler/Field/Integer.pm
+++ b/lib/HTML/FormHandler/Field/Integer.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Field::Integer;
+# ABSTRACT: validate an integer value
use HTML::FormHandler::Moose;
extends 'HTML::FormHandler::Field::Text';
@@ -22,27 +23,38 @@ apply(
]
);
+
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
+
+__END__
+=pod
+
=head1 NAME
HTML::FormHandler::Field::Integer - validate an integer value
+=head1 VERSION
+
+version 0.32002
+
=head1 DESCRIPTION
This accpets a positive or negative integer. Negative integers may
be prefixed with a dash. By default a max of eight digits are accepted.
Widget type is 'text'.
-=head1 AUTHORS
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
-Gerda Shank
+=head1 COPYRIGHT AND LICENSE
-=head1 COPYRIGHT
+This software is copyright (c) 2010 by Gerda Shank.
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+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
-__PACKAGE__->meta->make_immutable;
-use namespace::autoclean;
-1;
diff --git a/lib/HTML/FormHandler/Field/Minute.pm b/lib/HTML/FormHandler/Field/Minute.pm
index 645ab51..e0790fe 100644
--- a/lib/HTML/FormHandler/Field/Minute.pm
+++ b/lib/HTML/FormHandler/Field/Minute.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Field::Minute;
+# ABSTRACT: input range from 0 to 59
use Moose;
extends 'HTML::FormHandler::Field::IntRange';
@@ -8,26 +9,37 @@ has '+range_start' => ( default => 0 );
has '+range_end' => ( default => 59 );
has '+label_format' => ( default => '%02d' );
+
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
+
+__END__
+=pod
+
=head1 NAME
HTML::FormHandler::Field::Minute - input range from 0 to 59
+=head1 VERSION
+
+version 0.32002
+
=head1 DESCRIPTION
Generate a select list for entering a minute value.
Widget type is 'select'.
-=head1 AUTHORS
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
-Gerda Shank
+=head1 COPYRIGHT AND LICENSE
-=head1 COPYRIGHT
+This software is copyright (c) 2010 by Gerda Shank.
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+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
-__PACKAGE__->meta->make_immutable;
-use namespace::autoclean;
-1;
diff --git a/lib/HTML/FormHandler/Field/Money.pm b/lib/HTML/FormHandler/Field/Money.pm
index e5b0bfe..7a82a18 100644
--- a/lib/HTML/FormHandler/Field/Money.pm
+++ b/lib/HTML/FormHandler/Field/Money.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Field::Money;
+# ABSTRACT: US currency-like values
use HTML::FormHandler::Moose;
extends 'HTML::FormHandler::Field::Text';
@@ -24,9 +25,21 @@ apply(
]
);
+
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
+
+__END__
+=pod
+
=head1 NAME
-HTML::FormHandler::Field::Money - Input US currency-like values.
+HTML::FormHandler::Field::Money - US currency-like values
+
+=head1 VERSION
+
+version 0.32002
=head1 DESCRIPTION
@@ -35,17 +48,16 @@ Formatted with two decimal places.
Uses a period for the decimal point. Widget type is 'text'.
-=head1 AUTHORS
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
-Gerda Shank
+=head1 COPYRIGHT AND LICENSE
-=head1 COPYRIGHT
+This software is copyright (c) 2010 by Gerda Shank.
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+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
-__PACKAGE__->meta->make_immutable;
-use namespace::autoclean;
-1;
diff --git a/lib/HTML/FormHandler/Field/Month.pm b/lib/HTML/FormHandler/Field/Month.pm
index 9936c48..8429426 100644
--- a/lib/HTML/FormHandler/Field/Month.pm
+++ b/lib/HTML/FormHandler/Field/Month.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Field::Month;
+# ABSTRACT: select list 1 to 12
use Moose;
extends 'HTML::FormHandler::Field::IntRange';
@@ -7,25 +8,36 @@ our $VERSION = '0.01';
has '+range_start' => ( default => 1 );
has '+range_end' => ( default => 12 );
+
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
+
+__END__
+=pod
+
=head1 NAME
-HTML::FormHandler::Field::Month - Select list of 1 to 12
+HTML::FormHandler::Field::Month - select list 1 to 12
+
+=head1 VERSION
+
+version 0.32002
=head1 DESCRIPTION
Select list for range of 1 to 12. Widget type is 'select'
-=head1 AUTHORS
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
-Gerda Shank
+=head1 COPYRIGHT AND LICENSE
-=head1 COPYRIGHT
+This software is copyright (c) 2010 by Gerda Shank.
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+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
-__PACKAGE__->meta->make_immutable;
-use namespace::autoclean;
-1;
diff --git a/lib/HTML/FormHandler/Field/MonthDay.pm b/lib/HTML/FormHandler/Field/MonthDay.pm
index 31ce73f..230f461 100644
--- a/lib/HTML/FormHandler/Field/MonthDay.pm
+++ b/lib/HTML/FormHandler/Field/MonthDay.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Field::MonthDay;
+# ABSTRACT: select list 1 to 31
use Moose;
extends 'HTML::FormHandler::Field::IntRange';
@@ -7,25 +8,36 @@ our $VERSION = '0.01';
has '+range_start' => ( default => 1 );
has '+range_end' => ( default => 31 );
+
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
+
+__END__
+=pod
+
=head1 NAME
-HTML::FormHandler::Field::MonthDay - Select list for a day number 1 to 31
+HTML::FormHandler::Field::MonthDay - select list 1 to 31
+
+=head1 VERSION
+
+version 0.32002
=head1 DESCRIPTION
Generates a select list for integers 1 to 31.
-=head1 AUTHORS
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
-Gerda Shank
+=head1 COPYRIGHT AND LICENSE
-=head1 COPYRIGHT
+This software is copyright (c) 2010 by Gerda Shank.
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+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
-__PACKAGE__->meta->make_immutable;
-use namespace::autoclean;
-1;
diff --git a/lib/HTML/FormHandler/Field/MonthName.pm b/lib/HTML/FormHandler/Field/MonthName.pm
index 8a3e08c..7309616 100644
--- a/lib/HTML/FormHandler/Field/MonthName.pm
+++ b/lib/HTML/FormHandler/Field/MonthName.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Field::MonthName;
+# ABSTRACT: select list with month names
use Moose;
extends 'HTML::FormHandler::Field::Select';
@@ -23,25 +24,36 @@ sub build_options {
return [ map { { value => $i++, label => $_ } } @months ];
}
+
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
+
+__END__
+=pod
+
=head1 NAME
-HTML::FormHandler::Field::MonthName - Select list for month names
+HTML::FormHandler::Field::MonthName - select list with month names
+
+=head1 VERSION
+
+version 0.32002
=head1 DESCRIPTION
Generates a list of English month names.
-=head1 AUTHORS
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
-Gerda Shank
+=head1 COPYRIGHT AND LICENSE
-=head1 COPYRIGHT
+This software is copyright (c) 2010 by Gerda Shank.
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+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
-__PACKAGE__->meta->make_immutable;
-use namespace::autoclean;
-1;
diff --git a/lib/HTML/FormHandler/Field/Multiple.pm b/lib/HTML/FormHandler/Field/Multiple.pm
index 8e6b394..8e4750c 100644
--- a/lib/HTML/FormHandler/Field/Multiple.pm
+++ b/lib/HTML/FormHandler/Field/Multiple.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Field::Multiple;
+# ABSTRACT: multiple select list
use Moose;
extends 'HTML::FormHandler::Field::Select';
@@ -24,9 +25,21 @@ sub sort_options {
return $options;
}
+
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
+
+__END__
+=pod
+
=head1 NAME
-HTML::FormHandler::Field::Multiple - Select one or more options
+HTML::FormHandler::Field::Multiple - multiple select list
+
+=head1 VERSION
+
+version 0.32002
=head1 DESCRIPTION
@@ -36,17 +49,16 @@ and sets the "multiple" flag true to accept multiple options.
The currently selected items will be put at the top of the list.
Widget type is 'select'.
-=head1 AUTHORS
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
-Gerda Shank
+=head1 COPYRIGHT AND LICENSE
-=head1 COPYRIGHT
+This software is copyright (c) 2010 by Gerda Shank.
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+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
-__PACKAGE__->meta->make_immutable;
-use namespace::autoclean;
-1;
diff --git a/lib/HTML/FormHandler/Field/Nested.pm b/lib/HTML/FormHandler/Field/Nested.pm
index 17c6117..9226ed8 100644
--- a/lib/HTML/FormHandler/Field/Nested.pm
+++ b/lib/HTML/FormHandler/Field/Nested.pm
@@ -1,22 +1,43 @@
package HTML::FormHandler::Field::Nested;
+# ABSTRACT: for nested elements of compound fields
use Moose;
extends 'HTML::FormHandler::Field::Text';
+
+
+
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
+
+__END__
+=pod
+
=head1 NAME
HTML::FormHandler::Field::Nested - for nested elements of compound fields
+=head1 VERSION
+
+version 0.32002
+
=head1 SYNOPSIS
This field class is intended for nested elements of compound fields. It
does no particular validation, since the compound field should handle
that.
-=cut
+=head1 AUTHOR
+FormHandler Contributors - see HTML::FormHandler
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
-__PACKAGE__->meta->make_immutable;
-use namespace::autoclean;
-1;
diff --git a/lib/HTML/FormHandler/Field/NoValue.pm b/lib/HTML/FormHandler/Field/NoValue.pm
index 10e11ca..8ed3394 100644
--- a/lib/HTML/FormHandler/Field/NoValue.pm
+++ b/lib/HTML/FormHandler/Field/NoValue.pm
@@ -1,19 +1,9 @@
package HTML::FormHandler::Field::NoValue;
+# ABSTRACT: base class for submit field
use Moose;
extends 'HTML::FormHandler::Field';
-=head1 NAME
-
-HTML::FormHandler::Field::NoValue
-
-=head1 SYNOPSIS
-
-This is the base class for the Submit field. It can be used for fields that
-are do not produce valid 'values'. It should not be used for fields that
-produce a value or need validating.
-
-=cut
has 'html' => ( is => 'rw', isa => 'Str', default => '' );
has 'value' => (
@@ -61,3 +51,34 @@ sub render {
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Field::NoValue - base class for submit field
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 SYNOPSIS
+
+This is the base class for the Submit field. It can be used for fields that
+are do not produce valid 'values'. It should not be used for fields that
+produce a value or need validating.
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/Field/Password.pm b/lib/HTML/FormHandler/Field/Password.pm
index 68f15a4..7a3f0be 100644
--- a/lib/HTML/FormHandler/Field/Password.pm
+++ b/lib/HTML/FormHandler/Field/Password.pm
@@ -1,12 +1,54 @@
package HTML::FormHandler::Field::Password;
+# ABSTRACT: password field
use HTML::FormHandler::Moose;
extends 'HTML::FormHandler::Field::Text';
our $VERSION = '0.04';
+
+has '+widget' => ( default => 'password' );
+has '+password' => ( default => 1 );
+has '+required_message' => ( default => 'Please enter a password in this field' );
+has 'ne_username' => ( isa => 'Str', is => 'rw' );
+
+after 'validate_field' => sub {
+ my $self = shift;
+
+ if ( !$self->required && !( defined( $self->value ) && length( $self->value ) ) ) {
+ $self->noupdate(1);
+ $self->clear_errors;
+ }
+};
+
+sub validate {
+ my $self = shift;
+
+ $self->noupdate(0);
+ return unless $self->next::method;
+
+ my $value = $self->value;
+ if ( $self->form && $self->ne_username ) {
+ my $username = $self->form->get_param( $self->ne_username );
+ return $self->add_error( 'Password must not match ' . $self->ne_username )
+ if $username && $username eq $value;
+ }
+ return 1;
+}
+
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
+
+__END__
+=pod
+
=head1 NAME
-HTML::FormHandler::Field::Password - Input a password
+HTML::FormHandler::Field::Password - password field
+
+=head1 VERSION
+
+version 0.32002
=head1 DESCRIPTION
@@ -38,50 +80,16 @@ Set this attribute to the name of your username field (default 'username')
if you want to check that the password is not the same as the username.
Does not check by default.
-=cut
+=head1 AUTHOR
-has '+widget' => ( default => 'password' );
-has '+password' => ( default => 1 );
-has '+required_message' => ( default => 'Please enter a password in this field' );
-has 'ne_username' => ( isa => 'Str', is => 'rw' );
-
-after 'validate_field' => sub {
- my $self = shift;
+FormHandler Contributors - see HTML::FormHandler
- if ( !$self->required && !( defined( $self->value ) && length( $self->value ) ) ) {
- $self->noupdate(1);
- $self->clear_errors;
- }
-};
+=head1 COPYRIGHT AND LICENSE
-sub validate {
- my $self = shift;
+This software is copyright (c) 2010 by Gerda Shank.
- $self->noupdate(0);
- return unless $self->next::method;
-
- my $value = $self->value;
- if ( $self->form && $self->ne_username ) {
- my $username = $self->form->get_param( $self->ne_username );
- return $self->add_error( 'Password must not match ' . $self->ne_username )
- if $username && $username eq $value;
- }
- return 1;
-}
-
-=head1 AUTHORS
-
-Gerda Shank
-
-=head1 COPYRIGHT
-
-See L<HTML::FormHandler> for copyright.
-
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+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
-__PACKAGE__->meta->make_immutable;
-use namespace::autoclean;
-1;
diff --git a/lib/HTML/FormHandler/Field/PasswordConf.pm b/lib/HTML/FormHandler/Field/PasswordConf.pm
index a7241b1..ee6b26f 100644
--- a/lib/HTML/FormHandler/Field/PasswordConf.pm
+++ b/lib/HTML/FormHandler/Field/PasswordConf.pm
@@ -1,24 +1,10 @@
package HTML::FormHandler::Field::PasswordConf;
+# ABSTRACT: password confirmation
use HTML::FormHandler::Moose;
extends 'HTML::FormHandler::Field::Text';
our $VERSION = '0.03';
-=head1 NAME
-
-HTML::FormHandler::Field::PasswordConf - Password confirmation
-
-=head1 DESCRIPTION
-
-This field needs to be declared after the related Password field (or more
-precisely it needs to come after the Password field in the list returned by
-the L<HTML::FormHandler/fields> method).
-
-=head2 password_field
-
-Set this attribute to the name of your password field (default 'password')
-
-=cut
has '+widget' => ( default => 'password' );
has '+password' => ( default => 1 );
@@ -43,19 +29,41 @@ sub validate {
return 1;
}
-=head1 AUTHORS
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
-See L<HTML::FormHandler> for authors.
+__END__
+=pod
+
+=head1 NAME
-=head1 COPYRIGHT
+HTML::FormHandler::Field::PasswordConf - password confirmation
-See L<HTML::FormHandler> for copyright.
+=head1 VERSION
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+version 0.32002
+
+=head1 DESCRIPTION
+
+This field needs to be declared after the related Password field (or more
+precisely it needs to come after the Password field in the list returned by
+the L<HTML::FormHandler/fields> method).
+
+=head2 password_field
+
+Set this attribute to the name of your password field (default 'password')
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
-__PACKAGE__->meta->make_immutable;
-use namespace::autoclean;
-1;
diff --git a/lib/HTML/FormHandler/Field/PosInteger.pm b/lib/HTML/FormHandler/Field/PosInteger.pm
index b51f052..6882a96 100644
--- a/lib/HTML/FormHandler/Field/PosInteger.pm
+++ b/lib/HTML/FormHandler/Field/PosInteger.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Field::PosInteger;
+# ABSTRACT: positive integer field
use HTML::FormHandler::Moose;
extends 'HTML::FormHandler::Field::Integer';
@@ -13,25 +14,36 @@ apply(
]
);
+
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
+
+__END__
+=pod
+
=head1 NAME
-HTML::FormHandler::Field::PosInteger - Validates input is a positive integer
+HTML::FormHandler::Field::PosInteger - positive integer field
+
+=head1 VERSION
+
+version 0.32002
=head1 DESCRIPTION
Tests that the input is an integer and has a postive value.
-=head1 AUTHORS
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
-Gerda Shank
+=head1 COPYRIGHT AND LICENSE
-=head1 COPYRIGHT
+This software is copyright (c) 2010 by Gerda Shank.
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+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
-__PACKAGE__->meta->make_immutable;
-use namespace::autoclean;
-1;
diff --git a/lib/HTML/FormHandler/Field/PrimaryKey.pm b/lib/HTML/FormHandler/Field/PrimaryKey.pm
index a6e4904..273133c 100644
--- a/lib/HTML/FormHandler/Field/PrimaryKey.pm
+++ b/lib/HTML/FormHandler/Field/PrimaryKey.pm
@@ -1,22 +1,42 @@
package HTML::FormHandler::Field::PrimaryKey;
+# ABSTRACT: primary key field
use Moose;
extends 'HTML::FormHandler::Field';
+
+has 'is_primary_key' => ( isa => 'Bool', is => 'ro', default => '1' );
+has '+widget' => ( default => 'hidden' );
+
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
+
+__END__
+=pod
+
=head1 NAME
-HTML::FormHandler::Field::PrimaryKey - field for primary keys for
-Repeatable related fields.
+HTML::FormHandler::Field::PrimaryKey - primary key field
+
+=head1 VERSION
+
+version 0.32002
=head1 SYNOPSIS
has_field 'addresses.address_id' => ( type => 'PrimaryKey' );
-=cut
+=head1 AUTHOR
-has 'is_primary_key' => ( isa => 'Bool', is => 'ro', default => '1' );
-has '+widget' => ( default => 'hidden' );
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
-__PACKAGE__->meta->make_immutable;
-use namespace::autoclean;
-1;
diff --git a/lib/HTML/FormHandler/Field/Radio.pm b/lib/HTML/FormHandler/Field/Radio.pm
index 332b681..4e3518a 100644
--- a/lib/HTML/FormHandler/Field/Radio.pm
+++ b/lib/HTML/FormHandler/Field/Radio.pm
@@ -1,11 +1,28 @@
package HTML::FormHandler::Field::Radio;
+# ABSTRACT: not used
use Moose;
extends 'HTML::FormHandler::Field';
+
+has 'radio_value' => ( is => 'rw', default => 1 );
+
+has '+widget' => ( default => 'radio' );
+
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
+
+__END__
+=pod
+
=head1 NAME
-HTML::FormHandler::Field::Radio
+HTML::FormHandler::Field::Radio - not used
+
+=head1 VERSION
+
+version 0.32002
=head1 SYNOPSIS
@@ -20,28 +37,20 @@ atomic radio buttons.
[% END %]
/>
-
=head2 radio_value
See synopsis. Sets the value used in the radio button.
-=cut
-
-has 'radio_value' => ( is => 'rw', default => 1 );
-
-has '+widget' => ( default => 'radio' );
+=head1 AUTHOR
-=head1 AUTHORS
+FormHandler Contributors - see HTML::FormHandler
-Gerda Shank
+=head1 COPYRIGHT AND LICENSE
-=head1 COPYRIGHT
+This software is copyright (c) 2010 by Gerda Shank.
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+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
-__PACKAGE__->meta->make_immutable;
-use namespace::autoclean;
-1;
diff --git a/lib/HTML/FormHandler/Field/Repeatable.pm b/lib/HTML/FormHandler/Field/Repeatable.pm
index e2d2c53..6eb5517 100644
--- a/lib/HTML/FormHandler/Field/Repeatable.pm
+++ b/lib/HTML/FormHandler/Field/Repeatable.pm
@@ -1,110 +1,11 @@
package HTML::FormHandler::Field::Repeatable;
+# ABSTRACT: repeatable (array) field
use Moose;
extends 'HTML::FormHandler::Field::Compound';
use aliased 'HTML::FormHandler::Field::Repeatable::Instance';
-=head1 NAME
-
-HTML::FormHandler::Field::Repeatable - Repeatable (array) field
-
-=head1 SYNOPSIS
-
-In a form, for an array of hashrefs, equivalent to a 'has_many' database
-relationship.
-
- has_field 'addresses' => ( type => 'Repeatable' );
- has_field 'addresses.address_id' => ( type => 'PrimaryKey' );
- has_field 'addresses.street';
- has_field 'addresses.city';
- has_field 'addresses.state';
-
-For a database field include a PrimaryKey hidden field, or set 'auto_id' to
-have an 'id' field automatically created.
-
-In a form, for an array of single fields (not directly equivalent to a
-database relationship) use the 'contains' pseudo field name:
-
- has_field 'tags' => ( type => 'Repeatable' );
- has_field 'tags.contains' => ( type => 'Text',
- apply => [ { check => ['perl', 'programming', 'linux', 'internet'],
- message => 'Not a valid tag' } ]
- );
-
-or use 'contains' with single fields which are compound fields:
-
- has_field 'addresses' => ( type => 'Repeatable' );
- has_field 'addresses.contains' => ( type => '+MyAddress' );
-
-If the MyAddress field contains fields 'address_id', 'street', 'city', and
-'state', then this syntax is functionally equivalent to the first method
-where the fields are declared with dots ('addresses.city');
-
-=head1 DESCRIPTION
-
-This class represents an array. It can either be an array of hashrefs
-(compound fields) or an array of single fields.
-
-The 'contains' keyword is used for elements that do not have names
-because they are not hash elements.
-
-This field node will build arrays of fields from the the parameters or an
-initial object, or empty fields for an empty form.
-
-The name of the element fields will be an array index,
-starting with 0. Therefore the first array element can be accessed with:
-
- $form->field('tags')->field('0')
- $form->field('addresses')->field('0)->field('city')
-
-or using the shortcut form:
-
- $form->field('tags.0')
- $form->field('addresses.0.city')
-
-The array of elements will be in C<< $form->field('addresses')->fields >>.
-The subfields of the elements will be in a fields array in each element.
-
- foreach my $element ( $form->field('addresses')->fields )
- {
- foreach my $field ( $element->fields )
- {
- # do something
- }
- }
-
-Every field that has a 'fields' array will also have an 'error_fields' array
-containing references to the fields that contain errors.
-
-Note that after updates to the database the fields will be reloaded. This means
-that the array indexes ( the '3' in C<< $form->field('addresses.3') >> ) may
-not be the same if there have been changes since the fields were initially
-loaded.
-
-=head1 ATTRIBUTES
-
-=over
-
-=item index
-
-This attribute contains the next index number available to create an
-additional array element.
-
-=item num_when_empty
-
-This attribute (default 1) indicates how many empty fields to present
-in an empty form which hasn't been filled from parameters or database
-rows.
-
-=item auto_id
-
-Will create an 'id' field automatically
-
-=back
-
-
-=cut
has 'contains' => (
isa => 'HTML::FormHandler::Field',
@@ -123,7 +24,7 @@ sub _fields_validate {
# loop through array of fields and validate
my @value_array;
foreach my $field ( $self->all_fields ) {
- next if ( $field->inactive && !$field->_active );
+ next if ( $field->inactive && !$field->_active );
# Validate each field and "inflate" input -> value.
$field->validate_field; # this calls the field's 'validate' routine
push @value_array, $field->value;
@@ -227,7 +128,7 @@ sub _result_from_input {
sub _result_from_object {
my ( $self, $result, $values ) = @_;
- return $self->_result_from_fields( $result )
+ return $self->_result_from_fields( $result )
if ( $self->num_when_empty > 0 && !$values );
$self->item($values);
$self->init_state;
@@ -304,3 +205,122 @@ before 'value' => sub {
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Field::Repeatable - repeatable (array) field
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 SYNOPSIS
+
+In a form, for an array of hashrefs, equivalent to a 'has_many' database
+relationship.
+
+ has_field 'addresses' => ( type => 'Repeatable' );
+ has_field 'addresses.address_id' => ( type => 'PrimaryKey' );
+ has_field 'addresses.street';
+ has_field 'addresses.city';
+ has_field 'addresses.state';
+
+For a database field include a PrimaryKey hidden field, or set 'auto_id' to
+have an 'id' field automatically created.
+
+In a form, for an array of single fields (not directly equivalent to a
+database relationship) use the 'contains' pseudo field name:
+
+ has_field 'tags' => ( type => 'Repeatable' );
+ has_field 'tags.contains' => ( type => 'Text',
+ apply => [ { check => ['perl', 'programming', 'linux', 'internet'],
+ message => 'Not a valid tag' } ]
+ );
+
+or use 'contains' with single fields which are compound fields:
+
+ has_field 'addresses' => ( type => 'Repeatable' );
+ has_field 'addresses.contains' => ( type => '+MyAddress' );
+
+If the MyAddress field contains fields 'address_id', 'street', 'city', and
+'state', then this syntax is functionally equivalent to the first method
+where the fields are declared with dots ('addresses.city');
+
+=head1 DESCRIPTION
+
+This class represents an array. It can either be an array of hashrefs
+(compound fields) or an array of single fields.
+
+The 'contains' keyword is used for elements that do not have names
+because they are not hash elements.
+
+This field node will build arrays of fields from the the parameters or an
+initial object, or empty fields for an empty form.
+
+The name of the element fields will be an array index,
+starting with 0. Therefore the first array element can be accessed with:
+
+ $form->field('tags')->field('0')
+ $form->field('addresses')->field('0)->field('city')
+
+or using the shortcut form:
+
+ $form->field('tags.0')
+ $form->field('addresses.0.city')
+
+The array of elements will be in C<< $form->field('addresses')->fields >>.
+The subfields of the elements will be in a fields array in each element.
+
+ foreach my $element ( $form->field('addresses')->fields )
+ {
+ foreach my $field ( $element->fields )
+ {
+ # do something
+ }
+ }
+
+Every field that has a 'fields' array will also have an 'error_fields' array
+containing references to the fields that contain errors.
+
+Note that after updates to the database the fields will be reloaded. This means
+that the array indexes ( the '3' in C<< $form->field('addresses.3') >> ) may
+not be the same if there have been changes since the fields were initially
+loaded.
+
+=head1 ATTRIBUTES
+
+=over
+
+=item index
+
+This attribute contains the next index number available to create an
+additional array element.
+
+=item num_when_empty
+
+This attribute (default 1) indicates how many empty fields to present
+in an empty form which hasn't been filled from parameters or database
+rows.
+
+=item auto_id
+
+Will create an 'id' field automatically
+
+=back
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/Field/Repeatable/Instance.pm b/lib/HTML/FormHandler/Field/Repeatable/Instance.pm
index 95738aa..64ddedd 100644
--- a/lib/HTML/FormHandler/Field/Repeatable/Instance.pm
+++ b/lib/HTML/FormHandler/Field/Repeatable/Instance.pm
@@ -1,19 +1,10 @@
package # hide from Pause
HTML::FormHandler::Field::Repeatable::Instance;
+# ABSTRACT: used internally by repeatable fields
use Moose;
extends 'HTML::FormHandler::Field::Compound';
-=head1 NAME
-
-HTML::FormHandler::Field::Repeatable::Instance
-
-=head1 SYNOPSIS
-
-This is a simple container class to hold an instance of a Repeatable field.
-It will have a name like '0', '1'... Users should not need to use this class.
-
-=cut
# this class does not have a 'real' accessor
sub full_accessor {
@@ -26,3 +17,33 @@ sub full_accessor {
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Field::Repeatable::Instance - used internally by repeatable fields
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 SYNOPSIS
+
+This is a simple container class to hold an instance of a Repeatable field.
+It will have a name like '0', '1'... Users should not need to use this class.
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/Field/Reset.pm b/lib/HTML/FormHandler/Field/Reset.pm
index c1b006a..c9a50aa 100644
--- a/lib/HTML/FormHandler/Field/Reset.pm
+++ b/lib/HTML/FormHandler/Field/Reset.pm
@@ -1,12 +1,29 @@
package HTML::FormHandler::Field::Reset;
+# ABSTRACT: reset field
use Moose;
extends 'HTML::FormHandler::Field::NoValue';
+
+has '+widget' => ( default => 'reset' );
+
+has '+value' => ( default => 'Reset' );
+
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
+
+__END__
+=pod
+
=head1 NAME
HTML::FormHandler::Field::Reset - reset field
+=head1 VERSION
+
+version 0.32002
+
=head1 SYNOPSIS
Use this field to declare a reset field in your form.
@@ -15,12 +32,16 @@ Use this field to declare a reset field in your form.
Uses the 'reset' widget.
-=cut
+=head1 AUTHOR
-has '+widget' => ( default => 'reset' );
+FormHandler Contributors - see HTML::FormHandler
-has '+value' => ( default => 'Reset' );
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
-__PACKAGE__->meta->make_immutable;
-use namespace::autoclean;
-1;
diff --git a/lib/HTML/FormHandler/Field/Result.pm b/lib/HTML/FormHandler/Field/Result.pm
index 01288cf..1b029a9 100644
--- a/lib/HTML/FormHandler/Field/Result.pm
+++ b/lib/HTML/FormHandler/Field/Result.pm
@@ -1,17 +1,9 @@
package HTML::FormHandler::Field::Result;
+# ABSTRACT: result class for fields
use Moose;
with 'HTML::FormHandler::Result::Role';
-=head1 NAME
-
-HTML::FormHandler::Field::Result
-
-=head1 SYNOPSIS
-
-Result class for L<HTML::FormHandler::Field>
-
-=cut
has 'field_def' => (
is => 'ro',
@@ -50,18 +42,35 @@ sub peek {
return $string;
}
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
+
+__END__
+=pod
-=head1 AUTHORS
+=head1 NAME
-HTML::FormHandler Contributors; see HTML::FormHandler
+HTML::FormHandler::Field::Result - result class for fields
-=head1 COPYRIGHT
+=head1 VERSION
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+version 0.32002
+
+=head1 SYNOPSIS
+
+Result class for L<HTML::FormHandler::Field>
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
-__PACKAGE__->meta->make_immutable;
-use namespace::autoclean;
-1;
diff --git a/lib/HTML/FormHandler/Field/Second.pm b/lib/HTML/FormHandler/Field/Second.pm
index 17c62f8..3d440e7 100644
--- a/lib/HTML/FormHandler/Field/Second.pm
+++ b/lib/HTML/FormHandler/Field/Second.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Field::Second;
+# ABSTRACT: select list 0 to 59
use Moose;
extends 'HTML::FormHandler::Field::IntRange';
@@ -7,25 +8,36 @@ our $VERSION = '0.01';
has '+range_start' => ( default => 0 );
has '+range_end' => ( default => 59 );
+
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
+
+__END__
+=pod
+
=head1 NAME
-HTML::FormHandler::Field::Second - Select list for seconds
+HTML::FormHandler::Field::Second - select list 0 to 59
+
+=head1 VERSION
+
+version 0.32002
=head1 DESCRIPTION
A select field for seconds in the range of 0 to 59.
-=head1 AUTHORS
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
-Gerda Shank
+=head1 COPYRIGHT AND LICENSE
-=head1 COPYRIGHT
+This software is copyright (c) 2010 by Gerda Shank.
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+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
-__PACKAGE__->meta->make_immutable;
-use namespace::autoclean;
-1;
diff --git a/lib/HTML/FormHandler/Field/Select.pm b/lib/HTML/FormHandler/Field/Select.pm
index 9dec3d4..a6730c7 100644
--- a/lib/HTML/FormHandler/Field/Select.pm
+++ b/lib/HTML/FormHandler/Field/Select.pm
@@ -1,207 +1,11 @@
package HTML::FormHandler::Field::Select;
+# ABSTRACT: select fields
use Moose;
extends 'HTML::FormHandler::Field';
use Carp;
our $VERSION = '0.03';
-=head1 NAME
-
-HTML::FormHandler::Field::Select
-
-=head1 DESCRIPTION
-
-This is a field that includes a list of possible valid options.
-This can be used for select and multiple-select fields.
-Widget type is 'select'.
-
-Because select lists and checkbox_groups do not return an HTTP
-parameter when the entire list is unselected, the Select field
-must assume that the lack of a param means unselection. So to
-avoid setting a Select field, it must be set to inactive, not
-merely not included in the HTML for a form.
-
-This field type can also be used for fields that use the
-'radio_group' widget, and the 'checkbox_group' widget (for
-selects with multiple flag turned on, or that use the Multiple
-field).
-
-The 'options' array can come from four different places.
-The options attribute itself, either declaratively or using a
-'build_options' method in the field, from a method in the
-form ('options_<fieldname>') or from the database.
-
-In a field declaration:
-
- has_field 'opt_in' => ( type => 'Select', widget => 'radio_group',
- options => [{ value => 0, label => 'No'}, { value => 1, label => 'Yes'} ] );
-
-In a custom field class:
-
- package MyApp::Field::WeekDay;
- use Moose;
- extends 'HTML::FormHandler::Field::Select';
- ....
- sub build_options {
- my $i = 0;
- my @days = ('Sunday', 'Monday', 'Tuesday', 'Wednesday',
- 'Thursday', 'Friday', 'Saturday' );
- return [
- map {
- { value => $i++, label => $_ }
- } @days
- ];
- }
-
-In a form:
-
- has_field 'fruit' => ( type => 'Select' );
- sub options_fruit {
- return (
- 1 => 'apples',
- 2 => 'oranges',
- 3 => 'kiwi',
- );
- }
- -- or --
- has 'options_fruit' => ( is => 'rw', traits => ['Array'],
- default => sub { [1 => 'apples', 2 => 'oranges',
- 3 => 'kiwi'] } );
-
-Notice that, as a convenience, you can return a simple array (or arrayref)
-for the options array in the 'options_field_name' method. The hashrefs with
-'value' and 'label' keys will be constructed for you by FormHandler. The
-arrayref of hashrefs format can be useful if you want to add another key
-to the hashes that you can use in creating the HTML:
-
- sub options_license
- {
- my $self = shift;
- return unless $self->schema;
- my $licenses = $self->schema->resultset('License')->search({active => 1},
- {order_by => 'sequence'});
- my @selections;
- while ( my $license = $licenses->next ) {
- push @selections, { value => $license->id, label => $license->label,
- note => $license->note };
- }
- return @selections;
- }
-
-
-The final source of the options array is a database when the name of the
-accessor is a relation to the table holding the information used to construct
-the select list. The primary key is used as the value. The other columns used are:
-
- label_column -- Used for the labels in the options (default 'name')
- active_column -- The name of the column to be used in the query (default 'active')
- that allows the rows retrieved to be restricted
- sort_column -- The name of the column used to sort the options
-
-See also L<HTML::FormHandler::Model::DBIC>, the 'lookup_options' method.
-
-If the options come from the options_<fieldname> method or the database, they
-will be reloaded every time the form is reloaded because the available options
-may have changed. To prevent this from happening when the available options are
-known to be static, set the 'do_not_reload' flag, and the options will not be
-reloaded after the first time
-
-The sorting of the options may be changed using a 'sort_options' method in a
-custom field class. The 'Multiple' field uses this method to put the already
-selected options at the top of the list.
-
-=head1 Attributes and Methods
-
-=head2 options
-
-This is an array of hashes for this field.
-Each has must have a label and value keys.
-
-=head2 set_options
-
-Name of form method that sets options
-
-=head2 multiple
-
-If true allows multiple input values
-
-=head2 size
-
-This can be used to store how many items should be offered in the UI
-at a given time. Defaults to 0.
-
-=head2 empty_select
-
-Set to the string value of the select label if you want the renderer
-to create an empty select value. This only affects rendering - it does
-not add an entry to the list of options.
-
- has_field 'fruit' => ( type => 'Select,
- empty_select => '---Choose a Fruit---' );
-
-=head2 label_column
-
-Sets or returns the name of the method to call on the foreign class
-to fetch the text to use for the select list.
-
-Refers to the method (or column) name to use in a related
-object class for the label for select lists.
-
-Defaults to "name"
-
-=head2 localize_labels
-
-For the renderers: whether or not to call the localize method on the select
-labels. Default is off.
-
-=head2 active_column
-
-Sets or returns the name of a boolean column that is used as a flag to indicate that
-a row is active or not. Rows that are not active are ignored.
-
-The default is "active".
-
-If this column exists on the class then the list of options will included only
-rows that are marked "active".
-
-The exception is any columns that are marked inactive, but are also part of the
-input data will be included with brackets around the label. This allows
-updating records that might have data that is now considered inactive.
-
-=head2 auto_widget_size
-
-This is a way to provide a hint as to when to automatically
-select the widget to display for fields with a small number of options.
-For example, this can be used to decided to display a radio select for
-select lists smaller than the size specified.
-
-See L<select_widget> below.
-
-=head2 sort_column
-
-Sets or returns the column used in the foreign class for sorting the
-options labels. Default is undefined.
-
-If this column exists in the foreign table then labels returned will be sorted
-by this column.
-
-If not defined or the column is not found as a method on the foreign class then
-the label_column is used as the sort condition.
-
-=head2 select_widget
-
-If the widget is 'select' for the field then will look if the field
-also has a L<auto_widget_size>. If the options list is less than or equal
-to the L<auto_widget_size> then will return C<radio_group> if L<multiple> is false,
-otherwise will return C<checkbox_group>.
-
-=head2 as_label
-
-Returns the option label for the option value that matches the field's current value.
-Can be helpful for displaying information about the field in a more friendly format.
-This does a string compare.
-
-=cut
has 'options' => (
isa => 'ArrayRef',
@@ -407,19 +211,222 @@ before 'value' => sub {
}
};
-=head1 AUTHORS
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
-Gerda Shank, gshank at cpan.org
+__END__
+=pod
+
+=head1 NAME
-Based on the original source code of L<Form::Processor::Field::Select> by Bill Moseley
+HTML::FormHandler::Field::Select - select fields
-=head1 COPYRIGHT
+=head1 VERSION
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+version 0.32002
+
+=head1 DESCRIPTION
+
+This is a field that includes a list of possible valid options.
+This can be used for select and multiple-select fields.
+Widget type is 'select'.
+
+Because select lists and checkbox_groups do not return an HTTP
+parameter when the entire list is unselected, the Select field
+must assume that the lack of a param means unselection. So to
+avoid setting a Select field, it must be set to inactive, not
+merely not included in the HTML for a form.
+
+This field type can also be used for fields that use the
+'radio_group' widget, and the 'checkbox_group' widget (for
+selects with multiple flag turned on, or that use the Multiple
+field).
+
+The 'options' array can come from four different places.
+The options attribute itself, either declaratively or using a
+'build_options' method in the field, from a method in the
+form ('options_<fieldname>') or from the database.
+
+In a field declaration:
+
+ has_field 'opt_in' => ( type => 'Select', widget => 'radio_group',
+ options => [{ value => 0, label => 'No'}, { value => 1, label => 'Yes'} ] );
+
+In a custom field class:
+
+ package MyApp::Field::WeekDay;
+ use Moose;
+ extends 'HTML::FormHandler::Field::Select';
+ ....
+ sub build_options {
+ my $i = 0;
+ my @days = ('Sunday', 'Monday', 'Tuesday', 'Wednesday',
+ 'Thursday', 'Friday', 'Saturday' );
+ return [
+ map {
+ { value => $i++, label => $_ }
+ } @days
+ ];
+ }
+
+In a form:
+
+ has_field 'fruit' => ( type => 'Select' );
+ sub options_fruit {
+ return (
+ 1 => 'apples',
+ 2 => 'oranges',
+ 3 => 'kiwi',
+ );
+ }
+ -- or --
+ has 'options_fruit' => ( is => 'rw', traits => ['Array'],
+ default => sub { [1 => 'apples', 2 => 'oranges',
+ 3 => 'kiwi'] } );
+
+Notice that, as a convenience, you can return a simple array (or arrayref)
+for the options array in the 'options_field_name' method. The hashrefs with
+'value' and 'label' keys will be constructed for you by FormHandler. The
+arrayref of hashrefs format can be useful if you want to add another key
+to the hashes that you can use in creating the HTML:
+
+ sub options_license
+ {
+ my $self = shift;
+ return unless $self->schema;
+ my $licenses = $self->schema->resultset('License')->search({active => 1},
+ {order_by => 'sequence'});
+ my @selections;
+ while ( my $license = $licenses->next ) {
+ push @selections, { value => $license->id, label => $license->label,
+ note => $license->note };
+ }
+ return @selections;
+ }
+
+The final source of the options array is a database when the name of the
+accessor is a relation to the table holding the information used to construct
+the select list. The primary key is used as the value. The other columns used are:
+
+ label_column -- Used for the labels in the options (default 'name')
+ active_column -- The name of the column to be used in the query (default 'active')
+ that allows the rows retrieved to be restricted
+ sort_column -- The name of the column used to sort the options
+
+See also L<HTML::FormHandler::Model::DBIC>, the 'lookup_options' method.
+
+If the options come from the options_<fieldname> method or the database, they
+will be reloaded every time the form is reloaded because the available options
+may have changed. To prevent this from happening when the available options are
+known to be static, set the 'do_not_reload' flag, and the options will not be
+reloaded after the first time
+
+The sorting of the options may be changed using a 'sort_options' method in a
+custom field class. The 'Multiple' field uses this method to put the already
+selected options at the top of the list.
+
+=head1 Attributes and Methods
+
+=head2 options
+
+This is an array of hashes for this field.
+Each has must have a label and value keys.
+
+=head2 set_options
+
+Name of form method that sets options
+
+=head2 multiple
+
+If true allows multiple input values
+
+=head2 size
+
+This can be used to store how many items should be offered in the UI
+at a given time. Defaults to 0.
+
+=head2 empty_select
+
+Set to the string value of the select label if you want the renderer
+to create an empty select value. This only affects rendering - it does
+not add an entry to the list of options.
+
+ has_field 'fruit' => ( type => 'Select,
+ empty_select => '---Choose a Fruit---' );
+
+=head2 label_column
+
+Sets or returns the name of the method to call on the foreign class
+to fetch the text to use for the select list.
+
+Refers to the method (or column) name to use in a related
+object class for the label for select lists.
+
+Defaults to "name"
+
+=head2 localize_labels
+
+For the renderers: whether or not to call the localize method on the select
+labels. Default is off.
+
+=head2 active_column
+
+Sets or returns the name of a boolean column that is used as a flag to indicate that
+a row is active or not. Rows that are not active are ignored.
+
+The default is "active".
+
+If this column exists on the class then the list of options will included only
+rows that are marked "active".
+
+The exception is any columns that are marked inactive, but are also part of the
+input data will be included with brackets around the label. This allows
+updating records that might have data that is now considered inactive.
+
+=head2 auto_widget_size
+
+This is a way to provide a hint as to when to automatically
+select the widget to display for fields with a small number of options.
+For example, this can be used to decided to display a radio select for
+select lists smaller than the size specified.
+
+See L<select_widget> below.
+
+=head2 sort_column
+
+Sets or returns the column used in the foreign class for sorting the
+options labels. Default is undefined.
+
+If this column exists in the foreign table then labels returned will be sorted
+by this column.
+
+If not defined or the column is not found as a method on the foreign class then
+the label_column is used as the sort condition.
+
+=head2 select_widget
+
+If the widget is 'select' for the field then will look if the field
+also has a L<auto_widget_size>. If the options list is less than or equal
+to the L<auto_widget_size> then will return C<radio_group> if L<multiple> is false,
+otherwise will return C<checkbox_group>.
+
+=head2 as_label
+
+Returns the option label for the option value that matches the field's current value.
+Can be helpful for displaying information about the field in a more friendly format.
+This does a string compare.
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
-__PACKAGE__->meta->make_immutable;
-use namespace::autoclean;
-1;
diff --git a/lib/HTML/FormHandler/Field/Submit.pm b/lib/HTML/FormHandler/Field/Submit.pm
index 4411f2c..04f8f42 100644
--- a/lib/HTML/FormHandler/Field/Submit.pm
+++ b/lib/HTML/FormHandler/Field/Submit.pm
@@ -1,12 +1,36 @@
package HTML::FormHandler::Field::Submit;
+# ABSTRACT: submit field
use Moose;
extends 'HTML::FormHandler::Field::NoValue';
+
+has '+value' => ( default => 'Save' );
+has '+widget' => ( default => 'submit' );
+
+sub _result_from_input {
+ my ( $self, $result, $input, $exists ) = @_;
+ $self->_set_result($result);
+ $result->_set_input($input);
+ $result->_set_field_def($self);
+ return $result;
+}
+
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
+
+__END__
+=pod
+
=head1 NAME
HTML::FormHandler::Field::Submit - submit field
+=head1 VERSION
+
+version 0.32002
+
=head1 SYNOPSIS
Use this field to declare a submit field in your form.
@@ -20,21 +44,18 @@ Uses the 'submit' widget.
If you have multiple submit buttons, currently the only way to test
which one has been clicked is with C<< $field->input >>. The 'value'
-attribute is used for the HTML input field 'value'.
+attribute is used for the HTML input field 'value'.
-=cut
+=head1 AUTHOR
-has '+value' => ( default => 'Save' );
-has '+widget' => ( default => 'submit' );
+FormHandler Contributors - see HTML::FormHandler
-sub _result_from_input {
- my ( $self, $result, $input, $exists ) = @_;
- $self->_set_result($result);
- $result->_set_input($input);
- $result->_set_field_def($self);
- return $result;
-}
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
-__PACKAGE__->meta->make_immutable;
-use namespace::autoclean;
-1;
diff --git a/lib/HTML/FormHandler/Field/Text.pm b/lib/HTML/FormHandler/Field/Text.pm
index fbe4140..97db7ca 100644
--- a/lib/HTML/FormHandler/Field/Text.pm
+++ b/lib/HTML/FormHandler/Field/Text.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Field::Text;
+# ABSTRACT: text field
use Moose;
extends 'HTML::FormHandler::Field';
@@ -7,10 +8,10 @@ our $VERSION = '0.01';
has 'size' => ( isa => 'Int|Undef', is => 'rw', default => '0' );
has 'maxlength' => ( isa => 'Int|Undef', is => 'rw' );
has 'maxlength_message' => ( isa => 'Str', is => 'rw',
- default => 'Field should not exceed [quant,_1,character]. You entered [_2]',
+ default => 'Field should not exceed [quant,_1,character]. You entered [_2]',
);
has 'minlength' => ( isa => 'Int|Undef', is => 'rw', default => '0' );
-has 'minlength_message' => ( isa => 'Str', is => 'rw',
+has 'minlength_message' => ( isa => 'Str', is => 'rw',
default => 'Field must be at least [quant,_1,character]. You entered [_2]' );
has '+widget' => ( default => 'text' );
@@ -22,7 +23,7 @@ sub validate {
my $value = $field->input;
# Check for max length
if ( my $maxlength = $field->maxlength ) {
- return $field->add_error( $field->maxlength_message,
+ return $field->add_error( $field->maxlength_message,
$maxlength, length $value, $field->loc_label )
if length $value > $maxlength;
}
@@ -37,9 +38,21 @@ sub validate {
return 1;
}
+
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
+
+__END__
+=pod
+
=head1 NAME
-HTML::FormHandler::Field::Text - A simple text entry field
+HTML::FormHandler::Field::Text - text field
+
+=head1 VERSION
+
+version 0.32002
=head1 DESCRIPTION
@@ -62,17 +75,16 @@ be entered.
A constraint on the maximum length of the text.
-=head1 AUTHORS
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
-Gerda Shank
+=head1 COPYRIGHT AND LICENSE
-=head1 LICENSE
+This software is copyright (c) 2010 by Gerda Shank.
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+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
-__PACKAGE__->meta->make_immutable;
-use namespace::autoclean;
-1;
diff --git a/lib/HTML/FormHandler/Field/TextArea.pm b/lib/HTML/FormHandler/Field/TextArea.pm
index fa7b4b2..de53d23 100644
--- a/lib/HTML/FormHandler/Field/TextArea.pm
+++ b/lib/HTML/FormHandler/Field/TextArea.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Field::TextArea;
+# ABSTRACT: textarea input
use Moose;
extends 'HTML::FormHandler::Field';
@@ -8,21 +9,36 @@ has '+widget' => ( default => 'textarea' );
has 'cols' => ( isa => 'Int', is => 'rw' );
has 'rows' => ( isa => 'Int', is => 'rw' );
+
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
+
+__END__
+=pod
+
=head1 NAME
-HTML::FormHandler::Field::TextArea - Multiple line input
+HTML::FormHandler::Field::TextArea - textarea input
+
+=head1 VERSION
-=head1 AUTHORS
+version 0.32002
-Gerda Shank
+=head1 Summary
-=head1 COPYRIGHT
+For HTML textarea. Uses 'textarea' widget. Set cols/row.
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
-__PACKAGE__->meta->make_immutable;
-use namespace::autoclean;
-1;
diff --git a/lib/HTML/FormHandler/Field/Upload.pm b/lib/HTML/FormHandler/Field/Upload.pm
index f678aab..ff2c104 100644
--- a/lib/HTML/FormHandler/Field/Upload.pm
+++ b/lib/HTML/FormHandler/Field/Upload.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Field::Upload;
+# ABSTRACT: file upload field
use Moose;
use Moose::Util::TypeConstraints;
@@ -7,42 +8,6 @@ extends 'HTML::FormHandler::Field';
our $VERSION = '0.02';
-=head1 NAME
-
-HTML::FormHandler::Field::Upload - File upload field
-
-=head1 DESCRIPTION
-
-This field is designed to be used with a blessed object with a 'size' method,
-such as L<Catalyst::Request::Upload>, or a filehandle.
-Validates that the file is not empty and is within the 'min_size'
-and 'max_size' limits (limits are in bytes).
-A form containing this field must have the enctype set.
-
- package My::Form::Upload;
- use HTML::FormHandler::Moose;
- extends 'HTML::FormHandler';
-
- has '+enctype' => ( default => 'multipart/form-data');
-
- has_field 'file' => ( type => 'Upload', max_size => '2000000' );
- has_field 'submit' => ( type => 'Submit', value => 'Upload' );
-
-In your controller:
-
- my $form = My::Form::Upload->new;
- my @params = ( file => $c->req->upload('file') )
- if $c->req->method eq 'POST';
- $form->process( params => { @params } );
- return unless ( $form->validated );
-
-=head1 DEPENDENCIES
-
-=head2 widget
-
-Widget type is 'upload'
-
-=cut
has '+widget' => ( default => 'upload', );
has min_size => ( is => 'rw', isa => 'Int', default => 1 );
@@ -78,7 +43,7 @@ sub is_real_fh {
my $fh = shift;
my $reftype = Scalar::Util::reftype($fh) or return;
- if( $reftype eq 'IO'
+ if( $reftype eq 'IO'
or $reftype eq 'GLOB' && *{$fh}{IO} ){
my $m_fileno = $fh->fileno;
return unless defined $m_fileno;
@@ -94,21 +59,62 @@ sub is_real_fh {
}
__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
+
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Field::Upload - file upload field
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 DESCRIPTION
+
+This field is designed to be used with a blessed object with a 'size' method,
+such as L<Catalyst::Request::Upload>, or a filehandle.
+Validates that the file is not empty and is within the 'min_size'
+and 'max_size' limits (limits are in bytes).
+A form containing this field must have the enctype set.
+
+ package My::Form::Upload;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has '+enctype' => ( default => 'multipart/form-data');
+
+ has_field 'file' => ( type => 'Upload', max_size => '2000000' );
+ has_field 'submit' => ( type => 'Submit', value => 'Upload' );
+
+In your controller:
+
+ my $form = My::Form::Upload->new;
+ my @params = ( file => $c->req->upload('file') )
+ if $c->req->method eq 'POST';
+ $form->process( params => { @params } );
+ return unless ( $form->validated );
+
+=head1 DEPENDENCIES
+
+=head2 widget
+
+Widget type is 'upload'
=head1 AUTHOR
-Bernhard Graf & Oleg Kostyuk
+FormHandler Contributors - see HTML::FormHandler
-and FormHandler contributors
+=head1 COPYRIGHT AND LICENSE
-=head1 LICENSE
+This software is copyright (c) 2010 by Gerda Shank.
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+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
-__PACKAGE__->meta->make_immutable;
-use namespace::autoclean;
-1;
-
diff --git a/lib/HTML/FormHandler/Field/Weekday.pm b/lib/HTML/FormHandler/Field/Weekday.pm
index 8386f1b..54f14cd 100644
--- a/lib/HTML/FormHandler/Field/Weekday.pm
+++ b/lib/HTML/FormHandler/Field/Weekday.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Field::Weekday;
+# ABSTRACT: select list day of week strings
use Moose;
extends 'HTML::FormHandler::Field::Select';
@@ -18,25 +19,36 @@ sub build_options {
return [ map { { value => $i++, label => $_ } } @days ];
}
+
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
+
+__END__
+=pod
+
=head1 NAME
-HTML::FormHandler::Field::Weekday - Select valid day of the week
+HTML::FormHandler::Field::Weekday - select list day of week strings
+
+=head1 VERSION
+
+version 0.32002
=head1 DESCRIPTION
Creates an option list for the days of the week.
-=head1 AUTHORS
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
-Gerda Shank
+=head1 COPYRIGHT AND LICENSE
-=head1 COPYRIGHT
+This software is copyright (c) 2010 by Gerda Shank.
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+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
-__PACKAGE__->meta->make_immutable;
-use namespace::autoclean;
-1;
diff --git a/lib/HTML/FormHandler/Field/Year.pm b/lib/HTML/FormHandler/Field/Year.pm
index 9d5f05d..650cc04 100644
--- a/lib/HTML/FormHandler/Field/Year.pm
+++ b/lib/HTML/FormHandler/Field/Year.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Field::Year;
+# ABSTRACT: year selection list
use Moose;
extends 'HTML::FormHandler::Field::IntRange';
@@ -18,26 +19,37 @@ has '+range_end' => (
}
);
+
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
+
+__END__
+=pod
+
=head1 NAME
-HTML::FormHandler::Field::Year - Select a recent year.
+HTML::FormHandler::Field::Year - year selection list
+
+=head1 VERSION
+
+version 0.32002
=head1 DESCRIPTION
Provides a list of years starting five years back and extending 10 years into
the future.
-=head1 AUTHORS
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
-Gerda Shank
+=head1 COPYRIGHT AND LICENSE
-=head1 COPYRIGHT
+This software is copyright (c) 2010 by Gerda Shank.
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+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
-__PACKAGE__->meta->make_immutable;
-use namespace::autoclean;
-1;
diff --git a/lib/HTML/FormHandler/Fields.pm b/lib/HTML/FormHandler/Fields.pm
index 5aeb8d2..8c3e9cf 100644
--- a/lib/HTML/FormHandler/Fields.pm
+++ b/lib/HTML/FormHandler/Fields.pm
@@ -1,49 +1,8 @@
package HTML::FormHandler::Fields;
+# ABSTRACT: internal role for form and compound fields
use Moose::Role;
-=head1 NAME
-
-HTML::FormHandler::Fields;
-
-=head1 SYNOPSIS
-
-A role to implement field attributes, accessors, etc. To be applied
-to L<HTML::FormHandler> and L<HTML::FormHandler::Field::Compound>.
-
-=head2 fields
-
-The field definitions as built from the field_list and the 'has_field'
-declarations. This provides clear_fields, add_field, remove_last_field,
-num_fields, has_fields, and set_field_at methods.
-
-=head2 field( $full_name )
-
-Return the field objct with the full_name passed. Will return undef
-if the field is not found, or will die if passed a second parameter.
-
-=head2 field_index
-
-Convenience function for use with 'set_field_at'. Pass in 'name' of field
-(not full_name)
-
-=head2 sorted_fields
-
-Calls fields and returns them in sorted order by their "order"
-value. Non-sorted fields are retrieved with 'fields'.
-
-=head2 clear methods
-
- clear_data
- clear_fields
- clear_error_fields
-
-=head2 Dump information
-
- dump - turn verbose flag on to get this output
- dump_validated - shorter version
-
-=cut
has 'fields' => (
traits => ['Array'],
@@ -124,7 +83,7 @@ sub field {
sub sorted_fields {
my $self = shift;
- my @fields = sort { $a->order <=> $b->order }
+ my @fields = sort { $a->order <=> $b->order }
grep { !$_->inactive || ($_->inactive && $_->_active) } $self->all_fields;
return wantarray ? @fields : \@fields;
}
@@ -147,7 +106,7 @@ sub _fields_validate {
}
sub fields_set_value {
- my $self = shift;
+ my $self = shift;
my %value_hash;
foreach my $field ( $self->all_fields ) {
next if ( ($field->inactive && !$field->_active) || !$field->has_result );
@@ -232,3 +191,65 @@ sub dump_validated {
use namespace::autoclean;
1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Fields - internal role for form and compound fields
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 SYNOPSIS
+
+A role to implement field attributes, accessors, etc. To be applied
+to L<HTML::FormHandler> and L<HTML::FormHandler::Field::Compound>.
+
+=head2 fields
+
+The field definitions as built from the field_list and the 'has_field'
+declarations. This provides clear_fields, add_field, remove_last_field,
+num_fields, has_fields, and set_field_at methods.
+
+=head2 field( $full_name )
+
+Return the field objct with the full_name passed. Will return undef
+if the field is not found, or will die if passed a second parameter.
+
+=head2 field_index
+
+Convenience function for use with 'set_field_at'. Pass in 'name' of field
+(not full_name)
+
+=head2 sorted_fields
+
+Calls fields and returns them in sorted order by their "order"
+value. Non-sorted fields are retrieved with 'fields'.
+
+=head2 clear methods
+
+ clear_data
+ clear_fields
+ clear_error_fields
+
+=head2 Dump information
+
+ dump - turn verbose flag on to get this output
+ dump_validated - shorter version
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/I18N.pm b/lib/HTML/FormHandler/I18N.pm
index de77f47..c92be6b 100644
--- a/lib/HTML/FormHandler/I18N.pm
+++ b/lib/HTML/FormHandler/I18N.pm
@@ -1,4 +1,6 @@
package HTML::FormHandler::I18N;
+# ABSTRACT: internationalization
+
use strict;
use warnings;
use base ('Locale::Maketext');
@@ -8,7 +10,7 @@ sub maketext {
my ( $lh, @message ) = @_;
return unless scalar @message;
my $out;
- try {
+ try {
$out = $lh->SUPER::maketext(@message);
}
catch {
@@ -19,3 +21,28 @@ sub maketext {
1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::I18N - internationalization
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/I18N/de_de.pm b/lib/HTML/FormHandler/I18N/de_de.pm
index 6830ba1..290f8f2 100644
--- a/lib/HTML/FormHandler/I18N/de_de.pm
+++ b/lib/HTML/FormHandler/I18N/de_de.pm
@@ -1,4 +1,6 @@
package HTML::FormHandler::I18N::de_de;
+# ABSTRACT: German message translations
+
use strict;
use warnings;
use base 'HTML::FormHandler::I18N';
@@ -49,7 +51,7 @@ our %Lexicon = (
# H::F::Field
'field is invalid' => 'Feld ist ungültig',
-
+
# H::F::Model
'Value must be unique in the database' => 'Wert existiert bereits in der Datenbank',
@@ -71,7 +73,7 @@ our %Lexicon = (
'Must not be all digits' => 'Darf nicht nur Ziffern enthalten',
'Field contains non-printable characters' => 'Feld enthält nicht druckbare Zeichen',
'Field must contain a single word' => 'Feld muss ein einzelnes Wort enthalten',
-
+
# H::F::Validate::Actions
'Wrong value' => 'Ungültiger Wert',
'[_1] does not match' => '[_1] ist kein gültiger Wert',
@@ -90,3 +92,28 @@ our %Lexicon = (
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::I18N::de_de - German message translations
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/I18N/en_us.pm b/lib/HTML/FormHandler/I18N/en_us.pm
index 0e9ee7c..8288532 100644
--- a/lib/HTML/FormHandler/I18N/en_us.pm
+++ b/lib/HTML/FormHandler/I18N/en_us.pm
@@ -1,4 +1,6 @@
package HTML::FormHandler::I18N::en_us;
+# ABSTRACT: base message file
+
use strict;
use warnings;
use base 'HTML::FormHandler::I18N';
@@ -13,3 +15,28 @@ our %Lexicon = (
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::I18N::en_us - base message file
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/I18N/hu_hu.pm b/lib/HTML/FormHandler/I18N/hu_hu.pm
index dbe0aa6..d28d4c5 100644
--- a/lib/HTML/FormHandler/I18N/hu_hu.pm
+++ b/lib/HTML/FormHandler/I18N/hu_hu.pm
@@ -1,4 +1,6 @@
package HTML::FormHandler::I18N::hu_hu;
+# ABSTRACT: Hungarian message file
+
use strict;
use warnings;
use utf8;
@@ -91,3 +93,28 @@ our %Lexicon = (
1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::I18N::hu_hu - Hungarian message file
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/I18N/ru_ru.pm b/lib/HTML/FormHandler/I18N/ru_ru.pm
index b14ca59..b4f91ae 100644
--- a/lib/HTML/FormHandler/I18N/ru_ru.pm
+++ b/lib/HTML/FormHandler/I18N/ru_ru.pm
@@ -1,4 +1,6 @@
package HTML::FormHandler::I18N::ru_ru;
+# ABSTRACT: Russian message file
+
use strict;
use warnings;
use utf8;
@@ -92,3 +94,28 @@ our %Lexicon = (
1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::I18N::ru_ru - Russian message file
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/I18N/tr_tr.pm b/lib/HTML/FormHandler/I18N/tr_tr.pm
index af5ea91..5e1af8e 100644
--- a/lib/HTML/FormHandler/I18N/tr_tr.pm
+++ b/lib/HTML/FormHandler/I18N/tr_tr.pm
@@ -1,4 +1,6 @@
package HTML::FormHandler::I18N::tr_tr;
+# ABSTRACT: Turkish message file
+
use strict;
use warnings;
use base 'HTML::FormHandler::I18N';
@@ -10,51 +12,51 @@ use utf8;
# Auto define lexicon
our %Lexicon = (
'_AUTO' => 1,
-
+
# H::F::Field::Date
'Date is too early' => 'Bu tarih izin verilen en küçük tarihten daha önce',
'Date is too late' => 'Bu tarih izin verilen en büyük tarihten daha sonra',
-
+
# H::F::Field::DateTime
'Not a valid DateTime' => 'Geçersiz tarih/zaman',
-
+
# H::F::Field::Email
'Email should be of the format [_1]' => 'E-Posta [_1] formatında olmalı',
-
+
# H::F::Field::Integer
'Value must be an integer' => 'Tam sayı olmalı',
-
+
# H::F::Field::Money
'Value cannot be converted to money' => 'Değer para birimine çevrilemedi',
'Value must be a real number' => 'Ondalık sayı olmalı',
-
+
# H::F::Field::Password
'Please enter a password in this field' => 'Lütfen bir şifre girin',
-
+
# H::F::Field::PasswordConf
'Please enter a password confirmation' => 'Lütfen şifre onayı girin',
-
+
# H::F::Field::PosInteger
'Value must be a positive integer' => 'Pozitif tam sayı olmalı',
-
+
# H::F::Field::Select
'This field does not take multiple values' => 'Birden fazla değer seçilemez',
-
+
# H::F::Field::Text
'Please limit to [quant,_1,character]. You submitted [_2]' => 'Girilen verinin uzunluğu en fazla [_1] olabilir. Gönderilen: [_2]',
'Input must be at least [quant,_1,character]. You submitted [_2]' => 'Girilen verinin uzunluğu en az [_1] olabilir. Gönderilen: [_2]',
-
+
# H::F::Field::Upload
'File uploaded is empty' => 'Gönderilen dosya boş',
'File is too small (< [_1] bytes)' => 'Dosya çok küçük. (< [_1] bytes)',
'File is too big (> [_1] bytes)' => 'Dosya çok büyük. (> [_1] bytes)',
-
+
# H::F::Field
'field is invalid' => 'Geçersiz değer',
# H::F::Model
'Value must be unique in the database' => 'Daha önceden kullanımda',
-
+
# H::F::Types
'Must be a positive number' => 'Pozitif sayı olmalı',
'Must be a positive integer' => 'Pozitif tam sayı olmalı',
@@ -73,7 +75,7 @@ our %Lexicon = (
'Must not be all digits' => 'Sadece rakamlardan oluşamaz',
'Field contains non-printable characters' => 'Basılamayan karakterler içeriyor',
'Field must contain a single word' => 'Tek bir kelime olmalı',
-
+
# H::F::Validate::Actions
'Wrong value' => 'Hatalı değer',
### not translatable: '"$value" does not match' => '',
@@ -86,8 +88,8 @@ our %Lexicon = (
# Other
'Your datetime does not match your pattern.' => 'Tarih formatı hatalı.',
-
-
+
+
);
1;
@@ -95,3 +97,28 @@ our %Lexicon = (
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::I18N::tr_tr - Turkish message file
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/I18N/ua_ua.pm b/lib/HTML/FormHandler/I18N/ua_ua.pm
index 8213b2e..e68afb2 100644
--- a/lib/HTML/FormHandler/I18N/ua_ua.pm
+++ b/lib/HTML/FormHandler/I18N/ua_ua.pm
@@ -1,4 +1,6 @@
package HTML::FormHandler::I18N::ua_ua;
+# ABSTRACT: Ukrainian message file
+
use strict;
use warnings;
use utf8;
@@ -92,3 +94,28 @@ our %Lexicon = (
1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::I18N::ua_ua - Ukrainian message file
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/InitResult.pm b/lib/HTML/FormHandler/InitResult.pm
index 19e4f0e..0d00616 100644
--- a/lib/HTML/FormHandler/InitResult.pm
+++ b/lib/HTML/FormHandler/InitResult.pm
@@ -1,16 +1,8 @@
package HTML::FormHandler::InitResult;
+# ABSTRACT: internal code
use Moose::Role;
-=head1 NAME
-
-HTML::FormHandler::InitResult
-
-=head1 SYNOPSIS
-
-Internal role for initializing the result objects.
-
-=cut
# _init is for building fields when
# there is no initial object and no params
@@ -50,7 +42,7 @@ sub _result_from_input {
if ( ref $input eq 'HASH' ) {
foreach my $field ( $self->sorted_fields ) {
next if ($field->inactive && !$field->_active);
- my $field_name = $field->name;
+ my $field_name = $field->name;
my $result = HTML::FormHandler::Field::Result->new(
name => $field_name,
parent => $self_result
@@ -123,16 +115,34 @@ sub _get_value {
return $value;
}
-=head1 AUTHORS
+use namespace::autoclean;
+1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::InitResult - internal code
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 SYNOPSIS
-HTML::FormHandler Contributors; see HTML::FormHandler
+Internal role for initializing the result objects.
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
-=head1 COPYRIGHT
+=head1 COPYRIGHT AND LICENSE
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+This software is copyright (c) 2010 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
-use namespace::autoclean;
-1;
diff --git a/lib/HTML/FormHandler/Manual.pod b/lib/HTML/FormHandler/Manual.pod
index f19c582..2785cf9 100644
--- a/lib/HTML/FormHandler/Manual.pod
+++ b/lib/HTML/FormHandler/Manual.pod
@@ -1,13 +1,26 @@
-=head1 NAME
+package HTML::FormHandler::Manual
+# ABSTRACT: index of the manual
-HTML::FormHandler::Manual - Index of the Manual
+
+1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Manual - index of the manual
+
+=head1 VERSION
+
+version 0.32002
=head1 DESCRIPTION
This is the L<HTML::FormHandler> users manual. HTML::FormHandler is
an HTML form handling class written in Moose. It provides facilities
to write classes that represent HTML forms, and retrieves and loads
-data from the database.
+data from the database.
=head1 SECTIONS
@@ -46,5 +59,16 @@ IRC:
gshank: Gerda Shank <gshank at cpan.org>
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
diff --git a/lib/HTML/FormHandler/Manual/Catalyst.pod b/lib/HTML/FormHandler/Manual/Catalyst.pod
index bc2c866..3084735 100644
--- a/lib/HTML/FormHandler/Manual/Catalyst.pod
+++ b/lib/HTML/FormHandler/Manual/Catalyst.pod
@@ -1,7 +1,17 @@
+package HTML::FormHandler::Manual::Catalyst;
+# ABSTRACT: using HFH forms in Catalyst
+
+
+__END__
+=pod
=head1 NAME
-HTML::FormHandler::Manual::Catalyst - Using HFH forms in Catalyst controllers
+HTML::FormHandler::Manual::Catalyst - using HFH forms in Catalyst
+
+=head1 VERSION
+
+version 0.32002
=head1 SYNOPSIS
@@ -76,16 +86,16 @@ by both the create and edit actions.
1;
-=head2 Another way to set up your form
+=head2 Another way to set up your form
If you are setting the schema or other form attributes (such as the user_id,
-or other attributes) on your form you could create a base controller that would set
-these in the form on each call using L<Catalyst::Component::InstancePerContext>,
-or set them in a base Chained method.
+or other attributes) on your form you could create a base controller that would set
+these in the form on each call using L<Catalyst::Component::InstancePerContext>,
+or set them in a base Chained method.
sub book_base : Chained PathPart('book') CaptureArgs(0) {
my ( $self, $c ) = @_;
- my $form = MyApp::Form->new;
+ my $form = MyApp::Form->new;
$form->schema( $c->model('DB')->schema );
$form->params( $c->req->parameters );
$form->user_id( $c->user->id );
@@ -98,7 +108,7 @@ Then you could just pass in the item_id when the form is processed.
=head2 Using HTML::FillInForm
-If you want to use L<HTML::FillInForm> to fill in values instead of the
+If you want to use L<HTML::FillInForm> to fill in values instead of the
doing it in directly in a template using either the field or the form 'fif'
methods, you can use L<Catalyst::View::FillInForm> on your view class:
@@ -144,7 +154,7 @@ Then just pass the attributes in on new:
my $form => MyApp::Form->new( user_id => $c->user->id, hostname => $c->req->host,
captcha_store => $c->{session}->{captcha} );
-
+
Or set them using accessors:
$form->user_id( $c->user->id );
@@ -161,4 +171,16 @@ Then you can access these attributes in your form validation methods:
}
}
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/Manual/Cookbook.pod b/lib/HTML/FormHandler/Manual/Cookbook.pod
index 4537981..2740840 100644
--- a/lib/HTML/FormHandler/Manual/Cookbook.pod
+++ b/lib/HTML/FormHandler/Manual/Cookbook.pod
@@ -1,7 +1,18 @@
+package HTML::FormHandler::Manual::Cookbook;
+# ABSTRACT: FormHandler use recipes
+
+
+__END__
+=pod
+
=head1 NAME
HTML::FormHandler::Manual::Cookbook - FormHandler use recipes
+=head1 VERSION
+
+version 0.32002
+
=head1 SYNOPSIS
Collection of use recipes for L<HTML::FormHandler>
@@ -10,18 +21,18 @@ Collection of use recipes for L<HTML::FormHandler>
I had to create a tiny little form this week for admins to enter a comment, and
it seemed silly to have to create a form file and a template file. I remembered
-that you can set the TT 'template' to a a string reference and not use a template
-at all, which is nice when FormHandler will create the form HTML for you anyway.
+that you can set the TT 'template' to a a string reference and not use a template
+at all, which is nice when FormHandler will create the form HTML for you anyway.
sub comment : Chained('base_sub') PathPart('comment') Args(0) {
my ( $self, $c ) = @_;
-
- my $form = HTML::FormHandler->new( field_list =>
- [ comment => { type => 'Text', size => 60 },
+
+ my $form = HTML::FormHandler->new( field_list =>
+ [ comment => { type => 'Text', size => 60 },
submit => {type => 'Submit'} ] );
$form->process($c->req->params);
if ( $form->validated ) {
- $self->admin_log( $c, "Admin::Queue", "admin comment",
+ $self->admin_log( $c, "Admin::Queue", "admin comment",
$form->field('comment')->value );
$c->flash( message => 'Comment added' );
$c->res->redirect( $c->stash->{urilist}->{view} );
@@ -30,15 +41,14 @@ at all, which is nice when FormHandler will create the form HTML for you anyway.
$c->stash( template => \$rendered_form );
}
-This creates the form on the fly with a comment field and a submit button,
+This creates the form on the fly with a comment field and a submit button,
renders it using the default TT wrappers, then logs the comment. No other files
at all....
-FormHandler isn't really necessary for validation here, but it does make it
+FormHandler isn't really necessary for validation here, but it does make it
possible to have a simple, standalone method.
-
-=head2 Dynamically change the active fields
+=head2 Dynamically change the active fields
A common use case is for forms with some fields that should be displayed in
some circumstances and not in others. There are a number of ways to do this.
@@ -75,8 +85,8 @@ Or on the 'process' call:
$form->process( params => $params, active => ['foo', 'bar'] );
-Fields set to active with the form's 'active' modifier (but not on new) will
-be automatically set back to inactive when the form is cleared, so there's no
+Fields set to active with the form's 'active' modifier (but not on new) will
+be automatically set back to inactive when the form is cleared, so there's no
need to reset.
If you want the fields activated for the life of an object, set active on new:
@@ -87,7 +97,7 @@ If you want the fields activated for the life of an object, set active on new:
If you want to add custom attributes to the FormHandler fields but don't want
to subclass all the fields, you can apply a role containing the new
-attributes to an L<HTML::FormHandler::Field> in your form.
+attributes to an L<HTML::FormHandler::Field> in your form.
Use the form attribute 'field_traits' to apply a role to the base field class.
Use 'traits' on the individual fields to apply a role to field instances.
@@ -98,13 +108,12 @@ Use 'traits' on the individual fields to apply a role to field instances.
has_field 'foo' => ( traits => ['MyApp::TraitFor::Test'] );
has '+field_traits' => ( default => sub { ['Some::Trait', 'Another::Trait'] } );
-
+
Or set the traits on new:
my $form = MyApp::Form::User->new( field_traits => ['MyApp::TraitFor::Test'] );
- my $form = MyApp::Form::User->new(
+ my $form = MyApp::Form::User->new(
field_list => [ '+foo' => { traits => [...] } ]);
-
=head2 Select lists
@@ -113,7 +122,7 @@ default):
sub default_license {
my ( $self, $field, $item ) = @_;
- return 0 unless $item && $item->license_id;
+ return 0 unless $item && $item->license_id;
return $item->license_id;
}
@@ -124,16 +133,16 @@ a 'no choice' choice, in your template:
<select id="select_sc" name="[% f.name %]">
<option value="">--- Choose Subject Class---</option>
[% FOR option IN f.options %]
- <option value="[% option.value %]"
+ <option value="[% option.value %]"
[% IF option.value == f.fif %]selected="selected"[% END %]>
[% option.label | html %]</option>
- [% END %]
+ [% END %]
</select>
Or customize the select list in an 'options_' method:
sub options_country {
- my $self = shift;
+ my $self = shift;
return unless $self->schema;
my @rows =
$self->schema->resultset( 'Country' )->
@@ -141,7 +150,7 @@ Or customize the select list in an 'options_' method:
return [ map { $_->digraph, $_->country_name } @rows ];
}
-=head2 The database and FormHandler forms
+=head2 The database and FormHandler forms
If you have to process the input data before saving to the database, and
this is something that would be useful in other places besides your form,
@@ -155,9 +164,9 @@ the pre-processing, and then updating the database yourself.
The 'noupdate' flag is set in order to skip an attempt to update the database
for this field (it would not be necessary if the field doesn't actually exist
-in the database...). You can process the input for the non-updatable field
-field in a number of different places, depending on what is most logical.
-Some of the choices are:
+in the database...). You can process the input for the non-updatable field
+field in a number of different places, depending on what is most logical.
+Some of the choices are:
1) validate (for the form or field)
2) validate_model
@@ -213,7 +222,6 @@ And in the template:
[% form.nav_bar %]
<p><b>Summary: </b>[% form.summary %]</p>
-
Or you can make these customizations Moose roles.
package MyApp::Form::Role::Base;
@@ -224,13 +232,13 @@ Or you can make these customizations Moose roles.
use Moose;
with 'MyApp::Form::Role::Base';
...
-
+
=head2 Split up your forms into reusable pieces
A person form:
package Form::Person;
- use HTML::FormHandler::Moose;
+ use HTML::FormHandler::Moose;
extends 'HTML::FormHandler';
has_field 'name';
@@ -247,7 +255,7 @@ A person form:
An address form:
package Form::Address;
- use HTML::FormHandler::Moose;
+ use HTML::FormHandler::Moose;
extends 'HTML::FormHandler';
has_field 'street';
@@ -268,14 +276,14 @@ A form that extends them both:
use Moose;
extends ('Form::Person', 'Form::Address');
- use namespace::autoclean;
+ use namespace::autoclean;
1;
Or if you don't need to use the pieces of your forms as forms themself, you can
use roles;
package Form::Role::Address;
- use HTML::FormHandler::Moose::Role;
+ use HTML::FormHandler::Moose::Role;
has_field 'street';
has_field 'city';
@@ -303,27 +311,26 @@ You could make roles that are collections of validations:
1;
-And if the validations apply to fields with different names, specify the
+And if the validations apply to fields with different names, specify the
'set_validate' on the fields:
-
+
with 'Form::Role::Member';
has_field 'zip' => ( type => 'Integer', set_validate => 'check_zip' );
-
-=head2 Access a user record in the form
+=head2 Access a user record in the form
You might need the user_id to create specialized select lists, or do other form processing. Add a user_id attribute to your form:
has 'user_id' => ( isa => 'Int', is => 'rw' );
-
+
Then pass it in when you process the form:
$form->process( item => $item, params => $c->req->parameters, user_id = $c->user->user_id );
=head2 Handle extra database fields
-If there is another database field that needs to be updated when a row is
-created, add an attribute to the form, and then process it with
+If there is another database field that needs to be updated when a row is
+created, add an attribute to the form, and then process it with
C< before 'update_model' >.
In the form:
@@ -339,7 +346,7 @@ Then just use an additional parameter when you create/process your form:
$form->process( item => $item, params => $params, hostname => $c->req->host );
-=head2 Record the user update
+=head2 Record the user update
Use the 'before' or 'after' method modifiers for 'update_model', to flag a record
as updated by the user, for example:
@@ -376,7 +383,6 @@ In the form you could use the 'validate' method, but that doesn't help
if you want to keep the functionality packaged in a role. Instead you
can use the 'after' method modifier on the 'validate' method:
-
package MyApp::Form::Roles::DateFromTo;
use HTML::FormHandler::Moose::Role;
@@ -398,7 +404,7 @@ You can use a method modifier before 'validate_form':
my $self = shift;
my $required = 0;
$required = 1
- if( $self->params->{field_name} eq 'something' );
+ if( $self->params->{field_name} eq 'something' );
$self->field('some_field')->required($required);
};
@@ -414,7 +420,7 @@ to do these sort of checks in the form's 'validate' routine.
}
In a Moose role you would need to use a method modifier instead.
-
+
after 'validate' => sub { ... };
Don't forget the dependency list, which is used for cases where if any of one
@@ -478,11 +484,11 @@ And here's where the coderef is passed in to the form.
}
sub username_available {
my ( $self, $name ) = @_;
- # perform some sort of username availability checks
+ # perform some sort of username availability checks
}
1;
-=head2 Example of a form with custom database interface
+=head2 Example of a form with custom database interface
The default DBIC model requires that the form structure match the database
structure. If that doesn't work - you need to present the form in a different
@@ -513,10 +519,10 @@ record') that has a relationship to permission type roles in a relationship
my @is_not_admin;
my $active_families = $self->schema->resultset('Family')->search( { active => 1 } );
while ( my $fam = $active_families->next ) {
- my $admin_flag =
+ my $admin_flag =
$fam->search_related('user_roles', { role_id => 2 } )->count > 0 ? 1 : 0;
my $family_name = $fam->name1 . ", " . $fam->name2;
- my $elem = { family => $family_name, family_id => $fam->family_id,
+ my $elem = { family => $family_name, family_id => $fam->family_id,
admin_flag => $admin_flag };
if( $admin_flag ) {
push @is_admin, $elem;
@@ -524,7 +530,7 @@ record') that has a relationship to permission type roles in a relationship
else {
push @is_not_admin, $elem;
}
- }
+ }
# Note 7
# sort into admin flag first, then family_name
@is_admin = sort { $a->{family} cmp $b->{family} } @is_admin;
@@ -547,7 +553,7 @@ record') that has a relationship to permission type roles in a relationship
elsif( $elem->{admin_flag} == 0 && $has_admin_flag ) {
$fam->delete_related('user_roles', { role_id => 2 } );
}
- }
+ }
}
Note 1: This form creates its own 'schema' attribute. You could inherit from
@@ -559,8 +565,8 @@ fields, so 'widget_wrapper' is set to 'None' to skip wrapping the form inputs wi
divs or table elements.
Note 3: This form consists of an array of elements, so there will be a single
-Repeatable form field with subfields. If you wanted to use automatic rendering, you would
-also need to create a 'submit' field, but in this case it will just be done
+Repeatable form field with subfields. If you wanted to use automatic rendering, you would
+also need to create a 'submit' field, but in this case it will just be done
in the template.
Note 4: This field is actually going to be used for display purposes only, but it's
@@ -572,7 +578,7 @@ re-displayed with error messages.
Note 5: The 'family_id' is the primary key field, necessary for updating the
correct records.
-Note 6: 'init_object' method: This is where the initial object is created, which
+Note 6: 'init_object' method: This is where the initial object is created, which
takes the place of a database row for form creation.
Note 7: The entries with the admin flag turned on are sorted into the beginning
@@ -580,7 +586,6 @@ of the list. This is entirely a user interface choice.
Note 8: 'update_model' method: This is where the database updates are performed.
-
The Template Toolkit template for this form:
<h1>Update admin status for members</h1>
@@ -594,7 +599,7 @@ The Template Toolkit template for this form:
[% f.field('family_id').render %]</td><td> [% f.field('admin_flag').render %]</td>
</tr>
[% END %]
- </table>
+ </table>
<input class="submit" name="submit" value="Save" type="submit">
</form
@@ -619,14 +624,14 @@ The Catalyst controller action to execute the form:
return;
}
-Rather than redirect to some other page after saving the form, the form is redisplayed.
-If the form has been validated (i.e. the 'update_model' method has been run), the
-'process' call is run again in order to re-sort the displayed list with admin users at
+Rather than redirect to some other page after saving the form, the form is redisplayed.
+If the form has been validated (i.e. the 'update_model' method has been run), the
+'process' call is run again in order to re-sort the displayed list with admin users at
the top. That could have also been done in the 'update_model' method.
=head2 A form that takes a resultset, with custom update_model
-For updating a Repeatable field that is filled from a Resultset, and not a
+For updating a Repeatable field that is filled from a Resultset, and not a
relationship on a single row. Creates a 'resultset' attribute to pass in
a resultset. Massages the data into an array that's pointed to by an
'employers' hash key, and does the reverse in the 'update_model' method.
@@ -663,14 +668,16 @@ general solution, patches welcome.
}
}
-
=head1 AUTHOR
-Gerda Shank, gshank at cpan.org
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
-=head1 LICENSE
+This software is copyright (c) 2010 by Gerda Shank.
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+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
+
diff --git a/lib/HTML/FormHandler/Manual/Intro.pod b/lib/HTML/FormHandler/Manual/Intro.pod
index 6c493ab..2ff1955 100644
--- a/lib/HTML/FormHandler/Manual/Intro.pod
+++ b/lib/HTML/FormHandler/Manual/Intro.pod
@@ -1,37 +1,48 @@
+package HTML::FormHandler::Manual::Intro;
+# ABSTRACT: introduction to using FormHandler
+
+
+__END__
+=pod
+
=head1 NAME
-HTML::FormHandler::Manual::Intro - basic usage of FormHandler
+HTML::FormHandler::Manual::Intro - introduction to using FormHandler
+
+=head1 VERSION
+
+version 0.32002
=head1 SUMMARY
HTML::FormHandler is a form handling class that validates HTML form data
-and, for database forms, saves it to the database on validation.
-It has field classes that can be used for creating a set of widgets
+and, for database forms, saves it to the database on validation.
+It has field classes that can be used for creating a set of widgets
and highly automatic templates. There are two simple rendering roles,
-L<HTML::FormHandler::Render::Simple> and a subclass of it
+L<HTML::FormHandler::Render::Simple> and a subclass of it
L<HTML::FormHandler::Render::Table>, plus a set of widget roles for
individual form and field classes. FormHandler is designed to
make it easy to produce alternative rendering modules.
The DBIC & CDBI models will save form fields automatically to the database, will
-retrieve selection lists from the database (with type => 'Select' and a
+retrieve selection lists from the database (with type => 'Select' and a
fieldname containing a single relationship, or type => 'Multiple' and a
-many_to_many relationship), and will save the selected values (one value for
-'Select', multiple values in a mapping table for a 'Multiple' field).
+many_to_many relationship), and will save the selected values (one value for
+'Select', multiple values in a mapping table for a 'Multiple' field).
The 'form' is a Perl subclass of L<HTML::FormHandler> for non-database forms,
or a subclass of a model class for database forms, and in it you define
-your fields and validation routines. Because it's a Perl class, you have a
+your fields and validation routines. Because it's a Perl class, you have a
lot of flexibility.
-You can use transformations, Moose type constraints, and coercions, listed
-in the field's 'apply' attribute, to validate or inflate the fields
-(see L<HTML::FormHandler::Field/apply>). You can define your own
-L<HTML::FormHandler::Field> classes to create your own field types, and
+You can use transformations, Moose type constraints, and coercions, listed
+in the field's 'apply' attribute, to validate or inflate the fields
+(see L<HTML::FormHandler::Field/apply>). You can define your own
+L<HTML::FormHandler::Field> classes to create your own field types, and
perform specialized validation. You can create L<MooseX::Types> libraries
and use them to perform field validation.
-The L<HTML::FormHandler::Model::DBIC> package includes a working
+The L<HTML::FormHandler::Model::DBIC> package includes a working
example using a SQLite database and a number of forms in the test directory.
You can execute the sample from a downloaded DBIC model distribution package with:
@@ -39,10 +50,10 @@ You can execute the sample from a downloaded DBIC model distribution package wit
=head1 Basics
-You can either create a form dynamically with
+You can either create a form dynamically with
C<< my $form = HTML::FormHandler->new( <arguments>); >> (or with
C<< HTML::FormHandler::Model::DBIC->new(...) >> for DBIC forms ) or by
-creating a form subclass. There are some features
+creating a form subclass. There are some features
and usage patterns which do not fit well with the dynamic method - it's harder
to create form methods or attributes, for example. But most forms could be
created in either way.
@@ -70,7 +81,7 @@ defined using the 'field_list', as in the following dynamic example.
unique_message => 'That username is already taken' );
# the css_class, title, and widget attributes are for use in templates
has_field 'age' => ( type => 'PosInteger', required => 1, css_class => 'box',
- title => 'User age in years', widget => 'age_text', range_start => 18 );
+ title => 'User age in years', widget => 'age_text', range_start => 18 );
has_field 'sex' => ( type => 'Select', label => 'Gender', required => 1 );
# a customized field class
has_field 'birthdate' => ( type => '+MyApp::Field::Date' );
@@ -93,14 +104,14 @@ An example of a dynamically created form instance:
use HTML::FormHandler;
- my @select_options = ( {value => 1, label => 'One'},
+ my @select_options = ( {value => 1, label => 'One'},
{value => 2, label => 'Two'}, {value => 3, label => 'Three'} );
my $args = {
name => 'test_form',
field_list => [
'username' => {
type => 'Text',
- apply => [ { check => qr/^[0-9a-z]*/,
+ apply => [ { check => qr/^[0-9a-z]*/,
message => 'Contains invalid characters' } ],
},
'password' => {
@@ -153,12 +164,12 @@ An example of a dynamically created form instance:
},
'sub.user' => {
type => 'Text',
- apply => [ { check => qr/^[0-9a-z]*/,
+ apply => [ { check => qr/^[0-9a-z]*/,
message => 'Not a valid user' } ],
},
'sub.name' => {
type => 'Text',
- apply => [ { check => qr/^[0-9a-z]*/,
+ apply => [ { check => qr/^[0-9a-z]*/,
message => 'Not a valid name' } ],
},
'reset' => {
@@ -176,7 +187,6 @@ An example of a dynamically created form instance:
my $form = HTML::FormHandler->new( %$args );
my $renderedform = $form->render;
-
You can create custom rendering roles or classes and easily change the
rendering methods. FormHandler ships with 'Simple' and 'Table' renderers, and
returns the validated values in a hashref using C<< $form->value >>.
@@ -192,7 +202,7 @@ Individual fields can also be rendered:
You can also use the Simple and Table rendering roles by adding
C< with 'HTML::FormHandler::Field::Render'; > to your class. These rendering
-roles also enable use of the C< [% form.render %] > syntax, but the widget
+roles also enable use of the C< [% form.render %] > syntax, but the widget
rendering methods included in the these roles are accessed with:
[% form.render_field('title') %]
@@ -212,7 +222,7 @@ Plain HTML works fine for a simple input field if you use FillInForm to
supply the value.
For a select list, provide a relationship name as the field name, or provide
-an options_<field_name> subroutine in the form. You need to access the field
+an options_<field_name> subroutine in the form. You need to access the field
'options' to create a select list. You could,
of course, create the select lists by hand or some other way, but if you
don't use the same method that is used by your FormHandler Select field,
@@ -223,14 +233,14 @@ you risk getting out of sync. TT example:
<label class="label" for="[% f.name %]">[% f.label %]</label>
<select name="[% f.name %]">
[% FOR option IN f.options %]
- <option value="[% option.value %]"
+ <option value="[% option.value %]"
[% IF option.value == f.fif %]selected="selected"[% END %]>
[% option.label | html %]</option>
- [% END %]
+ [% END %]
</select>
</p>
-A multiple select list where 'hobbies' is a 'many_to_many' pseudo-relationship.
+A multiple select list where 'hobbies' is a 'many_to_many' pseudo-relationship.
(field attributes: sort_column, label_column, active_column).
<p>
@@ -239,11 +249,10 @@ A multiple select list where 'hobbies' is a 'many_to_many' pseudo-relationship.
<select name="[% f.name %]" multiple="multiple" size="[% f.size %]">
[% FOR option IN f.options %]
<option value="[% option.value %]" [% FOREACH selval IN f.fif %][% IF selval == option.value %]selected="selected"[% END %][% END %]>[% option.label | html %]</option>
- [% END %]
+ [% END %]
</select>
</p>
-
In a Catalyst controller:
package MyApp::Controller::User;
@@ -258,9 +267,9 @@ In a Catalyst controller:
sub edit : Local {
my ( $self, $c, $user_id ) = @_;
- $c->stash(
+ $c->stash(
form => $self->form,
- template => 'user/edit.tt' );
+ template => 'user/edit.tt' );
return unless $self->form->process( item_id => $user_id,
@@ -270,13 +279,13 @@ In a Catalyst controller:
$c->stash( user => $self->form->item );
$c->res->redirect($c->uri_for('profile'));
}
-
+
1;
With the DBIC model the schema is set from the 'item' (row object)
-passed in, or from the primary key ('item_id') and schema.
+passed in, or from the primary key ('item_id') and schema.
You might also want to pass in the 'action' to which the form will
-be submitted if you're using FormHandler's renderer and if it's important
+be submitted if you're using FormHandler's renderer and if it's important
to pass XHTML validation:
$form->process( action => <valid url>, item => $row,
@@ -284,7 +293,7 @@ to pass XHTML validation:
The example above uses persistent forms in a Moose attribute. The
'process' method will clear out non-persistent form values and
-update the information from the database row (if given).
+update the information from the database row (if given).
You can also create a new form on each request with new:
my $form = BookDB::Form::Book->new( item => $book );
@@ -300,13 +309,13 @@ the parameters will be an empty hashref, since the form has not been
submitted yet. FormHandler will load values from the database object
(item_id/schema or item) or from an 'init_object', and return false
because the form has not validated yet. At this point the 'return'
-(in Catalyst) will cause the renderview processing to take place and
-the form will be displayed with initialized values (from a template
+(in Catalyst) will cause the renderview processing to take place and
+the form will be displayed with initialized values (from a template
using the 'fif' values or from L<HTML::FillInForm>) to allow user input.
When the form is submitted, the action in the HTML form's 'action'
value will be called (the same one that just displayed the form
-usually), and the second pass of calling the FormHandler
+usually), and the second pass of calling the FormHandler
process method will occur.
This time there WILL be values in the parameters, and FormHandler
@@ -327,18 +336,18 @@ for all the form's fields:
$form->fif
-If you want to use L<HTML::FillInForm> to fill in values instead of the
+If you want to use L<HTML::FillInForm> to fill in values instead of the
doing it in directly in a template using either the field or the form 'fif'
-methods, you can use L<Catalyst::View::FillInForm> on your view class
+methods, you can use L<Catalyst::View::FillInForm> on your view class
and set the 'fif' hash in the 'fillinform' stash variable:
$self->form->process( ... );
$c->stash( fillinform => $self->form->fif );
return unless $form->validated;
-
+
Note that FormHandler by default uses empty params as a signal that the
form has not actually been posted, and so will not attempt to validate
-a form with empty params. Most of the time this works OK, but if you
+a form with empty params. Most of the time this works OK, but if you
have a small form with only the controls that do not return a post
parameter if unselected (checkboxes and select lists), then the form
will not be validated if everything is unselected. For this case you
@@ -360,39 +369,39 @@ package. See L<HTML::FormHandler::Generator::DBIC>.
The base class for a non-database form is HTML::FormHandler instead
of a model class.
You do not initialize a non-database form with an item or item_id,
-although you can use an init_object for the initial values.
+although you can use an init_object for the initial values.
-After validation, you can get a hashref of values back from
-the 'value' method.
+After validation, you can get a hashref of values back from
+the 'value' method.
return unless $form->validated;
my $result = $form->value;
The 'value' structure is what FormHandler uses to update the database.
-=head1 Form Models
+=head1 Form Models
-For a database form, use a model base class that interfaces with the
+For a database form, use a model base class that interfaces with the
database, such as L<HTML::FormHandler::Model::DBIC>, which needs to
be installed as a separate package.
When using a database model, form field values for the row are retrieved from
-the database using the field 'accessor' attributes (defaults to field name)
-as database class accessors.
+the database using the field 'accessor' attributes (defaults to field name)
+as database class accessors.
-FormHandler will use relationships to populate single and multiple
+FormHandler will use relationships to populate single and multiple
selection lists, and validate input. A 'single' relationship is processed
by L<HTML::FormHandler::Field::Compound>. A 'has_many' relationship is
-processed by L<HTML::FormHandler::Field::Repeatable>.
+processed by L<HTML::FormHandler::Field::Repeatable>.
-You can pass in either the primary key and or a row object to the form. If a
-primary key (item_id) is passed in, you must also provide the schema.
-The model will use the item_class (DBIC source name) to fetch the row from the
-database. If you pass in a row object (item), the schema, source_class, and
-item_id will be set from the row.
+You can pass in either the primary key and or a row object to the form. If a
+primary key (item_id) is passed in, you must also provide the schema.
+The model will use the item_class (DBIC source name) to fetch the row from the
+database. If you pass in a row object (item), the schema, source_class, and
+item_id will be set from the row.
-The C<< $form->process >> will validate
-the parameters and then update or create the database row object.
+The C<< $form->process >> will validate
+the parameters and then update or create the database row object.
=head1 Field names
@@ -400,12 +409,12 @@ The standard way to use FormHandler is with field names that match your
database accessors. If you want to prepend the HTML field names with a
name plus dot, you can set the form 'name' and use the 'html_prefix'
flag. "$name." will be stripped from the beginning of the HTML fields
-before processing by HFH, and will be added back in 'fif'. The field's
+before processing by HFH, and will be added back in 'fif'. The field's
'html_name' convenience attribute will return this name for use in templates.
If you want the FormHandler field name to be different than the
database accessor, set 'accessor' on your fields. (It defaults to the field
-name). You could then use any name that you want for your field.
+name). You could then use any name that you want for your field.
There are a number of name related field attributes. The 'name' is
the name used to identify this particular field in this fields array.
@@ -428,13 +437,13 @@ possibly by using 'html_prefix'.
This is not actually a Moose attribute. It is sugar to allow the
declarative specification of fields. It will not create accessors for the
fields. The 'type' is not a Moose type, but an L<HTML::FormHandler::Field>
-class name. To use this sugar, you must do
+class name. To use this sugar, you must do
use HTML::FormHandler::Moose;
instead of C< use Moose; >. (Moose best practice advises using
-C< use namespace::autoclean; > or putting C< no HTML::FormHandler::Moose; >
-at the end of the package to keep the namespace clean of imported methods.)
+C< use namespace::autoclean; > or putting C< no HTML::FormHandler::Moose; >
+at the end of the package to keep the namespace clean of imported methods.)
To declare fields use the syntax:
@@ -443,27 +452,27 @@ To declare fields use the syntax:
instead of:
- has 'field_list' => ( default => sub {
+ has 'field_list' => ( default => sub {
[
title => {
type => 'Text',
required => 1,
},
authors => 'Select',
- ]
+ ]
}
);
-
+
Fields specified in a field_list are processed after fields specified with 'has_field'.
After processing, fields live in the 'fields' array, and can be accessed with the
-field method: C<< $form->field('title') >>.
+field method: C<< $form->field('title') >>.
-Forms with 'has_field' field declarations may be subclassed. Or use
+Forms with 'has_field' field declarations may be subclassed. Or use
L<HTML::FormHandler::Moose::Role> to create roles with the 'has_field' syntax:
package Form::Role::Address;
- use HTML::FormHandler::Moose::Role;
+ use HTML::FormHandler::Moose::Role;
has_field 'street' => ( type => 'Text', size => '50' );
has_field 'city' => ( type = 'Text', size => 24 );
@@ -485,32 +494,31 @@ classes using 'with':
has_field 'user_name' => ( type => 'Text', required => 1 );
no HTML::FormHandler::Moose;
- 1;
-
+ 1;
+
If you prefix the field name with a '+' the attributes in this definition
-will modify existing attributes or be added to an existing field definition:
+will modify existing attributes or be added to an existing field definition:
has_field 'user' => ( type => 'Text', ...., required => 1 );
....
has_field '+user' => ( required => 0 );
-
=head1 The form field_list
An array of name, specification pairs to define fields.
The field_list is one way to define the fields in your form.
- has '+field_list' => ( default => sub {
+ has '+field_list' => ( default => sub {
[
field_one => {
type => 'Text',
required => 1
},
field_two => 'Text,
- ]
+ ]
}
- );
+ );
An example of a select field:
@@ -524,28 +532,27 @@ An example of a select field:
];
}
-
=head1 Fields
A form's fields are created from the 'has_field' and 'field_list'
definitions.
-FormHandler processes the field lists and creates an array of
-L<HTML::FormHandler::Field> objects. The "type" of a field
+FormHandler processes the field lists and creates an array of
+L<HTML::FormHandler::Field> objects. The "type" of a field
determines which field class to use. The field class determines which
-attributes are valid for a particular field. A number of field classes are
-provided by FormHandler. You can customize the validation in your form on a
-per field basis, but validation that will be used for more than one field
-might be more easily handled in a custom field class.
+attributes are valid for a particular field. A number of field classes are
+provided by FormHandler. You can customize the validation in your form on a
+per field basis, but validation that will be used for more than one field
+might be more easily handled in a custom field class.
In the templates the fields are accessed with C< form.field('name') >.
-Field errors are in C<< $field->errors >>.
+Field errors are in C<< $field->errors >>.
The fields are assumed to be in the HTML::FormHandler::Field name
space. If you want to explicitly list the field's package, prefix it
with a plus sign. The field_name_space plus the default name spaces
'HTML::FormHandler::Field' and 'HTML::FormHandlerX::Field' will be
searched for fields.
-
+
has '+field_name_space' => ( default => 'MyApp::Form::Field' );
has_field 'name' => ( type => 'Text' ); # HTML::FormHandler::Field::Text
@@ -553,7 +560,6 @@ searched for fields.
has_field 'foo' => ( type => +Foo' ); # MyApp::Form::Field::Foo
or
has_field 'foo' => ( type => 'Foo' ); # MyApp::Form::Field::Foo
-
The most basic type is "Text", which takes a single scalar value. (If the
type of a field is not specified, it will be set to 'Text'.) A "Select"
@@ -563,7 +569,7 @@ at a time.
Each field has a "value" method, which is the field's internal value. This is
the value your database object would have (e.g. scalar, boolean 0 or 1,
-DateTime object).
+DateTime object).
When data is passed in to validate the form, the input is copied into the
'value' attribute of the field, and the actions specified by 'apply'
@@ -576,7 +582,7 @@ the field's 'validate' method is called.
A compound field is a field that has sub-fields. Compound fields can be
created in two ways: 1) using a field class, 2) by declaration.
-To create a compound field class, you must extend
+To create a compound field class, you must extend
L<HTML::FormHandler::Field::Compound> and use L<HTML::FormHandler::Moose> to
allow declaring fields:
@@ -620,7 +626,6 @@ one row (belongs_to or has_one).
Repeatable fields are used for arrays of compound fields.
-
has_field 'addresses' => ( type => 'Repeatable' );
has_field 'addresses.address_id' => ( type => 'PrimaryKey' );
has_field 'addresses.street';
@@ -645,7 +650,7 @@ inflate the HTML field input, such as for a DateTime. You can also create
non-Moose transformations and constraints. See the 'apply' attribute
in L<HTML::FormHandler::Field>.
- has_field 'some_field' => ( apply => [ 'MooseType',
+ has_field 'some_field' => ( apply => [ 'MooseType',
{ transform => sub {...}, message => 'xxxx' },
{ check => sub { ... }, message => 'xxxx' } ] );
@@ -656,7 +661,7 @@ You can also create a simple subroutine in your form class to perform validation
The default name of this subroutine is 'validate_<fieldname>', but the name can
also be set in the field with the 'set_validate' attribute. (This method is
not called when the field is empty. Use 'required'/'required_message' for
-that case.)
+that case.)
If you need to access form attributes such as the schema, the 'set_validate'
subroutine may be preferable, but most validations can be performed using
@@ -673,23 +678,23 @@ class or in any place that validation is done, though it is probably better
to do it in a field class. Usually the form's validate_<field_name> methods
should expect to get the already inflated value (unless inflation failed).
-Deflation is done to convert the object that is retrieved from the model to
+Deflation is done to convert the object that is retrieved from the model to
a format that can be displayed in an HTML form. Deflation is always performed
when retrieving from the initial object. If an input value exists for a field
that value is usually used to re-display the field, and deflation is NOT
performed, unless the 'fif_from_value' flag is set for the field. (See
L<HTML::FormHandler::Field>). This might be desirable if you want to
-canonicalize the entered data into a standard form.
+canonicalize the entered data into a standard form.
=head2 Creating custom fields
Subclass a custom field from L<HTML::FormHandler::Field>, or one of the
existing subclasses. Almost everything that is done in a custom field
class can also be done in a form. The advantage of a field class
-is that it can simplify declaration of often-repeated sets of attributes.
+is that it can simplify declaration of often-repeated sets of attributes.
The simplest subclasses contain only a 'validate' routine or an 'apply' attribute,
-which is called by the base Field class from 'process'. Look at
+which is called by the base Field class from 'process'. Look at
L<HTML::FormHandler::Field::Email>, for example.
If the field's value will be an object instead of a simple scalar, such
@@ -701,7 +706,7 @@ Some custom fields might only require setting certain attributes to
defaults, such as the L<HTML::FormHandler::Field::Hour> field, which
set 'range_start' to 0 and 'range_end' to 23. A 'select' field might
override the 'build_options' builder for the 'options' array, like
-L<HTML::FormHandler::Field::IntRange>. A field may add additional
+L<HTML::FormHandler::Field::IntRange>. A field may add additional
attributes, such as 'label_format' in L<HTML::FormHandler::Field::IntRange>,
or set the 'required_message'.
@@ -710,8 +715,8 @@ be roles with collections of validations.
=head1 Common form attributes
-The 'dependency' field_list key is an array of arrays of field names.
-During validation, if any field in a given group
+The 'dependency' field_list key is an array of arrays of field names.
+During validation, if any field in a given group
contains the pattern /\S/ (non-blank), the 'required' flag
is set for all of the fields in the group.
@@ -736,13 +741,13 @@ The field name space for use with '+' prefixed fields:
has '+field_name_space' => ( default => 'MyApp::Form::Field' );
...
has_field 'subname' => ( type => '+SubName' );
-
+
An 'init_object' for filling in the form with default values instead of
the database object. (To set individual field values use "default_$fieldname"
or default => '...' on the field. Individual field defaults take precedence
over an init_object or model item.)
- has '+init_object' => ( default => sub {
+ has '+init_object' => ( default => sub {
{ name => 'Choose name',
project => 'Standard'
}
@@ -754,15 +759,15 @@ over an init_object or model item.)
=over 4
-=item options_$fieldname
+=item options_$fieldname
-If you have a 'Select' or 'Multiple' field, there are three ways to provide the
-'options', or the list of values and labels for the select list. 1) Get them
-automatically from a database table (from the relationship that is the field
-name/accessor), 2) provide them in the field's 'options' attribute, or 2)
+If you have a 'Select' or 'Multiple' field, there are three ways to provide the
+'options', or the list of values and labels for the select list. 1) Get them
+automatically from a database table (from the relationship that is the field
+name/accessor), 2) provide them in the field's 'options' attribute, or 2)
provide them from an options_$fieldname method in the form.
-An 'options_$fieldname' method should return a list of ordered key (option
+An 'options_$fieldname' method should return a list of ordered key (option
value) and value (label to be displayed in the select list) pairs.
sub options_fruit {
@@ -776,7 +781,7 @@ value) and value (label to be displayed in the select list) pairs.
You can also write custom methods to retrieve the option info from the database:
sub options_country {
- my $self = shift;
+ my $self = shift;
return unless $self->schema;
my @rows =
$self->schema->resultset( 'Country' )->
@@ -784,21 +789,19 @@ You can also write custom methods to retrieve the option info from the database:
return [ map { $_->digraph, $_->country_name } @rows ];
}
-
=item default_$fieldname
-Allows you to provide (in the form) a different initial value for a particular
+Allows you to provide (in the form) a different initial value for a particular
field than that in the database (formerly init_value_$fieldname ).
sub default_license {
my ( $self, $field, $item ) = @_;
- return 0 unless $item && $item->license_id;
+ return 0 unless $item && $item->license_id;
return $item->license_id;
}
Defaults can also be provided by the field's 'default' attribute and the
-init_object.
-
+init_object.
=item validate_$fieldname
@@ -811,28 +814,28 @@ do per-field validation customization in a form method:
if $field->value < 18;
}
-A different form method name for this can be specified with the field's
+A different form method name for this can be specified with the field's
'set_validate' attribute:
has_field 'age' => ( type => 'Text', set_validate => 'check_age' );
sub check_age {
...
- }
+ }
This method is not called when the field is empty.
-=item validate
+=item validate
Handle cross-field validation, or any validation that needs to be done after
-the entire form is validated. This form method is executed whether or not the form
+the entire form is validated. This form method is executed whether or not the form
has validated so far.
sub validate {
my $self = shift;
if ( $self->field('count')->value && $self->field('duration')->value )
{
- $self->field('duration')->add_error(
+ $self->field('duration')->add_error(
'Do not enter both a count and a duration' );
}
}
@@ -856,10 +859,10 @@ See L<HTML::FormHandler::Manual::Cookbook> for an example.
=head1 Filling the HTML form with values
There are three ways to get the database or parameter values into the actual
-HTML form.
+HTML form.
You can use the field method 'fif' (where "f" is "form.field('book')" ):
-
+
[% f.fif %]
You can use the hash returned by the form method "fif":
@@ -867,14 +870,14 @@ You can use the hash returned by the form method "fif":
[% form.fif.book %]
Or you can use L<HTML::FillInForm> (and L<Catalyst::View::FillInform> if you
-are using Catalyst) and the C<< $form->fif hash >>.
+are using Catalyst) and the C<< $form->fif hash >>.
If you are already using FormHandler field attributes in your form elements,
then using the field 'fif' method is probably easiest. If you are not using
FormHandler field attributes, then your choice is between using form.fif and
-FillInForm.
+FillInForm.
-If you are not using FormHandler select lists and you use FillInForm, then
+If you are not using FormHandler select lists and you use FillInForm, then
it is possible to have FormHandler process HTML forms that have no template
references to the form object at all, as long as the field names are correct.
If you think that FillInForm is evil, then you could manage with only
@@ -884,8 +887,8 @@ using FormHandler to fill in the form.
You can use FormHandler to validate your data (and load it into a database
if you choose) with nothing from FormHandler in the templates or HTML at all.
-The 'name' for the HTML form fields must match the HFH field names. If you have
-compound or repeatable fields, the field names must follow the HFH naming
+The 'name' for the HTML form fields must match the HFH field names. If you have
+compound or repeatable fields, the field names must follow the HFH naming
convention. (See the documentation for Compound and Repeatable fields.)
In order to load the form with values, you should use L<HTML::FillInForm>, and
@@ -900,15 +903,14 @@ FormHandler 'fif' hash into the Catalyst stash.
minimal interaction with the FormHandler form.)
If you have select lists and use the FormHandler 'Select' field types, you need
-to be careful that the select lists don't get out of sync.
+to be careful that the select lists don't get out of sync.
=head1 Testing
It's much easier to write unit tests for FormHandler forms than for
-Catalyst controllers. The 't' directory of the downloaded distribution
+Catalyst controllers. The 't' directory of the downloaded distribution
has lots of examples. Here is an example of a test script for a DBIC form:
-
use Test::More tests => 14;
use lib 't/lib';
@@ -957,24 +959,25 @@ has lots of examples. Here is an example of a test script for a DBIC form:
ok( !$form->field('author')->has_errors, 'author has no error' );
ok( $form->field('format')->has_errors, 'format has error' );
- my $good = {
+ my $good = {
title => "Another Silly Test Book",
author => "C. Foolish",
year => 1999,
pages => 101,
- format => 2
+ format => 2
};
ok( $form->process($good), 'now form validates' );
-
+=head1 AUTHOR
-=head1 AUTHORS
+FormHandler Contributors - see HTML::FormHandler
-Gerda Shank, gshank at cpan.org
+=head1 COPYRIGHT AND LICENSE
-=head1 COPYRIGHT
+This software is copyright (c) 2010 by Gerda Shank.
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+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
+
diff --git a/lib/HTML/FormHandler/Manual/Reference.pod b/lib/HTML/FormHandler/Manual/Reference.pod
index fcff981..60236f7 100644
--- a/lib/HTML/FormHandler/Manual/Reference.pod
+++ b/lib/HTML/FormHandler/Manual/Reference.pod
@@ -1,14 +1,26 @@
+package HTML::FormHandler::Manual::Reference;
+# ABSTRACT: concise reference
+
+
+
+__END__
+=pod
+
=head1 NAME
HTML::FormHandler::Manual::Reference - concise reference
+=head1 VERSION
+
+version 0.32002
+
=head1 DESCRIPTION
This is a concise reference of HTML::FormHandler.
HTML::FormHandler has a lot of options and many ways to customize your forms.
-More complete documentation can be found at L<HTML::FormHandler>,
-L<HTML::FormHandler::Field>, L<HTML::FormHandler::Model::DBIC>,
+More complete documentation can be found at L<HTML::FormHandler>,
+L<HTML::FormHandler::Field>, L<HTML::FormHandler::Model::DBIC>,
L<HTML::FormHandler::Render::Simple>, and in the individual field classes.
=head1 Fields
@@ -21,19 +33,19 @@ L<HTML::FormHandler::Render::Simple>, and in the individual field classes.
set_validate Name of validation method in form. Default is validate_$fieldname
set_init Name of the form method used to initialize a field
required Field is required
- required_message If this field is required, the message to display on failure
+ required_message If this field is required, the message to display on failure
id Useful for javascript that requires unique id. Set in Field.
- label Text label. Not used by FormHandler, but useful in templates
- order Set the order for fields. Used by sorted_fields, templates.
+ label Text label. Not used by FormHandler, but useful in templates
+ order Set the order for fields. Used by sorted_fields, templates.
widget Used by templates to decide widget usage. Set by field classes.
style Style to use for css formatting. Not used by FormHandler; for templates.
title For HTML titles. Not used by FormHandler.
- password Remove from params and do not display in forms.
+ password Remove from params and do not display in forms.
disabled HTML hint to not do updates (for templates) Init: 0
- readonly HTML hint to make the field readonly (for templates) Init: 0
+ readonly HTML hint to make the field readonly (for templates) Init: 0
noupdate Don't update this field in the database
writeonly Do not retrieve initial values
- errors Errors associated with this field
+ errors Errors associated with this field
(also num_errors, clear_errors, has_errors, add_error)
label_column Select lists: column to use for labels (default: name)
active_column Select lists: which values to list
@@ -41,9 +53,9 @@ L<HTML::FormHandler::Render::Simple>, and in the individual field classes.
size Text & select fields.
maxlength Text fields. Validated.
minlength Text fields. Used in validation
- range_start Range start for number fields
- range_end Range end for number fields
- unique Field should be unique in the database
+ range_start Range start for number fields
+ range_end Range end for number fields
+ unique Field should be unique in the database
unique_message If field is not unique, error message.
apply Array of constraint/coercion/transformation actions
value_changed Has the field's value changed from the init_value?
@@ -56,7 +68,7 @@ These attributes are usually accessed in a subroutine or in a template.
init_value Initial value from the database
value The value of your field.
input Input value from parameter or initial value from database
- fif Retrieve (do not set) values for filling in a form
+ fif Retrieve (do not set) values for filling in a form
options Select lists. Sorted array of hashes, keys: "value", "label"
=head1 Forms
@@ -64,13 +76,13 @@ These attributes are usually accessed in a subroutine or in a template.
=head2 Attributes to pass to new or set in form
item_class Class of db item
- item_id Primary key of db item
+ item_id Primary key of db item
schema Schema of item
item DB row object
init_object For default values instead of $item
dependency Array of arrays of field names. If one name has a value, all
fields in the list are set to 'required'
-
+
=head2 Other Form attributes
name Form name
@@ -78,51 +90,50 @@ These attributes are usually accessed in a subroutine or in a template.
ran_validation Flag that validation has already been run
field_name_space Where to look for your fields
num_errors Number of errors
- language handle For MakeText
- params HTTP parameters
+ language handle For MakeText
+ params HTTP parameters
fields Field array
- parent For compound/related fields: parent field reference
+ parent For compound/related fields: parent field reference
html_prefix Flag to prefix html field names with the form name
ctx Application context for your use
-
-
+
=head2 Form methods
has_field Moose-y sugar for declaring fields
- clear Resets state. Used in persistent forms.
+ clear Resets state. Used in persistent forms.
fields The array of fields
sorted_fields The sorted array of fields
field( $name ) Returns a field object
value Returns a hashref of values (with accessor keys)
- fif Returns a hashref for filling in form
+ fif Returns a hashref for filling in form
- has_errors True if any field has errors
+ has_errors True if any field has errors
num_errors The number of fields with errors
error_fields An array of fields with errors
- errors Returns an array of all errors
+ errors Returns an array of all errors
error_field_names Returns an array of field names with errors
uuid Creates an HTML element 'form_uuid'
- process Sets up form, validated, updates model
-
-=head2 Subroutines for your form
+ process Sets up form, validated, updates model
+
+=head2 Subroutines for your form
options_$fieldname Provides a list of key value pairs for select lists
- validate_$fieldname Validation routine for field
+ validate_$fieldname Validation routine for field
default_$fieldname Default value for the field in an initial form
- validate For validation after individual fields are validated
-
+ validate For validation after individual fields are validated
+
=head2 Methods from HTML::FormHandler::Model::DBIC for method modifiers
validate_model Add additional database type validation
update_model To perform additional database actions update
-
+
=head1 Useful in a template
$form->has_errors [% IF form.has_errors %]
- $field->has_errors [% IF field.has_errors %]
+ $field->has_errors [% IF field.has_errors %]
$form->error_fields [% FOREACH field IN form.error_fields %]
$form->error_field_names [% FOREACH name IN form.error_field_names %]
$form->errors Array of error messages for all fields
@@ -137,16 +148,17 @@ These attributes are usually accessed in a subroutine or in a template.
uuid subroutine that returns a uuid
$form->fif value="[% form.fif.title %]"
$field->fif value="[% field.fif %]
-
-
-=head1 AUTHORS
-Gerda Shank, gshank at cpan.org
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
-=head1 COPYRIGHT
+This software is copyright (c) 2010 by Gerda Shank.
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+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
diff --git a/lib/HTML/FormHandler/Manual/Rendering.pod b/lib/HTML/FormHandler/Manual/Rendering.pod
index 8ffc878..106d97b 100644
--- a/lib/HTML/FormHandler/Manual/Rendering.pod
+++ b/lib/HTML/FormHandler/Manual/Rendering.pod
@@ -1,6 +1,17 @@
+package HTML::FormHandler::Manual::Rendering;
+# ABSTRACT: how to render with FormHandler
+
+
+__END__
+=pod
+
=head1 NAME
-HTML::FormHandler::Manual::Rendering
+HTML::FormHandler::Manual::Rendering - how to render with FormHandler
+
+=head1 VERSION
+
+version 0.32002
=head1 SYNOPSIS
@@ -8,7 +19,7 @@ You can easily build any kind of renderer for FormHandler. A custom
renderer could be a separate object or class that takes a form object,
or a role that is applied to your form. Since the primary use of
FormHandler is for HTML forms, the built-in rendering methods create
-HTML (though in addition all forms can return a hashref of the values
+HTML (though in addition all forms can return a hashref of the values
and a hashref of the values to use to fill in an HTML form).
If you are interested in creating your own renderer,
@@ -69,13 +80,13 @@ then L<HTML::FormHandler::Widget::Form::Simple'> will not be applied.
The advantage of an all-in-one type role is that you can include all of
your rendering code for a particular form in one file. You could even
have one renderer for each form. The widgets are more atomic, so may
-make widget reuse easier.
+make widget reuse easier.
=head2 Rendering with Widgets
-All FormHandler widgets are Moose roles. Default widget roles are found in the
-HTML::FormHandler::Widget directory. They include widgets for the fields in the
-distribution. Field and wrapper widgets are automatically applied to fields,
+All FormHandler widgets are Moose roles. Default widget roles are found in the
+HTML::FormHandler::Widget directory. They include widgets for the fields in the
+distribution. Field and wrapper widgets are automatically applied to fields,
Each field can render itself with C<< $field->render >>.
The name space used to look for the widget roles can be specified on a form or
@@ -96,27 +107,27 @@ and Table). The form widget is specified in the form with 'widget_form'.
package MyApp::Form;
....
- has '+widget_form' => ( default => 'Simple' );
+ has '+widget_form' => ( default => 'Simple' );
...
-The 'wrapper' for field rendering can also be specified with 'widget_wrapper'.
+The 'wrapper' for field rendering can also be specified with 'widget_wrapper'.
The widget specified will be looked for in the widget directories' 'Wrapper'
subdirectory. It contains a 'wrap_field' method which is called from the Field
widgets. The wrap_field method takes the basic rendered field (passed from the
field widget) and wraps it with HTML. The defaults provided are 'Div' and 'Table'.
-You can specify a wrapper class for all the fields in the form by setting
+You can specify a wrapper class for all the fields in the form by setting
'widget_wrapper' in the form class, or you can set them individually by setting
'widget_wrapper' on individual fields.
has_field 'some_field' => ( widget_wrapper => 'MyWrapper' );
-
-The 'widget' attribute is set to a default in FormHandler fields, or you can
+
+The 'widget' attribute is set to a default in FormHandler fields, or you can
set it to a different widget in your field declarations.
has_field 'another_field' => (
widget => 'MyWidget',
widget_wrapper => 'MyWrapper'
- );
+ );
Can be set in the form:
@@ -149,7 +160,7 @@ clean the values used to fill in the form for Render::Simple and the Widgets.
The default filter changes quote, ampersand, <, and > to the equivalent html
entities. If you wish to use some other sort of filtering, you can set use
'render_filter' method in your form, or set a coderef on individual field
-objects.
+objects.
sub render_filter {
my ( $self, $string ) = @_;
@@ -159,7 +170,7 @@ objects.
-- or --
has_field 'foo' => ( render_filter => sub { ... } );
-The filter is called in Render::Simple in the widgets with as
+The filter is called in Render::Simple in the widgets with as
C<< $self->html_filter( $fif ) or $field->html_filter( $fif ) >>.
=head2 Customized Widgets
@@ -201,10 +212,10 @@ widget_tags in a form to apply them to all the fields:
=head2 Creating Widgets
-The new widgets are designed to be used with either the original FormHandler
+The new widgets are designed to be used with either the original FormHandler
form objects or the new L<HTML::FormHandler::Result> objects. For that reason,
-you should use C<< $field->result >> to access the current value, errors and
-'fif' (fill-in-form) in field widgets, so that they will work
+you should use C<< $field->result >> to access the current value, errors and
+'fif' (fill-in-form) in field widgets, so that they will work
for both form and result rendering.
The basic structure for a field widget:
@@ -224,10 +235,22 @@ The basic structure for a field widget:
< done creating rendered field )
return $self->wrap_field($result, $output);
}
- use namespace::autoclean;
+ use namespace::autoclean;
1;
Although the shipped widgets use a wrapper method, it is not necessary for
-you to do that in your widgets.
+you to do that in your widgets.
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/Manual/Templates.pod b/lib/HTML/FormHandler/Manual/Templates.pod
index 80fa62b..6c7bbad 100644
--- a/lib/HTML/FormHandler/Manual/Templates.pod
+++ b/lib/HTML/FormHandler/Manual/Templates.pod
@@ -1,7 +1,18 @@
+package HTML::FormHandler::Manual::Templates;
+# ABSTRACT: using templates
+
+
+__END__
+=pod
+
=head1 NAME
HTML::FormHandler::Manual::Templates - using templates
+=head1 VERSION
+
+version 0.32002
+
=head1 SYNOPSIS
Documentation on templates to use with L<HTML::FormHandler>
@@ -11,7 +22,7 @@ Documentation on templates to use with L<HTML::FormHandler>
There are lots of different ways to set up templates. One way is to
create a 'widget' directory, and store template snippets there.
-You can use the default 'widget' for the field class, or set the 'widget'
+You can use the default 'widget' for the field class, or set the 'widget'
for the field in your form:
fields => [
@@ -61,7 +72,6 @@ Simple text field;
<div><label class="label" for="[% f.id %]">[% f.label %]: </label>
<input type="text" name="[% f.html_name %]" id="[% f.id %]" value="[% f.fif %]" /> </div>
-
=head2 Select field
Single select:
@@ -69,28 +79,28 @@ Single select:
<label class="label" for="[% f.id %]">[% f.label %]</label>
<select name="[% f.html_name %]" id="[% f.id %]>
[% FOR option IN f.options %]
- <option value="[% option.value %]"
+ <option value="[% option.value %]"
[% IF option.value == f.fif %]
selected="selected"
[% END %]>
[% option.label %]</option>
- [% END %]
+ [% END %]
</select>
Multiple select:
<label class="label" for="[% f.id %]">[% f.label %]</label>
- <select name="[% f.html_name %]" id="[% f.id %]
+ <select name="[% f.html_name %]" id="[% f.id %]
multiple="multiple" size="[% f.size %]">
[% FOR option IN f.options %]
- <option value="[% option.value %]"
+ <option value="[% option.value %]"
[% FOREACH optval IN f.value %]
[% IF optval == option.value %]
selected="selected"
[% END %]
[% END %]>
[% option.label %]</option>
- [% END %]
+ [% END %]
</select>
Warning: TT has problems with single element arrays. If you are likely
@@ -107,17 +117,17 @@ with a good solution, please submit a doc patch.)
=head2 Textarea
<div><label class="label" for="[% f.id %]">[% f.label %]" </label>
- <textarea name="[% f.html_name %]" id="[% f.id %]"
+ <textarea name="[% f.html_name %]" id="[% f.id %]"
rows="[% f.rows %]" cols="[% f.cols %]">[% f.fif %]</textarea></div>
=head2 Hidden
- <div><input type="hidden" name="[% f.html_name %]" id="[% f.id %]"
+ <div><input type="hidden" name="[% f.html_name %]" id="[% f.id %]"
value="[% f.fif %]" /></div>
=head2 Submit
- <div><input type="submit" name="[% f.html_name %]" id="[% f.id %]"
+ <div><input type="submit" name="[% f.html_name %]" id="[% f.id %]"
value="[% f.value %]" /></div>
=head2 Radio group
@@ -125,22 +135,25 @@ with a good solution, please submit a doc patch.)
<div>
<label class="label" for="[% f.id %]">[% f.label %]</label>
[% FOR option IN f.options %]
- <input type="radio" value="[% option.value %]"
+ <input type="radio" value="[% option.value %]"
name="[% f.name %]"
[% IF option.value == f.fif %]
checked="checked"
[% END %]>
[% option.label %]<br />
- [% END %]
+ [% END %]
</div>
-=head1 AUTHORS
+=head1 AUTHOR
-HTML::FormHandler Contributors; see HTML::FormHandler
+FormHandler Contributors - see HTML::FormHandler
-=head1 COPYRIGHT
+=head1 COPYRIGHT AND LICENSE
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/Manual/Tutorial.pod b/lib/HTML/FormHandler/Manual/Tutorial.pod
index 25340cf..82655a5 100644
--- a/lib/HTML/FormHandler/Manual/Tutorial.pod
+++ b/lib/HTML/FormHandler/Manual/Tutorial.pod
@@ -1,6 +1,18 @@
+package HTML::FormHandler::Manual::Tutorial;
+# ABSTRACT: how to use FormHandler with Catalyst
+
+
+
+__END__
+=pod
+
=head1 NAME
-HTML::FormHandler::Manual::Tutorial - use FormHandler with Catalyst
+HTML::FormHandler::Manual::Tutorial - how to use FormHandler with Catalyst
+
+=head1 VERSION
+
+version 0.32002
=head1 DESCRIPTION
@@ -11,9 +23,9 @@ A tutorial for beginners to L<HTML::FormHandler>
This tutorial demonstrates how you can use L<HTML::FormHandler>
to manage forms, validate form input, and interface your forms with the database.
-=head1 Installation
+=head1 Installation
-Use CPAN to install L<HTML::FormHandler>
+Use CPAN to install L<HTML::FormHandler>
=head1 Use the Tutorial application
@@ -24,7 +36,7 @@ code repository. (See L<Catalyst::Manual::Tutorial::Intro>.)
=head2 Create an HTML::FormHandler form
-Untar the tutorial and make a lib/MyApp/Form directory. In that directory
+Untar the tutorial and make a lib/MyApp/Form directory. In that directory
create the file Book.pm.
package MyApp::Form::Book;
@@ -43,28 +55,28 @@ create the file Book.pm.
This is your Form class. The form initializes the 'item_class' to the
source name of your DBIx::Class result class. The form's fields are defined
-with the 'has_field' sugar, or in a 'field_list'. The names of the fields
-should match a column, relationship, or other accessor in your DBIx::Class
+with the 'has_field' sugar, or in a 'field_list'. The names of the fields
+should match a column, relationship, or other accessor in your DBIx::Class
result class.
The basic fields have only a 'type', such as
-'Text', or 'Integer'. These types are actually the names of
-L<HTML::FormHandler::Field> classes.
-'Text' and 'Integer' are types that are provided by HTML::FormHandler,
-in L<HTML::FormHandler::Field::Text> and L<HTML::FormHandler::Field::Integer>.
+'Text', or 'Integer'. These types are actually the names of
+L<HTML::FormHandler::Field> classes.
+'Text' and 'Integer' are types that are provided by HTML::FormHandler,
+in L<HTML::FormHandler::Field::Text> and L<HTML::FormHandler::Field::Integer>.
-The 'Multiple' type will allow you to easily create a multiple select
+The 'Multiple' type will allow you to easily create a multiple select
list from the 'authors' relationship. The 'label_column' attribute
-must be defined because the column in the 'authors' table which is used
+must be defined because the column in the 'authors' table which is used
to create the select list does not have the default column name ('name').
The 'submit' field is necessary if you are going to use FormHandler to
render your form. It wouldn't be necessary for hand-built templates or HTML.
-Eventually you will want to create your own field classes, but for
+Eventually you will want to create your own field classes, but for
this simple form the default types are adequate.
-=head2 Connect HTML::FormHandler to your controller
+=head2 Connect HTML::FormHandler to your controller
Edit lib/MyApp/Controller/Books.pm. Add use Moose:
@@ -77,7 +89,6 @@ Create an attribute to hold your form:
has 'form' => ( isa => 'MyApp::Form::Book', is => 'rw',
lazy => 1, default => sub { MyApp::Form::Book->new } );
-
=head2 Add Action to Display and Save the Form
In C<lib/MyApp/Controller/Books.pm> add the following method:
@@ -86,12 +97,12 @@ In C<lib/MyApp/Controller/Books.pm> add the following method:
my ( $self, $c, $book_id ) = @_;
$c->stash( template => 'books/edit.tt2',
- form => $self->form );
+ form => $self->form );
- # Validate and insert/update database
+ # Validate and insert/update database
return unless $self->form->process( item_id => $book_id,
params => $c->req->parameters,
- schema => $c->model('DB')->schema );
+ schema => $c->model('DB')->schema );
# Form validated, return to the books list
$c->flash->{status_msg} = 'Book saved';
@@ -102,7 +113,7 @@ This will handle both creating new books, and updating old books.
If $book_id is undefined, then HTML::FormHandler will create
a new book from your form. If you pass in a DBIx::Class row
object instead of a primary key, you don't need to specify the
-schema.
+schema.
=head2 Render the form
@@ -111,9 +122,9 @@ To use simple rendering, add a line to your form class:
with 'HTML::FormHandler::Render::Simple';
Then save a copy of C<root/src/books/edit.tt2> and create a new file that
-contains only:
+contains only:
- [% form.render %]
+ [% form.render %]
=head2 Alternative hand-built Template for the form (optional)
@@ -127,7 +138,7 @@ and build custom divs or tables or whatever around it:
<div class="mycustomclass">
[% form.render_field('book') %]
- </div>
+ </div>
If you don't want to play with HTML at this point, you can skip ahead
to the next section.
@@ -136,7 +147,7 @@ You could also use TT macros to do pretty sophisticated
template generation. But for now, we'll stick to a straightforward TT
template:
-Delete the single statement in C<root/src/books/edit.tt2>, and enter
+Delete the single statement in C<root/src/books/edit.tt2>, and enter
or copy the following:
[% META title = 'Book Form' %]
@@ -148,8 +159,8 @@ or copy the following:
[% END %]
[% END %]
- <form name="[% form.name %]"
- action="[% c.uri_for('edit', form.item_id) %]"
+ <form name="[% form.name %]"
+ action="[% c.uri_for('edit', form.item_id) %]"
method="post">
<p>
[% f = form.field('title') %]
@@ -166,19 +177,18 @@ or copy the following:
<label class="label" for="[% f.name %]">[% f.label %]:</label>
<select name="[% f.name %]" multiple="multiple" size="[% f.size %]">
[% FOR option IN f.options %]
- <option value="[% option.value %]"
+ <option value="[% option.value %]"
[% FOREACH selval IN f.fif %]
[% IF selval == option.value %]selected="selected"[% END %]
[% END %]>
[% option.label | html %]</option>
- [% END %]
+ [% END %]
</select>
</p>
<input class="button" name="submit" type="submit" value="Submit" />
</form>
-
- <p><a href="[% c.uri_for('list') %]">Return to book list</a></p>
+ <p><a href="[% c.uri_for('list') %]">Return to book list</a></p>
=head2 Add links to access create and update actions
@@ -190,24 +200,22 @@ list:
<a href="[% c.uri_for('delete', book.id) %]">Delete</a>|
<a href="[% c.uri_for('edit', book.id) %]">Edit</a>
</td>
-
-Change the link to create a book at the bottom of the file:
+
+Change the link to create a book at the bottom of the file:
<p>
<a href="[% c.uri_for('edit') %]">Create book</a>
</p>
-
=head2 Test the L<HTML::FormHandler> Create Form
-
Start up the server for MyApp:
$ script/myapp_server.pl
-(You'll need to login with test01/mypass if you're using the packaged
-tutorial.) Click the new "Create book" link at the bottom to display
-the form. Fill in the fields and click submit. You should be
+(You'll need to login with test01/mypass if you're using the packaged
+tutorial.) Click the new "Create book" link at the bottom to display
+the form. Fill in the fields and click submit. You should be
returned to the Book List page with a "Book saved" message.
Magic! A new book has been created and saved to the database
@@ -217,16 +225,15 @@ Click on the 'edit' links, and edit the existing books. Changes
should be saved and displayed properly. Try to add an alphabetic
character to the rating field. You should get an error message.
+=head2 Add additional attributes to your form's fields
-=head2 Add additional attributes to your form's fields
-
-We'll add a couple of 'label' attribute to the fields:
+We'll add a couple of 'label' attribute to the fields:
has_field 'title' => ( type => 'Text', label => 'Title of a Book' );
has_field 'rating' => ( type => 'Integer', label => 'Rating (1-5)' );
has_field 'authors' => ( type => 'Multiple', label_column => 'last_name' );
-If you want a new attribute in your fields, it's very easy to add it to your
+If you want a new attribute in your fields, it's very easy to add it to your
custom Field classes.
package MyApp::Form::Field::Extra;
@@ -237,16 +244,16 @@ custom Field classes.
1;
-Now if your Field classes inherit from this, you can have a 'my_attribute'
-attribute for all your fields. Or use a Moose role instead of inheritance.
+Now if your Field classes inherit from this, you can have a 'my_attribute'
+attribute for all your fields. Or use a Moose role instead of inheritance.
You can also add attributes to the base FormHandler field class using Moose.
This technique is described in L<HTML::FormHandler::Manual::Cookbook>.
-=head1 L<HTML::FormHandler> Validation
+=head1 L<HTML::FormHandler> Validation
Now we'll add more validation to ensure that users
-are entering correct data.
+are entering correct data.
Update the fields in the form file:
@@ -259,7 +266,7 @@ Update the fields in the form file:
required => 1 );
We've made all the fields required.
-We added 'size' and 'minlength' attributes to the 'title' field. These
+We added 'size' and 'minlength' attributes to the 'title' field. These
are attributes of the 'Text' Field, which will use them to validate.
We've added 'range_start' and 'range_end' attributes to the 'rating' field.
Numbers entered in the form will be checked to make sure they fall within
@@ -268,11 +275,11 @@ field type, which makes it easy to create a select list of numbers.)
=head2 Add customized validation
-Usually you would create a Field class for validation that will
+Usually you would create a Field class for validation that will
be performed on more than one field, but it is easy to perform
custom validation on a per-field basis.
-This form doesn't really require any customized validation,
+This form doesn't really require any customized validation,
so we'll add a silly field constraint. Add the following to the form:
sub validate_title {
@@ -283,11 +290,11 @@ so we'll add a silly field constraint. Add the following to the form:
You can also apply Moose constraints and transforms. Validation can also
be performed in a form 'validate_<field_name' method, in a 'validate_model'
-routine, and in a custom field class.
+routine, and in a custom field class.
You can validate that the field is unique, or use a dependency list to make
more fields required if one is updated.
-=head2 Check out the validation
+=head2 Check out the validation
Restart the development server, login, and try adding books with
various errors: title length less than 5 or more than 40, rating
@@ -300,19 +307,21 @@ You should get error messages for every error.
Although you can do database specific actions in a form class, you
should limit this to actions that won't be required for anything
-except for your HTML forms. Other actions should be done in your
+except for your HTML forms. Other actions should be done in your
L<DBIx::Class> classes. L<HTML::FormHandler::Model::DBIC> allows
the use of custom accessors, making it easier to keep the code
in the right place.
-=head1 AUTHORS
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
-Gerda Shank, gshank at cpan.org
+=head1 COPYRIGHT AND LICENSE
-=head1 COPYRIGHT
+This software is copyright (c) 2010 by Gerda Shank.
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+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
diff --git a/lib/HTML/FormHandler/Meta/Role.pm b/lib/HTML/FormHandler/Meta/Role.pm
index 99973a5..adca157 100644
--- a/lib/HTML/FormHandler/Meta/Role.pm
+++ b/lib/HTML/FormHandler/Meta/Role.pm
@@ -1,17 +1,9 @@
package # hide from Pause
HTML::FormHandler::Meta::Role;
+# ABSTRACT: field_list and apply_list
use Moose::Role;
-=head1 NAME
-
-HTML::FormHandler::Meta::Role
-
-=head1 SYNOPSIS
-
-Add metaclass to field_list attribute
-
-=cut
has 'field_list' => (
traits => ['Array'],
@@ -37,16 +29,34 @@ has 'apply_list' => (
}
);
+use namespace::autoclean;
+1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Meta::Role - field_list and apply_list
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 SYNOPSIS
+
+Add metaclass to field_list attribute
+
=head1 AUTHOR
-Gerda Shank, gshank at cpan.org
+FormHandler Contributors - see HTML::FormHandler
-=head1 COPYRIGHT
+=head1 COPYRIGHT AND LICENSE
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+This software is copyright (c) 2010 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
-use namespace::autoclean;
-1;
diff --git a/lib/HTML/FormHandler/Model.pm b/lib/HTML/FormHandler/Model.pm
index d61df0d..d4dcd6f 100644
--- a/lib/HTML/FormHandler/Model.pm
+++ b/lib/HTML/FormHandler/Model.pm
@@ -1,12 +1,70 @@
package HTML::FormHandler::Model;
+# ABSTRACT: default model base class
use Moose::Role;
use Carp;
+
+has 'item' => (
+ is => 'rw',
+ lazy => 1,
+ builder => 'build_item',
+ clearer => 'clear_item',
+ trigger => sub { shift->set_item(@_) }
+);
+sub build_item { return }
+
+sub set_item {
+ my ( $self, $item ) = @_;
+ $self->item_class( ref $item );
+}
+
+
+has 'item_id' => (
+ is => 'rw',
+ clearer => 'clear_item_id',
+ trigger => sub { shift->set_item_id(@_) }
+);
+
+sub set_item_id { }
+
+
+has 'item_class' => (
+ isa => 'Str',
+ is => 'rw',
+);
+
+
+sub guess_field_type {
+ Carp::confess "Don't know how to determine field type of [$_[1]]";
+}
+
+
+sub lookup_options { }
+
+
+sub validate_model { }
+
+
+sub clear_model { }
+
+
+sub update_model { }
+
+use namespace::autoclean;
+1;
+
+__END__
+=pod
+
=head1 NAME
HTML::FormHandler::Model - default model base class
+=head1 VERSION
+
+version 0.32002
+
=head1 SYNOPSIS
This class defines the base attributes for FormHandler model
@@ -35,38 +93,12 @@ For example, with Class::DBI you might return:
return $self->item_class->retrieve( $self->item_id );
-=cut
-
-has 'item' => (
- is => 'rw',
- lazy => 1,
- builder => 'build_item',
- clearer => 'clear_item',
- trigger => sub { shift->set_item(@_) }
-);
-sub build_item { return }
-
-sub set_item {
- my ( $self, $item ) = @_;
- $self->item_class( ref $item );
-}
-
=head2 item_id
The id (primary key) of the item (object) that the form is updating
or has just created. The model class should have a build_item method that can
fetch the object from the item_class for this id.
-=cut
-
-has 'item_id' => (
- is => 'rw',
- clearer => 'clear_item_id',
- trigger => sub { shift->set_item_id(@_) }
-);
-
-sub set_item_id { }
-
=head2 item_class
"item_class" sets and returns a value used by the model class to access
@@ -88,13 +120,6 @@ to access the data related to the form.
A builder for 'item_class' might be to return the class of the 'item'.
-=cut
-
-has 'item_class' => (
- isa => 'Str',
- is => 'rw',
-);
-
=head2 guess_field_type
Returns the guessed field type. The field name is passed as the first argument.
@@ -104,12 +129,6 @@ naming convention that indicates the field type.
The metadata info about the columns can be used to assign types.
-=cut
-
-sub guess_field_type {
- Carp::confess "Don't know how to determine field type of [$_[1]]";
-}
-
=head2 lookup_options
Retrieve possible options for a given select field from the database.
@@ -129,10 +148,6 @@ options are looked up:
The default for label_column is "name".
-=cut
-
-sub lookup_options { }
-
=head2 validate_model
Validates fields that are dependent on the model.
@@ -147,38 +162,24 @@ add_error method:
The default method does nothing.
-=cut
-
-sub validate_model { }
-
=head2 clear_model
Clear out any dynamic data for persistent object
-=cut
-
-sub clear_model { }
-
=head2 update_model
Update the model with validated fields
-=cut
-
-sub update_model { }
+=head1 AUTHOR
-=head1 AUTHORS
+FormHandler Contributors - see HTML::FormHandler
-HTML::FormHandler Contributors; see HTML::FormHandler
+=head1 COPYRIGHT AND LICENSE
-Initially based on the original source code of L<Form::Processor::Model> by Bill Moseley
+This software is copyright (c) 2010 by Gerda Shank.
-=head1 COPYRIGHT
-
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+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
-use namespace::autoclean;
-1;
diff --git a/lib/HTML/FormHandler/Model/CDBI.pm b/lib/HTML/FormHandler/Model/CDBI.pm
index 8ac3378..57e5713 100644
--- a/lib/HTML/FormHandler/Model/CDBI.pm
+++ b/lib/HTML/FormHandler/Model/CDBI.pm
@@ -1,5 +1,6 @@
package # hide from Pause
HTML::FormHandler::Model::CDBI;
+# ABSTRACT: Class::DBI model class (non-functioning)
use Moose;
use Carp;
@@ -8,61 +9,9 @@ extends 'HTML::FormHandler';
our $VERSION = '0.02';
-=head1 NAME
-
-HTML::FormHandler::Model::CDBI - Class::DBI model class for HTML::FormHandler
-
-=head1 SYNOPSIS
-
- package MyApplication::Form::User;
- use strict;
- use base 'HTML::FormHandler::Model::CDBI';
-
-
- # Associate this form with a CDBI class
- has '+item_class' => ( default => 'MyDB::User' );
-
- # Define the fields that this form will operate on
- sub field_list {
- return {
- [
- name => 'Text',
- age => 'PosInteger',
- sex => 'Select',
- birthdate => 'DateTimeDMYHM',
- ]
- };
- }
-
-=head1 DESCRIPTION
-
-A Class::DBI database model for HTML::FormHandler
-
-I don't use CDBI, so this module almost certainly doesn't work.
-It is only being left here as a starting point in case somebody is
-interested in getting it to work.
-
-Patches and tests gratefully accepted.
-
-
-=head1 METHODS
-
-=head2 item_class
-
-The name of your database class.
-
-=cut
HTML::FormHandler::Model::CDBI->meta->make_immutable;
-=head2 init_item
-
-This is called first time $form->item is called.
-It does the equivalent of:
-
- return $self->item_class->retrieve( $self->item_id );
-
-=cut
sub init_item {
my $self = shift;
@@ -76,22 +25,6 @@ sub BUILDARGS {
return {@args};
}
-=head2 guess_field_type
-
-Pass in a column and assigns field types.
-Must set $self->item_class to return the related item class.
-Returns the type in scalar context, returns the type and maybe the related table
-in list context.
-
-Currently returns:
-
- DateTime - for a has_a relationship that isa DateTime
- Select - for a has_a relationship
- Multiple - for a has_many
- DateTime - if the field ends in _time
- Text - otherwise
-
-=cut
sub guess_field_type {
my ( $self, $column, $class ) = @_;
@@ -133,34 +66,6 @@ sub guess_field_type {
return wantarray ? @return : $return[0];
}
-=head2 lookup_options
-
-Returns a array reference of key/value pairs for the column passed in.
-Calls $field->label_column to get the column name to use as the label.
-The default is "name". The labels are sorted by Perl's cmp sort.
-
-If there is an "active" column then only active are included, with the exception
-being 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;
-
-Which 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.
-
-In addition, if the foreign class is the same as the item's class (or the class returned
-by item_class) then options pointing to item are excluded. The reason for this is
-for a table column that points to the same table (self referenced), such as a "parent"
-column. The assumption is that a record cannot be its own parent.
-
-=cut
sub lookup_options {
my ( $self, $field ) = @_;
@@ -213,12 +118,6 @@ sub lookup_options {
}
-=head2 init_value
-
-Populate $field->value with object ids from the CDBI object. If the column
-expands to more than one object then an array ref is set.
-
-=cut
sub init_value {
my ( $self, $field, $item ) = @_;
@@ -248,15 +147,6 @@ sub init_value {
$field->value($value);
}
-=head2 validate_model
-
-Validates fields that are dependent on the model.
-Currently, "unique" fields are checked to make sure they are unique.
-
-This validation happens after other form validation. The form already has any
-field values entered in $field->value at this point.
-
-=cut
sub validate_model {
my ($self) = @_;
@@ -265,11 +155,6 @@ sub validate_model {
return 1;
}
-=head2 validate_unique
-
-Checks that the value for the field is not currently in the database.
-
-=cut
sub validate_unique {
my ($self) = @_;
@@ -377,12 +262,6 @@ sub update_model {
return $item;
}
-=head2 items_same
-
-Returns true if the two passed in cdbi objects are the same object.
-If both are undefined returns true.
-
-=cut
sub items_same {
my ( $self, $item1, $item2 ) = @_;
@@ -394,11 +273,6 @@ sub items_same {
return $self->obj_key($item1) eq $self->obj_key($item2);
}
-=head2 obj_key
-
-returns a key for a given object, or undef if the object is undefined.
-
-=cut
sub obj_key {
my ( $self, $item ) = @_;
@@ -406,19 +280,144 @@ sub obj_key {
map { $_ . '=' . ( $item->$_ || '.' ) } $item->primary_columns;
}
+__PACKAGE__->meta->make_immutable;
+no Moose;
+1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Model::CDBI - Class::DBI model class (non-functioning)
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 SYNOPSIS
+
+ package MyApplication::Form::User;
+ use strict;
+ use base 'HTML::FormHandler::Model::CDBI';
+
+
+ # Associate this form with a CDBI class
+ has '+item_class' => ( default => 'MyDB::User' );
+
+ # Define the fields that this form will operate on
+ sub field_list {
+ return {
+ [
+ name => 'Text',
+ age => 'PosInteger',
+ sex => 'Select',
+ birthdate => 'DateTimeDMYHM',
+ ]
+ };
+ }
+
+=head1 DESCRIPTION
+
+A Class::DBI database model for HTML::FormHandler
+
+I don't use CDBI, so this module almost certainly doesn't work.
+It is only being left here as a starting point in case somebody is
+interested in getting it to work.
+
+Patches and tests gratefully accepted.
+
+=head1 METHODS
+
+=head2 item_class
+
+The name of your database class.
+
+=head2 init_item
+
+This is called first time $form->item is called.
+It does the equivalent of:
+
+ return $self->item_class->retrieve( $self->item_id );
+
+=head2 guess_field_type
+
+Pass in a column and assigns field types.
+Must set $self->item_class to return the related item class.
+Returns the type in scalar context, returns the type and maybe the related table
+in list context.
+
+Currently returns:
+
+ DateTime - for a has_a relationship that isa DateTime
+ Select - for a has_a relationship
+ Multiple - for a has_many
+ DateTime - if the field ends in _time
+ Text - otherwise
+
+=head2 lookup_options
+
+Returns a array reference of key/value pairs for the column passed in.
+Calls $field->label_column to get the column name to use as the label.
+The default is "name". The labels are sorted by Perl's cmp sort.
+
+If there is an "active" column then only active are included, with the exception
+being 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;
+
+Which 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.
+
+In addition, if the foreign class is the same as the item's class (or the class returned
+by item_class) then options pointing to item are excluded. The reason for this is
+for a table column that points to the same table (self referenced), such as a "parent"
+column. The assumption is that a record cannot be its own parent.
+
+=head2 init_value
+
+Populate $field->value with object ids from the CDBI object. If the column
+expands to more than one object then an array ref is set.
+
+=head2 validate_model
+
+Validates fields that are dependent on the model.
+Currently, "unique" fields are checked to make sure they are unique.
+
+This validation happens after other form validation. The form already has any
+field values entered in $field->value at this point.
+
+=head2 validate_unique
+
+Checks that the value for the field is not currently in the database.
+
+=head2 items_same
+
+Returns true if the two passed in cdbi objects are the same object.
+If both are undefined returns true.
+
+=head2 obj_key
+
+returns a key for a given object, or undef if the object is undefined.
+
=head1 AUTHOR
-Gerda Shank, gshank at cpan.org
+FormHandler Contributors - see HTML::FormHandler
-Based on the original source code of L<Form::Processor::Model::CDBI> by Bill Moseley
+=head1 COPYRIGHT AND LICENSE
-=head1 COPYRIGHT
+This software is copyright (c) 2010 by Gerda Shank.
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+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
-__PACKAGE__->meta->make_immutable;
-no Moose;
-1;
diff --git a/lib/HTML/FormHandler/Model/Object.pm b/lib/HTML/FormHandler/Model/Object.pm
index 5cbd352..e59425c 100644
--- a/lib/HTML/FormHandler/Model/Object.pm
+++ b/lib/HTML/FormHandler/Model/Object.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Model::Object;
+# ABSTRACT: stub for Object model
use Moose::Role;
@@ -16,3 +17,28 @@ sub update_model {
use namespace::autoclean;
1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Model::Object - stub for Object model
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/Moose.pm b/lib/HTML/FormHandler/Moose.pm
index 7033621..6da02f1 100644
--- a/lib/HTML/FormHandler/Moose.pm
+++ b/lib/HTML/FormHandler/Moose.pm
@@ -1,30 +1,12 @@
package HTML::FormHandler::Moose;
+# ABSTRACT: to add FormHandler sugar
use Moose;
use Moose::Exporter;
use Moose::Util::MetaRole;
use HTML::FormHandler::Meta::Role;
+use constant HAS_MOOSE_V109_METAROLE => ($Moose::VERSION >= 1.09);
-=head1 NAME
-
-HTML::FormHandler::Moose - to add FormHandler sugar
-
-=head1 SYNOPSIS
-
-Enables the use of field specification sugar (has_field).
-Use this module instead of C< use Moose; >
-
- package MyApp::Form::Foo;
- use HTML::FormHandler::Moose;
- extends 'HTML::FormHandler';
-
- has_field 'username' => ( type => 'Text', ... );
- has_field 'something_else' => ( ... );
-
- no HTML::FormHandler::Moose;
- 1;
-
-=cut
Moose::Exporter->setup_import_methods(
with_meta => [ 'has_field', 'apply' ],
@@ -36,10 +18,20 @@ sub init_meta {
my %options = @_;
Moose->init_meta(%options);
- my $meta = Moose::Util::MetaRole::apply_metaclass_roles(
- for_class => $options{for_class},
- metaclass_roles => ['HTML::FormHandler::Meta::Role'],
- );
+ my $meta;
+ if (HAS_MOOSE_V109_METAROLE) {
+ $meta = Moose::Util::MetaRole::apply_metaroles(
+ for => $options{for_class},
+ class_metaroles => {
+ class => [ 'HTML::FormHandler::Meta::Role' ]
+ }
+ );
+ } else {
+ $meta = Moose::Util::MetaRole::apply_metaclass_roles(
+ for_class => $options{for_class},
+ metaclass_roles => ['HTML::FormHandler::Meta::Role'],
+ );
+ }
return $meta;
}
@@ -56,16 +48,45 @@ sub apply {
$meta->add_to_apply_list( @{$arrayref} );
}
+use namespace::autoclean;
+1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Moose - to add FormHandler sugar
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 SYNOPSIS
+
+Enables the use of field specification sugar (has_field).
+Use this module instead of C< use Moose; >
+
+ package MyApp::Form::Foo;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has_field 'username' => ( type => 'Text', ... );
+ has_field 'something_else' => ( ... );
+
+ no HTML::FormHandler::Moose;
+ 1;
+
=head1 AUTHOR
-HTML::FormHandler Contributors; see HTML::FormHandler
+FormHandler Contributors - see HTML::FormHandler
-=head1 COPYRIGHT
+=head1 COPYRIGHT AND LICENSE
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+This software is copyright (c) 2010 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
-use namespace::autoclean;
-1;
diff --git a/lib/HTML/FormHandler/Moose/Role.pm b/lib/HTML/FormHandler/Moose/Role.pm
index 28c907a..da45c57 100644
--- a/lib/HTML/FormHandler/Moose/Role.pm
+++ b/lib/HTML/FormHandler/Moose/Role.pm
@@ -1,27 +1,10 @@
package HTML::FormHandler::Moose::Role;
+# ABSTRACT: to add sugar to roles
use Moose::Role;
use Moose::Exporter;
+use constant HAS_MOOSE_V109_METAROLE => ($Moose::VERSION >= 1.09);
-=head1 NAME
-
-HTML::FormHandler::Moose::Role - to add FormHandler sugar to Roles
-
-=head1 SYNOPSIS
-
-Enables the use of field specification sugar (has_field) in roles.
-Use this module instead of C< use Moose::Role; >
-
- package MyApp::Form::Foo;
- use HTML::FormHandler::Moose::Role;
-
- has_field 'username' => ( type => 'Text', ... );
- has_field 'something_else' => ( ... );
-
- no HTML::FormHandler::Moose::Role;
- 1;
-
-=cut
Moose::Exporter->setup_import_methods(
with_caller => [ 'has_field', 'apply' ],
@@ -33,10 +16,21 @@ sub init_meta {
my %options = @_;
Moose::Role->init_meta(%options);
- my $meta = Moose::Util::MetaRole::apply_metaclass_roles(
- for_class => $options{for_class},
- metaclass_roles => ['HTML::FormHandler::Meta::Role'],
- );
+ my $meta;
+ if (HAS_MOOSE_V109_METAROLE) {
+ $meta = Moose::Util::MetaRole::apply_metaroles(
+ for => $options{for_class},
+ role_metaroles => {
+ role => [ 'HTML::FormHandler::Meta::Role' ]
+ }
+ );
+ } else {
+ $meta = Moose::Util::MetaRole::apply_metaclass_roles(
+ for_class => $options{for_class},
+ metaclass_roles => ['HTML::FormHandler::Meta::Role'],
+ );
+ }
+
return $meta;
}
@@ -51,16 +45,44 @@ sub apply {
$class->meta->add_to_apply_list( @{$arrayref} );
}
+use namespace::autoclean;
+1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Moose::Role - to add sugar to roles
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 SYNOPSIS
+
+Enables the use of field specification sugar (has_field) in roles.
+Use this module instead of C< use Moose::Role; >
+
+ package MyApp::Form::Foo;
+ use HTML::FormHandler::Moose::Role;
+
+ has_field 'username' => ( type => 'Text', ... );
+ has_field 'something_else' => ( ... );
+
+ no HTML::FormHandler::Moose::Role;
+ 1;
+
=head1 AUTHOR
-Gerda Shank, gshank at cpan.org
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
-=head1 COPYRIGHT
+This software is copyright (c) 2010 by Gerda Shank.
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+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
-use namespace::autoclean;
-1;
diff --git a/lib/HTML/FormHandler/Params.pm b/lib/HTML/FormHandler/Params.pm
index 84eb6ca..39ec5c2 100644
--- a/lib/HTML/FormHandler/Params.pm
+++ b/lib/HTML/FormHandler/Params.pm
@@ -1,5 +1,6 @@
package # hide from Pause
HTML::FormHandler::Params;
+# ABSTRACT: params handling
use Moose;
use Carp;
@@ -123,3 +124,28 @@ sub _collapse_hash {
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Params - params handling
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/Render/Simple.pm b/lib/HTML/FormHandler/Render/Simple.pm
index 96bb5a7..b870bb4 100644
--- a/lib/HTML/FormHandler/Render/Simple.pm
+++ b/lib/HTML/FormHandler/Render/Simple.pm
@@ -1,126 +1,18 @@
package HTML::FormHandler::Render::Simple;
+# ABSTRACT: simple rendering role
use Moose::Role;
requires( 'sorted_fields', 'field' );
+with 'HTML::FormHandler::Widget::Form::Role::HTMLAttributes';
our $VERSION = 0.01;
-=head1 NAME
-
-HTML::FormHandler::Render::Simple - Simple rendering routine
-
-=head1 SYNOPSIS
-
-This is a Moose role that is an example of a very simple rendering
-routine for L<HTML::FormHandler>. It has almost no features, but can
-be used as an example for producing something more complex.
-The idea is to produce your own custom rendering roles...
-
-You are advised to create a copy of this module for use in your
-forms, since it is not possible to make improvements to this module
-and maintain backwards compatibility.
-
-In your Form class:
-
- package MyApp::Form::Silly;
- use Moose;
- extends 'HTML::FormHandler::Model::DBIC';
- with 'HTML::FormHandler::Render::Simple';
-
-In a template:
-
- [% form.render %]
-
-or for individual fields:
-
- [% form.render_field( 'title' ) %]
-
-=head1 DESCRIPTION
-
-This role provides HTML output routines for the 'widget' types
-defined in the provided FormHandler fields. Each 'widget' name
-has a 'widget_$name' method here.
-
-These widget routines output strings with HTML suitable for displaying
-form fields.
-
-The widget for a particular field can be defined in the form. You can
-create additional widget routines in your form for custom widgets.
-
-The fill-in-form values ('fif') are cleaned with the 'render_filter'
-method of the base field class. You can change the filter to suit
-your own needs: see L<HTML::FormHandler::Manual::Rendering>
-
-=cut
-
-=head2 render
-
-To render all the fields in a form in sorted order (using
-'sorted_fields' method).
-
-=head2 render_start, render_end
-
-Will render the beginning and ending <form> tags and fieldsets. Allows for easy
-splitting up of the form if you want to hand-render some of the fields.
-
- [% form.render_start %]
- [% form.render_field('title') %]
- <insert specially rendered field>
- [% form.render_field('some_field') %]
- [% form.render_end %]
-
-=head2 render_field
-
-Render a field passing in a field object or a field name
-
- $form->render_field( $field )
- $form->render_field( 'title' )
-
-=head2 render_text
-
-Output an HTML string for a text widget
-
-=head2 render_password
-
-Output an HTML string for a password widget
-
-=head2 render_hidden
-
-Output an HTML string for a hidden input widget
-
-=head2 render_select
-
-Output an HTML string for a 'select' widget, single or multiple
-
-=head2 render_checkbox
-
-Output an HTML string for a 'checkbox' widget
-
-=head2 render_radio_group
-
-Output an HTML string for a 'radio_group' selection widget.
-This widget should be for a field that inherits from 'Select',
-since it requires the existance of an 'options' array.
-
-=head2 render_textarea
-
-Output an HTML string for a textarea widget
-
-=head2 render_compound
-
-Renders field with 'compound' widget
-
-=head2 render_submit
-
-Renders field with 'submit' widget
-
-=cut
has 'auto_fieldset' => ( isa => 'Bool', is => 'rw', default => 1 );
has 'label_types' => (
- traits => ['Hash'],
+ traits => ['Hash'],
isa => 'HashRef[Str]',
is => 'rw',
default => sub {
@@ -152,14 +44,13 @@ sub render {
sub render_start {
my $self = shift;
- my $output = '<form ';
- $output .= 'action="' . $self->action . '" ' if $self->action;
- $output .= 'id="' . $self->name . '" ' if $self->name;
- $output .= 'method="' . $self->http_method . '" ' if $self->http_method;
- $output .= 'enctype="' . $self->enctype . '" ' if $self->enctype;
- $output .= '>' . "\n";
- $output .= '<fieldset class="main_fieldset">' if $self->auto_fieldset;
- return $output;
+
+ my $output = $self->html_form_tag;
+
+ $output .= '<fieldset class="main_fieldset">'
+ if $self->form->auto_fieldset;
+
+ return $output
}
sub render_end {
@@ -276,7 +167,7 @@ sub render_select {
$output .= '>';
my $index = 0;
if( $field->empty_select ) {
- $output .= '<option value="">' . $field->_localize($field->empty_select) . '</option>';
+ $output .= '<option value="">' . $field->_localize($field->empty_select) . '</option>';
}
foreach my $option ( @{ $field->options } ) {
$output .= '<option value="' . $field->html_filter($option->{value}) . '" ';
@@ -368,7 +259,7 @@ sub render_upload {
sub _label {
my ( $self, $field ) = @_;
- return '<label class="label" for="' . $field->id . '">' .
+ return '<label class="label" for="' . $field->id . '">' .
$field->html_filter($field->loc_label)
. ': </label>';
}
@@ -419,17 +310,134 @@ sub _add_html_attributes {
return $output;
}
-=head1 AUTHORS
+use namespace::autoclean;
+1;
+
-See CONTRIBUTORS in L<HTML::FormHandler>
+__END__
+=pod
-=head1 COPYRIGHT
+=head1 NAME
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+HTML::FormHandler::Render::Simple - simple rendering role
-=cut
+=head1 VERSION
-use namespace::autoclean;
-1;
+version 0.32002
+
+=head1 SYNOPSIS
+
+This is a Moose role that is an example of a very simple rendering
+routine for L<HTML::FormHandler>. It has almost no features, but can
+be used as an example for producing something more complex.
+The idea is to produce your own custom rendering roles...
+
+You are advised to create a copy of this module for use in your
+forms, since it is not possible to make improvements to this module
+and maintain backwards compatibility.
+
+In your Form class:
+
+ package MyApp::Form::Silly;
+ use Moose;
+ extends 'HTML::FormHandler::Model::DBIC';
+ with 'HTML::FormHandler::Render::Simple';
+
+In a template:
+
+ [% form.render %]
+
+or for individual fields:
+
+ [% form.render_field( 'title' ) %]
+
+=head1 DESCRIPTION
+
+This role provides HTML output routines for the 'widget' types
+defined in the provided FormHandler fields. Each 'widget' name
+has a 'widget_$name' method here.
+
+These widget routines output strings with HTML suitable for displaying
+form fields.
+
+The widget for a particular field can be defined in the form. You can
+create additional widget routines in your form for custom widgets.
+
+The fill-in-form values ('fif') are cleaned with the 'render_filter'
+method of the base field class. You can change the filter to suit
+your own needs: see L<HTML::FormHandler::Manual::Rendering>
+
+=head2 render
+
+To render all the fields in a form in sorted order (using
+'sorted_fields' method).
+
+=head2 render_start, render_end
+
+Will render the beginning and ending <form> tags and fieldsets. Allows for easy
+splitting up of the form if you want to hand-render some of the fields.
+
+ [% form.render_start %]
+ [% form.render_field('title') %]
+ <insert specially rendered field>
+ [% form.render_field('some_field') %]
+ [% form.render_end %]
+
+=head2 render_field
+
+Render a field passing in a field object or a field name
+
+ $form->render_field( $field )
+ $form->render_field( 'title' )
+
+=head2 render_text
+
+Output an HTML string for a text widget
+
+=head2 render_password
+
+Output an HTML string for a password widget
+
+=head2 render_hidden
+
+Output an HTML string for a hidden input widget
+
+=head2 render_select
+
+Output an HTML string for a 'select' widget, single or multiple
+
+=head2 render_checkbox
+
+Output an HTML string for a 'checkbox' widget
+
+=head2 render_radio_group
+
+Output an HTML string for a 'radio_group' selection widget.
+This widget should be for a field that inherits from 'Select',
+since it requires the existance of an 'options' array.
+
+=head2 render_textarea
+
+Output an HTML string for a textarea widget
+
+=head2 render_compound
+
+Renders field with 'compound' widget
+
+=head2 render_submit
+
+Renders field with 'submit' widget
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
diff --git a/lib/HTML/FormHandler/Render/Table.pm b/lib/HTML/FormHandler/Render/Table.pm
index c3d4779..432b229 100644
--- a/lib/HTML/FormHandler/Render/Table.pm
+++ b/lib/HTML/FormHandler/Render/Table.pm
@@ -1,27 +1,11 @@
package HTML::FormHandler::Render::Table;
+# ABSTRACT: render a form with a table layout
use Moose::Role;
with 'HTML::FormHandler::Render::Simple' =>
{ excludes => [ 'render', 'render_field_struct', 'render_end', 'render_start' ] };
-=head1 NAME
-
-HTML::FormHandler::Render::Table - render a form with a table layout
-
-=head1 SYNOPSIS
-
-Include this role in a form:
-
- package MyApp::Form::User;
- use Moose;
- with 'HTML::FormHandler::Render::Table';
-
-Use in a template:
-
- [% form.render %]
-
-=cut
sub render {
my $self = shift;
@@ -36,15 +20,8 @@ sub render {
sub render_start {
my $self = shift;
- my $output = '<form ';
- $output .= 'action="' . $self->action . '" ' if $self->action;
- $output .= 'id="' . $self->name . '" ' if $self->name;
- $output .= 'name="' . $self->name . '" ' if $self->name;
- $output .= 'method="' . $self->http_method . '" ' if $self->http_method;
- $output .= 'enctype="' . $self->enctype . '" ' if $self->enctype;
- $output .= '>' . "\n";
- $output .= "<table>\n";
- return $output;
+
+ return $self->html_form_tag . "<table>\n";
}
sub render_end {
@@ -78,17 +55,43 @@ sub render_field_struct {
return $output;
}
-=head1 AUTHORS
+use namespace::autoclean;
+1;
-HFH Contributors, see L<HTML::FormHandler>
-=head1 COPYRIGHT
+__END__
+=pod
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+=head1 NAME
-=cut
+HTML::FormHandler::Render::Table - render a form with a table layout
-use namespace::autoclean;
-1;
+=head1 VERSION
+
+version 0.32002
+
+=head1 SYNOPSIS
+
+Include this role in a form:
+
+ package MyApp::Form::User;
+ use Moose;
+ with 'HTML::FormHandler::Render::Table';
+
+Use in a template:
+
+ [% form.render %]
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
diff --git a/lib/HTML/FormHandler/Render/WithTT.pm b/lib/HTML/FormHandler/Render/WithTT.pm
index 471ceb7..7179888 100644
--- a/lib/HTML/FormHandler/Render/WithTT.pm
+++ b/lib/HTML/FormHandler/Render/WithTT.pm
@@ -1,51 +1,20 @@
package HTML::FormHandler::Render::WithTT;
+# ABSTRACT: tt rendering
use Moose::Role;
use File::ShareDir;
use Template;
-use namespace::autoclean;
+use namespace::autoclean;
requires 'form';
-=head1 NAME
-
-HTML::FormHandler::Render::WithTT
-
-=head1 SYNOPSIS
-
-Warning: this feature is not quite ready for prime time. It has not
-been well tested and the template widgets aren't complete. Contributions
-welcome.
-
-A rendering role for HTML::FormHandler that allows rendering using
-Template::Toolkit
-
- package MyApp::Form;
- use HTML::FormHandler::Moose;
- extends 'HTML::FormHandler';
- with 'HTML::FormHandler::Render::WithTT';
-
- sub build_tt_template { 'user_form.tt' }
- sub build_tt_include_path { 'root/templates' }
- ....< define form >....
-
- my $form = MyApp::Form->new(
- $form->tt_render;
-
-
-=head1 DESCRIPTION
-
-Uses 'tt_render' instead of 'render' to allow using both TT templates and the
-built-in rendering.
-
-=cut
has 'tt_include_path' => (
traits => ['Array'],
is => 'rw',
isa => 'ArrayRef',
lazy => 1,
- builder => 'build_tt_include_path',
+ builder => 'build_tt_include_path',
);
sub build_tt_include_path {[]}
@@ -55,18 +24,18 @@ has 'tt_config' => (
lazy => 1,
builder => 'build_tt_config',
);
-sub build_tt_config {
+sub build_tt_config {
my $self = shift;
return {
- INCLUDE_PATH => [
+ INCLUDE_PATH => [
@{ $self->tt_include_path },
- File::ShareDir::dist_dir('HTML-FormHandler') . '/templates/'
+ File::ShareDir::dist_dir('HTML-FormHandler') . '/templates/'
]
};
}
# either file name string or string ref?
-has 'tt_template' => ( is => 'rw', isa => 'Str', lazy => 1,
+has 'tt_template' => ( is => 'rw', isa => 'Str', lazy => 1,
builder => 'build_tt_template' );
sub build_tt_template { 'form.tt' }
@@ -91,7 +60,7 @@ sub build_default_tt_vars {
return { form => $self->form };
}
-has 'tt_default_options' => (
+has 'tt_default_options' => (
traits => ['Hash'],
is => 'rw',
isa => 'HashRef',
@@ -112,3 +81,54 @@ sub tt_render {
1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Render::WithTT - tt rendering
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 SYNOPSIS
+
+Warning: this feature is not quite ready for prime time. It has not
+been well tested and the template widgets aren't complete. Contributions
+welcome.
+
+A rendering role for HTML::FormHandler that allows rendering using
+Template::Toolkit
+
+ package MyApp::Form;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+ with 'HTML::FormHandler::Render::WithTT';
+
+ sub build_tt_template { 'user_form.tt' }
+ sub build_tt_include_path { 'root/templates' }
+ ....< define form >....
+
+ my $form = MyApp::Form->new(
+ $form->tt_render;
+
+=head1 DESCRIPTION
+
+Uses 'tt_render' instead of 'render' to allow using both TT templates and the
+built-in rendering.
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/Result.pm b/lib/HTML/FormHandler/Result.pm
index f816871..bfa4cea 100644
--- a/lib/HTML/FormHandler/Result.pm
+++ b/lib/HTML/FormHandler/Result.pm
@@ -1,53 +1,10 @@
package HTML::FormHandler::Result;
+# ABSTRACT: form result object
use Moose;
with 'HTML::FormHandler::Result::Role';
with 'MooseX::Traits';
-=head1 NAME
-
-HTML::FormHandler::Result
-
-=head1 SYNOPSIS
-
-This is the Result object that maps to the Form.
-
- my $result = $self->form->run( $params );
- my $result2 = $self->form->run( $other_params );
-
- my $value = $result->field('title')->value;
- my $fif = $result->fif;
- my $field_fid = $result->field('title')->fif;
-
-=head2 DESCRIPTION
-
-This is currently experimental. Interfaces and interface names may change.
-
-The original FormHandler 'process' method, when used with persistent forms,
-leaves behind state data for a particular execution of 'process'. This is
-not optimal or clean from an architectural point of view.
-The intention with the 'result' object is to separate dynamic data from static.
-The 'form' object is treated as a kind of result factory, which will spit out
-results and leave the form in a consistent state.
-
-In the current state of implementation, the result object can be used to render
-a form:
-
- $result->render;
-
-However there are still open questions about how much of the form/field
-should be forwarded to the result. At this point, the number of forwarded
-methods is minimal. Mechanisms to make this more customizable are being
-considered.
-
-Dynamic select lists are not supported yet. Static select lists
-(that are the same for every form execution) should work fine, but lists
-that are different depending on some field value will not.
-
-Most of this object is implemented in L<HTML::FormHandler::Role::Result>,
-because it is shared with L<HTML::FormHandler::Field::Result>.
-
-=cut
has 'form' => (
isa => 'HTML::FormHandler',
@@ -89,17 +46,70 @@ sub peek {
return $string;
}
-=head1 AUTHORS
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Result - form result object
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 SYNOPSIS
+
+This is the Result object that maps to the Form.
+
+ my $result = $self->form->run( $params );
+ my $result2 = $self->form->run( $other_params );
+
+ my $value = $result->field('title')->value;
+ my $fif = $result->fif;
+ my $field_fid = $result->field('title')->fif;
+
+=head2 DESCRIPTION
+
+This is currently experimental. Interfaces and interface names may change.
+
+The original FormHandler 'process' method, when used with persistent forms,
+leaves behind state data for a particular execution of 'process'. This is
+not optimal or clean from an architectural point of view.
+The intention with the 'result' object is to separate dynamic data from static.
+The 'form' object is treated as a kind of result factory, which will spit out
+results and leave the form in a consistent state.
+
+In the current state of implementation, the result object can be used to render
+a form:
-HTML::FormHandler Contributors; see HTML::FormHandler
+ $result->render;
-=head1 COPYRIGHT
+However there are still open questions about how much of the form/field
+should be forwarded to the result. At this point, the number of forwarded
+methods is minimal. Mechanisms to make this more customizable are being
+considered.
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+Dynamic select lists are not supported yet. Static select lists
+(that are the same for every form execution) should work fine, but lists
+that are different depending on some field value will not.
+
+Most of this object is implemented in L<HTML::FormHandler::Role::Result>,
+because it is shared with L<HTML::FormHandler::Field::Result>.
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
-__PACKAGE__->meta->make_immutable;
-use namespace::autoclean;
-1;
diff --git a/lib/HTML/FormHandler/Result/Role.pm b/lib/HTML/FormHandler/Result/Role.pm
index e07d47e..2e2552a 100644
--- a/lib/HTML/FormHandler/Result/Role.pm
+++ b/lib/HTML/FormHandler/Result/Role.pm
@@ -1,17 +1,8 @@
package HTML::FormHandler::Result::Role;
+# ABSTRACT: role with common code for form & field results
use Moose::Role;
-=head1 NAME
-
-HTML::FormHandler::Role::Result
-
-=head1 SYNOPSIS
-
-Role to hold common result attributes for L<HTML::FormHandler::Result>
-and L<HTML::FormHandler::Result::Field>.
-
-=cut
has 'name' => ( isa => 'Str', is => 'rw', required => 1 );
@@ -38,7 +29,7 @@ has '_results' => (
is => 'rw',
default => sub { [] },
handles => {
- results => 'elements',
+ results => 'elements',
add_result => 'push',
num_results => 'count',
has_results => 'count',
@@ -101,16 +92,39 @@ sub field {
die "Field '$name' not found in '$self'";
}
-=head1 AUTHORS
+use namespace::autoclean;
+1;
-HTML::FormHandler Contributors; see HTML::FormHandler
+__END__
+=pod
-=head1 COPYRIGHT
+=head1 NAME
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+HTML::FormHandler::Result::Role - role with common code for form & field results
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 SYNOPSIS
+
+Role to hold common result attributes for L<HTML::FormHandler::Result>
+and L<HTML::FormHandler::Result::Field>.
+
+=head1 NAME
+
+HTML::FormHandler::Result::Role - common code for form & field results
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
-use namespace::autoclean;
-1;
diff --git a/lib/HTML/FormHandler/TraitFor/Captcha.pm b/lib/HTML/FormHandler/TraitFor/Captcha.pm
index 7f2a4a3..fcb858f 100644
--- a/lib/HTML/FormHandler/TraitFor/Captcha.pm
+++ b/lib/HTML/FormHandler/TraitFor/Captcha.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::TraitFor::Captcha;
+# ABSTRACT: generate and validate captchas
use HTML::FormHandler::Moose::Role;
use GD::SecurityImage;
@@ -8,10 +9,50 @@ requires('ctx');
has_field 'captcha' => ( type => 'Captcha', label => 'Verification' );
+
+sub get_captcha {
+ my $self = shift;
+ return unless $self->ctx;
+ my $captcha = $self->ctx->{session}->{captcha};
+ return $captcha;
+}
+
+
+sub set_captcha {
+ my ( $self, $captcha ) = @_;
+ return unless $self->ctx;
+ $self->ctx->{session}->{captcha} = $captcha;
+}
+
+sub render_captcha {
+ my ( $self, $field ) = @_;
+
+ my $output = $self->_label($field);
+ $output .= '<img src="' . $self->captcha_image_url . '"/>';
+ $output .= '<input id="' . $field->id . '" name="';
+ $output .= $field->name . '">';
+ return $output;
+}
+
+sub captcha_image_url {
+ my $self = shift;
+ return '/captcha/test';
+}
+
+use namespace::autoclean;
+1;
+
+__END__
+=pod
+
=head1 NAME
HTML::FormHandler::TraitFor::Captcha - generate and validate captchas
+=head1 VERSION
+
+version 0.32002
+
=head1 SYNOPSIS
A role to use in a form to implement a captcha field.
@@ -35,41 +76,20 @@ session plugin.
Get a captcha stored in C<< $form->ctx->{session} >>
-=cut
-
-sub get_captcha {
- my $self = shift;
- return unless $self->ctx;
- my $captcha = $self->ctx->{session}->{captcha};
- return $captcha;
-}
-
=head1 set_captcha
Set a captcha in C<< $self->ctx->{session} >>
-=cut
+=head1 AUTHOR
-sub set_captcha {
- my ( $self, $captcha ) = @_;
- return unless $self->ctx;
- $self->ctx->{session}->{captcha} = $captcha;
-}
+FormHandler Contributors - see HTML::FormHandler
-sub render_captcha {
- my ( $self, $field ) = @_;
+=head1 COPYRIGHT AND LICENSE
- my $output = $self->_label($field);
- $output .= '<img src="' . $self->captcha_image_url . '"/>';
- $output .= '<input id="' . $field->id . '" name="';
- $output .= $field->name . '">';
- return $output;
-}
+This software is copyright (c) 2010 by Gerda Shank.
-sub captcha_image_url {
- my $self = shift;
- return '/captcha/test';
-}
+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
-use namespace::autoclean;
-1;
diff --git a/lib/HTML/FormHandler/TraitFor/I18N.pm b/lib/HTML/FormHandler/TraitFor/I18N.pm
index 718bd88..7b1a365 100644
--- a/lib/HTML/FormHandler/TraitFor/I18N.pm
+++ b/lib/HTML/FormHandler/TraitFor/I18N.pm
@@ -1,9 +1,49 @@
package HTML::FormHandler::TraitFor::I18N;
+# ABSTRACT: localization
use HTML::FormHandler::I18N;
use Moose::Role;
use Moose::Util::TypeConstraints;
+
+has 'language_handle' => (
+ isa => duck_type( [ qw(maketext) ] ),
+ is => 'rw',
+ lazy_build => 1,
+ required => 1,
+);
+
+sub _build_language_handle {
+ my ($self) = @_;
+
+ if (!$self->isa('HTML::FormHandler') && $self->has_form) {
+ return $self->form->language_handle();
+ }
+ return $ENV{LANGUAGE_HANDLE} || HTML::FormHandler::I18N->get_handle;
+}
+
+sub _localize {
+ my ($self, @message) = @_;
+ my $message = $self->language_handle->maketext(@message);
+ return $message;
+}
+
+no Moose::Role;
+no Moose::Util::TypeConstraints;
+
+1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::TraitFor::I18N - localization
+
+=head1 VERSION
+
+version 0.32002
+
=head3 language_handle, _build_language_handle
Holds a Locale::Maketext (or other duck_type class with a 'maketext'
@@ -34,31 +74,16 @@ You can use non-Locale::Maketext language handles, such as L<Data::Localize>.
There's an example of building a L<Data::Localize> language handle
in t/xt/locale_data_localize.t in the distribution.
-=cut
+=head1 AUTHOR
-has 'language_handle' => (
- isa => duck_type( [ qw(maketext) ] ),
- is => 'rw',
- lazy_build => 1,
- required => 1,
-);
+FormHandler Contributors - see HTML::FormHandler
-sub _build_language_handle {
- my ($self) = @_;
+=head1 COPYRIGHT AND LICENSE
- if (!$self->isa('HTML::FormHandler') && $self->has_form) {
- return $self->form->language_handle();
- }
- return $ENV{LANGUAGE_HANDLE} || HTML::FormHandler::I18N->get_handle;
-}
+This software is copyright (c) 2010 by Gerda Shank.
-sub _localize {
- my ($self, @message) = @_;
- my $message = $self->language_handle->maketext(@message);
- return $message;
-}
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
-no Moose::Role;
-no Moose::Util::TypeConstraints;
+=cut
-1;
diff --git a/lib/HTML/FormHandler/Types.pm b/lib/HTML/FormHandler/Types.pm
index 966e359..1c01caf 100644
--- a/lib/HTML/FormHandler/Types.pm
+++ b/lib/HTML/FormHandler/Types.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Types;
+# ABSTRACT: Moose type constraints
use strict;
use warnings;
@@ -16,112 +17,6 @@ use MooseX::Types -declare => [
use MooseX::Types::Moose ( 'Str', 'Num', 'Int' );
-=head1 NAME
-
-HTML::FormHandler::Types
-
-=head1 SYNOPSIS
-
-These types are provided by MooseX::Types. These types must not be quoted
-when they are used:
-
- has 'posint' => ( is => 'rw', isa => PositiveInt);
- has_field 'email' => ( apply => [ Email ] );
-
-Types declared using Moose::Util::TypeConstraints, on the other hand,
-must be quoted:
-
- has_field 'text_both' => ( apply => [ PositiveInt, 'GreaterThan10' ] );
-
-To import these types into your forms, you must either specify (':all')
-or list the types you want to use:
-
- use HTML::FormHandler::Types (':all');
-
-or:
-
- use HTML::FormHandler::Types ('Email', 'PositiveInt');
-
-=head1 DESCRIPTION
-
-
-It would be possible to import the MooseX types (Common, etc), but for now
-we'll just re-implement them here in order to be able to change the
-messages and keep control of what types we provide.
-
-From MooseX::Types::Common:
-
- 'PositiveNum', 'PositiveInt', 'NegativeNum', 'NegativeInt', 'SingleDigit',
- 'SimpleStr', 'NonEmptySimpleStr', 'Password', 'StrongPassword', 'NonEmptyStr',
-
-
-=head1 Type Constraints
-
-These types check the value and issue an error message.
-
-=over
-
-=item Email
-
-Uses Email::Valid
-
-=item State
-
-Checks that the state is in a list of two uppercase letters.
-
-=item Zip
-
-=item IPAddress
-
-Must be a valid IPv4 address.
-
-=item NoSpaces
-
-No spaces in string allowed.
-
-=item WordChars
-
-Must be made up of letters, digits, and underscores.
-
-=item NotAllDigits
-
-Might be useful for passwords.
-
-=item Printable
-
-Must not contain non-printable characters.
-
-=item SingleWord
-
-Contains a single word.
-
-=back
-
-=head2 Type Coercions
-
-These types will transform the value without an error message;
-
-=over
-
-=item Collapse
-
-Replaces multiple spaces with a single space
-
-=item Upper
-
-Makes the string all upper case
-
-=item Lower
-
-Makes the string all lower case
-
-=item Trim
-
-Trims the string of starting and ending spaces
-
-=back
-
-=cut
subtype PositiveNum, as Num, where { $_ >= 0 }, message { "Must be a positive number" };
@@ -239,19 +134,132 @@ subtype Trim,
coerce Trim,
from Str,
via { s/^\s+// &&
- s/\s+$//;
+ s/\s+$//;
return $_; };
-=head1 AUTHORS
+1;
- HTML::FormHandler Contributors; see HTML::FormHandler
-=head1 COPYRIGHT
+__END__
+=pod
- This library is free software, you can redistribute it and/or modify it under
- the same terms as Perl itself.
+=head1 NAME
-=cut
+HTML::FormHandler::Types - Moose type constraints
-1;
+=head1 VERSION
+
+version 0.32002
+
+=head1 SYNOPSIS
+
+These types are provided by MooseX::Types. These types must not be quoted
+when they are used:
+
+ has 'posint' => ( is => 'rw', isa => PositiveInt);
+ has_field 'email' => ( apply => [ Email ] );
+
+Types declared using Moose::Util::TypeConstraints, on the other hand,
+must be quoted:
+
+ has_field 'text_both' => ( apply => [ PositiveInt, 'GreaterThan10' ] );
+
+To import these types into your forms, you must either specify (':all')
+or list the types you want to use:
+
+ use HTML::FormHandler::Types (':all');
+
+or:
+
+ use HTML::FormHandler::Types ('Email', 'PositiveInt');
+
+=head1 DESCRIPTION
+
+It would be possible to import the MooseX types (Common, etc), but for now
+we'll just re-implement them here in order to be able to change the
+messages and keep control of what types we provide.
+
+From MooseX::Types::Common:
+
+ 'PositiveNum', 'PositiveInt', 'NegativeNum', 'NegativeInt', 'SingleDigit',
+ 'SimpleStr', 'NonEmptySimpleStr', 'Password', 'StrongPassword', 'NonEmptyStr',
+
+=head1 Type Constraints
+
+These types check the value and issue an error message.
+
+=over
+
+=item Email
+
+Uses Email::Valid
+
+=item State
+
+Checks that the state is in a list of two uppercase letters.
+
+=item Zip
+
+=item IPAddress
+
+Must be a valid IPv4 address.
+
+=item NoSpaces
+
+No spaces in string allowed.
+
+=item WordChars
+
+Must be made up of letters, digits, and underscores.
+
+=item NotAllDigits
+
+Might be useful for passwords.
+
+=item Printable
+
+Must not contain non-printable characters.
+
+=item SingleWord
+
+Contains a single word.
+
+=back
+
+=head2 Type Coercions
+
+These types will transform the value without an error message;
+
+=over
+
+=item Collapse
+
+Replaces multiple spaces with a single space
+
+=item Upper
+
+Makes the string all upper case
+
+=item Lower
+
+Makes the string all lower case
+
+=item Trim
+
+Trims the string of starting and ending spaces
+
+=back
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
diff --git a/lib/HTML/FormHandler/Validate.pm b/lib/HTML/FormHandler/Validate.pm
index b9d5713..9e57de3 100644
--- a/lib/HTML/FormHandler/Validate.pm
+++ b/lib/HTML/FormHandler/Validate.pm
@@ -1,15 +1,6 @@
package HTML::FormHandler::Validate;
+# ABSTRACT: validation role (internal)
-=head1 NAME
-
-HTML::FormHandler::Validate
-
-=head1 SYNOPSIS
-
-This is a role that contains validation and transformation code
-used by both L<HTML::FormHandler> and L<HTML::FormHandler::Field>.
-
-=cut
use Moose::Role;
use Carp;
@@ -19,7 +10,7 @@ has 'required_message' => (
isa => 'ArrayRef|Str',
is => 'rw',
lazy => 1,
- default => sub {
+ default => sub {
return [ '[_1] field is required', shift->loc_label ];
}
);
@@ -104,17 +95,36 @@ sub _inner_validate_field { }
sub validate { 1 }
-=head1 AUTHORS
+use namespace::autoclean;
+1;
-HTML::FormHandler Contributors; see HTML::FormHandler
-=head1 COPYRIGHT
+__END__
+=pod
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+=head1 NAME
-=cut
+HTML::FormHandler::Validate - validation role (internal)
-use namespace::autoclean;
-1;
+=head1 VERSION
+
+version 0.32002
+
+=head1 SYNOPSIS
+
+This is a role that contains validation and transformation code
+used by both L<HTML::FormHandler> and L<HTML::FormHandler::Field>.
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
diff --git a/lib/HTML/FormHandler/Validate/Actions.pm b/lib/HTML/FormHandler/Validate/Actions.pm
index 93fe03a..648e626 100644
--- a/lib/HTML/FormHandler/Validate/Actions.pm
+++ b/lib/HTML/FormHandler/Validate/Actions.pm
@@ -1,17 +1,8 @@
package HTML::FormHandler::Validate::Actions;
+# ABSTRACT: internal role to validate actions
use Moose::Role;
-=head1 NAME
-
-FormHandler::Validate::Actions
-
-=head1 SYNOPSIS
-
-Role applies 'actions' (Moose types, coderefs, callbacks) to
-L<HTML::FormHandler::Field> and L<HTML::FormHandler>.
-
-=cut
has 'actions' => (
traits => ['Array'],
@@ -168,16 +159,35 @@ sub has_some_value {
return;
}
-=head1 AUTHORS
+use namespace::autoclean;
+1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Validate::Actions - internal role to validate actions
-HTML::FormHandler Contributors; see HTML::FormHandler
+=head1 VERSION
-=head1 COPYRIGHT
+version 0.32002
+
+=head1 SYNOPSIS
+
+Role applies 'actions' (Moose types, coderefs, callbacks) to
+L<HTML::FormHandler::Field> and L<HTML::FormHandler>.
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
-use namespace::autoclean;
-1;
diff --git a/lib/HTML/FormHandler/Widget/ApplyRole.pm b/lib/HTML/FormHandler/Widget/ApplyRole.pm
index 4677928..1b85ddc 100644
--- a/lib/HTML/FormHandler/Widget/ApplyRole.pm
+++ b/lib/HTML/FormHandler/Widget/ApplyRole.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Widget::ApplyRole;
+# ABSTRACT: role to apply widgets
use Moose::Role;
use File::Spec;
@@ -18,7 +19,7 @@ sub get_widget_role {
my ( $self, $widget_name, $dir ) = @_;
my $widget_class = $self->widget_class($widget_name);
my $ldir = $dir ? '::' . $dir . '::' : '::';
- my @name_spaces = ( @{$self->widget_name_space},
+ my @name_spaces = ( @{$self->widget_name_space},
('HTML::FormHandler::Widget', 'HTML::FormHandlerX::Widget') );
foreach my $ns (@name_spaces) {
my $render_role = $ns . $ldir . $widget_class;
@@ -36,9 +37,34 @@ sub widget_class {
if($widget eq lc $widget) {
$widget =~ s/^(\w{1})/\u$1/g;
$widget =~ s/_(\w{1})/\u$1/g;
- }
+ }
return $widget;
}
use namespace::autoclean;
1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Widget::ApplyRole - role to apply widgets
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/Widget/Field/Checkbox.pm b/lib/HTML/FormHandler/Widget/Field/Checkbox.pm
index ce323a9..ede95f3 100644
--- a/lib/HTML/FormHandler/Widget/Field/Checkbox.pm
+++ b/lib/HTML/FormHandler/Widget/Field/Checkbox.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Widget::Field::Checkbox;
+# ABSTRACT: HTML attributes field role
use Moose::Role;
use namespace::autoclean;
@@ -22,3 +23,28 @@ sub render {
}
1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Widget::Field::Checkbox - HTML attributes field role
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/Widget/Field/CheckboxGroup.pm b/lib/HTML/FormHandler/Widget/Field/CheckboxGroup.pm
index f92440e..8bb6e2d 100644
--- a/lib/HTML/FormHandler/Widget/Field/CheckboxGroup.pm
+++ b/lib/HTML/FormHandler/Widget/Field/CheckboxGroup.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Widget::Field::CheckboxGroup;
+# ABSTRACT: checkbox group field role
use Moose::Role;
use namespace::autoclean;
@@ -12,7 +13,7 @@ sub render {
my $output = " <br />";
my $index = 0;
my $id = $self->id;
- my $html_attributes = $self->_add_html_attributes; # does that make sense?
+ my $html_attributes = $self->_add_html_attributes;
foreach my $option ( @{ $self->options } ) {
$output .= '<input type="checkbox" value="'
@@ -48,3 +49,28 @@ sub render {
}
1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Widget::Field::CheckboxGroup - checkbox group field role
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/Widget/Field/Compound.pm b/lib/HTML/FormHandler/Widget/Field/Compound.pm
index b4d7429..80a57e2 100644
--- a/lib/HTML/FormHandler/Widget/Field/Compound.pm
+++ b/lib/HTML/FormHandler/Widget/Field/Compound.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Widget::Field::Compound;
+# ABSTRACT: compound field widget
use Moose::Role;
@@ -17,3 +18,28 @@ sub render {
use namespace::autoclean;
1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Widget::Field::Compound - compound field widget
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/Widget/Field/Hidden.pm b/lib/HTML/FormHandler/Widget/Field/Hidden.pm
index 45d2423..67fcaf9 100644
--- a/lib/HTML/FormHandler/Widget/Field/Hidden.pm
+++ b/lib/HTML/FormHandler/Widget/Field/Hidden.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Widget::Field::Hidden;
+# ABSTRACT: hidden field rendering widget
use Moose::Role;
with 'HTML::FormHandler::Widget::Field::Role::HTMLAttributes';
@@ -20,3 +21,28 @@ sub render {
use namespace::autoclean;
1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Widget::Field::Hidden - hidden field rendering widget
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/Widget/Field/NoRender.pm b/lib/HTML/FormHandler/Widget/Field/NoRender.pm
index c5a2656..e69742a 100644
--- a/lib/HTML/FormHandler/Widget/Field/NoRender.pm
+++ b/lib/HTML/FormHandler/Widget/Field/NoRender.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Widget::Field::NoRender;
+# ABSTRACT: no rendering widget
use Moose::Role;
@@ -6,3 +7,28 @@ sub render { '' }
use namespace::autoclean;
1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Widget::Field::NoRender - no rendering widget
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/Widget/Field/Password.pm b/lib/HTML/FormHandler/Widget/Field/Password.pm
index 4d8d7d0..ce415a3 100644
--- a/lib/HTML/FormHandler/Widget/Field/Password.pm
+++ b/lib/HTML/FormHandler/Widget/Field/Password.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Widget::Field::Password;
+# ABSTRACT: password rendering widget
use Moose::Role;
use namespace::autoclean;
@@ -21,3 +22,28 @@ sub render {
}
1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Widget::Field::Password - password rendering widget
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/Widget/Field/RadioGroup.pm b/lib/HTML/FormHandler/Widget/Field/RadioGroup.pm
index d5958a1..b05c9cb 100644
--- a/lib/HTML/FormHandler/Widget/Field/RadioGroup.pm
+++ b/lib/HTML/FormHandler/Widget/Field/RadioGroup.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Widget::Field::RadioGroup;
+# ABSTRACT: radio group rendering widget
use Moose::Role;
use namespace::autoclean;
@@ -26,3 +27,28 @@ sub render {
}
1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Widget::Field::RadioGroup - radio group rendering widget
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/Widget/Field/Reset.pm b/lib/HTML/FormHandler/Widget/Field/Reset.pm
index 50c3c00..3966e6c 100644
--- a/lib/HTML/FormHandler/Widget/Field/Reset.pm
+++ b/lib/HTML/FormHandler/Widget/Field/Reset.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Widget::Field::Reset;
+# ABSTRACT: reset field rendering widget
use Moose::Role;
use namespace::autoclean;
@@ -21,3 +22,28 @@ sub render {
}
1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Widget::Field::Reset - reset field rendering widget
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/Widget/Field/Role/HTMLAttributes.pm b/lib/HTML/FormHandler/Widget/Field/Role/HTMLAttributes.pm
index c28e9c6..aab12b4 100644
--- a/lib/HTML/FormHandler/Widget/Field/Role/HTMLAttributes.pm
+++ b/lib/HTML/FormHandler/Widget/Field/Role/HTMLAttributes.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Widget::Field::Role::HTMLAttributes;
+# ABSTRACT: apply HTML attributes
use Moose::Role;
@@ -6,7 +7,7 @@ sub _add_html_attributes {
my $self = shift;
my $output = q{};
- for my $attr ( 'readonly', 'disabled', 'style' ) {
+ for my $attr ( 'readonly', 'disabled', 'style', 'title' ) {
$output .= ( $self->$attr ? qq{ $attr="} . $self->$attr . '"' : '' );
}
$output .= ($self->javascript ? ' ' . $self->javascript : '');
@@ -17,3 +18,28 @@ sub _add_html_attributes {
}
1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Widget::Field::Role::HTMLAttributes - apply HTML attributes
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/Widget/Field/Role/SelectedOption.pm b/lib/HTML/FormHandler/Widget/Field/Role/SelectedOption.pm
index d84db0d..bffb7f5 100644
--- a/lib/HTML/FormHandler/Widget/Field/Role/SelectedOption.pm
+++ b/lib/HTML/FormHandler/Widget/Field/Role/SelectedOption.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Widget::Field::Role::SelectedOption;
+# ABSTRACT: allow setting options from options keys
use Moose::Role;
use namespace::autoclean;
@@ -18,3 +19,28 @@ sub check_selected_option {
}
1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Widget::Field::Role::SelectedOption - allow setting options from options keys
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/Widget/Field/Select.pm b/lib/HTML/FormHandler/Widget/Field/Select.pm
index d3e4de4..4c1e2ab 100644
--- a/lib/HTML/FormHandler/Widget/Field/Select.pm
+++ b/lib/HTML/FormHandler/Widget/Field/Select.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Widget::Field::Select;
+# ABSTRACT: select field rendering widget
use Moose::Role;
use namespace::autoclean;
@@ -59,3 +60,28 @@ sub render {
}
1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Widget::Field::Select - select field rendering widget
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/Widget/Field/Submit.pm b/lib/HTML/FormHandler/Widget/Field/Submit.pm
index e7be064..cfea490 100644
--- a/lib/HTML/FormHandler/Widget/Field/Submit.pm
+++ b/lib/HTML/FormHandler/Widget/Field/Submit.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Widget::Field::Submit;
+# ABSTRACT: submit field rendering widget
use Moose::Role;
use namespace::autoclean;
@@ -21,3 +22,28 @@ sub render {
}
1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Widget::Field::Submit - submit field rendering widget
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/Widget/Field/Text.pm b/lib/HTML/FormHandler/Widget/Field/Text.pm
index 770054f..6ccee16 100644
--- a/lib/HTML/FormHandler/Widget/Field/Text.pm
+++ b/lib/HTML/FormHandler/Widget/Field/Text.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Widget::Field::Text;
+# ABSTRACT: text field rendering widget
use Moose::Role;
use namespace::autoclean;
@@ -22,3 +23,28 @@ sub render {
}
1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Widget::Field::Text - text field rendering widget
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/Widget/Field/Textarea.pm b/lib/HTML/FormHandler/Widget/Field/Textarea.pm
index fa443ec..f38755c 100644
--- a/lib/HTML/FormHandler/Widget/Field/Textarea.pm
+++ b/lib/HTML/FormHandler/Widget/Field/Textarea.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Widget::Field::Textarea;
+# ABSTRACT: textarea rendering widget
use Moose::Role;
use namespace::autoclean;
@@ -23,3 +24,28 @@ sub render {
}
1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Widget::Field::Textarea - textarea rendering widget
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/Widget/Field/Upload.pm b/lib/HTML/FormHandler/Widget/Field/Upload.pm
index e2a51ab..913bdf0 100644
--- a/lib/HTML/FormHandler/Widget/Field/Upload.pm
+++ b/lib/HTML/FormHandler/Widget/Field/Upload.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Widget::Field::Upload;
+# ABSTRACT: update field rendering widget
use Moose::Role;
with 'HTML::FormHandler::Widget::Field::Role::HTMLAttributes';
@@ -18,3 +19,28 @@ sub render {
use namespace::autoclean;
1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Widget::Field::Upload - update field rendering widget
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/Widget/Form/Role/HTMLAttributes.pm b/lib/HTML/FormHandler/Widget/Form/Role/HTMLAttributes.pm
new file mode 100644
index 0000000..2fdd235
--- /dev/null
+++ b/lib/HTML/FormHandler/Widget/Form/Role/HTMLAttributes.pm
@@ -0,0 +1,55 @@
+package HTML::FormHandler::Widget::Form::Role::HTMLAttributes;
+# ABSTRACT: set HTML attributes on the form tag
+
+use Moose::Role;
+
+sub html_form_tag {
+ my $self = shift;
+
+ my @attr_accessors = (
+ [ action => 'action' ],
+ [ id => 'name' ],
+ [ method => 'http_method' ],
+ [ enctype => 'enctype' ],
+ [ class => 'css_class' ],
+ [ style => 'style' ],
+ );
+
+ my $output = '<form';
+ foreach my $attr_pair (@attr_accessors) {
+ my $accessor = $attr_pair->[1];
+ if ( my $value = $self->$accessor ) {
+ $output .= ' ' . $attr_pair->[0] . '="' . $value . '"';
+ }
+ }
+ $output .= " >\n";
+ return $output;
+}
+
+no Moose::Role;
+1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Widget::Form::Role::HTMLAttributes - set HTML attributes on the form tag
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/Widget/Form/Simple.pm b/lib/HTML/FormHandler/Widget/Form/Simple.pm
index d141fcc..6ddeb96 100644
--- a/lib/HTML/FormHandler/Widget/Form/Simple.pm
+++ b/lib/HTML/FormHandler/Widget/Form/Simple.pm
@@ -1,20 +1,11 @@
package HTML::FormHandler::Widget::Form::Simple;
+# ABSTRACT: widget to render a form with divs
use Moose::Role;
+with 'HTML::FormHandler::Widget::Form::Role::HTMLAttributes';
our $VERSION = 0.01;
-=head1 NAME
-
-HTML::FormHandler::Widget::Form::Simple
-
-=head1 SYNOPSIS
-
-Role to apply to form objects to allow rendering. In your form:
-
- has '+widget_form' => ( default => 'Simple' );
-
-=cut
has 'auto_fieldset' => ( isa => 'Bool', is => 'rw', lazy => 1, default => 1 );
@@ -34,7 +25,8 @@ sub render {
my $output = $form->render_start;
foreach my $fld_result ( $result->results ) {
- die "no field in result for " . $fld_result->name unless $fld_result->field_def;
+ die "no field in result for " . $fld_result->name
+ unless $fld_result->field_def;
$output .= $fld_result->render;
}
@@ -43,15 +35,14 @@ sub render {
}
sub render_start {
- my $self = shift;
- my $output = '<form ';
- $output .= 'action="' . $self->action . '" ' if $self->action;
- $output .= 'id="' . $self->name . '" ' if $self->name;
- $output .= 'method="' . $self->http_method . '" ' if $self->http_method;
- $output .= 'enctype="' . $self->enctype . '" ' if $self->enctype;
- $output .= '>' . "\n";
- $output .= '<fieldset class="main_fieldset">' if $self->form->auto_fieldset;
- return $output;
+ my $self = shift;
+
+ my $output = $self->html_form_tag;
+
+ $output .= '<fieldset class="main_fieldset">'
+ if $self->form->auto_fieldset;
+
+ return $output
}
sub render_end {
@@ -62,17 +53,37 @@ sub render_end {
return $output;
}
-=head1 AUTHORS
+use namespace::autoclean;
+1;
-See CONTRIBUTORS in L<HTML::FormHandler>
-=head1 COPYRIGHT
+__END__
+=pod
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+=head1 NAME
-=cut
+HTML::FormHandler::Widget::Form::Simple - widget to render a form with divs
-use namespace::autoclean;
-1;
+=head1 VERSION
+
+version 0.32002
+
+=head1 SYNOPSIS
+
+Role to apply to form objects to allow rendering. In your form:
+
+ has '+widget_form' => ( default => 'Simple' );
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
diff --git a/lib/HTML/FormHandler/Widget/Form/Table.pm b/lib/HTML/FormHandler/Widget/Form/Table.pm
index 2d52549..8e7b235 100644
--- a/lib/HTML/FormHandler/Widget/Form/Table.pm
+++ b/lib/HTML/FormHandler/Widget/Form/Table.pm
@@ -1,13 +1,38 @@
package HTML::FormHandler::Widget::Form::Table;
+# ABSTRACT: render a form with a table layout
use Moose::Role;
with 'HTML::FormHandler::Widget::Form::Simple' =>
{ excludes => [ 'render_start', 'render_end' ] };
+
+sub render_start {
+ my $self = shift;
+ return $self->html_form_tag . "<table>\n";
+}
+
+sub render_end {
+ my $self = shift;
+ my $output .= "</table>\n";
+ $output .= "</form>\n";
+ return $output;
+}
+
+use namespace::autoclean;
+1;
+
+
+__END__
+=pod
+
=head1 NAME
HTML::FormHandler::Widget::Form::Table - render a form with a table layout
+=head1 VERSION
+
+version 0.32002
+
=head1 SYNOPSIS
Set in your form:
@@ -18,39 +43,16 @@ Use in a template:
[% form.render %]
-=cut
+=head1 AUTHOR
-sub render_start {
- my $self = shift;
- my $output = '<form ';
- $output .= 'action="' . $self->action . '" ' if $self->action;
- $output .= 'id="' . $self->name . '" ' if $self->name;
- $output .= 'name="' . $self->name . '" ' if $self->name;
- $output .= 'method="' . $self->http_method . '" ' if $self->http_method;
- $output .= 'enctype="' . $self->enctype . '" ' if $self->enctype;
- $output .= '>' . "\n";
- $output .= "<table>\n";
- return $output;
-}
+FormHandler Contributors - see HTML::FormHandler
-sub render_end {
- my $self = shift;
- my $output .= "</table>\n";
- $output .= "</form>\n";
- return $output;
-}
-
-=head1 AUTHORS
+=head1 COPYRIGHT AND LICENSE
-HFH Contributors, see L<HTML::FormHandler>
+This software is copyright (c) 2010 by Gerda Shank.
-=head1 COPYRIGHT
-
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
+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
-use namespace::autoclean;
-1;
-
diff --git a/lib/HTML/FormHandler/Widget/Wrapper/Base.pm b/lib/HTML/FormHandler/Widget/Wrapper/Base.pm
index f79909b..9c4faaa 100644
--- a/lib/HTML/FormHandler/Widget/Wrapper/Base.pm
+++ b/lib/HTML/FormHandler/Widget/Wrapper/Base.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Widget::Wrapper::Base;
+# ABSTRACT: commong methods for widget wrappers
use Moose::Role;
@@ -25,3 +26,28 @@ sub render_class {
use namespace::autoclean;
1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Widget::Wrapper::Base - commong methods for widget wrappers
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/Widget/Wrapper/Fieldset.pm b/lib/HTML/FormHandler/Widget/Wrapper/Fieldset.pm
index 5e490ec..ac0daae 100644
--- a/lib/HTML/FormHandler/Widget/Wrapper/Fieldset.pm
+++ b/lib/HTML/FormHandler/Widget/Wrapper/Fieldset.pm
@@ -1,19 +1,11 @@
package HTML::FormHandler::Widget::Wrapper::Fieldset;
+# ABSTRACT: fieldset field wrapper
use Moose::Role;
use namespace::autoclean;
with 'HTML::FormHandler::Widget::Wrapper::Base';
-=head1 NAME
-
-HTML::FormHandler::Widget::Wrapper::Fieldset
-
-=head1 SYNOPSIS
-
-Wraps a single field in a fieldset.
-
-=cut
sub wrap_field {
my ( $self, $result, $rendered_widget ) = @_;
@@ -31,3 +23,36 @@ sub wrap_field {
}
1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Widget::Wrapper::Fieldset - fieldset field wrapper
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 SYNOPSIS
+
+Wraps a single field in a fieldset.
+
+=head1 NAME
+
+HTML::FormHandler::Widget::Wrapper::Fieldset - fieldset field wrapper
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/Widget/Wrapper/None.pm b/lib/HTML/FormHandler/Widget/Wrapper/None.pm
index e460d3c..6f80a58 100644
--- a/lib/HTML/FormHandler/Widget/Wrapper/None.pm
+++ b/lib/HTML/FormHandler/Widget/Wrapper/None.pm
@@ -1,8 +1,34 @@
package HTML::FormHandler::Widget::Wrapper::None;
+# ABSTRACT: wrapper that doesn't wrap
use Moose::Role;
-sub wrap_field { $_[2] }
+sub wrap_field { $_[2] }
use namespace::autoclean;
1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Widget::Wrapper::None - wrapper that doesn't wrap
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/Widget/Wrapper/Simple.pm b/lib/HTML/FormHandler/Widget/Wrapper/Simple.pm
index 49a3670..cce6afa 100644
--- a/lib/HTML/FormHandler/Widget/Wrapper/Simple.pm
+++ b/lib/HTML/FormHandler/Widget/Wrapper/Simple.pm
@@ -1,31 +1,11 @@
package HTML::FormHandler::Widget::Wrapper::Simple;
+# ABSTRACT: simple field wrapper
use Moose::Role;
use namespace::autoclean;
with 'HTML::FormHandler::Widget::Wrapper::Base';
-=head1 NAME
-
-HTML::FormHandler::Widget::Wrapper::Simple
-
-=head1 SYNOPSIS
-
-This is the default wrapper role. It will be installed if
-no other wrapper is specified and widget_wrapper is not set to
-'none'.
-
-It used the 'widget_tags' keys 'wrapper_start' and 'wrapper_end',
-so that the default C<< '<div<%class>>' >> and C<< '</div>' >> tags
-may be replaced. The following will cause the fields to be wrapped
-in paragraph tags instead:
-
- has '+widget_tags' => ( default => sub { {
- wrapper_start => '<p>',
- wrapper_end => '</p>' }
- );
-
-=cut
sub wrap_field {
my ( $self, $result, $rendered_widget ) = @_;
@@ -37,7 +17,7 @@ sub wrap_field {
my $output = "\n";
$start_tag =~ s/<%class%>/$class/g;
- $output .= $start_tag;
+ $output .= $start_tag;
if ( $is_compound ) {
$output .= '<fieldset class="' . $self->html_name . '">';
@@ -59,3 +39,44 @@ sub wrap_field {
}
1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Widget::Wrapper::Simple - simple field wrapper
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 SYNOPSIS
+
+This is the default wrapper role. It will be installed if
+no other wrapper is specified and widget_wrapper is not set to
+'none'.
+
+It used the 'widget_tags' keys 'wrapper_start' and 'wrapper_end',
+so that the default C<< '<div<%class>>' >> and C<< '</div>' >> tags
+may be replaced. The following will cause the fields to be wrapped
+in paragraph tags instead:
+
+ has '+widget_tags' => ( default => sub { {
+ wrapper_start => '<p>',
+ wrapper_end => '</p>' }
+ );
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/lib/HTML/FormHandler/Widget/Wrapper/Table.pm b/lib/HTML/FormHandler/Widget/Wrapper/Table.pm
index 086d8f8..4a5ab28 100644
--- a/lib/HTML/FormHandler/Widget/Wrapper/Table.pm
+++ b/lib/HTML/FormHandler/Widget/Wrapper/Table.pm
@@ -1,4 +1,5 @@
package HTML::FormHandler::Widget::Wrapper::Table;
+# ABSTRACT: wrapper class for table layout
use Moose::Role;
with 'HTML::FormHandler::Widget::Wrapper::Base';
@@ -27,3 +28,28 @@ sub wrap_field {
use namespace::autoclean;
1;
+
+__END__
+=pod
+
+=head1 NAME
+
+HTML::FormHandler::Widget::Wrapper::Table - wrapper class for table layout
+
+=head1 VERSION
+
+version 0.32002
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 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
+
diff --git a/share/templates/widget/form_start.tt b/share/templates/widget/form_start.tt
index c83885c..3f85668 100644
--- a/share/templates/widget/form_start.tt
+++ b/share/templates/widget/form_start.tt
@@ -1,5 +1,6 @@
<form id="[% form.name %]" method="[% form.http_method %]"
[% IF form.action %]action="[% form.action %]"[% END %]
[% IF form.enctype %]enctype="[% form.enctype %]"[% END %]
+ [% IF form.css_class %]class="[% form.css_class %]"[% END %]
+ [% IF form.style %]style="[% form.style %]"[% END %]
>
-
diff --git a/t/constraints.t b/t/constraints.t
index a86dd52..b5ead5d 100644
--- a/t/constraints.t
+++ b/t/constraints.t
@@ -27,7 +27,7 @@ use lib 't/lib';
enum 'RGBColors' => qw(red green blue);
no Moose::Util::TypeConstraints;
-
+
has_field 'empty_field' => (
apply => [ { check => qr/aaa/, message => 'Must contain aaa' } ],
);
diff --git a/t/dates.t b/t/dates.t
index ac13bc6..8576348 100644
--- a/t/dates.t
+++ b/t/dates.t
@@ -144,7 +144,7 @@ is( $field->fif, $date_hash, 'Correct value' );
}
$form = Test::DateTime->new;
my $dt = DateTime->new( year => '2010', month => '02', day => '22' );
-$form->process( init_object => { foo => 'abc', my_date => $dt } );
+$form->process( init_object => { foo => 'abc', my_date => $dt } );
is_deeply( $form->field('my_date')->fif, { year => '2010', month => '2', day => '22' },
'right fif from obj with date' );
my $fif = $form->fif;
diff --git a/t/defaults.t b/t/defaults.t
index 34ede90..1e31926 100644
--- a/t/defaults.t
+++ b/t/defaults.t
@@ -58,7 +58,7 @@ ok( $form, 'non-db form created OK');
is( $form->field('optname')->value, 'Over Again', 'get right value from form');
$form->process({});
ok( !$form->validated, 'form validated' );
-is( $form->field('reqname')->fif, 'Starting Perl',
+is( $form->field('reqname')->fif, 'Starting Perl',
'get right fif with init_object');
{
@@ -106,10 +106,10 @@ $DB::single=1;
has_field 'bax' => ( default => 'bax_from_default' );
has_field 'zero' => ( type => 'PosInteger', default => 0 );
has_field 'foo_list' => ( type => 'Multiple', default => [1,3],
- options => [{ value => 1, label => 'One'},
+ options => [{ value => 1, label => 'One'},
{ value => 2, label => 'Two'},
{ value => 3, label => 'Three'},
- ]
+ ]
);
sub init_object {
diff --git a/t/deflate.t b/t/deflate.t
index e484c90..1d5d75b 100644
--- a/t/deflate.t
+++ b/t/deflate.t
@@ -11,19 +11,19 @@ use Test::More;
has_field 'two';
has_field 'three';
- has '+deflation' => ( default => sub {
- sub {
+ has '+deflation' => ( default => sub {
+ sub {
my %hash = split(/-/, $_[0]);
return \%hash;
- }
+ }
});
apply ( [ { transform => sub {
my $value = shift;
my $string = 'one-' . $value->{one};
$string .= '-two-' . $value->{two};
$string .= '-three-' . $value->{three};
- return $string;
- }
+ return $string;
+ }
} ]
);
}
@@ -42,14 +42,14 @@ my $init_object = { foo => 'one-1-two-2-three-3', bar => 'xxyyzz' };
$form->process( init_object => $init_object, params => {} );
is_deeply( $form->value, { foo => { one => 1, two => 2, three => 3 },
bar => 'xxyyzz' }, 'value is correct?' );
-is_deeply( $form->fif, { 'foo.one' => 1, 'foo.two' => 2, 'foo.three' => 3, bar => 'xxyyzz' },
- 'fif is correct' );
+is_deeply( $form->fif, { 'foo.one' => 1, 'foo.two' => 2, 'foo.three' => 3, bar => 'xxyyzz' },
+ 'fif is correct' );
my $fif = { bar => 'aabbcc', 'foo.one' => 'x', 'foo.two' => 'xx', 'foo.three' => 'xxx' };
-$form->process( params => $fif );
+$form->process( params => $fif );
ok( $form->validated, 'form validated' );
is_deeply( $form->value, { bar => 'aabbcc', foo => 'one-x-two-xx-three-xxx' }, 'right value' );
-is_deeply( $form->fif, $fif, 'right fif' );
+is_deeply( $form->fif, $fif, 'right fif' );
is( $form->field('foo.one')->fif, 'x', 'correct fif' );
is( $form->field('foo')->value, 'one-x-two-xx-three-xxx', 'right value for foo field' );
@@ -70,7 +70,7 @@ is( $form->field('foo')->value, 'one-x-two-xx-three-xxx', 'right value for foo f
}
}
);
-
+
}
$form = Test::Deflate->new;
@@ -83,7 +83,7 @@ is( $form->field('foo')->value, 'deflated value', 'default values should be defl
use HTML::FormHandler::Moose;
extends 'HTML::FormHandler';
- has_field 'bullets' => ( type => 'Text',
+ has_field 'bullets' => ( type => 'Text',
apply => [ { transform => \&string_to_array } ],
deflation => \&array_to_string,
deflate_to => 'fif',
@@ -94,7 +94,7 @@ is( $form->field('foo')->value, 'deflated value', 'default values should be defl
my $sep = '';
for ( @$value ) {
$string .= $sep . $_->{text};
- $sep = ';';
+ $sep = ';';
}
return $string;
}
@@ -104,7 +104,7 @@ is( $form->field('foo')->value, 'deflated value', 'default values should be defl
}
}
-$init_object = { bullets => [{ text => 'one'}, { text => 'two' }, { text => 'three'}] };
+$init_object = { bullets => [{ text => 'one'}, { text => 'two' }, { text => 'three'}] };
$fif = { bullets => 'one;two;three' };
$form = Test::Deflate2->new;
ok( $form, 'form built');
diff --git a/t/dependency.t b/t/dependency.t
index 0ef0082..5c9cff1 100644
--- a/t/dependency.t
+++ b/t/dependency.t
@@ -1,5 +1,8 @@
use Test::More;
+use HTML::FormHandler::I18N;
+$ENV{LANGUAGE_HANDLE} = HTML::FormHandler::I18N->get_handle('en_en');
+
use DateTime;
{
diff --git a/t/field_traits.t b/t/field_traits.t
index 5353529..728c99b 100644
--- a/t/field_traits.t
+++ b/t/field_traits.t
@@ -29,7 +29,7 @@ use lib ('t/lib');
has 'bar_attr' => ( isa => 'Str', is => 'rw' );
}
-{
+{
package MyApp::Field::Test;
use Moose::Role;
sub got_here { 1 }
@@ -49,7 +49,7 @@ ok( $form->field('foo')->got_here && $form->field('bar')->got_here, 'base field
has 'my_attr' => ( is => 'rw', isa => 'Str' );
sub html {
my $self = shift;
- return "<h2>Pick something, quick!</h2>";
+ return "<h2>Pick something, quick!</h2>";
}
}
@@ -61,11 +61,11 @@ ok( $form->field('foo')->got_here && $form->field('bar')->got_here, 'base field
sub render {
my $self = shift;
return $self->widget_attr || 'empty attr';
- }
+ }
}
use HTML::FormHandler;
-$form = HTML::FormHandler->new(
+$form = HTML::FormHandler->new(
widget_name_space => ['MyApp::Widget'],
field_list => [
foo => { type => 'Text', required => 1, widget_attr => 'A Test!' },
diff --git a/t/field_types.t b/t/field_types.t
index ff778eb..de4176c 100644
--- a/t/field_types.t
+++ b/t/field_types.t
@@ -7,7 +7,7 @@ use HTML::FormHandler::Field::Text;
my $field = HTML::FormHandler::Field::Text->new( name => 'test',
apply => [ Collapse ]
-);
+);
ok( $field, 'field with Collapse' );
$field->input('This is a test');
@@ -16,7 +16,7 @@ is( $field->value, 'This is a test');
$field = HTML::FormHandler::Field::Text->new( name => 'test',
apply => [ Upper ]
-);
+);
ok( $field, 'field with Upper' );
$field->input('This is a test');
$field->validate_field;
@@ -24,7 +24,7 @@ is( $field->value, 'THIS IS A TEST');
$field = HTML::FormHandler::Field::Text->new( name => 'test',
apply => [ Lower ]
-);
+);
ok( $field, 'field with Lower' );
$field->input('This Is a Test');
$field->validate_field;
@@ -33,7 +33,7 @@ is( $field->value, 'this is a test');
$field = HTML::FormHandler::Field::Text->new( name => 'test',
trim => undef,
apply => [ Trim ]
-);
+);
ok( $field, 'field with Trim' );
$field->input(' This is a test ');
$field->validate_field;
diff --git a/t/filters.t b/t/filters.t
index 125f836..0733c93 100644
--- a/t/filters.t
+++ b/t/filters.t
@@ -42,13 +42,13 @@ $ENV{LANGUAGE_HANDLE} = HTML::FormHandler::I18N->get_handle('en_en');
apply => [ { transform => sub{ sprintf '<%.1g>', $_[0] } } ]
);
has_field 'regex_trim' => (
- trim => { transform => sub {
+ trim => { transform => sub {
my $string = shift;
$string =~ s/^\s+//;
$string =~ s/\s+$//;
return $string;
}}
- );
+ );
has_field 'date_time_error' => (
apply => [ { transform => sub{ DateTime->new( $_[0] ) },
message => 'Not a valid DateTime' } ],
diff --git a/t/form_handler.t b/t/form_handler.t
index 2384d2f..1be7505 100644
--- a/t/form_handler.t
+++ b/t/form_handler.t
@@ -2,6 +2,9 @@ use strict;
use warnings;
use Test::More;
+use HTML::FormHandler::I18N;
+$ENV{LANGUAGE_HANDLE} = HTML::FormHandler::I18N->get_handle('en_en');
+
use_ok('HTML::FormHandler');
{
@@ -90,7 +93,7 @@ ok( !$form->validated, 'form validated' );
# it's not crystal clear what the behavior should be here, but I think
# this is more correct than the previous behavior
-# it fills in the missing fields, which is what always happened for an
+# it fills in the missing fields, which is what always happened for an
# initial object (as opposed to hash), but it used to behave
# differently for a hash, which seems wrong
# TODO verify behavior is correct
@@ -159,7 +162,7 @@ is_deeply( $form->field( 'foo' )->value, { '' => 'bar', x => 42, y => 23 }, 'ima
package Test::Form;
use HTML::FormHandler::Moose;
extends 'HTML::FormHandler';
-
+
has_field 'foo';
has_field 'bar';
@@ -177,6 +180,6 @@ is_deeply( $form->value, { foo => 'bovine', bar => 'horse' }, 'correct value' );
# check for hashref constructor
$form = HTML::FormHandler->new( { name => 'test_form', field_list => { one => 'Text', two => 'Text' } } );
ok( $form, 'form constructed ok' );
-
+
done_testing;
diff --git a/t/form_options.t b/t/form_options.t
index 3dff195..4fecc76 100644
--- a/t/form_options.t
+++ b/t/form_options.t
@@ -110,13 +110,13 @@ ok( $form->validated, 'form validated' );
is( $form->field('fruit')->value, 2, 'fruit value is correct');
is_deeply( $form->field('vegetables')->value, [2,4], 'vegetables value is correct');
-is_deeply( $form->fif, { fruit => 2, vegetables => [2, 4], test_field => '', build_attr => '' },
+is_deeply( $form->fif, { fruit => 2, vegetables => [2, 4], test_field => '', build_attr => '' },
'fif is correct');
-is_deeply( $form->values, { fruit => 2, vegetables => [2, 4], empty => [], build_attr => undef },
+is_deeply( $form->values, { fruit => 2, vegetables => [2, 4], empty => [], build_attr => undef },
'values are correct');
$params = {
- fruit => 2,
+ fruit => 2,
};
$form->process($params);
is_deeply( $form->field('vegetables')->value, [], 'value for vegetables correct' );
diff --git a/t/has_field_arrayref.t b/t/has_field_arrayref.t
index 7cb6b01..5a2db3f 100644
--- a/t/has_field_arrayref.t
+++ b/t/has_field_arrayref.t
@@ -15,7 +15,7 @@ ok my $form1 = Test::HTML::FormHandler::HasFieldArrayRef->new,
ok my %params1 = (
home => '1112223333',
work => '4445556666',
- mobile => '7778889999',
+ mobile => '7778889999',
), 'Created Params Hash';
ok my $result1 = $form1->process(params=>\%params1),
diff --git a/t/has_many.t b/t/has_many.t
index db62e60..bfb4fe0 100644
--- a/t/has_many.t
+++ b/t/has_many.t
@@ -17,7 +17,7 @@ use_ok( 'HTML::FormHandler::Field::Repeatable::Instance' );
has_field 'addresses.country';
has_field 'addresses.sector' => ( type => 'Select' );
- sub options_addresses_sector
+ sub options_addresses_sector
{
[ 1 => 'East',
2 => 'West',
@@ -65,7 +65,7 @@ my $init_object = {
$form = Repeatable::Form->new( init_object => $init_object );
ok( $form, 'created form from initial object' );
-# add in fields in form not in init_object
+# add in fields in form not in init_object
$init_object->{my_test} = undef;
$init_object->{addresses}->[0]->{sector} = undef;
$init_object->{addresses}->[1]->{sector} = undef;
@@ -188,7 +188,7 @@ my $unemployed_params = {
};
$form->process( $unemployed_params);
ok( $form->validated, "User with empty employer validates" );
-is_deeply( $form->value, { employers => [], user_name => 'No Employer', occupation => 'Unemployed' },
+is_deeply( $form->value, { employers => [], user_name => 'No Employer', occupation => 'Unemployed' },
'creates right value for empty repeatable' );
is_deeply( $form->fif, $unemployed_params, 'right fif for empty repeatable' );
diff --git a/t/inactive_fields.t b/t/inactive_fields.t
index 23fd307..cbf98e6 100644
--- a/t/inactive_fields.t
+++ b/t/inactive_fields.t
@@ -31,10 +31,12 @@ is_deeply( $form->fif, $fif, 'fif is correct' );
is_deeply( $form->value, $fif, 'value is correct' );
$form = Test::Form->new;
-$form->process( active => ['foo'], params => $fif );
+my $active = ['foo'];
+$form->process( active => [@{$active}], params => $fif );
+is_deeply( $active, ['foo'], 'active hashref still there' );
ok( $form->validated, 'form validated' );
is_deeply( $form->fif, $fif, 'fif is correct' );
is_deeply( $form->value, $fif, 'value is correct' );
-
+
done_testing;
diff --git a/t/lib/Field/AltText.pm b/t/lib/Field/AltText.pm
index dbff807..462d326 100644
--- a/t/lib/Field/AltText.pm
+++ b/t/lib/Field/AltText.pm
@@ -11,12 +11,12 @@ 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/;
+ unless $input =~ m/$check/;
return 1;
}
diff --git a/t/lib/Form/Address.pm b/t/lib/Form/Address.pm
index 90715bd..d4cdd95 100644
--- a/t/lib/Form/Address.pm
+++ b/t/lib/Form/Address.pm
@@ -1,6 +1,6 @@
package Form::Address;
-use HTML::FormHandler::Moose;
+use HTML::FormHandler::Moose;
extends 'HTML::FormHandler';
has_field 'street';
diff --git a/t/lib/Form/AddressRole.pm b/t/lib/Form/AddressRole.pm
index 9734898..4c2074d 100644
--- a/t/lib/Form/AddressRole.pm
+++ b/t/lib/Form/AddressRole.pm
@@ -1,6 +1,6 @@
package Form::AddressRole;
-use HTML::FormHandler::Moose::Role;
+use HTML::FormHandler::Moose::Role;
has_field 'street';
has_field 'city';
diff --git a/t/lib/Form/Person.pm b/t/lib/Form/Person.pm
index b9df573..1f2deeb 100644
--- a/t/lib/Form/Person.pm
+++ b/t/lib/Form/Person.pm
@@ -1,6 +1,6 @@
package Form::Person;
-use HTML::FormHandler::Moose;
+use HTML::FormHandler::Moose;
extends 'HTML::FormHandler';
has_field 'name';
diff --git a/t/lib/Form/PersonRole.pm b/t/lib/Form/PersonRole.pm
index ddd4752..9139778 100644
--- a/t/lib/Form/PersonRole.pm
+++ b/t/lib/Form/PersonRole.pm
@@ -1,6 +1,6 @@
package Form::PersonRole;
-use HTML::FormHandler::Moose::Role;
+use HTML::FormHandler::Moose::Role;
has_field 'name';
has_field 'telephone';
diff --git a/t/lib/Perl/Critic/Policy/FormHandler/Deprecations.pm b/t/lib/Perl/Critic/Policy/FormHandler/Deprecations.pm
deleted file mode 100644
index 5040bfc..0000000
--- a/t/lib/Perl/Critic/Policy/FormHandler/Deprecations.pm
+++ /dev/null
@@ -1,182 +0,0 @@
-package Perl::Critic::Policy::FormHandler::Deprecations;
-
-our $VERSION = '0.001';
-
-use warnings;
-use strict;
-use Carp;
-
-use Perl::Critic::Utils qw( :severities :classification first_arg parse_arg_list split_nodes_on_comma );
-
-use base 'Perl::Critic::Policy';
-
-sub supported_parameters { return (); }
-sub default_severity { return $SEVERITY_HIGH; }
-sub default_themes { return qw( bugs formhandler); }
-sub applies_to { return 'PPI::Token::Word' }
-
-sub violates {
- my ($self, $elem ) = @_;
-
- if( is_method_call( $elem ) && $elem->literal eq 'has_error' ){
- return $self->violation('The "has_error" method used.',
- 'The "has_error" method is deprecated.',
- $elem
- );
- }
- return if ! is_function_call($elem);
- if( $elem eq 'has' ){
- my $farg = first_arg( $elem );
- return if ! $farg->can( 'string' );
- $farg = $farg->string;
- if( $farg eq '+min_length' ){
- return $self->violation('The "min_length" attribute used.',
- 'The "min_length" attribute is deprecated - use minlength instead.',
- $elem);
- }
- }
- elsif( $elem eq 'has_field' ){
- my @args = parse_arg_list( $elem );
- return if ref $args[1][0] ne 'PPI::Structure::List';
- for my $e( $args[1][0]->children ){
- next if ref $e ne 'PPI::Statement::Expression';
- my $i = 0;
- for my $attr ( split_nodes_on_comma( $e->children ) ){
- next if $i++ % 2;
- next if ref $attr ne 'ARRAY';
- for my $a( @$attr ){
- next if ref $a ne 'PPI::Token::Word';
- next if $a->literal ne 'min_length';
- return $self->violation('The "min_length" attribute used.',
- 'The "min_length" attribute is deprecated - use minlength instead.',
- $elem);
- }
- }
- }
- }
- return;
-}
-
-1; # Magic true value required at end of module
-__END__
-
-=head1 NAME
-
-Perl::Critic::Policy::FormHandler::Deprecations - Checks if deprecated parts of the HTML::FormHandlers API are used
-
-
-=head1 VERSION
-
-This document describes Perl::Critic::Policy::FormHandler::Deprecations version 0.0.1
-
-
-=head1 SYNOPSIS
-
- perlcritic --theme formhandler lib # assuming Perl::Critic::Policy::FormHandler::Deprecations is in the path
-
-=head1 DESCRIPTION
-
-This is a L<Perl::Critic> policy for code using HTML::FormHandler - it detects constructs deprecated in latest
-HTML::FormHandler version.
-
-
-=head1 INTERFACE
-
-=head1 DIAGNOSTICS
-
-=over
-
-=item C<< Error message here, perhaps with %s placeholders >>
-
-[Description of error here]
-
-=item C<< Another error message here >>
-
-[Description of error here]
-
-[Et cetera, et cetera]
-
-=back
-
-
-=head1 CONFIGURATION AND ENVIRONMENT
-
-=for author to fill in:
- A full explanation of any configuration system(s) used by the
- module, including the names and locations of any configuration
- files, and the meaning of any environment variables or properties
- that can be set. These descriptions must also include details of any
- configuration language used.
-
-Perl::Critic::Policy::FormHandler::Deprecations requires no configuration files or environment variables.
-
-
-=head1 DEPENDENCIES
-
-L<Perl::Critic>
-
-=head1 INCOMPATIBILITIES
-
-=for author to fill in:
- A list of any modules that this module cannot be used in conjunction
- with. This may be due to name conflicts in the interface, or
- competition for system or program resources, or due to internal
- limitations of Perl (for example, many modules that use source code
- filters are mutually incompatible).
-
-None reported.
-
-
-=head1 BUGS AND LIMITATIONS
-
-=for author to fill in:
- A list of known problems with the module, together with some
- indication Whether they are likely to be fixed in an upcoming
- release. Also a list of restrictions on the features the module
- does provide: data types that cannot be handled, performance issues
- and the circumstances in which they may arise, practical
- limitations on the size of data sets, special cases that are not
- (yet) handled, etc.
-
-No bugs have been reported.
-
-Please report any bugs or feature requests to
-C<bug-perl-critic-policy-formhandler-deprecations at rt.cpan.org>, or through the web interface at
-L<http://rt.cpan.org>.
-
-
-=head1 AUTHOR
-
-Zbigniew Lukasiak C<< <<zby @ cpan.org >> >>
-based on idea from L<http://blog.robin.smidsrod.no/index.php/2009/07/03/deprecated-code-analyzer-for-perl>
-
-=head1 LICENCE AND COPYRIGHT
-
-Copyright (c) 2009, Zbigniew Lukasiak C<< << zbigniew @ lukasiak.name >> >>. All rights reserved.
-
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See L<perlartistic>.
-
-
-=head1 DISCLAIMER OF WARRANTY
-
-BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
-FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
-OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
-PROVIDE THE SOFTWARE "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 SOFTWARE IS WITH
-YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
-NECESSARY SERVICING, REPAIR, OR CORRECTION.
-
-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 SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
-LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
-OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
-THE SOFTWARE (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 SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
-SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
-SUCH DAMAGES.
diff --git a/t/release-eol.t b/t/release-eol.t
new file mode 100644
index 0000000..4ce4ad8
--- /dev/null
+++ b/t/release-eol.t
@@ -0,0 +1,16 @@
+
+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 });
diff --git a/t/release-no-tabs.t b/t/release-no-tabs.t
new file mode 100644
index 0000000..1c7204e
--- /dev/null
+++ b/t/release-no-tabs.t
@@ -0,0 +1,16 @@
+
+BEGIN {
+ unless ($ENV{RELEASE_TESTING}) {
+ require Test::More;
+ Test::More::plan(skip_all => 'these tests are for release candidate testing');
+ }
+}
+
+use strict;
+use warnings;
+use Test::More;
+
+eval 'use Test::NoTabs';
+plan skip_all => 'Test::NoTabs required' if $@;
+
+all_perl_files_ok();
diff --git a/t/render.t b/t/render.t
index 5e89285..cdcf770 100644
--- a/t/render.t
+++ b/t/render.t
@@ -193,7 +193,7 @@ is( $form->render_field( $form->field('no_render')), '', 'no_render' );
has_field 'between' => ( type => 'Display', set_html => 'between_html' );
sub html_explanation {
- my ( $self, $field ) = @_;
+ my ( $self, $field ) = @_;
return "<p>I have an explanation somewhere around here...</p>";
}
diff --git a/t/render_filter.t b/t/render_filter.t
index 4c203f2..57c3025 100644
--- a/t/render_filter.t
+++ b/t/render_filter.t
@@ -47,7 +47,7 @@ like( $form->field('foo')->render, qr/MY/, 'rendering was filters' );
}
$form = Test::FieldFilter->new;
-$form->process( params => { foo => "What's mine is yours", bar => '<what a hoot>' } );
+$form->process( params => { foo => "What's mine is yours", bar => '<what a hoot>' } );
is( $form->field('bar')->render, '
<div><label class="label" for="bar">Bar: </label><input type="text" name="bar" id="bar" value="<what a hoot>" /></div>
', 'renders ok' );
diff --git a/t/render_html_attributes.t b/t/render_html_attributes.t
new file mode 100644
index 0000000..06ba255
--- /dev/null
+++ b/t/render_html_attributes.t
@@ -0,0 +1,64 @@
+use strict;
+use warnings;
+use Test::More;
+use File::ShareDir;
+
+BEGIN {
+ plan skip_all => 'Install Template Toolkit to test Render::WithTT'
+ unless eval { require Template };
+}
+
+use_ok('HTML::FormHandler::Render::WithTT');
+use_ok('HTML::FormHandler::Render::Simple');
+use_ok('HTML::FormHandler::Render::Table');
+
+my $dir = File::ShareDir::dist_dir('HTML-FormHandler') . '/templates/';
+ok( $dir, 'found template dir' );
+
+{
+
+ package Test::Form;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ sub build_tt_template {'form.tt'}
+ sub build_tt_include_path { ['share/templates'] }
+
+ has_field 'foo' => ( css_class => 'schoen', style => 'bunt' );
+
+}
+
+my %results;
+{
+ my $form
+ = Test::Form->new( css_class => 'beautifully', style => 'colorful' );
+ HTML::FormHandler::Render::WithTT->meta->apply($form);
+ $results{TT} = $form->render;
+}
+{
+ my $form
+ = Test::Form->new( css_class => 'beautifully', style => 'colorful' );
+ HTML::FormHandler::Render::Simple->meta->apply($form);
+ $results{Simple} = $form->render;
+}
+{
+ my $form
+ = Test::Form->new( css_class => 'beautifully', style => 'colorful' );
+ HTML::FormHandler::Render::Table->meta->apply($form);
+ $results{Table} = $form->render;
+}
+is( scalar( grep {$_} values %results ),
+ scalar keys %results,
+ 'Both methods rendered'
+);
+
+while ( my ( $key, $res ) = each %results ) {
+ like( $res, qr/class="schoen"/, "$key Field got the class" );
+ like( $res, qr/style="bunt"/, "$key Field got the style" );
+
+ like( $res, qr/class="beautifully"/, "$key Form got the class" );
+ like( $res, qr/style="colorful"/, "$key Form got the style" );
+}
+
+done_testing();
+
diff --git a/t/render_widgets.t b/t/render_widgets.t
index 0b75c61..9bf0e67 100644
--- a/t/render_widgets.t
+++ b/t/render_widgets.t
@@ -327,9 +327,9 @@ ok( $outputT, 'output from table rendering' );
};
}
);
- has_field 'bar' => ( widget_tags =>
+ has_field 'bar' => ( widget_tags =>
{wrapper_start => '<span>', wrapper_end => '</span>'});
- has_field 'baz' => ( widget_tags =>
+ has_field 'baz' => ( widget_tags =>
{wrapper_start => '', wrapper_end => ''});
}
diff --git a/t/render_withtt.t b/t/render_withtt.t
index c34d6fa..458c61b 100644
--- a/t/render_withtt.t
+++ b/t/render_withtt.t
@@ -4,11 +4,12 @@ use Test::More;
use File::ShareDir;
BEGIN {
- plan skip_all => 'Template Toolkit to rest Render::WithTT'
+ plan skip_all => 'Install Template Toolkit to test Render::WithTT'
unless eval { require Template };
}
use_ok('HTML::FormHandler::Render::WithTT');
+use_ok('HTML::FormHandler::Render::Simple');
my $dir = File::ShareDir::dist_dir('HTML-FormHandler') . '/templates/';
ok( $dir, 'found template dir' );
@@ -17,7 +18,7 @@ ok( $dir, 'found template dir' );
package Test::Form;
use HTML::FormHandler::Moose;
extends 'HTML::FormHandler';
- with 'HTML::FormHandler::Render::WithTT';
+ #with 'HTML::FormHandler::Render::WithTT';
sub build_tt_template { 'form.tt' }
sub build_tt_include_path { ['share/templates'] }
@@ -28,10 +29,33 @@ ok( $dir, 'found template dir' );
}
-my $form = Test::Form->new;
-ok( $form, 'form builds' );
-ok( $form->tt_include_path, 'tt include path' );
-my $rendered_form = $form->tt_render;
-ok($rendered_form, 'form renders' );
+my $rendered_via_tt;
+{
+ my $form = Test::Form->new(name => 'test_tt');
+ HTML::FormHandler::Render::WithTT->meta->apply($form);
+ ok( $form, 'form builds' );
+ ok( $form->tt_include_path, 'tt include path' );
+ $rendered_via_tt = $form->tt_render;
+ ok($rendered_via_tt, 'form tt renders' );
+}
+
+SKIP: {
+ skip 'Install HTML::TreeBuilder to test TT Result', 3
+ unless eval { require HTML::TreeBuilder };
+
+ my $rendered_via_widget;
+ {
+ my $form = Test::Form->new(name => 'test_tt');
+ HTML::FormHandler::Render::Simple->meta->apply($form);
+ ok( $form, 'form builds' );
+ $rendered_via_widget = $form->render;
+ ok($rendered_via_widget, 'form simple renders' );
+ }
+
+ my $widget = HTML::TreeBuilder->new_from_content($rendered_via_widget);
+ my $tt = HTML::TreeBuilder->new_from_content($rendered_via_tt);
+ is($widget->as_HTML, $tt->as_HTML,
+ "TT Rendering and Widget Rendering matches");
+};
done_testing;
diff --git a/t/result_errors.t b/t/result_errors.t
index 4f8b530..dde5dc4 100644
--- a/t/result_errors.t
+++ b/t/result_errors.t
@@ -2,6 +2,9 @@ use strict;
use warnings;
use Test::More;
+use HTML::FormHandler::I18N;
+$ENV{LANGUAGE_HANDLE} = HTML::FormHandler::I18N->get_handle('en_en');
+
{
package Test::Form;
use HTML::FormHandler::Moose;
diff --git a/t/update_fields.t b/t/update_fields.t
index 82f636d..a8fb21e 100644
--- a/t/update_fields.t
+++ b/t/update_fields.t
@@ -9,7 +9,7 @@ use Test::More;
has_field 'foo';
has_field 'foo_date' => ( type => 'Date' );
-
+
}
my $form = Test::Dates->new;
diff --git a/t/validate_coderef.t b/t/validate_coderef.t
index 0aa458b..d4fc3cc 100644
--- a/t/validate_coderef.t
+++ b/t/validate_coderef.t
@@ -56,7 +56,7 @@ use Try::Tiny;
}
-my $obj = MyApp::Signup->new;
+my $obj = MyApp::Signup->new;
ok( $obj->form, 'form built' );
diff --git a/t/xt/deprecations.t b/t/xt/deprecations.t
deleted file mode 100644
index 70a5ef2..0000000
--- a/t/xt/deprecations.t
+++ /dev/null
@@ -1,15 +0,0 @@
-use strict;
-use warnings;
-use Test::More;
-
-BEGIN {
- eval "use Perl::Critic";
- plan skip_all => 'Perl::Critic required' if $@;
- plan tests => 2;
-}
-my $critic = Perl::Critic->new( -theme => 'formhandler' );
-my @violations = $critic->critique( 't/lib/Form/MyForm.pm');
-is( $violations[0]->description, 'The "min_length" attribute used', 'min_length in has_field' );
- at violations = $critic->critique( 't/lib/Field/MyField.pm');
-is( $violations[0]->description, 'The "min_length" attribute used', '+min_length in field def' );
-
diff --git a/t/xt/02pod.t b/xt/02pod.t
similarity index 100%
rename from t/xt/02pod.t
rename to xt/02pod.t
diff --git a/t/xt/add_field.t b/xt/add_field.t
similarity index 100%
rename from t/xt/add_field.t
rename to xt/add_field.t
diff --git a/t/xt/captcha.t b/xt/captcha.t
similarity index 96%
rename from t/xt/captcha.t
rename to xt/captcha.t
index f00b373..3f91978 100644
--- a/t/xt/captcha.t
+++ b/xt/captcha.t
@@ -51,14 +51,14 @@ ok( $rnd ne $rnd2, 'we now have a different captcha');
ok( !$form->field('captcha')->fif, 'no fif for captcha' );
$params->{captcha} = $rnd2;
$params->{subject} = 'Incorrect';
-$form->process( ctx => $ctx, params => $params );
+$form->process( ctx => $ctx, params => $params );
# valid captcha, invalid subject
ok( !$form->validated, 'form did not validate: valid captcha, invalid field' );
-ok( $rnd2 == $ctx->{session}->{captcha}->{rnd}, 'captcha has not changed' );
+ok( $rnd2 == $ctx->{session}->{captcha}->{rnd}, 'captcha has not changed' );
$params->{subject} = 'Correct';
$form->process( ctx => $ctx, params => $params );
-ok( $form->validated, 'form validated; old captcha, valid fields' );
+ok( $form->validated, 'form validated; old captcha, valid fields' );
my $render = $form->render_field('captcha');
is( $render, '
diff --git a/t/xt/chbox_group.t b/xt/chbox_group.t
similarity index 100%
rename from t/xt/chbox_group.t
rename to xt/chbox_group.t
diff --git a/t/xt/check_selected_option.t b/xt/check_selected_option.t
similarity index 98%
rename from t/xt/check_selected_option.t
rename to xt/check_selected_option.t
index 89e6a41..e5003a4 100644
--- a/t/xt/check_selected_option.t
+++ b/xt/check_selected_option.t
@@ -14,51 +14,51 @@ use_ok('HTML::FormHandler::Widget::Field::Role::SelectedOption');
my $fif = '09U1N2';
my $foo = MyFoo->new;
-
+
ok(!$foo->check_selected_option({ value => '82HJ27' }, $fif),
'no selected/checked key and diff values');
-
+
ok($foo->check_selected_option({ value => $fif }, $fif),
'no selected/checked key and same values');
-
+
ok(!$foo->check_selected_option({
selected => 0,
value => '98HH21',
}, $fif), 'with selected key, values does not matter');
-
+
ok(!$foo->check_selected_option({
checked => 0,
value => '98HH21',
}, $fif), 'with checked key, values does not matter');
-
+
ok(!$foo->check_selected_option({
selected => 0,
value => $fif,
}, $fif), 'with selected key, values does not matter');
-
+
ok(!$foo->check_selected_option({
checked => 0,
value => $fif,
}, $fif), 'with checked key, values does not matter');
-
+
ok($foo->check_selected_option({
selected => 1,
value => 'H2H34H',
}, $fif), 'with selected key, values does not matter');
-
+
ok($foo->check_selected_option({
checked => 1,
value => 'H2H34H',
}, $fif), 'with checked key, values does not matter');
-
+
ok($foo->check_selected_option({
selected => 1,
value => $fif,
}, $fif), 'with selected key, values does not matter');
-
+
ok($foo->check_selected_option({
checked => 1,
value => $fif,
}, $fif), 'with checked key, values does not matter');
-
+
done_testing;
diff --git a/t/xt/custom_fields.t b/xt/custom_fields.t
similarity index 99%
rename from t/xt/custom_fields.t
rename to xt/custom_fields.t
index 47ccff8..49611cd 100644
--- a/t/xt/custom_fields.t
+++ b/xt/custom_fields.t
@@ -45,7 +45,7 @@ my $rendered_form = $form->render;
has '+field_name_space' => ( default => 'Test::Field' );
has '+widget_name_space' => ( default => sub { ['Test::Widget'] } );
- has_field 'my_date' => ( type => '+MonthYear', widget => 'MonthYear' );
+ has_field 'my_date' => ( type => '+MonthYear', widget => 'MonthYear' );
}
diff --git a/t/xt/display.t b/xt/display.t
similarity index 100%
rename from t/xt/display.t
rename to xt/display.t
diff --git a/t/xt/email.t b/xt/email.t
similarity index 100%
rename from t/xt/email.t
rename to xt/email.t
diff --git a/t/xt/field_list.t b/xt/field_list.t
similarity index 87%
rename from t/xt/field_list.t
rename to xt/field_list.t
index 3752c34..4d03772 100644
--- a/t/xt/field_list.t
+++ b/xt/field_list.t
@@ -12,7 +12,7 @@ my $field_list = [
submit => 'Submit',
];
-my $form = HTML::FormHandler->new( field_list => $field_list );
+my $form = HTML::FormHandler->new( field_list => $field_list );
ok( $form, 'created form OK the first time');
ok( $form->field('id'), 'id field exists' );
diff --git a/t/xt/form_errors.t b/xt/form_errors.t
similarity index 94%
rename from t/xt/form_errors.t
rename to xt/form_errors.t
index 1057acf..0dfac12 100644
--- a/t/xt/form_errors.t
+++ b/xt/form_errors.t
@@ -11,7 +11,7 @@ use Test::More;
has_field 'foo';
has_field 'bar';
-
+
sub validate_foo {
my ( $self, $field ) = @_;
$field->add_error('Not a valid foo')
@@ -25,7 +25,7 @@ use Test::More;
sub validate {
my $self = shift;
$self->add_form_error('Try again')
- if( $self->field('foo')->value ne $self->secret );
+ if( $self->field('foo')->value ne $self->secret );
}
}
@@ -35,7 +35,7 @@ $form->process( params => {} );
my $params = {
foo => 'test',
bar => 'bad_bar',
-};
+};
$form->process( secret => 'yikes', params => $params );
ok( !$form->validated, 'form did not validate' );
$form->process( secret => 'my_bar', params => { bar => 'my_bar', foo => 'my_foo' } );
@@ -44,5 +44,5 @@ is( $errors[0], 'Try again', 'form error' );
$form->process( secret => 'my_foo', params => { bar => 'my_bar', foo => 'my_foo' } );
ok( $form->validated, 'form validated' );
ok( !$form->has_form_errors, 'form errors are gone' );
-
+
done_testing;
diff --git a/t/xt/init.t b/xt/init.t
similarity index 98%
rename from t/xt/init.t
rename to xt/init.t
index 4591559..4b33a28 100644
--- a/t/xt/init.t
+++ b/xt/init.t
@@ -18,7 +18,7 @@ use Test::More;
has '+name' => ( default => 'testform_' );
has_field 'optname' => ( temp => 'First' );
- has_field 'reqname' => ( required => 1, default_over_obj => 'From Attribute' );
+ has_field 'reqname' => ( required => 1, default_over_obj => 'From Attribute' );
has_field 'altname' => ( traits => ['My::Default'] );
has_field 'somename';
has_field 'extraname' => ( default_over_obj => '' );
@@ -36,7 +36,7 @@ my $form = My::Other::Form->new;
ok( $form, 'get form' );
my $params = { reqname => 'Sweet', optname => 'Charity', somename => 'Exists' };
-$form->process( init_object => $init_object, params => $params );
+$form->process( init_object => $init_object, params => $params );
ok( $form->validated, 'form with init_obj & params validated' );
is( $form->field('reqname')->init_value, 'From Attribute', 'correct init_value');
is( $form->field('optname')->init_value, 'Over Again', 'correct init_value no meth');
diff --git a/t/xt/load_field.t b/xt/load_field.t
similarity index 95%
rename from t/xt/load_field.t
rename to xt/load_field.t
index af826d8..a9e25b5 100644
--- a/t/xt/load_field.t
+++ b/xt/load_field.t
@@ -19,7 +19,7 @@ use lib 't/lib';
}
-my $form = My::Form->new;
+my $form = My::Form->new;
ok( $form, 'get form' );
my $params = {
@@ -36,7 +36,7 @@ ok( !$form->validated, 'form validated' );
ok( !$form->field('field_one')->has_errors, 'field one has no error');
is( $form->field('field_two')->has_errors, 1, 'field two has one error');
-is( $form->field('field_two')->errors->[0],
+is( $form->field('field_two')->errors->[0],
'Fails AltText validation', 'get error message' );
ok( !$form->field('field_three')->has_errors, 'field three has no error');
diff --git a/t/xt/locale.t b/xt/locale.t
similarity index 100%
rename from t/xt/locale.t
rename to xt/locale.t
diff --git a/t/xt/locale_data_localize.t b/xt/locale_data_localize.t
similarity index 96%
rename from t/xt/locale_data_localize.t
rename to xt/locale_data_localize.t
index 8860ea5..36487d5 100644
--- a/t/xt/locale_data_localize.t
+++ b/xt/locale_data_localize.t
@@ -24,7 +24,7 @@ BEGIN {
use HTML::FormHandler::Moose;
extends 'HTML::FormHandler';
- sub _build_language_handle {
+ sub _build_language_handle {
my $class = Moose::Meta::Class->create_anon_class(
superclasses => [ 'Data::Localize' ],
methods => {
@@ -53,4 +53,4 @@ ok( $form, 'form built' );
$form->process( params => { foo => 'test' } );
is( $form->field('foo')->errors->[0], 'Not won, coin needed', 'right message' );
-done_testing;
\ No newline at end of file
+done_testing;
diff --git a/t/xt/mb_form.t b/xt/mb_form.t
similarity index 100%
rename from t/xt/mb_form.t
rename to xt/mb_form.t
diff --git a/t/xt/model_cdbi.t b/xt/model_cdbi.t
similarity index 100%
rename from t/xt/model_cdbi.t
rename to xt/model_cdbi.t
diff --git a/t/xt/multiple_forms.t b/xt/multiple_forms.t
similarity index 92%
rename from t/xt/multiple_forms.t
rename to xt/multiple_forms.t
index 21fe92e..25222ca 100644
--- a/t/xt/multiple_forms.t
+++ b/xt/multiple_forms.t
@@ -29,11 +29,11 @@ ok( $form1, 'get first form' );
has '+html_prefix' => ( default => 1 );
sub field_list {
- [
+ [
field_one => 'Text',
field_two => 'Text',
field_three => 'Text',
- ]
+ ]
}
}
my $form2 = My::Form::Two->new;
@@ -43,11 +43,11 @@ my $params = {
'One.field_one' => 'First field in first form',
'One.field_two' => 'Second field in first form',
'One.field_three' => 'Third field in first form',
- $form2->field('field_one')->html_name =>
+ $form2->field('field_one')->html_name =>
'First field in second form',
- $form2->field('field_two')->html_name =>
+ $form2->field('field_two')->html_name =>
'Second field in second form',
- $form2->field('field_three')->html_name =>
+ $form2->field('field_three')->html_name =>
'Third field in second form',
};
$form1->process( $params );
diff --git a/t/xt/order.t b/xt/order.t
similarity index 100%
rename from t/xt/order.t
rename to xt/order.t
diff --git a/t/xt/params.t b/xt/params.t
similarity index 95%
rename from t/xt/params.t
rename to xt/params.t
index ba04497..5df19dc 100644
--- a/t/xt/params.t
+++ b/xt/params.t
@@ -12,7 +12,7 @@ my $p1 = {
my $p1_exp = $_params->expand_hash( $p1 );
-is_deeply( $p1_exp, { book => { author => 'J.Doe',
+is_deeply( $p1_exp, { book => { author => 'J.Doe',
title => 'Doing something',
date => '2002' } }, 'get expanded has' );
@@ -40,7 +40,7 @@ my $p_hash = {
};
my $p2_exp = $_params->expand_hash( $p2 );
-is_deeply( $p2_exp, $p_hash, 'get expanded hash for dot notation' );
+is_deeply( $p2_exp, $p_hash, 'get expanded hash for dot notation' );
my $p3 = {
'books+0+author' => 'Jane Doe',
@@ -52,7 +52,7 @@ my $p3 = {
};
my $p3_exp = $_params->expand_hash( $p3, '+' );
-is_deeply( $p3_exp, $p_hash, 'get expanded hash for plus notation' );
+is_deeply( $p3_exp, $p_hash, 'get expanded hash for plus notation' );
my $p4 = {
@@ -65,7 +65,7 @@ my $p4 = {
};
my $p4_exp = $_params->expand_hash( $p4, '[]' );
-is_deeply( $p4_exp, $p_hash, 'get expanded hash for bracket notation' );
+is_deeply( $p4_exp, $p_hash, 'get expanded hash for bracket notation' );
my $p5 = {
'book.author' => 'Jane Doe',
@@ -74,7 +74,7 @@ my $p5 = {
};
my $p5_hash = {
- book =>
+ book =>
{ author => 'Jane Doe',
title => 'Janes Book',
date => '2003',
diff --git a/t/xt/posted.t b/xt/posted.t
similarity index 100%
rename from t/xt/posted.t
rename to xt/posted.t
diff --git a/t/xt/submit.t b/xt/submit.t
similarity index 100%
rename from t/xt/submit.t
rename to xt/submit.t
diff --git a/t/xt/upload.t b/xt/upload.t
similarity index 94%
rename from t/xt/upload.t
rename to xt/upload.t
index 5a687bb..0fc8d90 100644
--- a/t/xt/upload.t
+++ b/xt/upload.t
@@ -3,6 +3,8 @@ use warnings;
use Test::More;
use_ok('HTML::FormHandler::Field::Upload');
+use HTML::FormHandler::I18N;
+$ENV{LANGUAGE_HANDLE} = HTML::FormHandler::I18N->get_handle('en_en');
{
package Mock::Upload;
@@ -87,7 +89,7 @@ is( $form->field('file')->render, '
my $upload = Mock::Upload->new( filename => 'test.txt', size => 1024 );
-$form->process( params => { file => $upload } );
+$form->process( params => { file => $upload } );
ok( $form->validated, 'form validated' );
$upload->size( 20000000 );
@@ -108,7 +110,7 @@ open ( $fh, '<', 'temp.txt' );
$form->process( params => { file => $fh } );
ok( $form->validated, 'form validated' );
-# file doesn't exist
+# file doesn't exist
$form->process( params => { file => 'not_there.txt' } );
@errors = $form->errors;
is( $errors[0], 'File not found for upload field', 'error when file does not exist' );
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libhtml-formhandler-perl.git
More information about the Pkg-perl-cvs-commits
mailing list