[libhtml-formhandler-perl] 01/01: [svn-inject] Installing original source of libhtml-formhandler-perl
Damyan Ivanov
dmn at moszumanska.debian.org
Sat Nov 11 23:03:13 UTC 2017
This is an automated email from the git hooks/post-receive script.
dmn pushed a commit to tag upstream/0.31002
in repository libhtml-formhandler-perl.
commit b6fa579a31f8cccfa6e72f855579469fa04c2b87
Author: Antony Gelberg <antony at wayforth.co.uk>
Date: Tue May 4 12:55:40 2010 +0000
[svn-inject] Installing original source of libhtml-formhandler-perl
---
Changes | 219 ++++
MANIFEST | 205 ++++
META.yml | 42 +
Makefile.PL | 44 +
README | 39 +
TODO | 12 +
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 | 1075 +++++++++++++++++++
lib/HTML/FormHandler/BuildFields.pm | 365 +++++++
lib/HTML/FormHandler/Field.pm | 1110 ++++++++++++++++++++
lib/HTML/FormHandler/Field/Boolean.pm | 39 +
lib/HTML/FormHandler/Field/Captcha.pm | 108 ++
lib/HTML/FormHandler/Field/Checkbox.pm | 71 ++
lib/HTML/FormHandler/Field/Compound.pm | 127 +++
lib/HTML/FormHandler/Field/Date.pm | 130 +++
lib/HTML/FormHandler/Field/DateMDY.pm | 31 +
lib/HTML/FormHandler/Field/DateTime.pm | 88 ++
lib/HTML/FormHandler/Field/Display.pm | 84 ++
lib/HTML/FormHandler/Field/Duration.pm | 50 +
lib/HTML/FormHandler/Field/Email.pm | 46 +
lib/HTML/FormHandler/Field/Hidden.pm | 31 +
lib/HTML/FormHandler/Field/Hour.pm | 31 +
lib/HTML/FormHandler/Field/HtmlArea.pm | 101 ++
lib/HTML/FormHandler/Field/IntRange.pm | 57 +
lib/HTML/FormHandler/Field/Integer.pm | 48 +
lib/HTML/FormHandler/Field/Minute.pm | 33 +
lib/HTML/FormHandler/Field/Money.pm | 51 +
lib/HTML/FormHandler/Field/Month.pm | 31 +
lib/HTML/FormHandler/Field/MonthDay.pm | 31 +
lib/HTML/FormHandler/Field/MonthName.pm | 47 +
lib/HTML/FormHandler/Field/Multiple.pm | 52 +
lib/HTML/FormHandler/Field/Nested.pm | 22 +
lib/HTML/FormHandler/Field/NoValue.pm | 62 ++
lib/HTML/FormHandler/Field/Password.pm | 87 ++
lib/HTML/FormHandler/Field/PasswordConf.pm | 61 ++
lib/HTML/FormHandler/Field/PosInteger.pm | 37 +
lib/HTML/FormHandler/Field/PrimaryKey.pm | 22 +
lib/HTML/FormHandler/Field/Radio.pm | 47 +
lib/HTML/FormHandler/Field/Repeatable.pm | 293 ++++++
lib/HTML/FormHandler/Field/Repeatable/Instance.pm | 28 +
lib/HTML/FormHandler/Field/Reset.pm | 26 +
lib/HTML/FormHandler/Field/Result.pm | 50 +
lib/HTML/FormHandler/Field/Second.pm | 31 +
lib/HTML/FormHandler/Field/Select.pm | 382 +++++++
lib/HTML/FormHandler/Field/Submit.pm | 36 +
lib/HTML/FormHandler/Field/Text.pm | 94 ++
lib/HTML/FormHandler/Field/TextArea.pm | 28 +
lib/HTML/FormHandler/Field/Upload.pm | 85 ++
lib/HTML/FormHandler/Field/Weekday.pm | 42 +
lib/HTML/FormHandler/Field/Year.pm | 43 +
lib/HTML/FormHandler/Fields.pm | 234 +++++
lib/HTML/FormHandler/I18N.pm | 20 +
lib/HTML/FormHandler/I18N/de_de.pm | 63 ++
lib/HTML/FormHandler/I18N/en_us.pm | 15 +
lib/HTML/FormHandler/I18N/hu_hu.pm | 93 ++
lib/HTML/FormHandler/I18N/ru_ru.pm | 94 ++
lib/HTML/FormHandler/I18N/tr_tr.pm | 97 ++
lib/HTML/FormHandler/I18N/ua_ua.pm | 94 ++
lib/HTML/FormHandler/InitResult.pm | 135 +++
lib/HTML/FormHandler/Manual.pod | 50 +
lib/HTML/FormHandler/Manual/Catalyst.pod | 164 +++
lib/HTML/FormHandler/Manual/Cookbook.pod | 494 +++++++++
lib/HTML/FormHandler/Manual/Intro.pod | 958 +++++++++++++++++
lib/HTML/FormHandler/Manual/Reference.pod | 152 +++
lib/HTML/FormHandler/Manual/Rendering.pod | 227 ++++
lib/HTML/FormHandler/Manual/Templates.pod | 146 +++
lib/HTML/FormHandler/Manual/Tutorial.pod | 318 ++++++
lib/HTML/FormHandler/Meta/Role.pm | 52 +
lib/HTML/FormHandler/Model.pm | 184 ++++
lib/HTML/FormHandler/Model/CDBI.pm | 424 ++++++++
lib/HTML/FormHandler/Model/Object.pm | 18 +
lib/HTML/FormHandler/Moose.pm | 71 ++
lib/HTML/FormHandler/Moose/Role.pm | 66 ++
lib/HTML/FormHandler/Params.pm | 125 +++
lib/HTML/FormHandler/Render/Simple.pm | 431 ++++++++
lib/HTML/FormHandler/Render/Table.pm | 94 ++
lib/HTML/FormHandler/Render/WithTT.pm | 114 ++
lib/HTML/FormHandler/Result.pm | 79 ++
lib/HTML/FormHandler/Result/Role.pm | 116 ++
lib/HTML/FormHandler/TraitFor/Captcha.pm | 75 ++
lib/HTML/FormHandler/TraitFor/I18N.pm | 56 +
lib/HTML/FormHandler/Types.pm | 257 +++++
lib/HTML/FormHandler/Validate.pm | 128 +++
lib/HTML/FormHandler/Validate/Actions.pm | 159 +++
lib/HTML/FormHandler/Widget/ApplyRole.pm | 44 +
lib/HTML/FormHandler/Widget/Field/Checkbox.pm | 21 +
lib/HTML/FormHandler/Widget/Field/CheckboxGroup.pm | 50 +
lib/HTML/FormHandler/Widget/Field/Compound.pm | 19 +
lib/HTML/FormHandler/Widget/Field/Hidden.pm | 22 +
lib/HTML/FormHandler/Widget/Field/NoRender.pm | 8 +
lib/HTML/FormHandler/Widget/Field/Password.pm | 22 +
lib/HTML/FormHandler/Widget/Field/RadioGroup.pm | 25 +
lib/HTML/FormHandler/Widget/Field/Reset.pm | 22 +
.../Widget/Field/Role/HTMLAttributes.pm | 16 +
.../Widget/Field/Role/SelectedOption.pm | 20 +
lib/HTML/FormHandler/Widget/Field/Select.pm | 54 +
lib/HTML/FormHandler/Widget/Field/Submit.pm | 22 +
lib/HTML/FormHandler/Widget/Field/Text.pm | 22 +
lib/HTML/FormHandler/Widget/Field/Textarea.pm | 27 +
lib/HTML/FormHandler/Widget/Field/Upload.pm | 20 +
lib/HTML/FormHandler/Widget/Form/Simple.pm | 78 ++
lib/HTML/FormHandler/Widget/Form/Table.pm | 56 +
lib/HTML/FormHandler/Widget/Wrapper/Base.pm | 27 +
lib/HTML/FormHandler/Widget/Wrapper/None.pm | 8 +
lib/HTML/FormHandler/Widget/Wrapper/Simple.pm | 53 +
lib/HTML/FormHandler/Widget/Wrapper/Table.pm | 29 +
share/templates/form.tt | 1 +
share/templates/widget/checkbox.tt | 2 +
share/templates/widget/checkbox_group.tt | 9 +
share/templates/widget/form_end.tt | 1 +
share/templates/widget/form_start.tt | 5 +
share/templates/widget/hidden.tt | 1 +
share/templates/widget/password.tt | 3 +
share/templates/widget/radio.tt | 7 +
share/templates/widget/radio_group.tt | 8 +
share/templates/widget/reset.tt | 2 +
share/templates/widget/select.tt | 12 +
share/templates/widget/submit.tt | 2 +
share/templates/widget/text.tt | 3 +
share/templates/widget/textarea.tt | 4 +
share/templates/widget/upload.tt | 2 +
t/01app.t | 12 +
t/compound_field.t | 160 +++
t/constraints.t | 110 ++
t/dates.t | 159 +++
t/defaults.t | 105 ++
t/deflate.t | 51 +
t/dependency.t | 52 +
t/dynamic.t | 92 ++
t/errors.t | 130 +++
t/field_item.t | 124 +++
t/field_traits.t | 85 ++
t/field_types.t | 43 +
t/fields.t | 492 +++++++++
t/filters.t | 145 +++
t/form_handler.t | 181 ++++
t/form_options.t | 126 +++
t/formhandlerx.t | 52 +
t/has_field.t | 36 +
t/has_field_arrayref.t | 41 +
t/has_many.t | 185 ++++
t/inactive_fields.t | 40 +
t/input_param.t | 40 +
t/lib/BookDB/Form/Upload.pm | 11 +
t/lib/Field/Address.pm | 12 +
t/lib/Field/AltText.pm | 25 +
t/lib/Field/MyField.pm | 11 +
t/lib/Form/Address.pm | 12 +
t/lib/Form/AddressRole.pm | 11 +
t/lib/Form/Multiple.pm | 8 +
t/lib/Form/MultipleRole.pm | 10 +
t/lib/Form/MyForm.pm | 10 +
t/lib/Form/Person.pm | 11 +
t/lib/Form/PersonRole.pm | 10 +
t/lib/Form/Test.pm | 23 +
t/lib/Form/Two.pm | 12 +
t/lib/MyApp/I18N/abc_de.pm | 11 +
.../Perl/Critic/Policy/FormHandler/Deprecations.pm | 182 ++++
t/lib/Widget/Field/Omega.pm | 10 +
t/lib/Widget/Field/TestWidget.pm | 10 +
t/list.t | 39 +
t/password.t | 128 +++
t/render.t | 213 ++++
t/render_escaping.t | 177 ++++
t/render_filter.t | 58 +
t/render_result.t | 144 +++
t/render_table.t | 72 ++
t/render_widgets.t | 305 ++++++
t/render_withtt.t | 37 +
t/result.t | 139 +++
t/result_compound.t | 69 ++
t/result_errors.t | 28 +
t/structured.t | 129 +++
t/types.t | 138 +++
t/validate_coderef.t | 72 ++
t/xt/02pod.t | 7 +
t/xt/add_field.t | 40 +
t/xt/captcha.t | 70 ++
t/xt/chbox_group.t | 34 +
t/xt/check_selected_option.t | 64 ++
t/xt/custom_fields.t | 57 +
t/xt/deprecations.t | 15 +
t/xt/email.t | 36 +
t/xt/field_list.t | 24 +
t/xt/init.t | 38 +
t/xt/load_field.t | 64 ++
t/xt/locale.t | 124 +++
t/xt/model_cdbi.t | 13 +
t/xt/multiple_forms.t | 76 ++
t/xt/order.t | 27 +
t/xt/params.t | 85 ++
t/xt/submit.t | 43 +
t/xt/upload.t | 96 ++
205 files changed, 20629 insertions(+)
diff --git a/Changes b/Changes
new file mode 100644
index 0000000..d10b964
--- /dev/null
+++ b/Changes
@@ -0,0 +1,219 @@
+0.31002 Wed Apr 21, 2010
+ Remove unused HTML::Entities from Simple form widget
+ Move locale test file into xt because of env variable issues in test
+
+0.31001 Tues Apr 20, 2010
+ Use full length version number
+ Updates to translated messages & messages in Validate::Actions
+
+0.31 Fri Apr 16, 2010
+ Remove use of HTML::Entities for filtering. New render_filter coderef for filering.
+ Minor doc fixes for typos
+ Use _html_attributes in widgets (for disabled, readonly, javascript)
+ Localize default required field message
+ Add 'render_upload' to Render::Simple
+ Fix allowing array for field_name_space
+ Selected_option for select lists
+ Add example to cookbook and tests for setting a coderef for validation
+ Checkbox group use 'eq' instead of '=='
+ Fixes to tutorial to match Catalyst tutorial
+ Allow arrayref for 'has_field' (like Moose 'has')
+ Die on maketext errors
+ Move deflation from fif to get_value called by '_result_from_object'.
+ Possible incompatibility, except it was probably not working to start with...
+
+0.30003 Sun Feb 21, 2010
+ Partial fix for lack of defaults for compound fields
+ Support for using model_fields roles (DBICFields)
+ Use 'eq' instead of '==' when constructing html for multiple selects
+ Remove deprecated 'auto' syntax
+
+0.30002 Thu Feb 11, 2010
+ Don't convert widget names that contain uppercase
+ Better error messages for missing field classes
+ Field attribute 'input_param' to allow input names different than field names
+ Make field 'default' rw
+ Clean up doc on init_object
+
+0.30001 Fri Feb 5, 2009
+ Remove unnecessary IO::All use causing dep problems
+ Changes to Turkish messages
+ Russian and Urkainian message files
+ Use HTML::FormHandlerX namespace for fields and widgets
+ Fix bug with defaults set to 0
+
+0.30 Mon Feb 1, 2010
+ Improve Display Field, adding more ways to set html
+ Add initial pass at more automatic TT rendering
+ Change readonly, html attributes to 'rw'
+ Set widget in Reset field
+ Fix bugs and oddities in HFH::types
+ Fix bug allowing hashref to be passed to constructor
+ Improve doc on 'trim'
+ Add more doc on dynamic form creation
+ Allow 'options_<field_name>' attributes in form
+ Add Turkish message file
+ Add 'empty_select' to Select field
+ Fix bug displaying empty repeatable element if no values from object
+ Improvements in I18N factoring
+
+0.29002 Wed Dec 16, 2009
+ Remove locale.t from dist until issues solved
+
+0.29001 Tues Dec 15, 2009
+ Fix bug with passing widget_wrapper to fields
+ Fix bug with generated method names for form methods
+
+0.29 Wed Dec 2, 2009
+ Add CheckboxGroup widget, add MooseX::Traits to Form & Field class
+ Fix bug where defaults were not being used with an initial object
+ Fix DateTime field to trap DateTime errors, pass hash in value
+ Use build_label for field labels
+ Remove use of Class::Load, instead use Class::MOP::load_class()
+ Add set_active and make switching fields to active simpler
+ Fix bug when options lists from db are empty
+ Add encode_entities to rendering widgets
+ Switch from init_value_<fieldname> to default_<fieldname>
+ Change upload field.
+ Improve setting of method defaults for set_default, set_validate, set_options
+
+0.28
+ Switched to using native traits
+ Add Widget roles
+ Major refactor to support result classes
+ Reformatting source to more Perl standard
+ Fix bug generating CSS classes in Render::Simple (mazpe)
+ Fix POD example in ::Intro (mazpe)
+
+0.27006 Mon Aug 17, 2009
+ Add ability to set params class and arguments
+
+0.27005 Wed Aug 12, 2009
+ DateTime::Format::Strptime dep again
+
+0.27004 Tues Aug 11, 2009
+ Date inherits from Text. Fix loading compound fields from related.
+ Call load_options for forms with no init_obj & params
+
+0.27003 Sat Aug 2, 2009
+ Indexing failure missing version in Date
+
+0.27002 Sat Aug 2, 2009
+ Fix missing dependency on DateTime::Format::Strptime
+ Doc tweaks
+
+0.27001 Fri July 31, 2009
+ Doc fixes, fix Date field.
+
+0.27 Sat July 25, 2009
+ Split HTML::FormHandler::Model::DBIC into separate distribution
+ Add 'inactive' flag. Cleanup Makefile.PL. 'size' split into 'size' and
+ 'maxlength'. 'min_length' renamed to 'minlength'. Add Catalyst pod.
+ 'html_name' used for field 'id'. Fix DateMDY field.
+
+0.26 Tues June 23, 2009
+ Fix dependency test failures on UNIVERSAL::require and version
+
+0.25 Sat June 20, 2009
+ Add dependency for DateTime::Format::SQLite
+
+0.24 Sat June 20, 2009
+ Refactor validation processing for api consistency
+ Skip empty undef array elements. Update Password and PrimaryKey fields.
+ Fix bugs: calling validate_ method, recognizing errors in repeatable fields,
+ handling empty repeatable elements,
+ incorrect cloning in Repeatable, rendering fixes/updates.
+
+0.23 Fri May 22, 2009
+ Refactor HTH to use only 'process'. Deprecate 'validate' and 'update'
+ Add field_list array, deprecate other usages.
+ Clean up documentation
+ Add Repeatable field to support has_many relationships
+
+0.22 Fri May 1, 2009, 17:00
+ Removed development only test from distribution
+ Expanded apply documentation.
+
+0.21 Thu Apr 30, 2009, 20:00
+ Removed podcoverage, added skip to generator.t test, added
+ 'apply' sugar for adding actions, doc for compound field
+
+0.20 Thu Apr 23, 2009, 17:00
+ Added apply constraints, transforms, checks. Refactored code for future
+ use of nested fields. Improvements to compound fields. Bug fix for
+ checkboxes. Added ability to redefine attributes of existing fields
+ with '+fieldname'.
+
+0.19 Thu Mar 05, 2009, 17:00
+ Fix problem with empty values from form. Add Compound field.
+
+0.18 Sun Feb 22 2009, 15:00
+ Add missing test prereq DateTime::Format::MySQL.
+ Add 'values' method to form. Add 'accessor' attribute
+ to field.
+
+0.17 Thurs Feb 19 2009, 17:30
+ Refactor validate, adding validate_form method
+
+0.16 Thurs Feb 19 2009, 17:00
+ Add ability to use arrayrefs for primary key
+ Clear 'fif' for non-db forms. Allow init_object for non-db forms.
+
+0.15 Mon Feb 16 2009, 19:00
+ Fix inheritance of has_field. Add ability to use has_field
+ in roles. Some refactoring of 'clear'. If a field is not
+ in params, don't touch in db.
+
+0.14 Fri Feb 06 2009, 18:00
+ Wrong version in META.yml. Fix fif for password fields.
+
+0.13 Wed Feb 04 2009, 23:00
+ Fix validate to set params if hash
+
+0.12 Wed Feb 04 2009, 18:00
+ Fix 'dump_fields'. Add more output for verbose. Change so
+ that 'validate' doesn't require a separate 'clear' for
+ persistent forms. The controller test will only execute
+ with an environment variable.
+
+0.11 Mon Feb 02 2009, 17:00
+ Change to use BEGIN block in controllers for Catalyst 5.80.
+
+0.10 Thu Jan 29 2009, 07:00
+ Remove unnecessary 'use' from Render::Simple to eliminate install
+ failures. Change handling of 'has_field'.
+
+0.09 Sun Jan 25 2009, 17:00
+ Minor changes.
+
+0.08 Sat Jan 24 2009, 11:00
+ Remove controller and role. Refactor to support persistent
+ forms. Remove update_from_form method. Add 'process', and
+ 'update' methods. Update documentation to match. Update tutorial.
+
+0.07 Thurs Jan 22 2009, 04:00
+ Add prereq of DateTime. Minor doc changes.
+
+0.06 Wed Jan 21 2009, 04:00
+ Add prereq skip tests to controller test. Clean up Makefile.PL.
+ Convert test controller Book.pm to use chained. Support empty
+ rows.
+
+0.05 Mon Jan 19 2009, 15:00
+ Add skip test to htmlarea test. Add action, http_method, & submit to form.
+ Add javascript to field. Create widget directory for templates.
+
+0.04 Fri Jan 16 2009, 19:00
+ Move example to test directory. Change controller; add controller
+ test. Add use for HashRefInflator. Add more documentation.
+
+0.03 Tues Jan 12 2009, 16:00
+ Pod fix, remove failing test from htmlarea
+
+0.02 Tues Jan 12 2009, 03:00
+ Fixed pod formatting, naming of files
+
+0.01 Mon Jan 12 2009, 17:00
+ Released on an unsuspecting world
+ Conversion of Form::Processor to Moose, including
+ renaming many attributes and methods and refactoring
diff --git a/MANIFEST b/MANIFEST
new file mode 100644
index 0000000..4fcc229
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,205 @@
+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
+lib/HTML/FormHandler.pm
+lib/HTML/FormHandler/BuildFields.pm
+lib/HTML/FormHandler/Field.pm
+lib/HTML/FormHandler/Field/Boolean.pm
+lib/HTML/FormHandler/Field/Captcha.pm
+lib/HTML/FormHandler/Field/Checkbox.pm
+lib/HTML/FormHandler/Field/Compound.pm
+lib/HTML/FormHandler/Field/Date.pm
+lib/HTML/FormHandler/Field/DateMDY.pm
+lib/HTML/FormHandler/Field/DateTime.pm
+lib/HTML/FormHandler/Field/Display.pm
+lib/HTML/FormHandler/Field/Duration.pm
+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/Minute.pm
+lib/HTML/FormHandler/Field/Money.pm
+lib/HTML/FormHandler/Field/Month.pm
+lib/HTML/FormHandler/Field/MonthDay.pm
+lib/HTML/FormHandler/Field/MonthName.pm
+lib/HTML/FormHandler/Field/Multiple.pm
+lib/HTML/FormHandler/Field/Nested.pm
+lib/HTML/FormHandler/Field/NoValue.pm
+lib/HTML/FormHandler/Field/Password.pm
+lib/HTML/FormHandler/Field/PasswordConf.pm
+lib/HTML/FormHandler/Field/PosInteger.pm
+lib/HTML/FormHandler/Field/PrimaryKey.pm
+lib/HTML/FormHandler/Field/Radio.pm
+lib/HTML/FormHandler/Field/Repeatable.pm
+lib/HTML/FormHandler/Field/Repeatable/Instance.pm
+lib/HTML/FormHandler/Field/Reset.pm
+lib/HTML/FormHandler/Field/Result.pm
+lib/HTML/FormHandler/Field/Second.pm
+lib/HTML/FormHandler/Field/Select.pm
+lib/HTML/FormHandler/Field/Submit.pm
+lib/HTML/FormHandler/Field/Text.pm
+lib/HTML/FormHandler/Field/TextArea.pm
+lib/HTML/FormHandler/Field/Upload.pm
+lib/HTML/FormHandler/Field/Weekday.pm
+lib/HTML/FormHandler/Field/Year.pm
+lib/HTML/FormHandler/Fields.pm
+lib/HTML/FormHandler/I18N.pm
+lib/HTML/FormHandler/I18N/de_de.pm
+lib/HTML/FormHandler/I18N/en_us.pm
+lib/HTML/FormHandler/I18N/hu_hu.pm
+lib/HTML/FormHandler/I18N/ru_ru.pm
+lib/HTML/FormHandler/I18N/tr_tr.pm
+lib/HTML/FormHandler/I18N/ua_ua.pm
+lib/HTML/FormHandler/InitResult.pm
+lib/HTML/FormHandler/Manual.pod
+lib/HTML/FormHandler/Manual/Catalyst.pod
+lib/HTML/FormHandler/Manual/Cookbook.pod
+lib/HTML/FormHandler/Manual/Intro.pod
+lib/HTML/FormHandler/Manual/Reference.pod
+lib/HTML/FormHandler/Manual/Rendering.pod
+lib/HTML/FormHandler/Manual/Templates.pod
+lib/HTML/FormHandler/Manual/Tutorial.pod
+lib/HTML/FormHandler/Meta/Role.pm
+lib/HTML/FormHandler/Model.pm
+lib/HTML/FormHandler/Model/CDBI.pm
+lib/HTML/FormHandler/Model/Object.pm
+lib/HTML/FormHandler/Moose.pm
+lib/HTML/FormHandler/Moose/Role.pm
+lib/HTML/FormHandler/Params.pm
+lib/HTML/FormHandler/Render/Simple.pm
+lib/HTML/FormHandler/Render/Table.pm
+lib/HTML/FormHandler/Render/WithTT.pm
+lib/HTML/FormHandler/Result.pm
+lib/HTML/FormHandler/Result/Role.pm
+lib/HTML/FormHandler/TraitFor/Captcha.pm
+lib/HTML/FormHandler/TraitFor/I18N.pm
+lib/HTML/FormHandler/Types.pm
+lib/HTML/FormHandler/Validate.pm
+lib/HTML/FormHandler/Validate/Actions.pm
+lib/HTML/FormHandler/Widget/ApplyRole.pm
+lib/HTML/FormHandler/Widget/Field/Checkbox.pm
+lib/HTML/FormHandler/Widget/Field/CheckboxGroup.pm
+lib/HTML/FormHandler/Widget/Field/Compound.pm
+lib/HTML/FormHandler/Widget/Field/Hidden.pm
+lib/HTML/FormHandler/Widget/Field/NoRender.pm
+lib/HTML/FormHandler/Widget/Field/Password.pm
+lib/HTML/FormHandler/Widget/Field/RadioGroup.pm
+lib/HTML/FormHandler/Widget/Field/Reset.pm
+lib/HTML/FormHandler/Widget/Field/Role/HTMLAttributes.pm
+lib/HTML/FormHandler/Widget/Field/Role/SelectedOption.pm
+lib/HTML/FormHandler/Widget/Field/Select.pm
+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/Simple.pm
+lib/HTML/FormHandler/Widget/Form/Table.pm
+lib/HTML/FormHandler/Widget/Wrapper/Base.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
+share/templates/widget/form_end.tt
+share/templates/widget/form_start.tt
+share/templates/widget/hidden.tt
+share/templates/widget/password.tt
+share/templates/widget/radio.tt
+share/templates/widget/radio_group.tt
+share/templates/widget/reset.tt
+share/templates/widget/select.tt
+share/templates/widget/submit.tt
+share/templates/widget/text.tt
+share/templates/widget/textarea.tt
+share/templates/widget/upload.tt
+t/01app.t
+t/compound_field.t
+t/constraints.t
+t/dates.t
+t/defaults.t
+t/deflate.t
+t/dependency.t
+t/dynamic.t
+t/errors.t
+t/field_item.t
+t/field_traits.t
+t/field_types.t
+t/fields.t
+t/filters.t
+t/form_handler.t
+t/form_options.t
+t/formhandlerx.t
+t/has_field.t
+t/has_field_arrayref.t
+t/has_many.t
+t/inactive_fields.t
+t/input_param.t
+t/lib/BookDB/Form/Upload.pm
+t/lib/Field/Address.pm
+t/lib/Field/AltText.pm
+t/lib/Field/MyField.pm
+t/lib/Form/Address.pm
+t/lib/Form/AddressRole.pm
+t/lib/Form/Multiple.pm
+t/lib/Form/MultipleRole.pm
+t/lib/Form/MyForm.pm
+t/lib/Form/Person.pm
+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/render.t
+t/render_escaping.t
+t/render_filter.t
+t/render_result.t
+t/render_table.t
+t/render_widgets.t
+t/render_withtt.t
+t/result.t
+t/result_compound.t
+t/result_errors.t
+t/structured.t
+t/types.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/email.t
+t/xt/field_list.t
+t/xt/init.t
+t/xt/load_field.t
+t/xt/locale.t
+t/xt/model_cdbi.t
+t/xt/multiple_forms.t
+t/xt/order.t
+t/xt/params.t
+t/xt/submit.t
+t/xt/upload.t
+TODO
diff --git a/META.yml b/META.yml
new file mode 100644
index 0000000..5c1383d
--- /dev/null
+++ b/META.yml
@@ -0,0 +1,42 @@
+---
+abstract: 'form handler written in Moose'
+author:
+ - 'Gerda Shank'
+build_requires:
+ ExtUtils::MakeMaker: 6.42
+ Test::Differences: 0
+ Test::Exception: 0
+ Test::More: 0.88
+configure_requires:
+ ExtUtils::MakeMaker: 6.42
+distribution_type: module
+generated_by: 'Module::Install version 0.91'
+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
+ 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
+ perl: 5.8.0
+resources:
+ license: http://dev.perl.org/licenses/
+ repository: http://github.com/gshank/html-formhandler/tree/master
+version: 0.31002
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..364e340
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,44 @@
+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 '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';
+
+# 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();
+
diff --git a/README b/README
new file mode 100644
index 0000000..e7c581f
--- /dev/null
+++ b/README
@@ -0,0 +1,39 @@
+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...
+
+INSTALLATION
+
+To install this module, run the following commands:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+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/TODO b/TODO
new file mode 100644
index 0000000..fa76b71
--- /dev/null
+++ b/TODO
@@ -0,0 +1,12 @@
+ result refactoring tasks
+ Handle dynamic selection lists in result rendering
+ api for result
+ put back empty related fields for fif (to allow filling in if empty)
+ Unique support for non-top-level fields?
+ Create multibox widget & rendering for checkbox group for multiple select
+ Improve example of Repeatable form (BookDB, User) to do adds & deletes with js
+ Create more usable 'add_field' routine that will handle ordering, parent,
+ and form attributes. Use in create_instance.
+ add Rendering modules: TT using Data::Section? using HTML::Dom or Treebuilder?, Reaction?
+ improve auto field support
+ investigate a Catalyst View to provide better template support (like Reaction)
diff --git a/inc/Module/AutoInstall.pm b/inc/Module/AutoInstall.pm
new file mode 100644
index 0000000..dfb8ef7
--- /dev/null
+++ b/inc/Module/AutoInstall.pm
@@ -0,0 +1,805 @@
+#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
new file mode 100644
index 0000000..51eda5d
--- /dev/null
+++ b/inc/Module/Install.pm
@@ -0,0 +1,430 @@
+#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
new file mode 100644
index 0000000..c44931b
--- /dev/null
+++ b/inc/Module/Install/AuthorTests.pm
@@ -0,0 +1,59 @@
+#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
new file mode 100644
index 0000000..58dd026
--- /dev/null
+++ b/inc/Module/Install/AutoInstall.pm
@@ -0,0 +1,61 @@
+#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
new file mode 100644
index 0000000..60a74d2
--- /dev/null
+++ b/inc/Module/Install/Base.pm
@@ -0,0 +1,78 @@
+#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
new file mode 100644
index 0000000..e65e4f6
--- /dev/null
+++ b/inc/Module/Install/Can.pm
@@ -0,0 +1,81 @@
+#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
new file mode 100644
index 0000000..05f2079
--- /dev/null
+++ b/inc/Module/Install/Fetch.pm
@@ -0,0 +1,93 @@
+#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
new file mode 100644
index 0000000..7e792e0
--- /dev/null
+++ b/inc/Module/Install/Include.pm
@@ -0,0 +1,34 @@
+#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
new file mode 100644
index 0000000..98779db
--- /dev/null
+++ b/inc/Module/Install/Makefile.pm
@@ -0,0 +1,268 @@
+#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
new file mode 100644
index 0000000..653193d
--- /dev/null
+++ b/inc/Module/Install/Metadata.pm
@@ -0,0 +1,624 @@
+#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
new file mode 100644
index 0000000..f7e877c
--- /dev/null
+++ b/inc/Module/Install/Share.pm
@@ -0,0 +1,67 @@
+#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
new file mode 100644
index 0000000..f2f99df
--- /dev/null
+++ b/inc/Module/Install/Win32.pm
@@ -0,0 +1,64 @@
+#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
new file mode 100644
index 0000000..12471e5
--- /dev/null
+++ b/inc/Module/Install/WriteAll.pm
@@ -0,0 +1,60 @@
+#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
new file mode 100644
index 0000000..a1d550e
--- /dev/null
+++ b/lib/HTML/FormHandler.pm
@@ -0,0 +1,1075 @@
+package HTML::FormHandler;
+
+use Moose;
+with 'HTML::FormHandler::Model', 'HTML::FormHandler::Fields',
+ 'HTML::FormHandler::BuildFields',
+ 'HTML::FormHandler::Validate::Actions',
+ 'HTML::FormHandler::TraitFor::I18N';
+with 'HTML::FormHandler::InitResult';
+with 'HTML::FormHandler::Widget::ApplyRole';
+with 'MooseX::Traits';
+
+use Carp;
+use Class::MOP;
+use HTML::FormHandler::Result;
+
+use 5.008;
+
+# always use 5 digits after decimal because of toolchain issues
+our $VERSION = '0.31002';
+
+=head1 NAME
+
+HTML::FormHandler - form handler written in Moose
+
+=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,
+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
+simple HTML change that would take one minute by hand. Because you CAN do it
+by hand. Or you can automate HTML generation as much as you want, with
+template widgets or pure Perl rendering classes, and stay completely in
+control of what, where, and how much is done automatically. You can define
+custom renderers and display your rendered forms however you want.
+
+You can split the pieces of your forms up into logical parts and compose
+complete forms from FormHandler classes, roles, fields, collections of
+validations, transformations and Moose type constraints.
+You can write custom methods to process forms, add any attribute you like,
+use Moose method modifiers. FormHandler forms are Perl classes, so there's
+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
+'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.
+
+More Formhandler documentation and a tutorial can be found in the manual
+at L<HTML::FormHandler::Manual>.
+
+=head1 ATTRIBUTES and METHODS
+
+=head2 Creating a form with 'new'
+
+The new constructor takes name/value pairs:
+
+ MyForm->new(
+ item => $item,
+ );
+
+No attributes are required on new. The form's fields will be built from
+the form definitions. If no initial data object has been provided, the form
+will be empty. Most attributes can be set on either 'new' or 'process'.
+The common attributes to be passed in to the constructor for a database form
+are either item_id and schema or item:
+
+ item_id - database row primary key
+ item - database row object
+ schema - (for DBIC) the DBIx::Class schema
+
+The following are occasionally passed in, but are more often set
+in the form class:
+
+ item_class - source name of row
+ dependency - (see dependency)
+ field_list - and array of field definitions
+ init_object - a hashref or object to provide initial values
+
+Examples of creating a form object with new:
+
+ my $form = MyApp::Form::User->new;
+
+ # database form using a row object
+ my $form = MyApp::Form::Member->new( item => $row );
+
+ # a dynamic form (no form class has been defined)
+ my $form = HTML::FormHandler::Model::DBIC->new(
+ item_id => $id,
+ item_class => 'User',
+ schema => $schema,
+ field_list => [
+ name => 'Text',
+ active => 'Boolean',
+ ],
+ );
+
+See the model class for more information about the 'item', 'item_id',
+'item_class', and schema (for the DBIC model).
+L<HTML::FormHandler::Model::DBIC>.
+
+FormHandler forms are handled in two steps: 1) create with 'new',
+2) handle with 'process'. FormHandler doesn't
+care whether most parameters are set on new or process or update,
+but a 'field_list' argument must be passed in on 'new' since the
+fields are built at construction time.
+
+=head2 Processing the form
+
+=head3 process
+
+Call the 'process' method on your form to perform validation and
+update. A database form must have either an item (row object) or
+a schema, item_id (row primary key), and item_class (usually set in the form).
+A non-database form requires only parameters.
+
+ $form->process( item => $book, params => $c->req->parameters );
+ $form->process( item_id => $item_id,
+ schema => $schema, params => $c->req->parameters );
+ $form->process( params => $c->req->parameters );
+
+This process method returns the 'validated' flag. (C<< $form->validated >>)
+If it is a database form and the form validates, the database row
+will be updated.
+
+After the form has been processed, you can get a parameter hashref suitable
+for using to fill in the form from C<< $form->fif >>.
+A hash of inflated values (that would be used to update the database for
+a database form) can be retrieved with C<< $form->value >>.
+
+=head3 params
+
+Parameters are passed in or already set when you call 'process'.
+HFH gets data to validate and store in the database from the params hash.
+If the params hash is empty, no validation is done, so it is not necessary
+to check for POST before calling C<< $form->process >>.
+
+Params can either be in the form of CGI/HTTP style params:
+
+ {
+ user_name => "Joe Smith",
+ occupation => "Programmer",
+ 'addresses.0.street' => "999 Main Street",
+ 'addresses.0.city' => "Podunk",
+ 'addresses.0.country' => "UT",
+ 'addresses.0.address_id' => "1",
+ 'addresses.1.street' => "333 Valencia Street",
+ 'addresses.1.city' => "San Francisco",
+ 'addresses.1.country' => "UT",
+ 'addresses.1.address_id' => "2",
+ }
+
+or as structured data in the form of hashes and lists:
+
+ {
+ addresses => [
+ {
+ city => 'Middle City',
+ country => 'GK',
+ address_id => 1,
+ street => '101 Main St',
+ },
+ {
+ city => 'DownTown',
+ country => 'UT',
+ address_id => 2,
+ street => '99 Elm St',
+ },
+ ],
+ 'occupation' => 'management',
+ 'user_name' => 'jdoe',
+ }
+
+CGI style parameters will be converted to hashes and lists for HFH to
+operate on.
+
+You can add an additional param when setting params:
+
+ $form->process( params => { %{$c->req->params}, new_param => 'something' } );
+
+=head2 Getting data out
+
+=head3 fif (fill in form)
+
+Returns a hash of values suitable for use with HTML::FillInForm
+or for filling in a form with C<< $form->fif->{fieldname} >>.
+The fif value for a 'title' field in a TT form:
+
+ [% form.fif.title %]
+
+Or you can use the 'fif' method on individual fields:
+
+ [% form.field('title').fif %]
+
+=head3 value
+
+Returns a hashref of all field values. Useful for non-database forms, or if
+you want to update the database yourself. The 'fif' method returns
+a hashref with the field names for the keys and the field's 'fif' for the
+values; 'value' returns a hashref with the field accessors for the keys, and the
+field's 'value' (possibly inflated) for the the values.
+
+Forms containing arrays to be processed with L<HTML::FormHandler::Field::Repeatable>
+will have parameters with dots and numbers, like 'addresses.0.city', while the
+values hash will transform the fields with numbers to arrays.
+
+=head2 Accessing and setting up fields
+
+Fields are declared with a number of attributes which are defined in
+L<HTML::FormHandler::Field>. If you want additional attributes you can
+define your own field classes (or apply a role to a field class - see
+L<HTML::FormHandler::Manual::Cookbook>). The field 'type' (used in field
+definitions) is the short class name of the field class.
+
+=head3 has_field
+
+The most common way of declaring fields is the 'has_field' syntax.
+Using the 'has_field' syntax sugar requires C< use HTML::FormHandler::Moose; >
+or C< use HTML::FormHandler::Moose::Role; > in a role.
+See L<HTML::FormHandler::Manual::Intro>
+
+ use HTML::FormHandler::Moose;
+ has_field 'field_name' => ( type => 'FieldClass', .... );
+
+=head3 field_list
+
+A 'field_list' is an array of field definitions which can be used as an
+alternative to 'has_field' in small, dynamic forms.
+
+ field_list => [
+ field_one => {
+ type => 'Text',
+ required => 1
+ },
+ field_two => 'Text,
+ ]
+
+Or the field list can be set inside a form class, when you want to
+add fields to the form depending on some other state.
+
+ sub field_list {
+ my $self = shift;
+ my $fields = $self->schema->resultset('SomeTable')->
+ search({user_id => $self->user_id, .... });
+ my @field_list;
+ while ( my $field = $fields->next )
+ {
+ < create field list >
+ }
+ return \@field_list;
+ }
+
+=head3 active
+
+If a form has a variable number of fields, fields which are not always to be
+used should be defined as 'inactive':
+
+ has_field 'foo' => ( type => 'Text', inactive => 1 );
+
+Then the field name can be specified in the 'active' array, either on 'new',
+or on 'process':
+
+ my $form = MyApp::Form->new( active => ['foo'] );
+ ...
+ $form->process( active => ['foo'] );
+
+Fields specified as active on new will have the 'inactive' flag cleared, and so:
+those fields will be active for the life of the form object. Fields specified as
+active on 'process' will have the field's '_active' flag set just for the life of the
+request.
+
+=head3 field_name_space
+
+Use to set the name space used to locate fields that
+start with a "+", as: "+MetaText". Fields without a "+" are loaded
+from the "HTML::FormHandler::Field" name space. If 'field_name_space'
+is not set, then field types with a "+" must be the complete package
+name.
+
+=head3 fields
+
+The array of fields, objects of L<HTML::FormHandler::Field> or its subclasses.
+A compound field will itself have an array of fields,
+so this is a tree structure.
+
+=head3 field($name)
+
+This is the method that is usually called to access a field:
+
+ my $title = $form->field('title')->value;
+ [% f = form.field('title') %]
+
+ my $city = $form->field('addresses.0.city')->value;
+
+Pass a second true value to die on errors.
+
+=head2 Constraints and validation
+
+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
+
+ 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'
+ ],
+);
+
+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;
+}
+
+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',
+ }
+);
+
+
+# object with which to initialize
+has 'init_object' => ( is => 'rw', clearer => 'clear_init_object' );
+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 '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',
+ }
+);
+
+{
+ use Moose::Util::TypeConstraints;
+
+ my $tc = subtype as 'ClassName';
+ coerce $tc, from 'Str', via { Class::MOP::load_class($_); $_ };
+
+ has 'params_class' => (
+ is => 'ro',
+ isa => $tc,
+ coerce => 1,
+ default => 'HTML::FormHandler::Params',
+ );
+
+ no Moose::Util::TypeConstraints;
+}
+
+has 'params_args' => ( is => 'ro', isa => 'ArrayRef' );
+
+sub BUILDARGS {
+ my $class = shift;
+
+ if ( scalar @_ == 1 && ref( $_[0]) ne 'HASH' ) {
+ my $arg = $_[0];
+ return blessed($arg) ? { item => $arg } : { item_id => $arg };
+ }
+ return $class->SUPER::BUILDARGS(@_);
+}
+
+sub BUILD {
+ my $self = shift;
+
+ $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;
+
+ 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;
+}
+
+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;
+}
+
+sub db_validate {
+ my $self = shift;
+ my $fif = $self->fif;
+ $self->process($fif);
+ return $self->validated;
+}
+
+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;
+ return map { $_->all_errors } @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">];
+}
+
+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 { shift->has_error_fields }
+sub num_errors { shift->num_error_fields }
+
+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->item_id && !$self->item ) {
+ $self->item( $self->build_item );
+ }
+ $self->clear_result;
+ $self->set_active;
+ # 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;
+ if ( ref $value ) {
+ # at least one value is non-blank
+ next unless grep { /\S/ } @$value;
+ }
+ else {
+ next unless $value =~ /\S/;
+ }
+ # 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 _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 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 { }
+
+=head1 SUPPORT
+
+IRC:
+
+ Join #formhandler on irc.perl.org
+
+Mailing list:
+
+ http://groups.google.com/group/formhandler
+
+Code repository:
+
+ http://github.com/gshank/html-formhandler/tree/master
+
+=head1 SEE ALSO
+
+L<HTML::FormHandler::Manual>
+
+L<HTML::FormHandler::Manual::Tutorial>
+
+L<HTML::FormHandler::Manual::Intro>
+
+L<HTML::FormHandler::Manual::Templates>
+
+L<HTML::FormHandler::Manual::Cookbook>
+
+L<HTML::FormHandler::Manual::Rendering>
+
+L<HTML::FormHandler::Manual::Reference>
+
+L<HTML::FormHandler::Field>
+
+L<HTML::FormHandler::Model::DBIC>
+
+L<HTML::FormHandler::Render::Simple>
+
+L<HTML::FormHandler::Render::Table>
+
+L<HTML::FormHandler::Moose>
+
+
+=head1 CONTRIBUTORS
+
+gshank: Gerda Shank E<lt>gshank at cpan.orgE<gt>
+
+zby: Zbigniew Lukasiak E<lt>zby at cpan.orgE<gt>
+
+t0m: Tomas Doran E<lt>bobtfish at bobtfish.netE<gt>
+
+augensalat: Bernhard Graf E<lt>augensalat at gmail.comE<gt>
+
+cubuanic: Oleg Kostyuk E<lt>cub.uanic at gmail.comE<gt>
+
+rafl: Florian Ragwitz E<lt>rafl at debian.orgE<gt>
+
+mazpe: Lester Ariel Mesa
+
+dew: Dan Thomas
+
+koki: Klaus Ita
+
+jnapiorkowski: John Napiorkowski
+
+Initially based on the source code of L<Form::Processor> by Bill Moseley
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
+
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
diff --git a/lib/HTML/FormHandler/BuildFields.pm b/lib/HTML/FormHandler/BuildFields.pm
new file mode 100644
index 0000000..744afd8
--- /dev/null
+++ b/lib/HTML/FormHandler/BuildFields.pm
@@ -0,0 +1,365 @@
+package HTML::FormHandler::BuildFields;
+
+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' );
+
+has 'field_list' => ( isa => 'HashRef|ArrayRef', is => 'rw', default => sub { {} } );
+
+sub has_field_list {
+ my ( $self, $field_list ) = @_;
+ $field_list ||= $self->field_list;
+ if ( ref $field_list eq 'HASH' ) {
+ return $field_list if ( scalar keys %{$field_list} );
+ }
+ elsif ( ref $field_list eq 'ARRAY' ) {
+ return $field_list if ( scalar @{$field_list} );
+ }
+ return;
+}
+
+
+# This is the only entry point for this file. It processes the
+# various methods of field definition (has_field plus the attrs above),
+# creates objects for fields and writes them into the 'fields' attr
+# on the base object.
+#
+# calls routines to process various field lists
+# orders the fields after processing in order to skip
+# fields which have had the 'order' attribute set
+sub _build_fields {
+ my $self = shift;
+
+ my $meta_flist = $self->_build_meta_field_list;
+ $self->_process_field_array( $meta_flist, 0 ) if $meta_flist;
+ my $flist = $self->has_field_list;
+ $self->_process_field_list($flist) if $flist;
+ my $mlist = $self->model_fields if $self->fields_from_model;
+ $self->_process_field_list( $mlist ) if $mlist;
+ return unless $self->has_fields;
+
+ # order the fields
+ # There's a hole in this... if child fields are defined at
+ # a level above the containing parent, then they won't
+ # exist when this routine is called and won't be ordered.
+ # This probably needs to be moved out of here into
+ # a separate recursive step that's called after build_fields.
+
+ # get highest order number
+ my $order = 0;
+ foreach my $field ( $self->all_fields ) {
+ $order++ if $field->order > $order;
+ }
+ $order++;
+ # number all unordered fields
+ foreach my $field ( $self->all_fields ) {
+ $field->order($order) unless $field->order;
+ $order++;
+ }
+}
+
+# process all the stupidly many different formats for field_list
+# remove undocumented syntaxes after a while
+sub _process_field_list {
+ my ( $self, $flist ) = @_;
+
+ if ( ref $flist eq 'ARRAY' ) {
+ my @flist_copy = @{$flist};
+ $self->_process_field_array( $self->_array_fields( \@flist_copy ) );
+ return;
+ }
+ my %flist_copy = %{$flist};
+ $flist = \%flist_copy;
+}
+
+# loops through all inherited classes and composed roles
+# to find fields specified with 'has_field'
+sub _build_meta_field_list {
+ my $self = shift;
+ my @field_list;
+
+ foreach my $sc ( reverse $self->meta->linearized_isa ) {
+ my $meta = $sc->meta;
+ if ( $meta->can('calculate_all_roles') ) {
+ foreach my $role ( reverse $meta->calculate_all_roles ) {
+ if ( $role->can('field_list') && $role->has_field_list ) {
+ foreach my $fld_def ( @{ $role->field_list } ) {
+ my %new_fld = %{$fld_def}; # copy hashref
+ push @field_list, \%new_fld;
+ }
+ }
+ }
+ }
+ if ( $meta->can('field_list') && $meta->has_field_list ) {
+ foreach my $fld_def ( @{ $meta->field_list } ) {
+ my %new_fld = %{$fld_def}; # copy hashref
+ push @field_list, \%new_fld;
+ }
+ }
+ }
+ return \@field_list if scalar @field_list;
+}
+
+# munges the field_list auto fields into an array of field attributes
+sub _auto_fields {
+ my ( $self, $fields, $required ) = @_;
+
+ my @new_fields;
+ foreach my $name (@$fields) {
+ push @new_fields,
+ {
+ name => $name,
+ type => $self->guess_field_type($name),
+ required => $required
+ };
+ }
+ return \@new_fields;
+}
+
+# munges the field_list hashref fields into an array of field attributes
+sub _hashref_fields {
+ my ( $self, $fields, $required ) = @_;
+ my @new_fields;
+ while ( my ( $key, $value ) = each %{$fields} ) {
+ unless ( ref $value eq 'HASH' ) {
+ $value = { type => $value };
+ }
+ if ( defined $required ) {
+ $value->{required} = $required;
+ }
+ push @new_fields, { name => $key, %$value };
+ }
+ return \@new_fields;
+}
+
+# munges the field_list array into an array of field attributes
+sub _array_fields {
+ my ( $self, $fields ) = @_;
+
+ my @new_fields;
+ while (@$fields) {
+ my $name = shift @$fields;
+ my $attr = shift @$fields;
+ unless ( ref $attr eq 'HASH' ) {
+ $attr = { type => $attr };
+ }
+ push @new_fields, { name => $name, %$attr };
+ }
+ return \@new_fields;
+}
+
+# loop through array of field hashrefs
+sub _process_field_array {
+ my ( $self, $fields ) = @_;
+
+ # the point here is to process fields in the order parents
+ # before children, so we process all fields with no dots
+ # first, then one dot, then two dots...
+ my $num_fields = scalar @$fields;
+ my $num_dots = 0;
+ my $count_fields = 0;
+ while ( $count_fields < $num_fields ) {
+ foreach my $field (@$fields) {
+ my $count = ( $field->{name} =~ tr/\.// );
+ next unless $count == $num_dots;
+ $self->_make_field($field);
+ $count_fields++;
+ }
+ $num_dots++;
+ }
+}
+
+# Maps the field type to a field class, finds the parent,
+# sets the 'form' attribute, calls update_or_create
+# The 'field_attr' hashref must have a 'name' key
+sub _make_field {
+ my ( $self, $field_attr ) = @_;
+
+ $field_attr->{type} ||= 'Text';
+ my $type = $field_attr->{type};
+ my $name = $field_attr->{name};
+ return unless $name;
+
+ my $do_update;
+ if ( $name =~ /^\+(.*)/ ) {
+ $field_attr->{name} = $name = $1;
+ $do_update = 1;
+ }
+
+ my $class;
+ if( $type =~ s/^\+// ) {
+ # type prefixed with '+', not a built-in
+ if( ref $self->field_name_space eq 'ARRAY' ) {
+ my $loaded;
+ foreach my $ns (@{$self->field_name_space}) {
+ $class = $ns . "::" . $type;
+ try {
+ Class::MOP::load_class($class);
+ $loaded++;
+ };
+ last if $loaded;
+ }
+ die "Could not load field class '$type' for field '$name'"
+ unless $loaded;
+ }
+ elsif ( $self->field_name_space ) {
+ $class = $self->field_name_space . "::" . $type;
+ Class::MOP::load_class($class) or
+ die "Could not load field class '$class' for field '$name'";
+ }
+ else {
+ $class = $type;
+ Class::MOP::load_class($class) or
+ die "Could not load field class '$class' for field '$name'";
+ }
+ }
+ else {
+ # built-in. look in HTML::FormHandler::Field
+ # and HTML::FormHandlerX::Field
+ $class = 'HTML::FormHandler::Field::' . $type;
+ my @errors;
+ try {
+ Class::MOP::load_class($class);
+ } catch {
+ $class = 'HTML::FormHandlerX::Field::' . $type;
+ push @errors, $_;
+ try {
+ Class::MOP::load_class($class);
+ } catch {
+ push @errors, $_;
+ die "Could not load field class '$type' for field '$name'.".
+ join("\n[+] ", @errors);
+ };
+ };
+ }
+
+ $field_attr->{form} = $self->form if $self->form;
+ # parent and name correction for names with dots
+ if ( $field_attr->{name} =~ /\./ ) {
+ my @names = split /\./, $field_attr->{name};
+ my $simple_name = pop @names;
+ my $parent_name = join '.', @names;
+ my $parent = $self->field($parent_name);
+ if ($parent) {
+ die "The parent of field " . $field_attr->{name} . " is not a Compound Field"
+ unless $parent->isa('HTML::FormHandler::Field::Compound');
+ $field_attr->{parent} = $parent;
+ $field_attr->{name} = $simple_name;
+ }
+ }
+ elsif ( !( $self->form && $self == $self->form ) ) {
+ # set parent
+ $field_attr->{parent} = $self;
+ }
+ $self->_update_or_create( $field_attr->{parent} || $self->form,
+ $field_attr, $class, $do_update );
+}
+
+# update, replace, or create field
+# Create makes the field object and passes in the properties as constructor args.
+# Update changes properties on a previously created object.
+# Replace overwrites a field with a different configuration.
+# (The update/replace business is much the same as you'd see with inheritance.)
+# This function populates/updates the base object's 'field' array.
+sub _update_or_create {
+ my ( $self, $parent, $field_attr, $class, $do_update ) = @_;
+
+ my $index = $parent->field_index( $field_attr->{name} );
+ my $field;
+ if ( defined $index ) {
+ if ($do_update) # this field started with '+'. Update.
+ {
+ $field = $parent->field( $field_attr->{name} );
+ die "Field to update for " . $field_attr->{name} . " not found"
+ unless $field;
+ delete $field_attr->{name};
+ foreach my $key ( keys %{$field_attr} ) {
+ $field->$key( $field_attr->{$key} )
+ if $field->can($key);
+ }
+ }
+ else # replace existing field
+ {
+ $field = $self->new_field_with_traits( $class, $field_attr);
+ $parent->set_field_at( $index, $field );
+ }
+ }
+ else # new field
+ {
+ $field = $self->new_field_with_traits( $class, $field_attr);
+ $parent->add_field($field);
+ }
+ $field->form->reload_after_update(1)
+ if ( $field->form && $field->reload_after_update );
+}
+
+sub new_field_with_traits {
+ my ( $self, $class, $field_attr ) = @_;
+
+ my $widget = $field_attr->{widget};
+ my $field;
+ unless( $widget ) {
+ my $attr = $class->meta->find_attribute_by_name( 'widget' );
+ if ( $attr ) {
+ $widget = $attr->default;
+ }
+ }
+ my $widget_wrapper = $field_attr->{widget_wrapper};
+ $widget_wrapper ||= $field_attr->{form}->widget_wrapper if $field_attr->{form};
+ unless( $widget_wrapper ) {
+ my $attr = $class->meta->get_attribute('widget_wrapper');
+ $widget_wrapper = $class->meta->get_attribute('widget')->default if $attr;
+ $widget_wrapper ||= 'Simple';
+ }
+ my @traits;
+ if( $field_attr->{traits} ) {
+ @traits = @{$field_attr->{traits}};
+ delete $field_attr->{traits};
+ }
+ if( $widget ) {
+ my $widget_role = $self->get_widget_role( $widget, 'Field' );
+ my $wrapper_role = $self->get_widget_role( $widget_wrapper, 'Wrapper' );
+ push @traits, $widget_role, $wrapper_role;
+ }
+ if( @traits ) {
+ $field = $class->new_with_traits( traits => \@traits, %{$field_attr} );
+ }
+ else {
+ $field = $class->new( %{$field_attr} );
+ }
+ if( $field->form ) {
+ foreach my $key ( keys %{$field->form->widget_tags} ) {
+ $field->set_tag( $key, $field->form->widget_tags->{$key} )
+ unless $field->tag_exists($key);
+ };
+ }
+ return $field;
+}
+
+=head1 AUTHORS
+
+HTML::FormHandler Contributors; see HTML::FormHandler
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
+
+use namespace::autoclean;
+1;
diff --git a/lib/HTML/FormHandler/Field.pm b/lib/HTML/FormHandler/Field.pm
new file mode 100644
index 0000000..2b150ba
--- /dev/null
+++ b/lib/HTML/FormHandler/Field.pm
@@ -0,0 +1,1110 @@
+package HTML::FormHandler::Field;
+
+use HTML::FormHandler::Moose;
+use HTML::FormHandler::Field::Result;
+use Try::Tiny;
+
+with 'MooseX::Traits';
+with 'HTML::FormHandler::Validate';
+with 'HTML::FormHandler::Validate::Actions';
+with 'HTML::FormHandler::Widget::ApplyRole';
+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.
+
+Inheritance hierarchy of the distribution's field classes:
+
+ 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
+
+See the documentation or source for the individual fields.
+
+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 ATTRIBUTES
+
+=head2 Names, types, accessor
+
+=over
+
+=item name
+
+The name of the field. Used in the HTML form. Often a db accessor.
+The only required attribute.
+
+=item type
+
+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 accessor
+
+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:
+
+ 'event.start_date.month'
+
+=item full_accessor
+
+The field accessor with all parents
+
+=item html_name
+
+The full_name plus the form name if 'html_prefix' is set.
+
+=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 Field data
+
+=over
+
+=item inactive
+
+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.
+
+=item input
+
+The input string from the parameters passed in.
+
+=item value
+
+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'.
+
+=item fif
+
+Values used to fill in the form. Read only. Use a deflation to get
+from 'value' to 'fif' if the an inflator was used.
+
+ [% form.field('title').fif %]
+
+=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.
+
+=item parent
+
+A reference to the parent of this field. Compound fields are the
+parents for the fields they contain.
+
+=back
+
+=head2 Errors
+
+=over
+
+=item errors
+
+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.
+
+=item add_error
+
+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.
+
+ return $field->add_error( 'bad data' ) if $bad;
+
+=item error_fields
+
+Compound fields will have an array of errors from the subfields.
+
+=back
+
+=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)
+ 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
+
+=head2 widget
+
+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.
+
+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.
+
+Widget types for the provided field classes:
+
+ 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
+
+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.
+
+=head2 Flags
+
+ 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)
+
+=head2 Form methods for fields
+
+These provide the name of a method in a form (not the field ) which will act
+on a particular field.
+
+=over
+
+=item set_validate
+
+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_field 'title' => ( isa => 'Str', set_validate => 'check_title' );
+ has_field 'subtitle' => ( isa => 'Str', set_validate => 'check_title' );
+
+=item set_default
+
+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.
+
+=item default
+
+Provide an initial value just like the 'set_default' method, except in the field
+declaration:
+
+ has_field 'bax' => ( default => 'Default bax' );
+
+=back
+
+=head1 Constraints and Validations
+
+=head2 Constraints set in attributes
+
+=over
+
+=item required
+
+Flag indicating whether this field must have a value
+
+=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,
+ }
+
+=back
+
+=head2 apply
+
+Use the 'apply' keyword to specify an ArrayRef of constraints and coercions to
+be executed on the field at validate_field time.
+
+ 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):
+
+ has_field 'some_text_to_int' => (
+ apply => [ 'MyStr', 'MyInt' ]
+ );
+
+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 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:
+
+ apply => [ { type => 'MyStr', message => 'Not a valid value' } ];
+
+=head2 Non-Moose checks and transforms
+
+A simple 'check' constraint uses the 'check' keyword pointing to a coderef,
+a regular expression, or an array of valid values, plus a message.
+
+A 'check' coderef will be passed the current value of the field. It should
+return true or false:
+
+ has_field 'this_num' => (
+ apply => [
+ {
+ check => sub { if ( $_[0] =~ /(\d+)/ ) { return $1 > 10 } },
+ message => 'Must contain number greater than 10',
+ }
+ );
+
+A 'check' regular expression:
+
+ has_field 'some_text' => (
+ apply => [ { check => qr/aaa/, message => 'Must contain aaa' } ],
+ );
+
+A 'check' array of valid values:
+
+ has_field 'more_text' => (
+ apply => [ { check => ['aaa', 'bbb'], message => 'Must be aaa or bbb' } ]
+ );
+
+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.
+
+ has_field 'sprintf_filter' => (
+ apply => [ { transform => sub{ sprintf '<%.1g>', $_[0] } } ]
+ );
+
+=head2 trim
+
+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.
+
+ trim => { transform => sub {
+ my $string = shift;
+ $string =~ s/^\s+//;
+ $string =~ s/\s+$//;
+ return $string;
+ } }
+ trim => { type => MyTypeConstraint }
+
+Trimming is performed before any other defined actions.
+
+=head2 deflation, deflate
+
+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.
+
+ 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';
+
+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
+
+Normally if you have a deflation, you will need a matching inflation, which can be
+supplied via a 'transform' action. When deflating/inflating values, the 'value' hash
+only contains reliably inflated values after validation has been performed, since
+inflation is performed at validation time.
+
+=head1 Processing and validating the field
+
+=head2 validate_field
+
+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
+
+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 >>.
+
+ sub validate {
+ my $field = shift;
+ my $value = $field->value;
+ return $field->add_error( ... ) if ( ... );
+ }
+
+=cut
+
+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 => 'ro', isa => 'Bool' );
+has 'init_value' => ( is => 'rw', clearer => 'clear_init_value' );
+has 'default' => ( is => 'rw' );
+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' );
+
+sub has_input {
+ my $self = shift;
+ return unless $self->has_result;
+ return $self->result->has_input;
+}
+
+sub has_value {
+ my $self = shift;
+ return unless $self->has_result;
+ return $self->result->has_value;
+}
+
+# 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;
+}
+
+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;
+}
+
+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);
+}
+
+sub is_repeatable { }
+has 'reload_after_update' => ( is => 'rw', isa => 'Bool' );
+
+has 'fif_from_value' => ( isa => 'Str', is => 'ro' );
+
+sub fif {
+ my ( $self, $result ) = @_;
+
+ 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 ) {
+ 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 '';
+}
+
+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' );
+
+sub has_flag {
+ my ( $self, $flag_name ) = @_;
+ return unless $self->can($flag_name);
+ return $self->$flag_name;
+}
+
+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 $self->_localize($label);
+}
+has 'title' => ( isa => 'Str', is => 'rw' );
+has 'style' => ( isa => 'Str', is => 'rw' );
+has 'css_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'
+);
+
+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',
+);
+has 'trim' => (
+ is => 'rw',
+ default => sub { { transform => \&default_trim } }
+);
+
+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' },
+);
+
+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;
+}
+
+has 'input_param' => ( is => 'rw', isa => 'Str' );
+
+sub BUILDARGS {
+ my $class = shift;
+
+ # 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);
+}
+
+sub BUILD {
+ my ( $self, $params ) = @_;
+
+ $self->_set_default( $self->_comp_default_meth )
+ if( $self->form && $self->form->can( $self->_comp_default_meth ) );
+ # 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};
+}
+
+# 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 ) = @_;
+
+ if ( my @values = $self->get_default_value ) {
+ 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;
+}
+
+sub _result_from_input {
+ my ( $self, $result, $input, $exists ) = @_;
+
+ 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;
+}
+
+sub _result_from_object {
+ my ( $self, $result, $value ) = @_;
+
+ $self->_set_result($result);
+
+ 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;
+}
+
+sub full_name {
+ my $field = shift;
+
+ my $name = $field->name;
+ my $parent = $field->parent || return $name;
+ return $parent->full_name . '.' . $name;
+}
+
+sub full_accessor {
+ my $field = shift;
+
+ my $accessor = $field->accessor;
+ my $parent = $field->parent || return $accessor;
+ return $parent->full_accessor . '.' . $accessor;
+}
+
+sub add_error {
+ my ( $self, @message ) = @_;
+
+ unless ( defined $message[0] ) {
+ @message = ('field is invalid');
+ }
+ my $out;
+ try {
+ $out = $self->_localize(@message);
+ }
+ catch {
+ die "Error occurred localizing error message for " . $self->label . ". $_";
+ };
+
+ $self->push_errors($out);
+ return;
+}
+
+sub _apply_deflation {
+ my ( $self, $value ) = @_;
+
+ 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');
+}
+
+# use Class::MOP to clone
+sub clone {
+ my ( $self, %params ) = @_;
+ $self->meta->clone_object( $self, %params );
+}
+
+sub value_changed {
+ my ($self) = @_;
+
+ 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];
+}
+
+sub required_text { shift->required ? 'required' : 'optional' }
+
+sub has_some_value {
+ my $x = shift;
+
+ return unless defined $x;
+ return $x =~ /\S/ if !ref $x;
+ if ( ref $x eq 'ARRAY' ) {
+ for my $elem (@$x) {
+ return 1 if has_some_value($elem);
+ }
+ return 0;
+ }
+ if ( ref $x eq 'HASH' ) {
+ for my $key ( keys %$x ) {
+ return 1 if has_some_value( $x->{$key} );
+ }
+ return 0;
+ }
+ return blessed($x); # true if blessed, otherwise false
+}
+
+sub input_defined {
+ my ($self) = @_;
+ return unless $self->has_input;
+ return has_some_value( $self->input );
+}
+
+sub dump {
+ my $self = shift;
+
+ 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;
+
+ if ( $self->can('options') ) {
+ my $o = $self->options;
+ warn "HFH: options: " . Data::Dumper::Dumper $o;
+ }
+}
+
+sub apply_rendering_widgets {
+ my $self = shift;
+
+ if( $self->form ) {
+ $self->add_widget_name_space( @{$self->form->widget_name_space} );
+ }
+ 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;
+
+}
+
+=head1 AUTHORS
+
+HTML::FormHandler Contributors; see HTML::FormHandler
+
+Initially based on the original source code of L<Form::Processor::Field> by Bill Moseley
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl 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
new file mode 100644
index 0000000..a8878f1
--- /dev/null
+++ b/lib/HTML/FormHandler/Field/Boolean.pm
@@ -0,0 +1,39 @@
+package HTML::FormHandler::Field::Boolean;
+
+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;
+
+ my $v = $self->SUPER::value(@_);
+
+ return $v ? 1 : 0;
+}
+
+=head1 AUTHORS
+
+Gerda Shank
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl 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
new file mode 100644
index 0000000..9d9d8f9
--- /dev/null
+++ b/lib/HTML/FormHandler/Field/Captcha.pm
@@ -0,0 +1,108 @@
+package HTML::FormHandler::Field::Captcha;
+
+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' );
+has 'scramble' => ( isa => 'Int', is => 'rw', default => '0' );
+has 'lines' => ( isa => 'Int', is => 'rw', default => '2' );
+has 'gd_font' => ( isa => 'Str', is => 'rw', default => 'Large' );
+has 'image' => ( is => 'rw' );
+has '+css_class' => ( default => 'captcha' );
+
+has '+noupdate' => ( default => 1 );
+
+sub get_default_value {
+ my $self = shift;
+
+ my $captcha = $self->form->get_captcha;
+ if ($captcha) {
+ if ( $captcha->{validated} ) {
+ $self->required(0);
+ $self->widget('no_render');
+ }
+ else {
+ $self->required(1);
+ $self->widget('captcha');
+ $self->image( $captcha->{image} );
+ }
+ }
+ else {
+ $self->required(1);
+ $self->widget('captcha');
+ $self->gen_captcha;
+ }
+ return;
+}
+
+sub validate {
+ my $self = shift;
+
+ my $captcha = $self->form->get_captcha;
+ unless ( $captcha->{rnd} eq $self->value ) {
+ $self->add_error("Verification incorrect. Try again.");
+ $self->gen_captcha;
+ }
+ else {
+ $captcha->{validated} = 1;
+ }
+ return !$self->has_errors;
+}
+
+sub fif { }
+
+sub gen_captcha {
+ my $self = shift;
+
+ my ( $image, $type, $rnd ) = GD::SecurityImage->new(
+ height => $self->height,
+ width => $self->width,
+ scramble => $self->scramble,
+ lines => $self->lines,
+ gd_font => $self->gd_font,
+ )->random->create->out;
+ my $captcha = {
+ image => $image,
+ type => $type,
+ rnd => $rnd,
+ validated => 0,
+ };
+ $self->image($image);
+ $self->form->set_captcha($captcha);
+}
+
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
diff --git a/lib/HTML/FormHandler/Field/Checkbox.pm b/lib/HTML/FormHandler/Field/Checkbox.pm
new file mode 100644
index 0000000..c183029
--- /dev/null
+++ b/lib/HTML/FormHandler/Field/Checkbox.pm
@@ -0,0 +1,71 @@
+package HTML::FormHandler::Field::Checkbox;
+
+use HTML::FormHandler::Moose;
+extends 'HTML::FormHandler::Field';
+our $VERSION = '0.02';
+
+=head1 NAME
+
+HTML::FormHandler::Field::Checkbox - A checkbox field type
+
+=head1 DESCRIPTION
+
+This field is very similar to the Boolean Widget except that this
+field allows other positive values besides 1. Since unselected
+checkboxes do not return a parameter, fields with Checkbox type
+will always be set to the 'input_without_param' default if they
+do not appear in the form.
+
+=head2 widget
+
+checkbox
+
+=head2 checkbox_value
+
+In order to create the HTML for a checkbox, there must be a 'value="xx"'.
+This value is specified with the 'checkbox_value' attribute, which
+defaults to 1.
+
+=head2 input_without_param
+
+If the checkbox is not checked, it will be set to the value
+of this attribute (the unchecked value). Default = 0. Because
+unchecked checkboxes do not return anything in the HTTP parameters,
+the absence of a checkbox key in the parameters hash forces this
+field to this value. This means that Checkbox fields, unlike other
+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
+
+has '+widget' => ( default => 'checkbox' );
+has 'checkbox_value' => ( is => 'rw', default => 1 );
+has '+input_without_param' => ( default => 0 );
+
+sub value {
+ my $field = shift;
+ return $field->SUPER::value(@_) if @_;
+ my $v = $field->SUPER::value;
+ return defined $v ? $v : 0;
+}
+
+sub validate {
+ my $self = shift;
+ $self->add_error( $self->required_message ) if ( $self->required && !$self->value );
+}
+
+=head1 AUTHORS
+
+Gerda Shank
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl 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
new file mode 100644
index 0000000..8432201
--- /dev/null
+++ b/lib/HTML/FormHandler/Field/Compound.pm
@@ -0,0 +1,127 @@
+package HTML::FormHandler::Field::Compound;
+
+use Moose;
+extends 'HTML::FormHandler::Field';
+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 );
+has 'item' => ( is => 'rw', clearer => 'clear_item' );
+
+has '+field_name_space' => (
+ default => sub {
+ my $self = shift;
+ return $self->form->field_name_space
+ if $self->form && $self->form->field_name_space;
+ return '';
+ },
+);
+
+sub BUILD {
+ my $self = shift;
+ $self->_build_fields;
+}
+
+# this is for testing compound fields outside
+# of a form
+sub test_validate_field {
+ my $self = shift;
+ unless( $self->form ) {
+ if( $self->has_input ) {
+ $self->_result_from_input( $self->result, $self->input );;
+ }
+ else {
+ $self->_result_from_fields( $self->result );
+ }
+ }
+ $self->validate_field;
+ unless( $self->form ) {
+ $self->get_error_fields;
+ foreach my $err_res (@{$self->result->error_results}) {
+ $self->result->push_errors($err_res->all_errors);
+ }
+ }
+}
+
+around '_result_from_object' => sub {
+ my $orig = shift;
+ my $self = shift;
+ my ( $self_result, $item ) = @_;
+ $self->item($item) if $item;
+ $self->$orig(@_);
+};
+
+after 'clear_data' => sub {
+ my $self = shift;
+ $self->clear_item;
+};
+
+around '_result_from_input' => sub {
+ my $orig = shift;
+ my $self = shift;
+ my ( $self_result, $input, $exists ) = @_;
+ if ( !$input && !$exists ) {
+ return $self->_result_from_fields($self_result);
+ }
+ else {
+ return $self->$orig(@_);
+ }
+};
+
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
diff --git a/lib/HTML/FormHandler/Field/Date.pm b/lib/HTML/FormHandler/Field/Date.pm
new file mode 100644
index 0000000..7dd50d7
--- /dev/null
+++ b/lib/HTML/FormHandler/Field/Date.pm
@@ -0,0 +1,130 @@
+package HTML::FormHandler::Field::Date;
+
+use Moose;
+extends 'HTML::FormHandler::Field::Text';
+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
+has 'time_zone' => ( is => 'rw', isa => 'Str' ); # TODO
+has 'date_start' => ( is => 'rw', isa => 'Str', clearer => 'clear_date_start' );
+has 'date_end' => ( is => 'rw', isa => 'Str', clearer => 'clear_date_end' );
+has '+size' => ( default => '10' );
+
+# translator for Datepicker formats to DateTime strftime formats
+my $dp_to_dt = {
+ "d" => "\%e", # day of month (no leading zero)
+ "dd" => "\%1", # day of month (2 digits) "%d"
+ "o" => "\%4", # day of year (no leading zero) "%{day_of_year}"
+ "oo" => "\%j", # day of year (3 digits)
+ "D" => "\%a", # day name long
+ "DD" => "\%A", # day name short
+ "m" => "\%5", # month of year (no leading zero) "%{day_of_month}"
+ "mm" => "\%3", # month of year (two digits) "%m"
+ "M" => "\%b", # Month name short
+ "MM" => "\%B", # Month name long
+ "y" => "\%2", # year (2 digits) "%y"
+ "yy" => "\%Y", # year (4 digits)
+ "@" => "\%s", # epoch
+};
+
+sub deflate {
+ my ( $self, $value ) = @_;
+
+ $value ||= $self->value;
+ return unless ref $value eq 'DateTime';
+ my $format = $self->get_strf_format;
+ my $string = $value->strftime($format);
+ return $string;
+}
+
+sub validate {
+ my $self = shift;
+
+ my $format = $self->get_strf_format;
+ my $strp = DateTime::Format::Strptime->new( pattern => $format );
+
+ my $dt = eval { $strp->parse_datetime( $self->value ) };
+ unless ($dt) {
+ $self->add_error( $strp->errmsg || $@ );
+ return;
+ }
+ $self->_set_value($dt);
+ my $val_strp = DateTime::Format::Strptime->new( pattern => "%Y-%m-%d" );
+ if ( $self->date_start ) {
+ my $date_start = $val_strp->parse_datetime( $self->date_start );
+ die "date_start: " . $val_strp->errmsg unless $date_start;
+ my $cmp = DateTime->compare( $date_start, $dt );
+ $self->add_error("Date is too early") if $cmp eq 1;
+ }
+ if ( $self->date_end ) {
+ my $date_end = $val_strp->parse_datetime( $self->date_end );
+ die "date_end: " . $val_strp->errmsg unless $date_end;
+ my $cmp = DateTime->compare( $date_end, $dt );
+ $self->add_error("Date is too late") if $cmp eq -1;
+ }
+}
+
+sub get_strf_format {
+ my $self = shift;
+
+ # if contains %, then it's a strftime format
+ return $self->format if $self->format =~ /\%/;
+ my $format = $self->format;
+ foreach my $dpf ( reverse sort keys %{$dp_to_dt} ) {
+ my $strf = $dp_to_dt->{$dpf};
+ $format =~ s/$dpf/$strf/g;
+ }
+ $format =~ s/\%1/\%d/g,
+ $format =~ s/\%2/\%y/g,
+ $format =~ s/\%3/\%m/g,
+ $format =~ s/\%4/\%{day_of_year}/g,
+ $format =~ s/\%5/\%{day_of_month}/g,
+ return $format;
+}
+
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
diff --git a/lib/HTML/FormHandler/Field/DateMDY.pm b/lib/HTML/FormHandler/Field/DateMDY.pm
new file mode 100644
index 0000000..b2ceb47
--- /dev/null
+++ b/lib/HTML/FormHandler/Field/DateMDY.pm
@@ -0,0 +1,31 @@
+package HTML::FormHandler::Field::DateMDY;
+
+use HTML::FormHandler::Moose;
+extends 'HTML::FormHandler::Field::Date';
+
+has '+format' => ( default => '%m/%d/%Y' );
+
+=head1 NAME
+
+HTML::FormHandler::Field::DateMDY
+
+=head1 SYNOPSIS
+
+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
+
+Gerda Shank
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl 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
new file mode 100644
index 0000000..0e8bfaf
--- /dev/null
+++ b/lib/HTML/FormHandler/Field/DateTime.pm
@@ -0,0 +1,88 @@
+package HTML::FormHandler::Field::DateTime;
+
+use Moose;
+extends 'HTML::FormHandler::Field::Compound';
+
+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' );
+
+sub deflate {
+ my ( $self, $value ) = @_;
+ return $value unless ref $value eq 'DateTime';
+ my %hash;
+ foreach my $field ( $self->all_fields ) {
+ my $meth = $field->name;
+ $hash{$meth} = $value->$meth;
+ }
+ return \%hash;
+}
+
+sub validate {
+ my ($self) = @_;
+ my @dt_parms;
+ foreach my $child ( $self->all_fields ) {
+ next unless $child->value;
+ push @dt_parms, ( $child->accessor => $child->value );
+ }
+
+ # set the value
+ my $dt;
+ try {
+ $dt = DateTime->new(@dt_parms);
+ }
+ catch {
+ $self->add_error('Not a valid DateTime');
+ };
+ if( $dt ) {
+ $self->_set_value($dt);
+ }
+ else {
+ $self->_set_value( {@dt_parms} );
+ }
+}
+
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
+
diff --git a/lib/HTML/FormHandler/Field/Display.pm b/lib/HTML/FormHandler/Field/Display.pm
new file mode 100644
index 0000000..d459305
--- /dev/null
+++ b/lib/HTML/FormHandler/Field/Display.pm
@@ -0,0 +1,84 @@
+package HTML::FormHandler::Field::Display;
+
+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:
+
+ sub html_explanation {
+ my ( $self, $field ) = @_;
+ if( $self->something ) {
+ return '<p>This type of explanation...</p>';
+ }
+ else {
+ return '<p>Another type of explanation...</p>';
+ }
+ }
+
+or set the name of the rendering method:
+
+ has_field 'explanation' => ( type => 'Display', set_html => 'my_explanation' );
+ sub my_explanation {
+ ....
+ }
+
+=cut
+
+has 'html' => ( is => 'rw', isa => 'Str', builder => 'build_html' );
+sub build_html {''}
+has 'set_html' => ( isa => 'Str', is => 'ro');
+sub _set_html_meth {
+ my $self = shift;
+ return $self->set_html if $self->set_html;
+ my $name = $self->full_name;
+ $name =~ s/\./_/g;
+ $name =~ s/_\d+_/_/g;
+ return 'html_' . $name;
+}
+sub _can_form_html {
+ my $self = shift;
+ my $set_html = $self->_set_html_meth;
+ return
+ unless $self->form &&
+ $set_html &&
+ $self->form->can( $set_html );
+ return $set_html;
+}
+sub _form_html {
+ my $self = shift;
+ return unless (my $meth = $self->_can_form_html);
+ if( $self->form->meta->has_attribute( $meth ) ) {
+ return $self->form->$meth;
+ }
+ else {
+ return $self->form->$meth($self);
+ }
+}
+
+sub render {
+ my $self = shift;
+ if ( my $meth = $self->_can_form_html ) {
+ return $self->form->$meth( $self );
+ }
+ elsif ( $self->html ) {
+ return $self->html;
+ }
+ return '';
+}
+
+__PACKAGE__->meta->make_immutable;
+1;
diff --git a/lib/HTML/FormHandler/Field/Duration.pm b/lib/HTML/FormHandler/Field/Duration.pm
new file mode 100644
index 0000000..991ddce
--- /dev/null
+++ b/lib/HTML/FormHandler/Field/Duration.pm
@@ -0,0 +1,50 @@
+package HTML::FormHandler::Field::Duration;
+
+use Moose;
+extends 'HTML::FormHandler::Field::Compound';
+use DateTime;
+
+our $VERSION = '0.01';
+
+=head1 NAME
+
+HTML::FormHandler::Field::Duration - DateTime::Duration from HTML form values
+
+=head1 SubFields
+
+Subfield names:
+
+ years, months, weeks, days, hours, minutes, seconds, nanoseconds
+
+For example:
+
+ has 'duration' => ( type => 'Compound' );
+ has 'duration.hours' => ( type => 'Int', range_start => 0,
+ range_end => 23 );
+ has 'duration.minutes' => ( type => 'Int', range_start => 0,
+ range_end => 59 );
+
+
+=cut
+
+sub validate {
+ my ($self) = @_;
+
+ my @dur_parms;
+ foreach my $child ( $self->all_fields ) {
+ unless ( $child->value =~ /^\d+$/ ) {
+ $self->add_error( "Invalid value for " . $self->label . " " . $child->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;
+
diff --git a/lib/HTML/FormHandler/Field/Email.pm b/lib/HTML/FormHandler/Field/Email.pm
new file mode 100644
index 0000000..6369c80
--- /dev/null
+++ b/lib/HTML/FormHandler/Field/Email.pm
@@ -0,0 +1,46 @@
+package HTML::FormHandler::Field::Email;
+
+use HTML::FormHandler::Moose;
+extends 'HTML::FormHandler::Field::Text';
+use Email::Valid;
+our $VERSION = '0.02';
+
+apply(
+ [
+ {
+ transform => sub { lc( $_[0] ) }
+ },
+ {
+ check => sub { Email::Valid->address( $_[0] ) },
+ message => [ 'Email should be of the format [_1]', 'someuser at example.com' ]
+ }
+ ]
+);
+
+=head1 NAME
+
+HTML::FormHandler::Field::Email - Validates email uisng Email::Valid
+
+=head1 DESCRIPTION
+
+Validates that the input looks like an email address uisng L<Email::Valid>.
+Widget type is 'text'.
+
+=head1 DEPENDENCIES
+
+L<Email::Valid>
+
+=head1 AUTHORS
+
+Gerda Shank
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl 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
new file mode 100644
index 0000000..df42fa2
--- /dev/null
+++ b/lib/HTML/FormHandler/Field/Hidden.pm
@@ -0,0 +1,31 @@
+package HTML::FormHandler::Field::Hidden;
+
+use Moose;
+extends 'HTML::FormHandler::Field::Text';
+our $VERSION = '0.01';
+
+has '+widget' => ( default => 'hidden' );
+
+=head1 NAME
+
+HTML::FormHandler::Field::Hidden
+
+=head1 DESCRIPTION
+
+This is a text field that uses the 'hidden' widget type, for HTML
+of type 'hidden'.
+
+=head1 AUTHORS
+
+Zbigniew Lukasiak
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl 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
new file mode 100644
index 0000000..7571e31
--- /dev/null
+++ b/lib/HTML/FormHandler/Field/Hour.pm
@@ -0,0 +1,31 @@
+package HTML::FormHandler::Field::Hour;
+
+use Moose;
+extends 'HTML::FormHandler::Field::IntRange';
+our $VERSION = '0.03';
+
+has '+range_start' => ( default => 0 );
+has '+range_end' => ( default => 23 );
+
+=head1 NAME
+
+HTML::FormHandler::Field::Hour - accept integer from 0 to 23
+
+=head1 DESCRIPTION
+
+Enter an integer from 0 to 23 hours.
+
+=head1 AUTHORS
+
+Gerda Shank
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl 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
new file mode 100644
index 0000000..c33fcbe
--- /dev/null
+++ b/lib/HTML/FormHandler/Field/HtmlArea.pm
@@ -0,0 +1,101 @@
+package HTML::FormHandler::Field::HtmlArea;
+
+use Moose;
+extends 'HTML::FormHandler::Field::TextArea';
+use HTML::Tidy;
+use File::Temp;
+our $VERSION = '0.01';
+
+my $tidy;
+
+has '+widget' => ( default => 'textarea' );
+
+sub validate {
+ my $field = shift;
+
+ return unless $field->SUPER::validate;
+
+ $tidy ||= $field->tidy;
+ $tidy->clear_messages;
+
+ # parse doesn't pass the config file in HTML::Tidy.
+ $tidy->clean( $field->input );
+
+ my $ok = 1;
+
+ for ( $tidy->messages ) {
+ $field->add_error( $_->as_string );
+ $ok = 0;
+ }
+
+ return $ok;
+}
+
+# Parses config file. Do it once.
+
+my $tidy_config;
+
+sub tidy {
+ my $field = shift;
+ $tidy_config ||= $field->init_tidy;
+ my $t = HTML::Tidy->new( { config_file => $tidy_config } );
+
+ $t->ignore( text => qr/DOCTYPE/ );
+ $t->ignore( text => qr/missing 'title'/ );
+ # $t->ignore( type => TIDY_WARNING );
+
+ return $t;
+}
+
+sub init_tidy {
+
+ my $tidy_conf = <<EOF;
+char-encoding: utf8
+input-encoding: utf8
+output-xhtml: yes
+logical-emphasis: yes
+quiet: yes
+show-body-only: yes
+wrap: 45
+EOF
+
+ my $tidy_file = File::Temp->new( UNLINK => 1 );
+ print $tidy_file $tidy_conf;
+ close $tidy_file;
+
+ return $tidy_file;
+
+}
+
+=head1 NAME
+
+HTML::FormHandler::Field::HtmlArea - Input HTML in a textarea
+
+=head1 SYNOPSIS
+
+See L<HTML::FormHandler>
+
+=head1 DESCRIPTION
+
+Field validates using HTML::Tidy. A simple Tidy configuration file
+is created and written to disk each time the field is validated.
+Widget type is 'textarea'.
+
+=head1 DEPENDENCIES
+
+L<HTML::Tidy> L<File::Temp>
+
+=head1 AUTHORS
+
+Gerda Shank
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl 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
new file mode 100644
index 0000000..dd5165b
--- /dev/null
+++ b/lib/HTML/FormHandler/Field/IntRange.pm
@@ -0,0 +1,57 @@
+package HTML::FormHandler::Field::IntRange;
+
+use Moose;
+extends 'HTML::FormHandler::Field::Select';
+our $VERSION = '0.01';
+
+has 'label_format' => ( isa => 'Str', is => 'rw', default => '%d' );
+has '+range_start' => ( default => 1 );
+has '+range_end' => ( default => 10 );
+
+sub build_options {
+ my $self = shift;
+
+ my $start = $self->range_start;
+ my $end = $self->range_end;
+
+ for ( $start, $end ) {
+ die "Both range_start and range_end must be defined" unless defined $_;
+ die "Integer ranges must be integers" unless /^\d+$/;
+ }
+
+ die "range_start must be less than range_end" unless $start < $end;
+
+ my $format = $self->label_format || die 'IntRange needs label_format';
+
+ return [ map { { value => $_, label => sprintf( $format, $_ ) } }
+ $self->range_start .. $self->range_end ];
+}
+
+=head1 NAME
+
+HTML::FormHandler::Field::IntRange - Select an integer range in a select list
+
+=head1 DESCRIPTION
+
+This field generates a select list of numbers from 1 to 10. Override the
+range_start and range_end for a select list with a different range.
+
+ has_field 'age' => ( type => 'IntRange',
+ range_start => 0, range_end => 100 );
+
+Widget type is 'select'.
+
+=head1 AUTHORS
+
+Gerda Shank
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl 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
new file mode 100644
index 0000000..8bfec7b
--- /dev/null
+++ b/lib/HTML/FormHandler/Field/Integer.pm
@@ -0,0 +1,48 @@
+package HTML::FormHandler::Field::Integer;
+
+use HTML::FormHandler::Moose;
+extends 'HTML::FormHandler::Field::Text';
+our $VERSION = '0.02';
+
+has '+size' => ( default => 8 );
+
+apply(
+ [
+ {
+ transform => sub {
+ my $value = shift;
+ $value =~ s/^\+//;
+ return $value;
+ }
+ },
+ {
+ check => sub { $_[0] =~ /^-?[0-9]+$/ },
+ message => 'Value must be an integer'
+ }
+ ]
+);
+
+=head1 NAME
+
+HTML::FormHandler::Field::Integer - validate an integer value
+
+=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
+
+Gerda Shank
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl 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
new file mode 100644
index 0000000..645ab51
--- /dev/null
+++ b/lib/HTML/FormHandler/Field/Minute.pm
@@ -0,0 +1,33 @@
+package HTML::FormHandler::Field::Minute;
+
+use Moose;
+extends 'HTML::FormHandler::Field::IntRange';
+our $VERSION = '0.01';
+
+has '+range_start' => ( default => 0 );
+has '+range_end' => ( default => 59 );
+has '+label_format' => ( default => '%02d' );
+
+=head1 NAME
+
+HTML::FormHandler::Field::Minute - input range from 0 to 59
+
+=head1 DESCRIPTION
+
+Generate a select list for entering a minute value.
+Widget type is 'select'.
+
+=head1 AUTHORS
+
+Gerda Shank
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl 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
new file mode 100644
index 0000000..e5b0bfe
--- /dev/null
+++ b/lib/HTML/FormHandler/Field/Money.pm
@@ -0,0 +1,51 @@
+package HTML::FormHandler::Field::Money;
+
+use HTML::FormHandler::Moose;
+extends 'HTML::FormHandler::Field::Text';
+our $VERSION = '0.01';
+
+apply(
+ [
+ {
+ transform => sub {
+ my $value = shift;
+ $value =~ s/^\$//;
+ return $value;
+ }
+ },
+ {
+ transform => sub { sprintf '%.2f', $_[0] },
+ message => 'Value cannot be converted to money'
+ },
+ {
+ check => sub { $_[0] =~ /^-?\d+\.?\d*$/ },
+ message => 'Value must be a real number'
+ }
+ ]
+);
+
+=head1 NAME
+
+HTML::FormHandler::Field::Money - Input US currency-like values.
+
+=head1 DESCRIPTION
+
+Validates that a postive or negative real value is entered.
+Formatted with two decimal places.
+
+Uses a period for the decimal point. Widget type is 'text'.
+
+=head1 AUTHORS
+
+Gerda Shank
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl 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
new file mode 100644
index 0000000..9936c48
--- /dev/null
+++ b/lib/HTML/FormHandler/Field/Month.pm
@@ -0,0 +1,31 @@
+package HTML::FormHandler::Field::Month;
+
+use Moose;
+extends 'HTML::FormHandler::Field::IntRange';
+our $VERSION = '0.01';
+
+has '+range_start' => ( default => 1 );
+has '+range_end' => ( default => 12 );
+
+=head1 NAME
+
+HTML::FormHandler::Field::Month - Select list of 1 to 12
+
+=head1 DESCRIPTION
+
+Select list for range of 1 to 12. Widget type is 'select'
+
+=head1 AUTHORS
+
+Gerda Shank
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl 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
new file mode 100644
index 0000000..31ce73f
--- /dev/null
+++ b/lib/HTML/FormHandler/Field/MonthDay.pm
@@ -0,0 +1,31 @@
+package HTML::FormHandler::Field::MonthDay;
+
+use Moose;
+extends 'HTML::FormHandler::Field::IntRange';
+our $VERSION = '0.01';
+
+has '+range_start' => ( default => 1 );
+has '+range_end' => ( default => 31 );
+
+=head1 NAME
+
+HTML::FormHandler::Field::MonthDay - Select list for a day number 1 to 31
+
+=head1 DESCRIPTION
+
+Generates a select list for integers 1 to 31.
+
+=head1 AUTHORS
+
+Gerda Shank
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl 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
new file mode 100644
index 0000000..8a3e08c
--- /dev/null
+++ b/lib/HTML/FormHandler/Field/MonthName.pm
@@ -0,0 +1,47 @@
+package HTML::FormHandler::Field::MonthName;
+
+use Moose;
+extends 'HTML::FormHandler::Field::Select';
+our $VERSION = '0.01';
+
+sub build_options {
+ my $i = 1;
+ my @months = qw/
+ January
+ February
+ March
+ April
+ May
+ June
+ July
+ August
+ September
+ October
+ November
+ December
+ /;
+ return [ map { { value => $i++, label => $_ } } @months ];
+}
+
+=head1 NAME
+
+HTML::FormHandler::Field::MonthName - Select list for month names
+
+=head1 DESCRIPTION
+
+Generates a list of English month names.
+
+=head1 AUTHORS
+
+Gerda Shank
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl 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
new file mode 100644
index 0000000..8e6b394
--- /dev/null
+++ b/lib/HTML/FormHandler/Field/Multiple.pm
@@ -0,0 +1,52 @@
+package HTML::FormHandler::Field::Multiple;
+
+use Moose;
+extends 'HTML::FormHandler::Field::Select';
+our $VERSION = '0.01';
+
+has '+multiple' => ( default => 1 );
+has '+size' => ( default => 5 );
+
+sub sort_options {
+ my ( $self, $options ) = @_;
+
+ my $value = $self->value;
+ # This places the currently selected options at the top of the list
+ # Makes the drop down lists a bit nicer
+ if ( @$options && defined $value ) {
+ my %selected = map { $_ => 1 } ref($value) eq 'ARRAY' ? @$value : ($value);
+
+ my @out = grep { $selected{ $_->{value} } } @$options;
+ push @out, grep { !$selected{ $_->{value} } } @$options;
+
+ return \@out;
+ }
+ return $options;
+}
+
+=head1 NAME
+
+HTML::FormHandler::Field::Multiple - Select one or more options
+
+=head1 DESCRIPTION
+
+This inherits from the Select field,
+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
+
+Gerda Shank
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl 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
new file mode 100644
index 0000000..17c6117
--- /dev/null
+++ b/lib/HTML/FormHandler/Field/Nested.pm
@@ -0,0 +1,22 @@
+package HTML::FormHandler::Field::Nested;
+
+use Moose;
+extends 'HTML::FormHandler::Field::Text';
+
+=head1 NAME
+
+HTML::FormHandler::Field::Nested - for nested elements of compound fields
+
+=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
+
+
+
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
diff --git a/lib/HTML/FormHandler/Field/NoValue.pm b/lib/HTML/FormHandler/Field/NoValue.pm
new file mode 100644
index 0000000..6ec5b3f
--- /dev/null
+++ b/lib/HTML/FormHandler/Field/NoValue.pm
@@ -0,0 +1,62 @@
+package HTML::FormHandler::Field::NoValue;
+
+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' => (
+ is => 'rw',
+ predicate => 'has_value',
+);
+
+sub _result_from_fields {
+ my ( $self, $result ) = @_;
+ $self->_set_result($result);
+ $result->_set_field_def($self);
+ return $result;
+}
+
+sub _result_from_input {
+ my ( $self, $result, $input, $exists ) = @_;
+ $self->_set_result($result);
+ $result->_set_field_def($self);
+ return $result;
+}
+
+sub _result_from_object {
+ my ( $self, $result, $value ) = @_;
+ $self->_set_result($result);
+ $result->_set_field_def($self);
+ return $result;
+}
+
+sub fif { }
+
+has '+widget' => ( default => '' );
+has '+writeonly' => ( default => 1 );
+has '+noupdate' => ( default => 1 );
+
+sub validate_field { }
+
+sub clear_value { }
+
+sub render {
+ my $self = shift;
+ return $self->html;
+}
+
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
diff --git a/lib/HTML/FormHandler/Field/Password.pm b/lib/HTML/FormHandler/Field/Password.pm
new file mode 100644
index 0000000..68aaa68
--- /dev/null
+++ b/lib/HTML/FormHandler/Field/Password.pm
@@ -0,0 +1,87 @@
+package HTML::FormHandler::Field::Password;
+
+use HTML::FormHandler::Moose;
+extends 'HTML::FormHandler::Field::Text';
+our $VERSION = '0.04';
+
+=head1 NAME
+
+HTML::FormHandler::Field::Password - Input a password
+
+=head1 DESCRIPTION
+
+The password field has a default minimum length of 6, which can be
+easily changed:
+
+ has_field 'password' => ( type => 'Password', minlength => 7 );
+
+It does not come with additional default checks, since password
+requirements vary so widely. There are a few constraints in the
+L<HTML::FormHandler::Types> modules which could be used with this
+field: NoSpaces, WordChars, NotAllDigits.
+These constraints can be used in the field definitions 'apply':
+
+ use HTML::FormHandler::Types ('NoSpaces', 'WordChars', 'NotAllDigits' );
+ ...
+ has_field 'password' => ( type => 'Password',
+ apply => [ NoSpaces, WordChars, NotAllDigits ],
+ );
+
+You can add your own constraints in addition, of course.
+
+If a password field is not required, then the field will be marked 'noupdate',
+to prevent a null from being saved into the database.
+
+=head2 ne_username
+
+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
+
+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->SUPER::validate;
+
+ 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.
+
+=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
new file mode 100644
index 0000000..a7241b1
--- /dev/null
+++ b/lib/HTML/FormHandler/Field/PasswordConf.pm
@@ -0,0 +1,61 @@
+package HTML::FormHandler::Field::PasswordConf;
+
+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 );
+has '+required' => ( default => 1 );
+has '+required_message' => ( default => 'Please enter a password confirmation' );
+has 'password_field' => ( isa => 'Str', is => 'rw', default => 'password' );
+has 'pass_conf_message' => (
+ isa => 'Str',
+ is => 'rw',
+ default => 'The password confirmation does not match the password'
+);
+
+sub validate {
+ my $self = shift;
+
+ my $value = $self->value;
+ my $password = $self->form->field( $self->password_field )->value;
+ if ( $password ne $self->value ) {
+ $self->add_error( $self->pass_conf_message );
+ return;
+ }
+ return 1;
+}
+
+=head1 AUTHORS
+
+See L<HTML::FormHandler> for authors.
+
+=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.
+
+=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
new file mode 100644
index 0000000..b51f052
--- /dev/null
+++ b/lib/HTML/FormHandler/Field/PosInteger.pm
@@ -0,0 +1,37 @@
+package HTML::FormHandler::Field::PosInteger;
+
+use HTML::FormHandler::Moose;
+extends 'HTML::FormHandler::Field::Integer';
+our $VERSION = '0.02';
+
+apply(
+ [
+ {
+ check => sub { $_[0] >= 0 },
+ message => 'Value must be a positive integer'
+ }
+ ]
+);
+
+=head1 NAME
+
+HTML::FormHandler::Field::PosInteger - Validates input is a positive integer
+
+=head1 DESCRIPTION
+
+Tests that the input is an integer and has a postive value.
+
+=head1 AUTHORS
+
+Gerda Shank
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl 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
new file mode 100644
index 0000000..a6e4904
--- /dev/null
+++ b/lib/HTML/FormHandler/Field/PrimaryKey.pm
@@ -0,0 +1,22 @@
+package HTML::FormHandler::Field::PrimaryKey;
+
+use Moose;
+extends 'HTML::FormHandler::Field';
+
+=head1 NAME
+
+HTML::FormHandler::Field::PrimaryKey - field for primary keys for
+Repeatable related fields.
+
+=head1 SYNOPSIS
+
+ has_field 'addresses.address_id' => ( type => 'PrimaryKey' );
+
+=cut
+
+has 'is_primary_key' => ( isa => 'Bool', is => 'ro', default => '1' );
+has '+widget' => ( default => 'hidden' );
+
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
diff --git a/lib/HTML/FormHandler/Field/Radio.pm b/lib/HTML/FormHandler/Field/Radio.pm
new file mode 100644
index 0000000..332b681
--- /dev/null
+++ b/lib/HTML/FormHandler/Field/Radio.pm
@@ -0,0 +1,47 @@
+package HTML::FormHandler::Field::Radio;
+
+use Moose;
+extends 'HTML::FormHandler::Field';
+
+=head1 NAME
+
+HTML::FormHandler::Field::Radio
+
+=head1 SYNOPSIS
+
+This field is not currently used. Placeholder for possible future
+atomic radio buttons.
+
+ <label class="label" for="[% field.name %]">[% field.label</label>
+ <input name="[% field.name %]" type="radio"
+ value="[% field.radio_value %]"
+ [% IF field.fif == field.radio_value %]
+ select="selected"
+ [% 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 AUTHORS
+
+Gerda Shank
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl 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
new file mode 100644
index 0000000..10dbdac
--- /dev/null
+++ b/lib/HTML/FormHandler/Field/Repeatable.pm
@@ -0,0 +1,293 @@
+package HTML::FormHandler::Field::Repeatable;
+
+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' withsingle 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',
+ is => 'rw',
+ predicate => 'has_contains'
+);
+
+has 'num_when_empty' => ( isa => 'Int', is => 'rw', default => 1 );
+has 'index' => ( isa => 'Int', is => 'rw', default => 0 );
+has 'auto_id' => ( isa => 'Bool', is => 'rw', default => 0 );
+has '+reload_after_update' => ( default => 1 );
+has 'is_repeatable' => ( is => 'ro', default => 1 );
+
+sub _fields_validate {
+ my $self = shift;
+ # loop through array of fields and validate
+ my @value_array;
+ foreach my $field ( $self->all_fields ) {
+ 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;
+ }
+ $self->_set_value( \@value_array );
+}
+
+sub init_state {
+ my $self = shift;
+
+ # must clear out instances built last time
+ unless ( $self->has_contains ) {
+ if ( $self->num_fields == 1 && $self->field('contains') ) {
+ $self->contains( $self->field('contains') );
+ }
+ else {
+ $self->contains( $self->create_element );
+ }
+ }
+ $self->clear_fields;
+}
+
+sub create_element {
+ my ($self) = @_;
+ my $instance = Instance->new(
+ name => 'contains',
+ parent => $self,
+ form => $self->form
+ );
+ # copy the fields from this field into the instance
+ $instance->add_field( $self->all_fields );
+ if ( $self->auto_id ) {
+ unless ( grep $_->can('is_primary_key') && $_->is_primary_key, $instance->all_fields )
+ {
+ my $field = HTML::FormHandler::Field->new( type => 'PrimaryKey', name => 'id' );
+ $instance->add_field($field);
+ }
+ }
+ $_->parent($instance) for $instance->all_fields;
+ return $instance;
+}
+
+sub clone_element {
+ my ( $self, $result, $index ) = @_;
+
+ my $field = $self->contains->clone( errors => [], error_fields => [] );
+ $field->name($index);
+ $field->parent($self);
+ $field->_set_result($result);
+ $field->result->_set_field_def($field);
+ if ( $field->has_fields ) {
+ $self->clone_fields( $result, $field, [ $field->all_fields ] );
+ }
+ return $field;
+}
+
+sub clone_fields {
+ my ( $self, $parent_result, $parent, $fields ) = @_;
+ my @field_array;
+ $parent->fields( [] );
+ foreach my $field ( @{$fields} ) {
+ my $result = HTML::FormHandler::Field::Result->new(
+ name => $field->name,
+ parent => $parent_result
+ );
+ my $new_field = $field->clone( errors => [], error_fields => [] );
+ if ( $new_field->has_fields ) {
+ $self->clone_fields( $result, $new_field, [ $new_field->all_fields ] );
+ }
+ $new_field->parent($parent);
+ $new_field->_set_result($result);
+ $new_field->result->_set_field_def($new_field);
+ $parent_result->add_result($result);
+ $parent->add_field($new_field);
+ }
+}
+
+# params exist and validation will be performed (later)
+sub _result_from_input {
+ my ( $self, $result, $input ) = @_;
+
+ $self->init_state;
+ $result->_set_input($input);
+ $self->_set_result($result);
+ # if Repeatable has array input, need to build instances
+ $self->fields( [] );
+ if ( ref $input eq 'ARRAY' ) {
+ # build appropriate instance array
+ my $index = 0;
+ foreach my $element ( @{$input} ) {
+ next unless $element;
+ my $result = HTML::FormHandler::Field::Result->new(
+ name => $index,
+ parent => $self->result
+ );
+ my $field = $self->clone_element( $result, $index );
+ $result = $field->_result_from_input( $result, $element, 1 );
+ $self->result->add_result($result);
+ $self->add_field($field);
+ $index++;
+ }
+ $self->index($index);
+ }
+ $self->result->_set_field_def($self);
+ return $self->result;
+}
+
+# this is called when there is an init_object or an db item with values
+sub _result_from_object {
+ my ( $self, $result, $values ) = @_;
+
+ return $self->_result_from_fields( $result )
+ if ( $self->num_when_empty > 0 && !$values );
+ $self->item($values);
+ $self->init_state;
+ $self->_set_result($result);
+ # Create field instances and fill with values
+ my $index = 0;
+ my @new_values;
+ $self->fields( [] );
+ $values = [$values] if ( $values && ref $values ne 'ARRAY' );
+ foreach my $element ( @{$values} ) {
+ next unless $element;
+ my $result =
+ HTML::FormHandler::Field::Result->new( name => $index, parent => $self->result );
+ my $field = $self->clone_element( $result, $index );
+ $result = $field->_result_from_object( $result, $element );
+ push @new_values, $result->value;
+ $self->add_field($field);
+ $self->result->add_result( $field->result );
+ $index++;
+ }
+ $self->index($index);
+ $values = \@new_values if scalar @new_values;
+ $self->_set_value($values);
+ $self->result->_set_field_def($self);
+ return $self->result;
+}
+
+# create an empty form
+sub _result_from_fields {
+ my ( $self, $result ) = @_;
+
+ $self->init_state;
+ $self->_set_result($result);
+ my $count = $self->num_when_empty;
+ my $index = 0;
+ # build empty instance
+ $self->fields( [] );
+ while ( $count > 0 ) {
+ my $result =
+ HTML::FormHandler::Field::Result->new( name => $index, parent => $self->result );
+ my $field = $self->clone_element( $result, $index );
+ $result = $field->_result_from_fields($result);
+ $result->add_result( $field->result ) if $result;
+ $self->add_field($field);
+ $index++;
+ $count--;
+ }
+ $self->index($index);
+ $self->result->_set_field_def($self);
+ return $result;
+}
+
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
diff --git a/lib/HTML/FormHandler/Field/Repeatable/Instance.pm b/lib/HTML/FormHandler/Field/Repeatable/Instance.pm
new file mode 100644
index 0000000..95738aa
--- /dev/null
+++ b/lib/HTML/FormHandler/Field/Repeatable/Instance.pm
@@ -0,0 +1,28 @@
+package # hide from Pause
+ HTML::FormHandler::Field::Repeatable::Instance;
+
+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 {
+ my $field = shift;
+
+ my $parent = $field->parent || return '';
+ return $parent->full_accessor;
+}
+
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
diff --git a/lib/HTML/FormHandler/Field/Reset.pm b/lib/HTML/FormHandler/Field/Reset.pm
new file mode 100644
index 0000000..c1b006a
--- /dev/null
+++ b/lib/HTML/FormHandler/Field/Reset.pm
@@ -0,0 +1,26 @@
+package HTML::FormHandler::Field::Reset;
+
+use Moose;
+extends 'HTML::FormHandler::Field::NoValue';
+
+=head1 NAME
+
+HTML::FormHandler::Field::Reset - reset field
+
+=head1 SYNOPSIS
+
+Use this field to declare a reset field in your form.
+
+ has_field 'reset' => ( type => 'Reset', value => 'Restore' );
+
+Uses the 'reset' widget.
+
+=cut
+
+has '+widget' => ( default => 'reset' );
+
+has '+value' => ( default => 'Reset' );
+
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
diff --git a/lib/HTML/FormHandler/Field/Result.pm b/lib/HTML/FormHandler/Field/Result.pm
new file mode 100644
index 0000000..61b417a
--- /dev/null
+++ b/lib/HTML/FormHandler/Field/Result.pm
@@ -0,0 +1,50 @@
+package HTML::FormHandler::Field::Result;
+
+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',
+ isa => 'HTML::FormHandler::Field',
+ writer => '_set_field_def',
+);
+
+sub fif {
+ my $self = shift;
+ return $self->field_def->fif($self);
+}
+
+sub fields_fif {
+ my ( $self, $prefix ) = @_;
+ return $self->field_def->fields_fif( $self, $prefix );
+}
+
+sub render {
+ my $self = shift;
+ return $self->field_def->render($self);
+}
+
+=head1 AUTHORS
+
+HTML::FormHandler Contributors; see HTML::FormHandler
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl 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
new file mode 100644
index 0000000..17c62f8
--- /dev/null
+++ b/lib/HTML/FormHandler/Field/Second.pm
@@ -0,0 +1,31 @@
+package HTML::FormHandler::Field::Second;
+
+use Moose;
+extends 'HTML::FormHandler::Field::IntRange';
+our $VERSION = '0.01';
+
+has '+range_start' => ( default => 0 );
+has '+range_end' => ( default => 59 );
+
+=head1 NAME
+
+HTML::FormHandler::Field::Second - Select list for seconds
+
+=head1 DESCRIPTION
+
+A select field for seconds in the range of 0 to 59.
+
+=head1 AUTHORS
+
+Gerda Shank
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl 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
new file mode 100644
index 0000000..06bdde9
--- /dev/null
+++ b/lib/HTML/FormHandler/Field/Select.pm
@@ -0,0 +1,382 @@
+package HTML::FormHandler::Field::Select;
+
+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'.
+
+This field type can also be used for fields that use the
+'radio_group' widget.
+
+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:
+
+ sub build_options {
+ my $i = 0;
+ my @days = ('Sunday', 'Monday', 'Tuesday', 'Wednesday',
+ 'Thursday', 'Friday', 'Saturday' );
+ return [
+ map {
+ { value => $i++, label => $_ }
+ } @days
+ ];
+ }
+
+In a form:
+
+ sub options_fruit {
+ return (
+ 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 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',
+ is => 'rw',
+ traits => ['Array'],
+ auto_deref => 1,
+ handles => {
+ all_options => 'elements',
+ reset_options => 'clear',
+ clear_options => 'clear',
+ has_options => 'count',
+ num_options => 'count',
+ },
+ lazy => 1,
+ builder => 'build_options'
+);
+
+sub build_options { [] }
+has 'options_from' => ( isa => 'Str', is => 'rw', default => 'none' );
+has 'do_not_reload' => ( isa => 'Bool', is => 'ro' );
+
+sub BUILD {
+ my $self = shift;
+
+ $self->options_from('build') if $self->options && $self->has_options;
+}
+
+has 'set_options' => ( isa => 'Str', is => 'ro');
+sub _set_options_meth {
+ my $self = shift;
+ return $self->set_options if $self->set_options;
+ my $name = $self->full_name;
+ $name =~ s/\./_/g;
+ $name =~ s/_\d+_/_/g;
+ return 'options_' . $name;
+}
+sub _can_form_options {
+ my $self = shift;
+ my $set_options = $self->_set_options_meth;
+ return
+ unless $self->form &&
+ $set_options &&
+ $self->form->can( $set_options );
+ return $set_options;
+}
+
+sub _form_options {
+ my $self = shift;
+ return unless (my $meth = $self->_can_form_options);
+ my $attr = $self->form->meta->find_method_by_name( $meth );
+ if ( $attr and $attr->isa('Moose::Meta::Method::Accessor') ) {
+ return $self->form->$meth;
+ }
+ else {
+ return $self->form->$meth($self);
+ }
+}
+
+has 'multiple' => ( isa => 'Bool', is => 'rw', default => '0' );
+has 'size' => ( isa => 'Int|Undef', is => 'rw' );
+has 'label_column' => ( isa => 'Str', is => 'rw', default => 'name' );
+has 'active_column' => ( isa => 'Str', is => 'rw', default => 'active' );
+has 'auto_widget_size' => ( isa => 'Int', is => 'rw', default => '0' );
+has 'sort_column' => ( isa => 'Str', is => 'rw' );
+has '+widget' => ( default => 'select' );
+has 'empty_select' => ( isa => 'Str', is => 'rw' );
+
+sub select_widget {
+ my $field = shift;
+
+ my $size = $field->auto_widget_size;
+ return $field->widget unless $field->widget eq 'select' && $size;
+ my $options = $field->options || [];
+ return 'select' if @$options > $size;
+ return $field->multiple ? 'checkbox_group' : 'radio_group';
+}
+
+sub as_label {
+ my $field = shift;
+
+ my $value = $field->value;
+ return unless defined $value;
+
+ for ( $field->options ) {
+ return $_->{label} if $_->{value} eq $value;
+ }
+ return;
+}
+
+sub _inner_validate_field {
+ my ($self) = @_;
+
+ my $value = $self->value;
+ return 1 unless defined $value; # nothing to check
+
+ if ( ref $value eq 'ARRAY' &&
+ !( $self->can('multiple') && $self->multiple ) )
+ {
+ $self->add_error('This field does not take multiple values');
+ return;
+ }
+ elsif ( ref $value ne 'ARRAY' && $self->multiple ) {
+ $value = [$value];
+ $self->_set_value($value);
+ }
+
+ # create a lookup hash
+ my %options = map { $_->{value} => 1 } @{ $self->options };
+ for my $value ( ref $value eq 'ARRAY' ? @$value : ($value) ) {
+ unless ( $options{$value} ) {
+ $self->add_error("'$value' is not a valid value");
+ return;
+ }
+ }
+ return 1;
+}
+
+sub _result_from_object {
+ my ( $self, $result, $item ) = @_;
+
+ $result = $self->SUPER::_result_from_object( $result, $item );
+ $self->_load_options;
+ return $result;
+}
+
+sub _result_from_fields {
+ my ( $self, $result ) = @_;
+
+ $result = $self->SUPER::_result_from_fields($result);
+ $self->_load_options;
+ return $result;
+}
+
+sub _result_from_input {
+ my ( $self, $result, $input, $exists ) = @_;
+
+ $result = $self->SUPER::_result_from_input( $result, $input, $exists );
+ $self->_load_options;
+ return $result;
+}
+
+sub _load_options {
+ my $self = shift;
+
+ return
+ if ( $self->options_from eq 'build' ||
+ ( $self->has_options && $self->do_not_reload ) );
+ my @options;
+ if ( $self->_can_form_options ) {
+ @options = $self->_form_options;
+ $self->options_from('method');
+ }
+ elsif ( $self->form ) {
+ my $full_accessor;
+ $full_accessor = $self->parent->full_accessor if $self->parent;
+ @options = $self->form->lookup_options( $self, $full_accessor );
+ $self->options_from('model') if scalar @options;
+ }
+ return unless @options; # so if there isn't an options method and no options
+ # from a table, already set options attributes stays put
+
+ # allow returning arrayref
+ if ( ref $options[0] eq 'ARRAY' ) {
+ @options = @{ $options[0] };
+ }
+ return unless @options;
+ my $opts;
+ # if options_<field_name> is returning an already constructed array of hashrefs
+ if ( ref $options[0] eq 'HASH' ) {
+ $opts = \@options;
+ }
+ else {
+ croak "Options array must contain an even number of elements for field " . $self->name
+ if @options % 2;
+ push @{$opts}, { value => shift @options, label => shift @options } while @options;
+ }
+ if ($opts) {
+ my $opts = $self->sort_options($opts); # allow sorting options
+ $self->options($opts);
+ }
+}
+
+sub sort_options { shift; return shift; }
+
+=head1 AUTHORS
+
+Gerda Shank, gshank at cpan.org
+
+Based on the original source code of L<Form::Processor::Field::Select> by Bill Moseley
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl 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
new file mode 100644
index 0000000..1ac4d97
--- /dev/null
+++ b/lib/HTML/FormHandler/Field/Submit.pm
@@ -0,0 +1,36 @@
+package HTML::FormHandler::Field::Submit;
+
+use Moose;
+extends 'HTML::FormHandler::Field::NoValue';
+
+=head1 NAME
+
+HTML::FormHandler::Field::Submit - submit field
+
+=head1 SYNOPSIS
+
+Use this field to declare a submit field in your form.
+
+ has_field 'submit' => ( type => 'Submit', value => 'Save' );
+
+It will be used by L<HTML::FormHandler::Render::Simple> to construct
+a form with C<< $form->render >>.
+
+Uses the 'submit' widget.
+
+=cut
+
+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;
diff --git a/lib/HTML/FormHandler/Field/Text.pm b/lib/HTML/FormHandler/Field/Text.pm
new file mode 100644
index 0000000..793d01e
--- /dev/null
+++ b/lib/HTML/FormHandler/Field/Text.pm
@@ -0,0 +1,94 @@
+package HTML::FormHandler::Field::Text;
+
+use Moose;
+extends 'HTML::FormHandler::Field';
+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]',
+);
+has 'minlength' => ( isa => 'Int|Undef', is => 'rw', default => '0' );
+has 'minlength_message' => ( isa => 'Str', is => 'rw',
+ default => 'Field must be at least [quant,_1,character]. You entered [_2]' );
+has 'min_length' => (
+ isa => 'Int|Undef',
+ is => 'rw',
+ default => '0',
+ reader => '_min_length_r',
+ writer => '_min_length_w'
+); # for backcompat
+
+sub min_length {
+ my ( $self, $value ) = @_;
+ warn "Please use the 'minlength' attribute - 'min_length' is deprecated";
+ if ($value) {
+ $self->_min_length_w($value);
+ }
+ return $self->_min_length_r;
+}
+
+has '+widget' => ( default => 'text' );
+
+sub validate {
+ my $field = shift;
+
+ return unless $field->SUPER::validate;
+ my $value = $field->input;
+ # Check for max length
+ if ( my $maxlength = $field->maxlength ) {
+ return $field->add_error( $field->maxlength_message,
+ $maxlength, length $value, $field->label )
+ if length $value > $maxlength;
+ }
+
+ # Check for min length
+ if ( my $minlength = $field->minlength || $field->_min_length_r ) {
+ return $field->add_error(
+ $field->minlength_message,
+ $minlength, length $value, $field->label )
+ if length $value < $minlength;
+ }
+ return 1;
+}
+
+=head1 NAME
+
+HTML::FormHandler::Field::Text - A simple text entry field
+
+=head1 DESCRIPTION
+
+This is a simple text entry field. Widget type is 'text'.
+
+=head1 METHODS
+
+=head2 size [integer]
+
+This is used in constructing HTML. It determines the size of the input field.
+The 'maxlength' field should be used as a constraint on the size of the field,
+not this attribute.
+
+=head2 minlength [integer]
+
+This integer value, if non-zero, defines the minimum number of characters that must
+be entered.
+
+=head2 maxlength [integer]
+
+A constraint on the maximum length of the text.
+
+=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
+
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
diff --git a/lib/HTML/FormHandler/Field/TextArea.pm b/lib/HTML/FormHandler/Field/TextArea.pm
new file mode 100644
index 0000000..fa7b4b2
--- /dev/null
+++ b/lib/HTML/FormHandler/Field/TextArea.pm
@@ -0,0 +1,28 @@
+package HTML::FormHandler::Field::TextArea;
+
+use Moose;
+extends 'HTML::FormHandler::Field';
+our $VERSION = '0.01';
+
+has '+widget' => ( default => 'textarea' );
+has 'cols' => ( isa => 'Int', is => 'rw' );
+has 'rows' => ( isa => 'Int', is => 'rw' );
+
+=head1 NAME
+
+HTML::FormHandler::Field::TextArea - Multiple line input
+
+=head1 AUTHORS
+
+Gerda Shank
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl 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
new file mode 100644
index 0000000..fc2bf6b
--- /dev/null
+++ b/lib/HTML/FormHandler/Field/Upload.pm
@@ -0,0 +1,85 @@
+package HTML::FormHandler::Field::Upload;
+
+use Moose;
+use Moose::Util::TypeConstraints;
+
+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 L<Catalyst::Request::Upload>.
+Validates that the input is an uploaded file.
+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' );
+ 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 );
+has max_size => ( is => 'rw', isa => 'Int', default => 1048576 );
+
+
+sub validate {
+ my $self = shift;
+
+ my $upload = $self->value;
+ blessed($upload) and
+ $upload->size > 0 or
+ return $self->add_error('File uploaded is empty');
+
+ my $size = $upload->size;
+
+ $upload->size >= $self->min_size or
+ return $self->add_error( 'File is too small (< [_1] bytes)', $self->min_size );
+
+ $upload->size <= $self->max_size or
+ return $self->add_error( 'File is too big (> [_1] bytes)', $self->max_size );
+}
+
+__PACKAGE__->meta->make_immutable;
+
+=head1 AUTHOR
+
+Bernhard Graf & Oleg Kostyuk
+
+and FormHandler contributors
+
+=head1 LICENSE
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl 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
new file mode 100644
index 0000000..8386f1b
--- /dev/null
+++ b/lib/HTML/FormHandler/Field/Weekday.pm
@@ -0,0 +1,42 @@
+package HTML::FormHandler::Field::Weekday;
+
+use Moose;
+extends 'HTML::FormHandler::Field::Select';
+our $VERSION = '0.01';
+
+sub build_options {
+ my $i = 0;
+ my @days = qw/
+ Sunday
+ Monday
+ Tuesday
+ Wednesday
+ Thursday
+ Friday
+ Saturday
+ /;
+ return [ map { { value => $i++, label => $_ } } @days ];
+}
+
+=head1 NAME
+
+HTML::FormHandler::Field::Weekday - Select valid day of the week
+
+=head1 DESCRIPTION
+
+Creates an option list for the days of the week.
+
+=head1 AUTHORS
+
+Gerda Shank
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl 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
new file mode 100644
index 0000000..9d5f05d
--- /dev/null
+++ b/lib/HTML/FormHandler/Field/Year.pm
@@ -0,0 +1,43 @@
+package HTML::FormHandler::Field::Year;
+
+use Moose;
+extends 'HTML::FormHandler::Field::IntRange';
+
+our $VERSION = '0.01';
+
+has '+range_start' => (
+ default => sub {
+ my $year = (localtime)[5] + 1900 - 5;
+ return $year;
+ }
+);
+has '+range_end' => (
+ default => sub {
+ my $year = (localtime)[5] + 1900 + 10;
+ return $year;
+ }
+);
+
+=head1 NAME
+
+HTML::FormHandler::Field::Year - Select a recent year.
+
+=head1 DESCRIPTION
+
+Provides a list of years starting five years back and extending 10 years into
+the future.
+
+=head1 AUTHORS
+
+Gerda Shank
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
+
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
diff --git a/lib/HTML/FormHandler/Fields.pm b/lib/HTML/FormHandler/Fields.pm
new file mode 100644
index 0000000..5aeb8d2
--- /dev/null
+++ b/lib/HTML/FormHandler/Fields.pm
@@ -0,0 +1,234 @@
+package HTML::FormHandler::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'],
+ isa => 'ArrayRef[HTML::FormHandler::Field]',
+ is => 'rw',
+ default => sub { [] },
+ auto_deref => 1,
+ handles => {
+ all_fields => 'elements',
+ clear_fields => 'clear',
+ push_field => 'push',
+ num_fields => 'count',
+ has_fields => 'count',
+ set_field_at => 'set',
+ }
+);
+
+# compatibility wrappers for result errors
+sub error_fields {
+ my $self = shift;
+ return map { $_->field_def } @{ $self->result->error_results };
+}
+sub has_error_fields { shift->result->has_error_results }
+
+sub add_error_field {
+ my ( $self, $field ) = @_;
+ $self->result->add_error_result( $field->result );
+}
+sub num_error_fields { shift->result->num_error_results }
+
+sub add_field {
+ shift->push_field(@_);
+}
+
+has 'field_name_space' => (
+ isa => 'Str|ArrayRef[Str]|Undef',
+ is => 'rw',
+ lazy => 1,
+ default => '',
+);
+
+sub field_index {
+ my ( $self, $name ) = @_;
+ my $index = 0;
+ for my $field ( $self->all_fields ) {
+ return $index if $field->name eq $name;
+ $index++;
+ }
+ return;
+}
+
+sub field {
+ my ( $self, $name, $die ) = @_;
+
+ my $index;
+ # if this is a full_name for a compound field
+ # walk through the fields to get to it
+ return undef unless ( defined $name );
+ if ( $name =~ /\./ ) {
+ my @names = split /\./, $name;
+ my $f = $self->form || $self;
+ foreach my $fname (@names) {
+ $f = $f->field($fname);
+ return unless $f;
+ }
+ return $f;
+ }
+ else # not a compound name
+ {
+ for my $field ( $self->all_fields ) {
+ return $field if ( $field->name eq $name );
+ }
+ }
+ return unless $die;
+ die "Field '$name' not found in '$self'";
+}
+
+sub sorted_fields {
+ my $self = shift;
+
+ my @fields = sort { $a->order <=> $b->order }
+ grep { !$_->inactive || ($_->inactive && $_->_active) } $self->all_fields;
+ return wantarray ? @fields : \@fields;
+}
+
+# the routine for looping through and processing each field
+sub _fields_validate {
+ my $self = shift;
+
+ return unless $self->has_fields;
+ # validate all fields
+ my %value_hash;
+ foreach my $field ( $self->all_fields ) {
+ next if ( ($field->inactive && !$field->_active) || !$field->has_result );
+ # Validate each field and "inflate" input -> value.
+ $field->validate_field; # this calls the field's 'validate' routine
+ $value_hash{ $field->accessor } = $field->value
+ if ( $field->has_value && !$field->noupdate );
+ }
+ $self->_set_value( \%value_hash );
+}
+
+sub fields_set_value {
+ my $self = shift;
+ my %value_hash;
+ foreach my $field ( $self->all_fields ) {
+ next if ( ($field->inactive && !$field->_active) || !$field->has_result );
+ $value_hash{ $field->accessor } = $field->value
+ if ( $field->has_value && !$field->noupdate );
+ }
+ $self->_set_value( \%value_hash );
+}
+
+sub fields_fif {
+ my ( $self, $result, $prefix ) = @_;
+
+ $result ||= $self->result;
+ return unless $result;
+ $prefix ||= '';
+ if ( $self->isa('HTML::FormHandler') ) {
+ $prefix = $self->name . "." if $self->html_prefix;
+ }
+ my %params;
+ foreach my $fld_result ( $result->results ) {
+ my $field = $fld_result->field_def;
+ next if ( ($field->inactive && !$field->_active) || $field->password );
+ my $fif = $fld_result->fif;
+ next if ( !defined $fif || (ref $fif eq 'ARRAY' && ! scalar @{$fif} ) );
+ if ( $fld_result->has_results ) {
+ my $next_params = $fld_result->fields_fif( $prefix . $field->name . '.' );
+ next unless $next_params;
+ %params = ( %params, %{$next_params} );
+ }
+ else {
+ $params{ $prefix . $field->name } = $fif;
+ }
+ }
+ return if !%params;
+ return \%params;
+}
+
+sub clear_data {
+ my $self = shift;
+ $self->clear_result;
+ $self->clear_active;
+ $_->clear_data for $self->all_fields;
+}
+
+sub get_error_fields {
+ my $self = shift;
+
+ my @error_results;
+ foreach my $field ( $self->sorted_fields ) {
+ next unless $field->has_result;
+ if ( $field->has_fields ) {
+ $field->get_error_fields;
+ push @error_results, @{ $field->result->error_results }
+ if $field->result->has_error_results;
+ }
+ push @error_results, $field->result if $field->result->has_errors;
+ }
+ $self->result->add_error_result(@error_results) if scalar @error_results;
+}
+
+sub dump_fields { shift->dump(@_) }
+
+sub dump {
+ my $self = shift;
+
+ warn "HFH: ------- fields for ", $self->name, "-------\n";
+ for my $field ( $self->sorted_fields ) {
+ $field->dump;
+ }
+ warn "HFH: ------- end fields -------\n";
+}
+
+sub dump_validated {
+ my $self = shift;
+ warn "HFH: fields validated:\n";
+ foreach my $field ( $self->all_fields ) {
+ $field->dump_validated if $field->can('dump_validated');
+ warn "HFH: ", $field->name, ": ",
+ ( $field->has_errors ? join( ' | ', $field->errors ) : 'validated' ), "\n";
+ }
+}
+
+use namespace::autoclean;
+1;
diff --git a/lib/HTML/FormHandler/I18N.pm b/lib/HTML/FormHandler/I18N.pm
new file mode 100644
index 0000000..89ebd10
--- /dev/null
+++ b/lib/HTML/FormHandler/I18N.pm
@@ -0,0 +1,20 @@
+package HTML::FormHandler::I18N;
+use strict;
+use warnings;
+use base ('Locale::Maketext');
+use Try::Tiny;
+
+sub maketext {
+ my ( $lh, @message ) = @_;
+ my $out;
+ try {
+ $out = $lh->SUPER::maketext(@message);
+ }
+ catch {
+ die "Unable to do maketext on: " . $message[0];
+ };
+ return $out;
+}
+
+1;
+
diff --git a/lib/HTML/FormHandler/I18N/de_de.pm b/lib/HTML/FormHandler/I18N/de_de.pm
new file mode 100644
index 0000000..2e7f8c4
--- /dev/null
+++ b/lib/HTML/FormHandler/I18N/de_de.pm
@@ -0,0 +1,63 @@
+package HTML::FormHandler::I18N::de_de;
+use strict;
+use warnings;
+use base 'HTML::FormHandler::I18N';
+
+use utf8;
+
+# Auto define lexicon
+our %Lexicon = (
+ '_AUTO' => 1,
+
+ # H::F::Field::Email
+ 'Email should be of the format [_1]' => 'E-Mail sollte die Form [_1] haben',
+
+ # H::F::Field::Integer
+ 'Value must be an integer' => 'Muss eine positive ganze Zahl sein',
+
+ # H::F::Field::Money
+ 'Value cannot be converted to money' => 'Wert kann nicht in Betrag konvertiert werden',
+ 'Value must be a real number' => 'Muss eine Dezimalzahl sein',
+
+ # H::F::Field::Password
+ 'Please enter a password in this field' => 'Bitte ein Passwort eingeben',
+
+ # H::F::Field::PasswordConf
+ 'Please enter a password confirmation' => 'Bitte das Passwort bestätigen',
+
+ # H::F::Field::PosInteger
+ 'Value must be a positive integer' => 'Muss eine positive ganze Zahl sein',
+
+ # H::F::Field
+ 'field is invalid' => 'Feld ist ungültig',
+
+ # H::F::Types
+ 'Must be a positive number' => 'Muss eine positive Zahl sein',
+ 'Must be a positive integer' => 'Muss eine positive ganze Zahl sein',
+ 'Must be a negative number' => 'Muss eine negative Zahl sein',
+ 'Must be a negative integer' => 'Muss eine negative ganze Zahl sein',
+ 'Must be a single digit' => 'Muss eine einzelne Ziffer sein',
+ 'Must be a single line of no more than 255 chars' => 'Muss eine einzelne Zeile (max. 255 Zeichen) sein',
+ 'Must be a non-empty single line of no more than 255 chars' => 'Muss eine nicht leere Zeile (max. 255 Zeichen) sein',
+ 'Must be between 4 and 255 chars' => '4 bis 255 Zeichen erforderlich',
+ 'Not a valid state' => 'Kein gültiger Bundesstaat',
+ 'Email is not valid' => 'E-Mail ist nicht gültig',
+ 'Zip is not valid' => 'PLZ ungültig',
+ 'Not a valid IP address' => 'IP Adresse ungültig',
+ 'Cannot contain spaces' => 'Darf keine Leerzeichen enthalten',
+ 'Must be made up of letters, digits, and underscores' => 'Darf nur Buchstaben, Ziffern oder "_" enthalten',
+ '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',
+ ### not translatable: '"$value" does not match' => '',
+ ### not translatable: '"$value" not allowed' => '',
+ );
+
+1;
+
+
+
+
diff --git a/lib/HTML/FormHandler/I18N/en_us.pm b/lib/HTML/FormHandler/I18N/en_us.pm
new file mode 100644
index 0000000..0e9ee7c
--- /dev/null
+++ b/lib/HTML/FormHandler/I18N/en_us.pm
@@ -0,0 +1,15 @@
+package HTML::FormHandler::I18N::en_us;
+use strict;
+use warnings;
+use base 'HTML::FormHandler::I18N';
+
+# Auto define lexicon
+our %Lexicon = (
+ '_AUTO' => 1,
+ );
+
+1;
+
+
+
+
diff --git a/lib/HTML/FormHandler/I18N/hu_hu.pm b/lib/HTML/FormHandler/I18N/hu_hu.pm
new file mode 100644
index 0000000..dbe0aa6
--- /dev/null
+++ b/lib/HTML/FormHandler/I18N/hu_hu.pm
@@ -0,0 +1,93 @@
+package HTML::FormHandler::I18N::hu_hu;
+use strict;
+use warnings;
+use utf8;
+use base 'HTML::FormHandler::I18N';
+
+# translator: Csaba Hetényi
+# notify before release: cub at cpan.org
+
+# Auto define lexicon
+our %Lexicon = (
+ '_AUTO' => 1,
+
+ # H::F::Field::Date
+ 'Date is too early' => 'A dátum túl korai',
+ 'Date is too late' => 'A dátum túl késő',
+
+ # H::F::Field::DateTime
+ 'Not a valid DateTime' => 'Érvénytelen formátum',
+
+ # H::F::Field::Email
+ 'Email should be of the format [_1]' => 'Az email [_1] formátumú legyen',
+
+ # H::F::Field::Integer
+ 'Value must be an integer' => 'Az érték egész szám legyen',
+
+ # H::F::Field::Money
+ 'Value cannot be converted to money' => 'Az érték nem alakítható pénz formátumra',
+ 'Value must be a real number' => 'Az érték valós szám kell legyen',
+
+ # H::F::Field::Password
+ 'Please enter a password in this field' => 'Légyszíves adj meg jelszót ebben a mezőben',
+
+ # H::F::Field::PasswordConf
+ 'Please enter a password confirmation' => 'Jelszó megerősítése',
+
+ # H::F::Field::PosInteger
+ 'Value must be a positive integer' => 'Pozitív egész szám szükséges',
+
+ # H::F::Field::Select
+ 'This field does not take multiple values' => 'Ez a mező csak egy értéket kaphat',
+
+ # H::F::Field::Text
+ 'Please limit to [quant,_1,character]. You submitted [_2]' => 'A maximális hossz: [_1] karakter. A tiéd pedig: [_2]',
+ 'Input must be at least [quant,_1,character]. You submitted [_2]' => 'A minimális hossz: [_1] karakter. A tiéd pedig: [_2]',
+
+ # H:: F:: Field:: Upload
+ 'File uploaded is empty' => 'A feltöltött fájl üres',
+ 'File is too small (<[_1] bytes)' => 'A fájl túl kicsi (<[_1] byte)',
+ 'File is too big (> [_1] bytes)' => 'A fájl túl nagy (>[_1] byte)',
+
+ # H:: F:: Field
+ 'field is invalid' => 'A mező érvénytelen',
+
+ # H:: F:: Model
+ 'Value must be unique in the database' => 'Az érték egyedi kell legyen az adatbázisban',
+
+ # H:: F:: Types
+ 'Must be a positive number' => 'Pozitív szám szükséges',
+ 'Must be a positive integer' => 'Pozitív egész szám szükséges',
+ 'Must be a negative number' => 'Negatív szám szükséges',
+ 'Must be a negative integer' => 'Negatív egész szám szükséges',
+ 'Must be a single digit' => 'Egy számjegy szükséges',
+ 'Must be a single line of no more than 255 chars' => 'Egy sor legyen és ne legyen több 255 karakternél',
+ 'Must be a non-empty single line of no more than 255 chars' => 'Nem lehet üres sor és nem lehet több 255 karakternél',
+ 'Must be between 4 and 255 chars' => '4 és 255 karakter közt legyen',
+ 'Not a valid state' => 'Érvénytelen állapot',
+ 'Email is not valid' => 'Az email cím nem megfelelő',
+ 'Zip is not valid' => 'Az irányítószám nem megfelelő',
+ 'Not a valid IP address' => 'Az IP cím nem megfelelő',
+ 'Cannot contain spaces' => 'Nem tartalmazhat szóközt',
+ 'Must be made up of letters, digits, and underscores' => 'Csak betűket, számokat és alulvonást tartalmazhat',
+ 'Must not be all digits' => 'Nem csak számok szükségesek',
+ 'Field contains non-printable characters' => 'A mező nem nyomtatható karaktert tartalmaz',
+ 'Field must contain a single word' => 'A mező csak egy szót tartalmazhat',
+
+ # H:: F:: Validate:: Actions
+ 'Wrong value' => 'Rossz érték',
+ # # # Not translatable: ' "$ value" does not match' =>'',
+ # # # Not translatable: ' "$ value" not allowed' =>'',
+
+ # H:: F:: Validate
+ 'value must be between [_1] and [_2]' => 'az érték [_1] és [_2] között legyen',
+ 'value must be greater than or equal to [_1]' => 'az érték nagyobb vagy egyenlő legyen: [_1]',
+ 'value must be less than or equal to [_1]' => 'az érték kisebb vagy egyenlő legyen: [_1]',
+ '[_1] field is required' => 'A [_1] mező szükséges',
+
+ # Other
+ 'Your datetime does not match your pattern.' => 'A datetime érték nem illeszkedik a mintára.',
+);
+
+1;
+
diff --git a/lib/HTML/FormHandler/I18N/ru_ru.pm b/lib/HTML/FormHandler/I18N/ru_ru.pm
new file mode 100644
index 0000000..b14ca59
--- /dev/null
+++ b/lib/HTML/FormHandler/I18N/ru_ru.pm
@@ -0,0 +1,94 @@
+package HTML::FormHandler::I18N::ru_ru;
+use strict;
+use warnings;
+use utf8;
+use base 'HTML::FormHandler::I18N';
+
+# translator: Oleg Kostyuk
+# notify before release: cub at cpan.org
+
+# Auto define lexicon
+our %Lexicon = (
+ '_AUTO' => 1,
+
+ # H::F::Field::Date
+ 'Date is too early' => 'Слишком ранняя дата',
+ 'Date is too late' => 'Слишком поздняя дата',
+
+ # H::F::Field::DateTime
+ 'Not a valid DateTime' => 'Неверная дата/время',
+
+ # H::F::Field::Email
+ 'Email should be of the format [_1]' => 'Адрес электронной почты должен быть в формате [_1]',
+
+ # H::F::Field::Integer
+ 'Value must be an integer' => 'Значение должно быть целым числом',
+
+ # H::F::Field::Money
+ 'Value cannot be converted to money' => 'Значение не может быть воспринято как денежное',
+ 'Value must be a real number' => 'Значение должно быть вещественным числом',
+
+ # H::F::Field::Password
+ 'Please enter a password in this field' => 'Пожалуйста, введите пароль',
+
+ # H::F::Field::PasswordConf
+ 'Please enter a password confirmation' => 'Пожалуйста, введите подтверждение пароля',
+
+ # H::F::Field::PosInteger
+ 'Value must be a positive integer' => 'Значение должно быть положительным целым числом',
+
+ # H::F::Field::Select
+ 'This field does not take multiple values' => 'Это поле не принимает несколько значений',
+
+ # H::F::Field::Text
+ 'Please limit to [quant,_1,character]. You submitted [_2]' => 'Символов должно быть не более [_1]. Вы ввели: [_2]',
+ 'Input must be at least [quant,_1,character]. You submitted [_2]' => 'Символов должно быть не менее [_1]. Вы ввели: [_2]',
+
+ # H::F::Field::Upload
+ 'File uploaded is empty' => 'Переданный файл пуст',
+ 'File is too small (< [_1] bytes)' => 'Файл слишком мал (менее [_1] байт)',
+ 'File is too big (> [_1] bytes)' => 'Файл слишком велик (более [_1] байт)',
+
+ # H::F::Field
+ 'field is invalid' => 'Поле неверно',
+
+ # H::F::Model
+ 'Value must be unique in the database' => 'Значение должно быть уникальным для базы данных',
+
+ # H::F::Types
+ 'Must be a positive number' => 'Должно быть положительным числом',
+ 'Must be a positive integer' => 'Должно быть положительным целым числом',
+ 'Must be a negative number' => 'Должно быть отрицательным числом',
+ 'Must be a negative integer' => 'Должно быть отрицательным целым числом',
+ 'Must be a single digit' => 'Должно быть одной цифрой',
+ 'Must be a single line of no more than 255 chars' => 'Должно быть одной строкой, не более 255 символов',
+ 'Must be a non-empty single line of no more than 255 chars' => 'Должно быть не пустой строкой, не более 255 символов',
+ 'Must be between 4 and 255 chars' => 'Должно быть от 4 до 255 символов',
+ 'Not a valid state' => 'Не верное состояние',
+ 'Email is not valid' => 'Адрес электронной почты не корректен',
+ 'Zip is not valid' => 'Почтовый индекс не корректен',
+ 'Not a valid IP address' => 'IP адрес не корректен',
+ 'Cannot contain spaces' => 'Не может содержать пробелы',
+ 'Must be made up of letters, digits, and underscores' => 'Должно состоять из букв, цифр и подчёркиваний',
+ 'Must not be all digits' => 'Должно состоять не только из цифр',
+ 'Field contains non-printable characters' => 'Поле содержит непечатаемые символы',
+ 'Field must contain a single word' => 'Поле должно содержать одно слово',
+
+ # H::F::Validate::Actions
+ 'Wrong value' => 'Неверное значение',
+ '[_1] does not match' => 'не совпадает с [_1]',
+ '[_1] not allowed' => '[_1] не разрешено',
+
+ # H::F::Validate
+ 'value must be between [_1] and [_2]' => 'значение должно быть между [_1] и [_2]',
+ 'value must be greater than or equal to [_1]' => 'значение должно быть больше или равно [_1]',
+ 'value must be less than or equal to [_1]' => 'значение должно быть меньше или равно [_1]',
+ '[_1] field is required' => 'поле [_1] является обязательным',
+
+ # Other
+ 'Your datetime does not match your pattern.' => 'Введённые дата/время не совпадают с вашим шаблоном.',
+ 'error occurred' => 'произошла ошибка',
+);
+
+1;
+
diff --git a/lib/HTML/FormHandler/I18N/tr_tr.pm b/lib/HTML/FormHandler/I18N/tr_tr.pm
new file mode 100644
index 0000000..af5ea91
--- /dev/null
+++ b/lib/HTML/FormHandler/I18N/tr_tr.pm
@@ -0,0 +1,97 @@
+package HTML::FormHandler::I18N::tr_tr;
+use strict;
+use warnings;
+use base 'HTML::FormHandler::I18N';
+
+# Translated by Ozum Eldogan
+
+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ı',
+ 'Must be a negative number' => 'Negatif sayı olmalı',
+ 'Must be a negative integer' => 'Negatif tam sayı olmalı',
+ 'Must be a single digit' => 'Tek haneli bir sayı olmalı',
+ 'Must be a single line of no more than 255 chars' => '255 karakterden kısa ve tek bir satır olmalı',
+ 'Must be a non-empty single line of no more than 255 chars' => 'Boş bırakılmamalı, 255 karakterden kısa ve tek bir satır olmalı',
+ 'Must be between 4 and 255 chars' => '4 ile 255 karakter arasında olmalı',
+ 'Not a valid state' => 'Geçerli bir eyalet değil',
+ 'Email is not valid' => 'Geçersiz E-Posta',
+ 'Zip is not valid' => 'Geçersiz posta kodu',
+ 'Not a valid IP address' => 'Geçersiz IP adresi',
+ 'Cannot contain spaces' => 'Boşluk içeremez',
+ 'Must be made up of letters, digits, and underscores' => 'Sadece harf, rakam ya da "_" içerebilir',
+ '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' => '',
+ ### not translatable: '"$value" not allowed' => '',
+
+ # H::F::Validate
+ 'value must be between [_1] and [_2]' => 'değer [_1] ile [_2] arasında olmalı',
+ 'value must be greater than or equal to [_1]' => 'değer [_1] veya daha yüksek olmalı',
+ 'value must be less than or equal to [_1]' => 'değer [_1] veya daha düşük olmalı',
+
+ # Other
+ 'Your datetime does not match your pattern.' => 'Tarih formatı hatalı.',
+
+
+ );
+
+1;
+
+
+
+
diff --git a/lib/HTML/FormHandler/I18N/ua_ua.pm b/lib/HTML/FormHandler/I18N/ua_ua.pm
new file mode 100644
index 0000000..8213b2e
--- /dev/null
+++ b/lib/HTML/FormHandler/I18N/ua_ua.pm
@@ -0,0 +1,94 @@
+package HTML::FormHandler::I18N::ua_ua;
+use strict;
+use warnings;
+use utf8;
+use base 'HTML::FormHandler::I18N';
+
+# translator: Oleg Kostyuk
+# notify before release: cub at cpan.org
+
+# Auto define lexicon
+our %Lexicon = (
+ '_AUTO' => 1,
+
+ # H::F::Field::Date
+ 'Date is too early' => 'Дата занадто рання',
+ 'Date is too late' => 'Дата занадто піздня',
+
+ # H::F::Field::DateTime
+ 'Not a valid DateTime' => 'Невірна дата/час',
+
+ # H::F::Field::Email
+ 'Email should be of the format [_1]' => 'Адреса электроної пошти має бути у форматі [_1]',
+
+ # H::F::Field::Integer
+ 'Value must be an integer' => 'Значення має бути цілим числом',
+
+ # H::F::Field::Money
+ 'Value cannot be converted to money' => 'Значення не може бути сприйнято як грошове',
+ 'Value must be a real number' => 'Значення має бути речовим числом',
+
+ # H::F::Field::Password
+ 'Please enter a password in this field' => 'Будь ласка, введіть пароль',
+
+ # H::F::Field::PasswordConf
+ 'Please enter a password confirmation' => 'Будь ласка, введіть підтвердження паролю',
+
+ # H::F::Field::PosInteger
+ 'Value must be a positive integer' => 'Значення має бути позитивним цілим числом',
+
+ # H::F::Field::Select
+ 'This field does not take multiple values' => 'Це поле не приймає кілька значень',
+
+ # H::F::Field::Text
+ 'Please limit to [quant,_1,character]. You submitted [_2]' => 'Символів має бути не більше [_1]. Ви ввели: [_2]',
+ 'Input must be at least [quant,_1,character]. You submitted [_2]' => 'Символів має бути не менше [_1]. Ви ввели: [_2]',
+
+ # H:: F:: Field:: Upload
+ 'File uploaded is empty' => 'Переданий файл порожній',
+ 'File is too small (<[_1] bytes)' => 'Файл занадто малий (менше [_1] байт)',
+ 'File is too big (> [_1] bytes)' => 'Файл занадто великий (більше [_1] байт)',
+
+ # H:: F:: Field
+ 'field is invalid' => 'Поле невірне',
+
+ # H:: F:: Model
+ 'Value must be unique in the database' => 'Значення має бути унікальним для бази даних',
+
+ # H:: F:: Types
+ 'Must be a positive number' => 'Має бути позитивним числом',
+ 'Must be a positive integer' => 'Має бути позитивним цілим числом',
+ 'Must be a negative number' => 'Має бути негативним числом',
+ 'Must be a negative integer' => 'Має бути негативним цілим числом',
+ 'Must be a single digit' => 'Має бути однією цифрою',
+ 'Must be a single line of no more than 255 chars' => 'Має бути одним рядком, не більше 255 символів',
+ 'Must be a non-empty single line of no more than 255 chars' => 'Має бути не пустим рядком, не більше 255 символів',
+ 'Must be between 4 and 255 chars' => 'Має бути від 4 до 255 символів',
+ 'Not a valid state' => 'Не вірний стан',
+ 'Email is not valid' => 'Адреса електронної пошти не коректна',
+ 'Zip is not valid' => 'Поштовий індекс не коректний',
+ 'Not a valid IP address' => 'IP адреса не коректна',
+ 'Cannot contain spaces' => 'Не може мати пробіли',
+ 'Must be made up of letters, digits, and underscores' => 'Має складатися з букв, цифр та підкреслень',
+ 'Must not be all digits' => 'Має бути не тільки з цифр',
+ 'Field contains non-printable characters' => 'Поле містить недруковані символи',
+ 'Field must contain a single word' => 'Поле має містити одне слово',
+
+ # H:: F:: Validate:: Actions
+ 'Wrong value' => 'Неправильне значення',
+ '[_1] does not match' => 'не співпадає з [_1]',
+ '[_1] not allowed' => '[_1] не дозволяється',
+
+ # H:: F:: Validate
+ 'value must be between [_1] and [_2]' => 'значення повинне бути між [_1] та [_2]',
+ 'value must be greater than or equal to [_1]' => 'значення повинне бути більше або дорівнювати [_1]',
+ 'value must be less than or equal to [_1]' => 'значення повинне бути менше або дорівнювати [_1]',
+ '[_1] field is required' => 'поле [_1] є обов\x{02BC}язковим',
+
+ # Other
+ 'Your datetime does not match your pattern.' => 'Введені дата/час не співпадають з вашим шаблоном.',
+ 'error occurred' => 'трапилась помилка',
+);
+
+1;
+
diff --git a/lib/HTML/FormHandler/InitResult.pm b/lib/HTML/FormHandler/InitResult.pm
new file mode 100644
index 0000000..09484bf
--- /dev/null
+++ b/lib/HTML/FormHandler/InitResult.pm
@@ -0,0 +1,135 @@
+package HTML::FormHandler::InitResult;
+
+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
+# formerly _init
+sub _result_from_fields {
+ my ( $self, $self_result ) = @_;
+ for my $field ( $self->sorted_fields ) {
+ next if ($field->inactive && !$field->_active);
+ my $result = HTML::FormHandler::Field::Result->new(
+ name => $field->name,
+ parent => $self_result
+ );
+ $result = $field->_result_from_fields($result);
+ $self_result->add_result($result) if $result;
+ }
+ # this is for compound fields. form-level would use init_object instead
+ # which is a little strange.
+ if ( my @values = $self->get_default_value ) {
+ my $value = @values > 1 ? \@values : shift @values;
+ $self->init_value($value) if defined $value;
+ $self_result->_set_value($value) if defined $value;
+ }
+ $self->_set_result($self_result);
+ $self_result->_set_field_def($self) if $self->DOES('HTML::FormHandler::Field');
+ return $self_result;
+}
+
+# building fields from input (params)
+# formerly done in validate_field
+sub _result_from_input {
+ my ( $self, $self_result, $input, $exists ) = @_;
+
+ # transfer the input values to the input attributes of the
+ # subfields
+ return unless ( defined $input || $exists || $self->has_fields );
+ $self_result->_set_input($input);
+ if ( ref $input eq 'HASH' ) {
+ foreach my $field ( $self->sorted_fields ) {
+ next if ($field->inactive && !$field->_active);
+ my $field_name = $field->name;
+ my $result = HTML::FormHandler::Field::Result->new(
+ name => $field_name,
+ parent => $self_result
+ );
+ $result =
+ $field->_result_from_input( $result, $input->{$field->input_param || $field_name},
+ exists $input->{$field->input_param || $field_name} );
+ $self_result->add_result($result) if $result;
+ }
+ }
+ $self->_set_result($self_result);
+ $self_result->_set_field_def($self) if $self->DOES('HTML::FormHandler::Field');
+ return $self_result;
+}
+
+# building fields from model object or init_obj hash
+# formerly _init_from_object
+sub _result_from_object {
+ my ( $self, $self_result, $item ) = @_;
+
+ return unless ( $item || $self->has_fields ); # empty fields for compounds
+ my $my_value;
+ for my $field ( $self->sorted_fields ) {
+ next if ( $field->inactive && !$field->_active );
+ my $result = HTML::FormHandler::Field::Result->new(
+ name => $field->name,
+ parent => $self_result
+ );
+ if ( (ref $item eq 'HASH' && !exists $item->{ $field->accessor } ) ||
+ ( blessed($item) && !$item->can($field->accessor) ) ) {
+ $result = $field->_result_from_fields($result);
+ }
+ else {
+ my $value = $self->_get_value( $field, $item );
+ $result = $field->_result_from_object( $result, $value );
+ }
+ $self_result->add_result($result) if $result;
+ $my_value->{ $field->name } = $field->value;
+ }
+ $self_result->_set_value($my_value);
+ $self->_set_result($self_result);
+ $self_result->_set_field_def($self) if $self->DOES('HTML::FormHandler::Field');
+ return $self_result;
+}
+
+
+sub _get_value {
+ my ( $self, $field, $item ) = @_;
+
+ my $accessor = $field->accessor;
+ my @values;
+ if ( @values = $field->get_default_value ) {
+ }
+ elsif ( blessed($item) && $item->can($accessor) ) {
+ @values = $item->$accessor;
+ }
+ elsif ( exists $item->{$accessor} ) {
+ @values = $item->{$accessor};
+ }
+ else {
+ return;
+ }
+ if( $field->_can_deflate ) {
+ @values = $field->_apply_deflation(@values);
+ }
+ my $value = @values > 1 ? \@values : shift @values;
+ return $value;
+}
+
+=head1 AUTHORS
+
+HTML::FormHandler Contributors; see HTML::FormHandler
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
+
+use namespace::autoclean;
+1;
diff --git a/lib/HTML/FormHandler/Manual.pod b/lib/HTML/FormHandler/Manual.pod
new file mode 100644
index 0000000..f19c582
--- /dev/null
+++ b/lib/HTML/FormHandler/Manual.pod
@@ -0,0 +1,50 @@
+=head1 NAME
+
+HTML::FormHandler::Manual - Index of the Manual
+
+=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.
+
+=head1 SECTIONS
+
+=head2 L<HTML::FormHandler::Manual::Intro>
+
+Creating FormHandler forms and interfacing them
+with your controllers.
+
+=head2 L<HTML::FormHandler::Manual::Rendering>
+
+Rendering options, particularly rendering with widgets
+
+=head2 L<HTML::FormHandler::Manual::Tutorial>
+
+Builds on the Catalyst tutorial. Step-by-step guide.
+
+=head2 L<HTML::FormHandler::Manual::Cookbook>
+
+'Howto' recipes
+
+=head2 L<HTML::FormHandler::Manual::Templates>
+
+Cut-and-paste examples of templates to use with FormHandler
+
+=head2 L<HTML::FormHandler::Manual::Catalyst>
+
+Catalyst specific documentation
+
+=head1 SUPPORT
+
+IRC:
+
+ Join #formhandler on irc.perl.org
+
+=head1 AUTHOR
+
+gshank: Gerda Shank <gshank at cpan.org>
+
+=cut
+
diff --git a/lib/HTML/FormHandler/Manual/Catalyst.pod b/lib/HTML/FormHandler/Manual/Catalyst.pod
new file mode 100644
index 0000000..bc2c866
--- /dev/null
+++ b/lib/HTML/FormHandler/Manual/Catalyst.pod
@@ -0,0 +1,164 @@
+
+=head1 NAME
+
+HTML::FormHandler::Manual::Catalyst - Using HFH forms in Catalyst controllers
+
+=head1 SYNOPSIS
+
+This part of the FormHandler Manual is devoted to using the L<HTML::FormHandler>
+package in Catalyst controllers.
+
+See the other FormHandler documentation at L<HTML::FormHandler::Manual>, or
+the base class at L<HTML::FormHandler>.
+
+=head1 DESCRIPTION
+
+Although L<HTML::FormHandler> can be used in any Perl web application, module, or
+script, one of its most common uses is in L<Catalyst> applications.
+
+Using a form takes only a few lines of code, so it's not necessary to have
+a L<Catalyst> base controller, although you could make a base controller for
+FormHandler if you're doing more than the basics.
+
+=head2 A Controller Example
+
+The following example uses chained dispatching. The 'form' method is called
+by both the create and edit actions.
+
+ package BookDB::Controller::Borrower;
+
+ use Moose;
+ BEGIN { extends 'Catalyst::Controller' }
+
+ sub borrower_base : Chained PathPart('borrower') CaptureArgs(0) { }
+
+ sub list : Chained('borrower_base') PathPart('list') Args(0) {
+ my ( $self, $c ) = @_;
+ my $borrowers = [ $c->model('DB::Borrower')->all ];
+ my @columns = ( 'name', 'email' );
+ $c->stash( borrowers => $borrowers, columns => \@columns,
+ template => 'borrower/list.tt' );
+ }
+
+ sub add : Chained('borrower_base') PathPart('add') Args(0) {
+ my ( $self, $c ) = @_;
+ # Create the empty borrower row for the form
+ $c->stash( borrower => $c->model('DB::Borrower')->new_result({}) );
+ return $self->form($c);
+ }
+
+ sub item : Chained('borrower_base') PathPart('') CaptureArgs(1) {
+ my ( $self, $c, $borrower_id ) = @_;
+ $c->stash( borrower => $c->model('DB::Borrower')->find($borrower_id) );
+ }
+
+ sub edit : Chained('item') PathPart('edit') Args(0) {
+ my ( $self, $c ) = @_;
+ return $self->form($c);
+ }
+
+ sub form {
+ my ( $self, $c ) = @_;
+
+ my $form = BookDB::Form::Borrower->new;
+ $c->stash( form => $form, template => 'borrower/form.tt' );
+ return unless $form->process( item => $c->stash->{borrower},
+ params => $c->req->parameters );
+ $c->res->redirect( $c->uri_for($self->action_for('list')) );
+ }
+
+ sub delete : Chained('item') PathPart('delete') Args(0) {
+ my ( $self, $c ) = @_;
+
+ $c->stash->{borrower}->delete;
+ $c->res->redirect( $c->uri_for($c->action_for('list')) );
+ }
+
+ 1;
+
+=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.
+
+ sub book_base : Chained PathPart('book') CaptureArgs(0) {
+ my ( $self, $c ) = @_;
+ my $form = MyApp::Form->new;
+ $form->schema( $c->model('DB')->schema );
+ $form->params( $c->req->parameters );
+ $form->user_id( $c->user->id );
+ $c->stash( form => $form );
+ }
+
+Then you could just pass in the item_id when the form is processed.
+
+ return unless $c->stash->{form}->process($id);
+
+=head2 Using HTML::FillInForm
+
+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:
+
+ package MyApp::View::TT;
+ use Moose;
+ with 'Catalyst::View::FillInForm';
+ ....
+ 1;
+
+and set the 'fif' hash in the 'fillinform' stash variable:
+
+ $self->form->process( ... );
+ $c->stash( fillinform => $self->form->fif );
+ return unless $form->validated;
+
+When the 'fillinform' stash variable is set, HTML::FillInForm will automatically
+be used by your view to fill in the the form values. This can be very helpful
+when you want to build your forms by hand, or when you have legacy forms that
+you're just trying to hook up to FormHandler.
+
+=head2 The Catalyst context
+
+FormHandler has a 'ctx' attribute that can be used to set the Catalyst context (or
+anything you want, really). But if you can avoid passing in the context, you should do so,
+because you're mixing up your MVC and it makes it much more difficult to test your
+forms. But if you need to do it, you can:
+
+ my $form = MyApp::Form->new( ctx => $c );
+
+Usually you should prefer to add new attributes to your form:
+
+ package MyApp::Form;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has 'user_id' => ( is => 'rw' );
+ has 'hostname' => ( is => 'rw' );
+ has 'captcha_store' => ( is => 'rw' );
+ ....
+ 1;
+
+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 );
+ $form->hostname( $c->req->host );
+ $form->captcha_store( $c->{session}->{captcha} );
+
+Then you can access these attributes in your form validation methods:
+
+ sub validate_selection {
+ my ( $self, $field ) = @_;
+ if( $field->value eq 'something' && $self->hostname eq 'something_else' )
+ {
+ $field->add_error("some error message" );
+ }
+ }
+
+=cut
diff --git a/lib/HTML/FormHandler/Manual/Cookbook.pod b/lib/HTML/FormHandler/Manual/Cookbook.pod
new file mode 100644
index 0000000..1c26fe3
--- /dev/null
+++ b/lib/HTML/FormHandler/Manual/Cookbook.pod
@@ -0,0 +1,494 @@
+=head1 NAME
+
+HTML::FormHandler::Manual::Cookbook - FormHandler use recipes
+
+=head1 SYNOPSIS
+
+Collection of use recipes for L<HTML::FormHandler>
+
+=head2 No form file, no template file...
+
+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.
+
+ sub comment : Chained('base_sub') PathPart('comment') Args(0) {
+ my ( $self, $c ) = @_;
+
+ 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",
+ $form->field('comment')->value );
+ $c->flash( message => 'Comment added' );
+ $c->res->redirect( $c->stash->{urilist}->{view} );
+ }
+ my $rendered_form = $form->render;
+ $c->stash( template => \$rendered_form );
+ }
+
+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
+possible to have a simple, standalone method.
+
+
+=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.
+One way is to use the 'field_list' method:
+
+ sub field_list {
+ my $self = shift;
+ my @fields;
+ <build list of fields>
+ return \@fields;
+ }
+
+This only happens at form construction time, however. Another method that
+works is to define all of the possible fields in your form, and mark some
+of them 'inactive';
+
+ package MyApp::Variable::Form;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has_field 'foo';
+ has_field 'bar' => ( inactive => 1 );
+ 1;
+
+Then you can mark them active using a Moose method modifier on
+'set_active'.
+
+ before 'set_active' => sub {
+ my $self = shift;
+ $self->active(['foo', bar']) if ( <some_condition> );
+ };
+
+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
+need to reset.
+
+If you want the fields activated for the life of an object, set active on new:
+
+ my $form = MyApp::Form::User->new( active => ['opt_in', 'active']);
+
+=head2 Add custom attributes to FormHandler fields
+
+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.
+
+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.
+
+ package MyApp::Form::Test;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ 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(
+ field_list => [ '+foo' => { traits => [...] } ]);
+
+
+=head2 Select lists
+
+If you want to set the default value of a select field to 0 (or some other
+default):
+
+ sub default_license {
+ my ( $self, $field, $item ) = @_;
+ return 0 unless $item && $item->license_id;
+ return $item->license_id;
+ }
+
+If the table defining the choices for a select list doesn't include
+a 'no choice' choice, in your template:
+
+ [% f = form.field('subject_class') %]
+ <select id="select_sc" name="[% f.name %]">
+ <option value="">--- Choose Subject Class---</option>
+ [% FOR option IN f.options %]
+ <option value="[% option.value %]"
+ [% IF option.value == f.fif %]selected="selected"[% END %]>
+ [% option.label | html %]</option>
+ [% END %]
+ </select>
+
+Or customize the select list in an 'options_' method:
+
+ sub options_country {
+ my $self = shift;
+ return unless $self->schema;
+ my @rows =
+ $self->schema->resultset( 'Country' )->
+ search( {}, { order_by => ['rank', 'country_name'] } )->all;
+ return [ map { $_->digraph, $_->country_name } @rows ];
+ }
+
+=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,
+you should do that processing in the DBIx::Class result class.
+
+If the pre-processing is only relevant to HTML form input, you might want
+to do it in the form by setting a flag to prevent database updates, performing
+the pre-processing, and then updating the database yourself.
+
+ has_field 'my_complex_field' => ( type => 'Text', noupdate => 1 );
+
+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:
+
+ 1) validate (for the form or field)
+ 2) validate_model
+ 3) model_update
+
+When the field is flagged 'writeonly', the value from the database will not
+be used to fill in the form (put in the C<< $form->fif >> hash, or the
+field C<< $field->fif >>), but a value entered in the form WILL be used
+to update the database.
+
+If you want to enter fields from an additional table that is related to
+this one in a 'single' relationship, you can use the DBIx::Class 'proxy'
+feature to create accessors for those fields.
+
+=head2 Set up form base classes or roles for your application
+
+You can add whatever attributes you want to your form classes. Maybe you
+want to save a title, or a particular navigation widget. You could even
+save bits of text, or retrieve them from the database. Sometimes doing it
+this way would be the wrong way. But it's your form, your choice. In the
+right circumstances, it might provide a way to keep code out of your
+templates and simplify your controllers.
+
+ package MyApp::Form::Base;
+ use Moose;
+ extends 'HTML::FormHandler::Model::DBIC';
+
+ has 'title' => ( isa => 'Str', is => 'rw' );
+ has 'nav_bar' => ( isa => 'Str', is => 'rw' );
+
+ sub summary {
+ my $self = shift;
+ my $schema = $self->schema;
+ my $text = $schema->resultset('Summary')->find( ... )->text;
+ return $text;
+ }
+ 1;
+
+Then:
+
+ package MyApp::Form::Whatsup;
+ use Moose;
+ extends 'MyApp::Form::Base';
+
+ has '+title' => ( default => 'This page is an example of what to expect...' );
+ has '+nav_bar' => ( default => ... );
+ ...
+ 1;
+
+And in the template:
+
+ <h1>[% form.title %]</h1>
+ [% form.nav_bar %]
+ <p><b>Summary: </b>[% form.summary %]</p>
+
+
+Or you can make these customizations Moose roles.
+
+ package MyApp::Form::Role::Base;
+ use Moose::Role;
+ ...
+
+ package MyApp::Form::Whatsup;
+ 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;
+ extends 'HTML::FormHandler';
+
+ has_field 'name';
+ has_field 'telephone';
+ has_field 'email' => ( type => 'Email' );
+
+ sub validate_name {
+ ....
+ }
+
+ no HTML::FormHandler::Moose;
+ 1;
+
+An address form:
+
+ package Form::Address;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has_field 'street';
+ has_field 'city';
+ has_field 'state' => ( type => 'Select' );
+ has_field 'zip' => ( type => '+Zip' );
+
+ sub options_state {
+ ...
+ }
+
+ no HTML::FormHandler::Moose;
+ 1;
+
+A form that extends them both:
+
+ package Form::Member;
+ use Moose;
+ extends ('Form::Person', 'Form::Address');
+
+ 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;
+
+ has_field 'street';
+ has_field 'city';
+ has_field 'state' => ( type => 'Select' );
+ has_field 'zip' => ( type => '+Zip' );
+
+ sub options_state {
+ ...
+ }
+
+ no HTML::FormHandler::Moose::Role;
+ 1;
+
+You could make roles that are collections of validations:
+
+ package Form::Role::Member;
+ use Moose::Role;
+
+ sub check_zip {
+ ...
+ }
+ sub check_email {
+ ...
+ }
+
+ 1;
+
+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
+
+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
+C< before 'update_model' >.
+
+In the form:
+
+ has 'hostname' => ( isa => 'Int', is => 'ro' );
+
+ before 'update_model' => sub {
+ my $self = shift;
+ $self->item->hostname( $self->hostname );
+ };
+
+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
+
+Use the 'before' or 'after' method modifiers for 'update_model', to flag a record
+as updated by the user, for example:
+
+ before 'update_model' => sub {
+ my $self = shift;
+ $self->item->user_updated if $self->item;
+ };
+
+=head2 Additional changes to the database
+
+If you want to do additional database updates besides the ones that FormHandler
+does for you, the best solution would generally be to add the functionality to
+your result source or resultset classes, but if you want to do additional updates
+in a form you should use an 'around' method modifier and a transaction:
+
+ around 'update_model' => sub {
+ my $orig = shift;
+ my $self = shift;
+ my $item = $self->item;
+
+ $self->schema->txn_do( sub {
+ $orig->($self, @_);
+
+ <perform additional updates>
+ });
+ };
+
+=head2 Doing cross validation in roles
+
+In a role that handles a number of different fields, you may want to
+perform cross validation after the individual fields are validated.
+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;
+ has_field 'date_from' => ( type => 'Date' );
+ has_field 'date_to' => ( type => 'Date' );
+
+ after 'validate' => sub {
+ my $self = shift;
+ $self->field('date_from')->add_error('From date must be before To date')
+ if $self->field('date_from')->value gt $self->field('date_to')->value;
+ };
+
+=head2 Changing required flag
+
+Sometimes a field is required in one situation and not required in another.
+You can use a method modifier before 'validate_form':
+
+ before 'validate_form' => sub {
+ my $self = shift;
+ my $required = 0;
+ $required = 1
+ if( $self->params->{field_name} eq 'something' );
+ $self->field('some_field')->required($required);
+ };
+
+This happens before the fields contain input or values, so you would need to
+look at the param value. If you need the validated value, it might be better
+to do these sort of checks in the form's 'validate' routine.
+
+ sub validate {
+ my $self = shift;
+ $self->field('dependent_field')->add_error("Field is required")
+ if( $self->field('some_field')->value eq 'something' &&
+ !$self->field('dependent_field')->has_value);
+ }
+
+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
+of a group of fields has a value, all of the fields are required.
+
+=head2 Supply an external coderef for validation
+
+There are situations in which you need to use a subroutine for validation
+which is not logically part of the form. It's possible to pass in a context
+or other sort of pointer and call the routine in the form's validation
+routine, but that makes the architecture muddy and is not a clear separation
+of concerns.
+
+This is an example of how to supply a coderef when constructing the form that
+performs validation and can be used to set an appropriate error
+using L<Moose::Meta::Attribute::Native::Trait::Code>.
+(Thanks to Florian Ragwitz for this excellent idea...)
+
+Here's the form:
+
+ package SignupForm;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has check_name_availability => (
+ traits => ['Code'],
+ isa => 'CodeRef',
+ required => 1,
+ handles => { name_available => 'execute', },
+ );
+
+ has_field 'name';
+ has_field 'email';
+
+ sub validate {
+ my $self = shift;
+ my $name = $self->value->{name};
+ if ( defined $name && length $name && !$self->name_available($name) ) {
+ $self->field('name')->add_error('That name is taken already');
+ }
+ }
+ 1;
+
+And here's where the coderef is passed in to the form.
+
+ package MyApp::Signup;
+ use Moose;
+
+ has 'form' => ( is => 'ro', builder => 'build_form' );
+ sub build_form {
+ my $self = shift;
+ return SignupForm->new(
+ {
+ check_name_availability => sub {
+ my $name = shift;
+ return $self->username_available($name);
+ },
+ }
+ );
+
+ }
+ sub username_available {
+ my ( $self, $name ) = @_;
+ # perform some sort of username availability checks
+ }
+ 1;
+
+=head1 AUTHOR
+
+Gerda Shank, gshank at cpan.org
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
diff --git a/lib/HTML/FormHandler/Manual/Intro.pod b/lib/HTML/FormHandler/Manual/Intro.pod
new file mode 100644
index 0000000..75896c3
--- /dev/null
+++ b/lib/HTML/FormHandler/Manual/Intro.pod
@@ -0,0 +1,958 @@
+=head1 NAME
+
+HTML::FormHandler::Manual::Intro - basic usage of FormHandler
+
+=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 highly automatic templates. There are two simple rendering roles,
+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
+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).
+
+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
+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
+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
+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:
+
+ perl -Ilib t/script/bookdb_server.pl
+
+=head1 Basics
+
+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
+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.
+
+Create a Form, subclassed from HTML::FormHandler::Model::DBIC. The fields
+are declared here using the 'has_field' sugar, but they could also be
+defined using the 'field_list', as in the following dynamic example.
+
+ package MyApp:Form::User;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler::Model::DBIC';
+
+ # Associate this form with a DBIx::Class result class
+ # Or 'item_class' can be passed in on 'new', or you
+ # you can always pass in a row object
+ has '+item_class' => ( default => 'User' );
+
+ # Define the fields that this form will operate on
+ # Field names are usually column, accessor, or relationship names in your
+ # DBIx::Class result class. You can also have fields that don't exist
+ # in your result class.
+
+ has_field 'name' => ( type => 'Text', label => 'Username', required => 1,
+ required_message => 'You must enter a username', unique => 1,
+ 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 );
+ has_field 'sex' => ( type => 'Select', label => 'Gender', required => 1 );
+ # a customized field class
+ has_field 'birthdate' => ( type => '+MyApp::Field::Date' );
+ has_field 'hobbies' => ( type => 'Multiple', size => 5 );
+ has_field 'address' => ( type => 'Text' );
+ has_field 'city' => ( type => 'Text' );
+ has_field 'state' => ( type => 'Select' );
+
+ has '+dependency' => ( default => sub {
+ [
+ ['address', 'city', 'state'],
+ ],
+ }
+ );
+
+ no HTML::FormHandler::Moose;
+ 1;
+
+An example of a dynamically created form instance:
+
+ use HTML::FormHandler;
+
+ 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]*/,
+ message => 'Contains invalid characters' } ],
+ },
+ 'password' => {
+ type => 'Password',
+ },
+ 'some_number' => {
+ type => 'IntRange',
+ range_min => 12,
+ range_max => 291,
+ },
+ 'some_option' => {
+ type => 'Checkbox',
+ checkbox_value => 'yes',
+ input_without_param => 'no'
+ },
+ 'some_text' => {
+ type => 'TextArea',
+ },
+ 'hidden_field' => {
+ type => 'Hidden',
+ default => 'foo',
+ },
+ 'upload_file' => {
+ type => 'Upload',
+ max_size => 262144,
+ },
+ 'select_foo' => {
+ type => 'Select',
+ options => \@select_options,
+ },
+ 'select_bar' => {
+ type => 'Select',
+ options => \@select_options,
+ multiple => 1,
+ size => 4,
+ },
+ 'select_baz' => {
+ type => 'Select',
+ options => \@select_options,
+ widget => 'radio_group',
+ },
+ 'select_bax' => {
+ type => 'Select',
+ options => \@select_options,
+ multiple => 1,
+ widget => 'checkbox_group'
+ },
+ 'sub' => {
+ type => 'Compound',
+ },
+ 'sub.user' => {
+ type => 'Text',
+ apply => [ { check => qr/^[0-9a-z]*/,
+ message => 'Not a valid user' } ],
+ },
+ 'sub.name' => {
+ type => 'Text',
+ apply => [ { check => qr/^[0-9a-z]*/,
+ message => 'Not a valid name' } ],
+ },
+ 'reset' => {
+ type => 'Reset',
+ },
+ 'submit' => {
+ type => 'Submit',
+ },
+ 'some_link' => {
+ type => 'Display',
+ html => '<a href="http://google.com/">Go somewhere</>',
+ },
+ ]
+ };
+ 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 >>.
+
+By default the L<HTML::FormHandler::Widget> roles will be applied, making it
+possible to render a simple form for scaffolding:
+
+ [% form.render %]
+
+Individual fields can also be rendered:
+
+ [% form.field('title').render %]
+
+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
+rendering methods included in the these roles are accessed with:
+
+ [% form.render_field('title') %]
+
+Using a template, for an input field:
+
+ <p>
+ [% f = form.field('address') %]
+ <label class="label" for="[% f.name %]">[% f.label %]:</label>
+ <input type="text" name="[% f.name %]" id="[% f.name %]" value="[% f.fif %]">
+ </p>
+
+The value can come from the hash returned by C<< $form->fif >>, from the 'fif'
+attribute of the field, or can be supplied by FillInForm and the
+L<Catalyst::View::FillInForm> role on your view class.
+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
+'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,
+you risk getting out of sync. TT example:
+
+ <p>
+ [% f = form.field('sex') %]
+ <label class="label" for="[% f.name %]">[% f.label %]</label>
+ <select name="[% f.name %]">
+ [% FOR option IN f.options %]
+ <option value="[% option.value %]"
+ [% IF option.value == f.fif %]selected="selected"[% END %]>
+ [% option.label | html %]</option>
+ [% END %]
+ </select>
+ </p>
+
+A multiple select list where 'hobbies' is a 'many_to_many' pseudo-relationship.
+(field attributes: sort_column, label_column, active_column).
+
+ <p>
+ [% f = form.field('hobbies') %]
+ <label class="label" for="[% f.name %]">[% f.label || f.name %]</label>
+ <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 %]
+ </select>
+ </p>
+
+
+In a Catalyst controller:
+
+ package MyApp::Controller::User;
+ use Moose;
+ BEGIN { extends 'Catalyst::Controller' }
+ use MyApp::Form::User
+
+ has 'form' => ( isa => 'MyApp::Form::User', is => 'rw',
+ lazy => 1, default => sub { MyApp::Form::User->new } );
+
+ # Create or edit
+ sub edit : Local {
+ my ( $self, $c, $user_id ) = @_;
+
+ $c->stash(
+ form => $self->form,
+ template => 'user/edit.tt' );
+
+
+ return unless $self->form->process( item_id => $user_id,
+ schema => $c->model('DB')->schema );
+
+ # Form validated.
+ $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.
+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
+to pass XHTML validation:
+
+ $form->process( action => <valid url>, item => $row,
+ params => $c->req->params );
+
+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).
+You can also create a new form on each request with new:
+
+ my $form = BookDB::Form::Book->new( item => $book );
+ return unless $form->process( params => $c->req->parameters );
+
+There is also a 'validated' flag:
+
+ $form->process( params => $c->req->parameters );
+ return unless $form->validated;
+
+Form processing is a two-pass operation. The first time through
+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
+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
+process method will occur.
+
+This time there WILL be values in the parameters, and FormHandler
+will call the validation routines. If the validation succeeds, FormHandler
+will return a 'true' value, and execution will fall through to after
+the "return unless ...." line. At this point you will either redirect
+to some other page, or in some cases redisplay the form with a message
+that saving succeeded. If the validation fails, the 'return' will cause
+the form to be displayed again.
+
+The values to be used to fill in your form are automatically created
+by FormHandler, and are available in the field's 'fif' attribute:
+
+ $field->fif
+
+or in the form's fif hash, which will contain the fill-in-form values
+for all the form's fields:
+
+ $form->fif
+
+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
+and set the 'fif' hash in the 'fillinform' stash variable:
+
+ $self->form->process( ... );
+ $c->stash( fillinform => $self->form->fif );
+ return unless $form->validated;
+
+=head1 Form generator
+
+A DBIC form generator is installed with the L<HTML::FormHandler::Model::DBIC>
+package. See L<HTML::FormHandler::Generator::DBIC>.
+
+=head1 Non-database forms
+
+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.
+
+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
+
+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.
+
+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>.
+
+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.
+
+=head1 Field names
+
+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
+'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.
+
+There are a number of name related field attributes. The 'name' is
+the name used to identify this particular field in this fields array.
+The 'full_name' is includes the names of all parents of this field,
+like 'address.street.streetname'. The 'html_name' is the same as the
+'full_name' unless you have set the 'html_prefix' flag, in which case
+it includes the form name: 'myform.address.street.streetname'.
+
+To retrieve a field by name, you can use either the full_name or a
+chain: C<< $form->field('address')->field('street')->field('streetname') >>
+or: C<< $form->field('address.street.streetname') >>.
+
+You can process multiple FormHandler forms at the same time (using
+the same HTML form) with multiple form objects and multiple process/update
+calls. You would have to ensure that there are no duplicate field names,
+possibly by using 'html_prefix'.
+
+=head1 has_field
+
+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
+
+ 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.)
+
+To declare fields use the syntax:
+
+ has_field 'title' => ( type => 'Text', required => 1 );
+ has_field 'authors' => ( type => 'Select' );
+
+instead of:
+
+ 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') >>.
+
+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;
+
+ has_field 'street' => ( type => 'Text', size => '50' );
+ has_field 'city' => ( type = 'Text', size => 24 );
+ has_field 'state' => ( type => 'Select );
+ has_field 'zip' => ( type => '+Zip', required => 1 );
+
+ no HTML::FormHandler::Moose::Role;
+ 1;
+
+You can use roles to define fields and validations and include them in form
+classes using 'with':
+
+ package Form::Member;
+ use HTML::FormHandler::Moose;
+ with 'Form::Role::Person';
+ with 'Form::Role::Address';
+ extends 'HTML::FormHandler::Model::DBIC';
+
+ has_field 'user_name' => ( type => 'Text', required => 1 );
+
+ no HTML::FormHandler::Moose;
+ 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:
+
+ 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 {
+ [
+ field_one => {
+ type => 'Text',
+ required => 1
+ },
+ field_two => 'Text,
+ ]
+ }
+ );
+
+An example of a select field:
+
+ sub field_list {
+ return [
+ favorite_color => {
+ type => 'Select',
+ label_column => 'color_name',
+ active_column => 'is_active',
+ },
+ ];
+ }
+
+
+=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
+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.
+
+In the templates the fields are accessed with C< form.field('name') >.
+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 for "+" prefixed fields can
+be set with the form's "field_name_space" attribute:
+
+ has '+field_name_space' => ( default => 'MyApp::Form::Field' );
+
+ has_field 'name' => ( type => 'Text' ); # HTML::FormHandler::Field::Text
+ 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"
+class is similar, but its value must be a valid choice from a list of options.
+A "Multiple" type is like "Select" but it allows selecting more than one value
+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).
+
+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'
+will be performed on the value. This includes the 'trim' transform which
+will strip leading and trailing spaces. After the actions are applied,
+the field's 'validate' method is called.
+
+=head2 Compound fields
+
+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
+L<HTML::FormHandler::Field::Compound> and use L<HTML::FormHandler::Moose> to
+allow declaring fields:
+
+ package MyApp::Field::Duration;
+
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler::Field::Compound';
+
+ has_field 'month' => (type => 'Integer');
+ has_field 'day' => ( type => 'Integer' );
+ has_field 'minutes' => ( type => 'Integer' );
+
+Then in the form:
+
+ has_field 'my_duration' => ( type => '+Duration' );
+
+To create a compound field by declaration, declare the containing
+compound field and subfields, prefixing the subfield names
+with the name of the containing compound field plus a dot:
+
+ package MyApp::Form;
+
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has_field 'duration' => ( type => 'Compound' );
+ has_field 'duration.month' => ( type => 'Integer' );
+ has_field 'duration.day' => ( type => 'Integer' );
+ has_field 'duration.year' => ( type => 'Integer' );
+
+In an HTML form the name of the field must be the complete name
+with dots. The 'html_name' field attribute can be used to get
+this name:
+
+ [% field.html_name %]
+
+A compound field can be used for a database relation that will have only
+one row (belongs_to or has_one).
+
+=head2 Repeatable fields
+
+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';
+ has_field 'addresses.city';
+ has_field 'addresses.country' => ( type => 'Select' );
+
+The arrays will be built from arrays passed in the params, or from
+related ('has_many') rows in the database.
+
+It is also used for arrays of single fields using the 'contains' keyword:
+
+ has_field 'tags' => ( type => 'Repeatable' );
+ has_field 'tags.contains' => ( type => '+Tag' );
+
+See L<HTML::FormHandler::Field::Repeatable> for more information.
+
+=head2 Filters, transformations, and constraints
+
+L<HTML::FormHandler> has a flexible system of of filters and constraints. You can
+use Moose types to constrain the allowable values in a field and use coercions to
+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',
+ { transform => sub {...}, message => 'xxxx' },
+ { check => sub { ... }, message => 'xxxx' } ] );
+
+The actions in the 'apply' array will be performed in the order they are
+specified, allowing fine-grained control over inflation and validation.
+
+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.)
+
+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
+either method.
+
+=head2 Inflation/deflation
+
+The most common object that needs inflation and deflation is a DateTime
+field, such as would come from a DBIC result class if you are using
+the InflateColumn plugin, but it could be any object, such as a Duration.
+
+Inflation can be done in one of the 'actions' that are applied to the field
+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
+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.
+
+=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.
+
+The simplest subclasses contain only a 'validate' routine or an 'apply' attribute,
+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
+as a DateTime and you want to use the transformed value to fill in the
+form, then you will also need a deflation or field class 'deflate' method
+to reformat the object into a form suitable for an HTML form field.
+
+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
+attributes, such as 'label_format' in L<HTML::FormHandler::Field::IntRange>,
+or set the 'required_message'.
+
+An alternative to new field classes for many field validations might
+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
+contains the pattern /\S/ (non-blank), the 'required' flag
+is set for all of the fields in the group.
+
+ has '+dependency' => ( default => sub {
+ [
+ ['address', 'city', 'state', 'zip'],
+ ['cc_no', 'cc_expires'],
+ ],
+ },
+ );
+
+The 'item_class':
+
+ has '+item_class' => ( default => 'Book' );
+
+The form name:
+
+ has '+name' => ( default => 'book_form' );
+
+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 {
+ { name => 'Choose name',
+ project => 'Standard'
+ }
+ }
+ );
+ sub init_object { ... }
+
+=head1 Other methods for your form
+
+=over 4
+
+=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)
+provide them from an options_$fieldname method in the form.
+
+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 {
+ return (
+ 1 => 'apples',
+ 2 => 'oranges',
+ 3 => 'kiwi',
+ );
+ }
+
+You can also write custom methods to retrieve the option info from the database:
+
+ sub options_country {
+ my $self = shift;
+ return unless $self->schema;
+ my @rows =
+ $self->schema->resultset( 'Country' )->
+ search( {}, { order_by => ['rank', 'country_name'] } )->all;
+ return [ map { $_->digraph, $_->country_name } @rows ];
+ }
+
+
+=item default_$fieldname
+
+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 $item->license_id;
+ }
+
+Defaults can also be provided by the field's 'default' attribute and the
+init_object.
+
+
+=item validate_$fieldname
+
+Instead of using field constraints, you can choose to
+do per-field validation customization in a form method:
+
+ sub validate_age {
+ my ( $self, $field ) = @_;
+ $field->add_error('Sorry, you must be 18')
+ if $field->value < 18;
+ }
+
+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
+
+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
+has validated so far.
+
+ sub validate {
+ my $self = shift;
+ if ( $self->field('count')->value && $self->field('duration')->value )
+ {
+ $self->field('duration')->add_error(
+ 'Do not enter both a count and a duration' );
+ }
+ }
+
+=item update_model
+
+Override the model's 'update_model' method to do additional updates.
+
+ sub update_model {
+ my $self = shift;
+ $self->SUPER::update_model;
+ my $event = $self->item;
+ $event->update( ... );
+ }
+
+=back
+
+=head1 Filling the HTML form with values
+
+There are three ways to get the database or parameter values into the actual
+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":
+
+ [% 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 >>.
+
+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.
+
+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
+using FormHandler to fill in the form.
+
+=head1 Using FormHandler with hand-built forms
+
+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
+convention. (See the documentation for Compound and Repeatable fields.)
+
+In order to load the form with values, you should use L<HTML::FillInForm>, and
+L<Catalyst::View::FillInForm> if you're using Catalyst. You must put the
+FormHandler 'fif' hash into the Catalyst stash.
+
+ $form->process($params);
+ $c->stash( fillinform => $form->fif );
+ return unless $form->validated;
+
+(Or you could use one of the options described in the previous section for
+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.
+
+=head1 Testing
+
+It's much easier to write unit tests for FormHandler forms than for
+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';
+
+ use_ok( 'BookDB::Form::Book');
+ use_ok( 'BookDB::Schema::DB');
+
+ my $schema = BookDB::Schema::DB->connect('dbi:SQLite:t/db/book.db');
+ ok($schema, 'get db schema');
+
+ my $form = BookDB::Form::Book->new(schema => $schema);
+
+ # This is munging up the equivalent of param data from a form
+ my $good = {
+ 'title' => 'How to Test Perl Form Processors',
+ 'author' => 'I.M. Author',
+ 'genres' => [2, 4],
+ 'format' => 2,
+ 'isbn' => '123-02345-0502-2' ,
+ 'publisher' => 'EreWhon Publishing',
+ };
+ ok( $form->process( params => $good ), 'Good data' );
+
+ my $book = $form->item;
+ END { $book->delete };
+ ok ($book, 'get book object from form');
+ my $num_genres = $book->genres->count;
+ is( $num_genres, 2, 'multiple select list updated ok');
+ is( $form->value('format'), 2, 'get value for format' );
+
+ my $bad_1 = {
+ notitle => 'not req',
+ silly_field => 4,
+ };
+ ok( !$form->process( $bad_1 ), 'bad 1' );
+
+ my $bad_2 = {
+ 'title' => "Another Silly Test Book",
+ 'author' => "C. Foolish",
+ 'year' => '1590',
+ 'pages' => 'too few',
+ 'format' => '22',
+ };
+ ok( !$form->process( $bad_2 ), 'bad 2');
+ ok( $form->field('year')->has_errors, 'year has error' );
+ ok( $form->field('pages')->has_errors, 'pages has error' );
+ ok( !$form->field('author')->has_errors, 'author has no error' );
+ ok( $form->field('format')->has_errors, 'format has error' );
+
+ my $good = {
+ title => "Another Silly Test Book",
+ author => "C. Foolish",
+ year => 1999,
+ pages => 101,
+ format => 2
+ };
+ ok( $form->process($good), 'now form validates' );
+
+
+
+=head1 AUTHORS
+
+Gerda Shank, gshank at cpan.org
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
diff --git a/lib/HTML/FormHandler/Manual/Reference.pod b/lib/HTML/FormHandler/Manual/Reference.pod
new file mode 100644
index 0000000..fcff981
--- /dev/null
+++ b/lib/HTML/FormHandler/Manual/Reference.pod
@@ -0,0 +1,152 @@
+=head1 NAME
+
+HTML::FormHandler::Manual::Reference - concise reference
+
+=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>,
+L<HTML::FormHandler::Render::Simple>, and in the individual field classes.
+
+=head1 Fields
+
+=head2 Attributes for fields defined in your form:
+
+ name Field name. Must be the same as database column name or rel
+ type Field type. From a Field class: 'Text', 'Select', etc
+ accessor Database accessor name if different than field name
+ 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
+ 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.
+ 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.
+ disabled HTML hint to not do updates (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
+ (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
+ sort_column Select lists: column to use for sorting (default: label_column)
+ 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
+ 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?
+ dump For debugging
+
+=head2 Field attributes not set in a user form
+
+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
+ options Select lists. Sorted array of hashes, keys: "value", "label"
+
+=head1 Forms
+
+=head2 Attributes to pass to new or set in form
+
+ item_class Class 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
+ validated Flag that form has validated
+ 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
+ fields Field array
+ 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.
+
+ 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
+
+ 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
+ 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
+
+ options_$fieldname Provides a list of key value pairs for select lists
+ 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
+
+=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 %]
+ $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
+
+ [% FOR field IN form.error_fields %]
+ [% FOR error IN field.errors %]
+ <p><span class='error' id=error>[% error %] </span></p>
+ [% END %]
+ [% END %]
+
+ sorted_fields [% FOREACH field IN form.sorted_fields %]
+ 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 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
+
diff --git a/lib/HTML/FormHandler/Manual/Rendering.pod b/lib/HTML/FormHandler/Manual/Rendering.pod
new file mode 100644
index 0000000..7643e7d
--- /dev/null
+++ b/lib/HTML/FormHandler/Manual/Rendering.pod
@@ -0,0 +1,227 @@
+=head1 NAME
+
+HTML::FormHandler::Manual::Rendering
+
+=head1 SYNOPSIS
+
+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
+and a hashref of the values to use to fill in an HTML form).
+
+If you are interested in creating your own renderer,
+L<HTML::FormHandler::Render::Simple> can be used as an example of
+rendering directly from forms/fields. Depending on what kind of
+rendering you want to do, it may be simpler to take the 'value'
+hashref and use that.
+
+HFH has a number of different rendering methods:
+
+ 1. Handcoded html with no assist from HFH at all
+ 2. Use templates and the field 'widget' to determine the template snippet
+ 3. Use a rendering role in your form class, like Render::Simple
+
+and now:
+
+ 4. Automatically installed rendering widgets using a combination of
+ rendering roles, which can easily be customized by the user.
+
+With all of the rendering roles, it is impossible to make improvements
+and additions to rendering without changes to the output, so you should
+consider either using your own versions of the rendering objects, or
+carefully inspecting the output when installing new versions of FormHandler.
+
+=head2 Handcoded HTML
+
+The names of your fields must match the names of your FormHandler fields.
+If you use compound fields, you must use the FormHandler naming convention.
+If you want your fields automatically filled, you probably need to
+use L<HTML::FillInForm> in some manner. If you use Select fields, you
+must take care that the select lists in your HTML do not get out of
+sync with the Select lists in FormHandler. A totally hand-built solution
+would be difficult for Compound and Repeatable fields.
+
+The best alternative may be to render some of the HTML by hand, but use
+FormHandler to display the field elements:
+
+ [% form.field('title').render %]
+
+FormHandler is not a template system, so unless your form is very simple,
+rendering the entire form page only with FormHandler may not be the best solution.
+It's great for scaffolding, or simple admin forms, but user facing forms
+may need some degree of hand-building.
+
+It is *possible* to do fairly complex form rendering in FormHandler.
+Whether it makes sense for your application is something you have to decide.
+The rendering roles make it easy to integrate other types of templating.
+
+=head2 Use Render::Simple/Table or rendering widgets?
+
+The form and fields rendering widgets will be automatically applied unless
+a 'render' method already exists, so if your form class applies a role like:
+
+ with 'HTML::FormHandler::Render::Simple';
+
+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.
+
+=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,
+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
+field basis by setting 'widget_name_space' to an arrayref of name spaces:
+
+ has '+widget_name_space' => ( default => sub { ['MyApp::Form::Submit',
+ 'MyApp::Form::Widget' ]);
+
+The HTML::FormHandler::Widget name space is always searched as the last name space.
+This means that you can set up an application or form specific set of widgets.
+
+Widgets in a widget directory (specified in widget_name_space) are located in either
+a 'Field', 'Wrapper', or 'Form' subdirectory.
+
+The form's rendering role is looked for in the widget name space plus 'Form'. The
+default form rendering roles are in HTML::FormHandler::Widget::Form (Simple
+and Table). The form widget is specified in the form with 'widget_form'.
+
+ package MyApp::Form;
+ ....
+ has '+widget_form' => ( widget_form => 'Simple' );
+ ...
+
+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
+'widget_wrapper' in the form class, or you can set them individually by setting
+'widget_wrapper' on individual fields.
+
+ has 'some_field' => ( widget_wrapper => 'MyWrapper' );
+
+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 'another_field' => ( widget => 'MyWidget', widget_wrapper => 'MyWrapper' );
+
+Can be set in the form:
+
+ widget_name_space
+ widget_wrapper
+ widget_form
+
+Can be set in the field:
+
+ widget_name_space
+ widget_wrapper
+ widget
+
+The widget_name_space and widget_wrapper will be copied into the fields from the
+form if they are not already defined.
+
+By default, a form will use the Form::Simple and Wrapper::Simple widgets. If you
+want to use the table format you can change the 'widget_form' and 'widget_wrapper'
+attributes in the form, or do it on new:
+
+ my $form = MyApp::Form->new( widget_form => 'Table', widget_wrapper => 'Table' );
+
+=head2 Rendering filter for fill-in-form values
+
+The base field class has a 'render_filter' attribute which is a coderef used to
+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.
+
+ sub render_filter {
+ my ( $self, $string ) = @_;
+ $string =~ s/my/MY/g; # perform some kind of transformation
+ return $string;
+ }
+ -- or --
+ has_field 'foo' => ( render_filter => sub { ... } );
+
+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
+
+You can create custom widgets for your complete application or on a per-form basis.
+One possible layout for your widgets;
+
+ lib/MyApp/Form
+ lib/MyApp/Form/Widget/Form
+ lib/MyApp/Form/Widget/Field (contains MyWidget.pm)
+ lib/MyApp/Form/Widget/Wrapper
+
+Create custom widgets and put them in the respective directories, and then specify your
+widget name space:
+
+ MyApp::Form::User:
+ ...
+ has '+widget_name_space' => ( default => sub { ['MyApp::Form::Widget'] } );
+ ..
+ has 'some_field' => ( widget => 'MyWidget' );
+
+Your rendering widgets will be applied into your field classes.
+
+The 'widget_tags' hashref attribute has been provided to allow customizing
+rendering behavior on a per-field basis. They can be used to switch the Simple
+wrapper from divs to using paragraphs instead:
+
+ has_field 'my_field' => ( widget_tags => {wrapper_start => '<p>',
+ wrapper_end => '</p>' } );
+
+Widget tags set for the form will be copied into the fields if the same key
+does not exist in the field 'wrapper_tags' hashref, so you can set the
+widget_tags in a form to apply them to all the fields:
+
+ package MyApp::Form;
+ ....
+ has '+widget_tags' => ( default => sub { {wrapper_start => '<p>',
+ wrapper_end => '</p>' } );
+
+=head2 Creating Widgets
+
+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
+for both form and result rendering.
+
+The basic structure for a field widget:
+
+ package MyApp::Form::Widget::Field::MyWidget;
+ use Moose::Role;
+
+ sub render {
+ my ( $self, $result ) = @_;
+
+ $result ||= $self->result;
+ my $output;
+ < create rendered field >
+ my $fif = $result->fif;
+ my $value = $result->value;
+ my $errors = $result->errors;
+ < done creating rendered field )
+ return $self->wrap_field($result, $output);
+ }
+ use namespace::autoclean;
+ 1;
+
+Although the shipped widgets use a wrapper method, it is not necessary for
+you to do that in your widgets.
+
+=cut
diff --git a/lib/HTML/FormHandler/Manual/Templates.pod b/lib/HTML/FormHandler/Manual/Templates.pod
new file mode 100644
index 0000000..80fa62b
--- /dev/null
+++ b/lib/HTML/FormHandler/Manual/Templates.pod
@@ -0,0 +1,146 @@
+=head1 NAME
+
+HTML::FormHandler::Manual::Templates - using templates
+
+=head1 SYNOPSIS
+
+Documentation on templates to use with L<HTML::FormHandler>
+
+=head1 Using templates
+
+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'
+for the field in your form:
+
+ fields => [
+ my_special_field => {
+ type => 'Text',
+ widget => 'my_special_widget',
+ },
+ my_second_field => {
+ type => 'Text',
+ widget => 'yet_another_widget',
+ },
+ ]
+
+And include them in a generic template:
+
+ [% PROCESS widget/form_start.tt %]
+
+ [% FOREACH f IN form.sorted_fields %]
+ [% PROCESS widget/${f.widget}.tt %]
+ [% END %]
+
+ [% PROCESS widget/form_end.tt %]
+
+=head1 Sample templates
+
+Note that the following templates assume that the field is in a TT variable "f",
+as though they were processed in the above loop. Otherwise the individual
+fields could be preceded by something like:
+
+ [% f = form.field('title') %]
+
+=head2 Text input field with error class on div & error messages
+
+ <div class="[% f.css_class %] [% IF f.has_errors %]error_fld[% END %]">
+ [% IF f.has_errors %]
+ [% FOR error IN f.errors %]
+ <p><span class="error" id="error">[% error %] </span></p>
+ [% END %]
+ [% END %]
+ <label class="label" for="[% f.id %]">[% f.label %]</label>
+ <input type="text" name="[% f.html_name %]" id="[% f.id %]" value="[% f.fif %]">
+ </div>
+
+Simple text field;
+
+ [% f = form.field('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:
+
+ <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 %]"
+ [% IF option.value == f.fif %]
+ selected="selected"
+ [% END %]>
+ [% option.label %]</option>
+ [% END %]
+ </select>
+
+Multiple select:
+
+ <label class="label" for="[% f.id %]">[% f.label %]</label>
+ <select name="[% f.html_name %]" id="[% f.id %]
+ multiple="multiple" size="[% f.size %]">
+ [% FOR option IN f.options %]
+ <option value="[% option.value %]"
+ [% FOREACH optval IN f.value %]
+ [% IF optval == option.value %]
+ selected="selected"
+ [% END %]
+ [% END %]>
+ [% option.label %]</option>
+ [% END %]
+ </select>
+
+Warning: TT has problems with single element arrays. If you are likely
+to have a single element in a select list, you might want to use the
+rendering method instead or add an extra "choose" row. (If you come up
+with a good solution, please submit a doc patch.)
+
+=head2 Checkbox
+
+ <div><label class="label" for="[% f.id %]">[% f.label %]: </label>
+ <input type="checkbox" name="[% f.html_name %]" id="[% f.id %]" value="1" />
+ </div>
+
+=head2 Textarea
+
+ <div><label class="label" for="[% f.id %]">[% f.label %]" </label>
+ <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 %]"
+ value="[% f.fif %]" /></div>
+
+=head2 Submit
+
+ <div><input type="submit" name="[% f.html_name %]" id="[% f.id %]"
+ value="[% f.value %]" /></div>
+
+=head2 Radio group
+
+ <div>
+ <label class="label" for="[% f.id %]">[% f.label %]</label>
+ [% FOR option IN f.options %]
+ <input type="radio" value="[% option.value %]"
+ name="[% f.name %]"
+ [% IF option.value == f.fif %]
+ checked="checked"
+ [% END %]>
+ [% option.label %]<br />
+ [% END %]
+ </div>
+
+=head1 AUTHORS
+
+HTML::FormHandler Contributors; see HTML::FormHandler
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
diff --git a/lib/HTML/FormHandler/Manual/Tutorial.pod b/lib/HTML/FormHandler/Manual/Tutorial.pod
new file mode 100644
index 0000000..25340cf
--- /dev/null
+++ b/lib/HTML/FormHandler/Manual/Tutorial.pod
@@ -0,0 +1,318 @@
+=head1 NAME
+
+HTML::FormHandler::Manual::Tutorial - use FormHandler with Catalyst
+
+=head1 DESCRIPTION
+
+A tutorial for beginners to L<HTML::FormHandler>
+
+=head1 Using HTML::FormHandler with Catalyst
+
+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
+
+Use CPAN to install L<HTML::FormHandler>
+
+=head1 Use the Tutorial application
+
+We'll use the files that were created in the L<Catalyst::Manual::Tutorial>, in
+order to concentrate on just the bits where HTML::FormHandler is useful.
+You can download a tar file of the tutorial files from the Catalyst
+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
+create the file Book.pm.
+
+ package MyApp::Form::Book;
+
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler::Model::DBIC';
+
+ has '+item_class' => ( default => 'Book' );
+ has_field 'title' => ( type => 'Text' );
+ has_field 'rating' => ( type => 'Integer' );
+ has_field 'authors' => ( type => 'Multiple', label_column => 'last_name' );
+ has_field 'submit' => ( type => 'Submit', value => 'Submit' );
+
+ no HTML::FormHandler::Moose;
+ 1;
+
+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
+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>.
+
+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
+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
+this simple form the default types are adequate.
+
+=head2 Connect HTML::FormHandler to your controller
+
+Edit lib/MyApp/Controller/Books.pm. Add use Moose:
+
+ use Moose;
+ BEGIN { extends 'Catalyst::Controller' }
+ use MyApp::Form::Book;
+
+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:
+
+ sub edit : Local {
+ my ( $self, $c, $book_id ) = @_;
+
+ $c->stash( template => 'books/edit.tt2',
+ form => $self->form );
+
+ # Validate and insert/update database
+ return unless $self->form->process( item_id => $book_id,
+ params => $c->req->parameters,
+ schema => $c->model('DB')->schema );
+
+ # Form validated, return to the books list
+ $c->flash->{status_msg} = 'Book saved';
+ $c->res->redirect($c->uri_for('list'));
+ }
+
+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.
+
+=head2 Render the form
+
+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:
+
+ [% form.render %]
+
+=head2 Alternative hand-built Template for the form (optional)
+
+Although L<HTML::FormHandler::Render::Simple> works well for scaffolding and may
+be adequate for simple forms, sometimes it's necessary to hand build
+HTML. This section contains an example of a Template Toolkit template
+that may be used to display a FormHandler form.
+
+In some cases, you might want to use the rendering for just the field
+and build custom divs or tables or whatever around it:
+
+ <div class="mycustomclass">
+ [% form.render_field('book') %]
+ </div>
+
+If you don't want to play with HTML at this point, you can skip ahead
+to the next section.
+
+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
+or copy the following:
+
+ [% META title = 'Book Form' %]
+
+ [% FOR field IN form.error_fields %]
+ [% FOR error IN field.errors %]
+ <p><span class="error" id="error">
+ [% field.label _ ': ' _ error %] </span></p>
+ [% END %]
+ [% END %]
+
+ <form name="[% form.name %]"
+ action="[% c.uri_for('edit', form.item_id) %]"
+ method="post">
+ <p>
+ [% f = form.field('title') %]
+ <label class="label" for="[% f.name %]">[% f.label %]:</label>
+ <input type="text" name="[% f.name %]" id="[% f.name %]" value="[% f.fif %]">
+ </p>
+ <p>
+ [% f = form.field('rating') %]
+ <label class="label" for="[% f.name %]">[% f.label %]:</label>
+ <input type="text" name="[% f.name %]" id="[% f.name %]" %] value="[% f.fif %]">
+ </p>
+ <p>
+ [% f = form.field('authors') %]
+ <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 %]"
+ [% FOREACH selval IN f.fif %]
+ [% IF selval == option.value %]selected="selected"[% END %]
+ [% END %]>
+ [% option.label | html %]</option>
+ [% 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>
+
+
+=head2 Add links to access create and update actions
+
+Add a link to root/src/books/list.tt2 to allow you to edit
+an existing book, by changing the last <td> cell in the book
+list:
+
+ <td>
+ <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:
+
+ <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
+returned to the Book List page with a "Book saved" message.
+
+Magic! A new book has been created and saved to the database
+with very little code in your controller.
+
+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
+
+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
+custom Field classes.
+
+ package MyApp::Form::Field::Extra;
+ use Moose;
+ extends 'HTML::FormHandler::Field';
+
+ has 'my_attribute' => ( isa => Str, is => 'ro' );
+
+ 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.
+
+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
+
+Now we'll add more validation to ensure that users
+are entering correct data.
+
+Update the fields in the form file:
+
+ has_field 'title' => ( type => 'Text', label => 'Title of a Book',
+ required => 1, size => 40, minlength => 5 );
+ has_field 'rating' => ( type => 'Integer', label => 'Rating (1-5)',
+ required => 1, required_message => 'You must rate the book',
+ range_start => 1, range_end => 5 );
+ has_field 'authors' => ( type => 'Multiple', label_column => 'last_name',
+ required => 1 );
+
+We've made all the fields required.
+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
+the defined range. (Another option would have been to use the 'IntRange'
+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
+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,
+so we'll add a silly field constraint. Add the following to the form:
+
+ sub validate_title {
+ my ( $self, $field ) = @_;
+ $field->add_error("The word \'Rainbows\' is not allowed in titles")
+ if ( $field->value =~ /Rainbows/ );
+ }
+
+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.
+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
+
+Restart the development server, login, and try adding books with
+various errors: title length less than 5 or more than 40, rating
+above 5, leaving out a particular field. Create a book with
+'Rainbows' in the title.
+
+You should get error messages for every error.
+
+=head2 Database accessors
+
+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
+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
+
+Gerda Shank, gshank at cpan.org
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
+
diff --git a/lib/HTML/FormHandler/Meta/Role.pm b/lib/HTML/FormHandler/Meta/Role.pm
new file mode 100644
index 0000000..99973a5
--- /dev/null
+++ b/lib/HTML/FormHandler/Meta/Role.pm
@@ -0,0 +1,52 @@
+package # hide from Pause
+ HTML::FormHandler::Meta::Role;
+
+use Moose::Role;
+
+=head1 NAME
+
+HTML::FormHandler::Meta::Role
+
+=head1 SYNOPSIS
+
+Add metaclass to field_list attribute
+
+=cut
+
+has 'field_list' => (
+ traits => ['Array'],
+ is => 'rw',
+ isa => 'ArrayRef',
+ default => sub { [] },
+ handles => {
+ add_to_field_list => 'push',
+ clear_field_list => 'clear',
+ has_field_list => 'count',
+ }
+);
+
+has 'apply_list' => (
+ traits => ['Array'],
+ is => 'rw',
+ isa => 'ArrayRef',
+ default => sub { [] },
+ handles => {
+ add_to_apply_list => 'push',
+ has_apply_list => 'count',
+ clear_apply_list => 'clear',
+ }
+);
+
+=head1 AUTHOR
+
+Gerda Shank, gshank at cpan.org
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
+
+use namespace::autoclean;
+1;
diff --git a/lib/HTML/FormHandler/Model.pm b/lib/HTML/FormHandler/Model.pm
new file mode 100644
index 0000000..d61df0d
--- /dev/null
+++ b/lib/HTML/FormHandler/Model.pm
@@ -0,0 +1,184 @@
+package HTML::FormHandler::Model;
+
+use Moose::Role;
+use Carp;
+
+=head1 NAME
+
+HTML::FormHandler::Model - default model base class
+
+=head1 SYNOPSIS
+
+This class defines the base attributes for FormHandler model
+classes. It is not used directly.
+
+=head1 DESCRIPTION
+
+This is an empty base class that defines methods called by
+HTML::FormHandler to support interfacing forms with a data store
+such as a database.
+
+This module provides instructions on methods to override to create
+a HTML::FormHandler::Model class to work with a specific object relational
+mapping (ORM) tool.
+
+=head1 METHODS
+
+=head2 item, build_item
+
+The "item" is initialized with "build_item" the first time $form->item is called.
+"item" must be defined in the model class to fetch the object based on the item id.
+It should return the item's object. Column values are fetched and updated
+by calling methods on the returned object.
+
+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
+the ORM class related to a form.
+
+For example:
+
+ has '+item_class' => ( default => 'User' );
+
+This gives the model class a way to access the data store.
+If this is not a fixed value (as above) then do not define the
+method in your subclass and instead set the value when the form
+is created:
+
+ my $form = MyApp::Form::Users->new( item_class => $class );
+
+The value can be any scalar (or object) needed by the specific ORM
+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.
+This is only required if using "Auto" type of fields in your form classes.
+You could override this in your form class, for example, if you use a field
+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.
+The default method returns undef.
+
+Returns an array reference of key/value pairs for the column passed in.
+These values are used for the values and labels for field types that
+provide a list of options to select from (e.g. Select, Multiple).
+
+A 'Select' type field (or a field that inherits from
+HTML::FormHandler::Field::Select) can set a number of scalars that control how
+options are looked up:
+
+ label_column() - column that holds the label
+ active_column() - column that indicates if a row is acitve
+ sort_column() - column used for sorting the options
+
+The default for label_column is "name".
+
+=cut
+
+sub lookup_options { }
+
+=head2 validate_model
+
+Validates fields that are dependent on the model.
+This is called via the validation process and the model class
+must at least validate "unique" constraints defined in the form
+class.
+
+Any errors on a field found should be set by calling the field's
+add_error method:
+
+ $field->add_error('Value must be unique in the database');
+
+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 AUTHORS
+
+HTML::FormHandler Contributors; see HTML::FormHandler
+
+Initially based on the original source code of L<Form::Processor::Model> by Bill Moseley
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
+
+use namespace::autoclean;
+1;
diff --git a/lib/HTML/FormHandler/Model/CDBI.pm b/lib/HTML/FormHandler/Model/CDBI.pm
new file mode 100644
index 0000000..8ac3378
--- /dev/null
+++ b/lib/HTML/FormHandler/Model/CDBI.pm
@@ -0,0 +1,424 @@
+package # hide from Pause
+ HTML::FormHandler::Model::CDBI;
+
+use Moose;
+use Carp;
+use Data::Dumper;
+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;
+
+ my $item_id = $self->item_id or return;
+ return $self->item_class->retrieve($item_id);
+}
+
+sub BUILDARGS {
+ my ( $self, @args ) = @_;
+ 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 ) = @_;
+
+ $class ||= $self->item_class;
+
+ return unless $class && $class->isa('Class::DBI');
+
+ my @return;
+
+ # Is it a direct has_a relationship?
+ if ( my $meta = $class->meta_info('has_a')->{$column} ) {
+ my $f_class = $meta->foreign_class;
+
+ @return =
+ $f_class->isa('DateTime') ? ('DateTime') :
+ ( 'Select', $f_class );
+
+ # Otherwise, check for has_many
+ }
+ elsif ( $meta = $class->meta_info('has_many')->{$column} ) {
+
+ my $f_class = $meta->foreign_class;
+ # Is there a mapping table in between? If so need to find the
+ # actual class for lookups -- call recursively
+ if ( @{ $meta->args->{mapping} } ) {
+ my $t;
+ ( $t, $f_class ) = $self->guess_field_type( $meta->args->{mapping}[0], $f_class );
+ }
+ @return = ( 'Multiple', $f_class );
+ }
+ elsif ( $column =~ /_time$/ ) {
+ @return = ('DateTime');
+ }
+ else {
+ @return = ('Text');
+ }
+
+ 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 ) = @_;
+
+ my $class = $self->item_class or return;
+ return unless $class->isa('Class::DBI');
+ my $field_name = $field->name;
+ my ( $type, $f_class ) = $self->guess_field_type( $field_name, $class );
+ return unless $f_class;
+
+ # label column
+ my $label_column = $field->label_column;
+ return unless $f_class->find_column($label_column);
+ # active column
+ my $active_col =
+ $self->can('active_column') ? $self->active_column :
+ $field->active_column;
+ $active_col = '' unless $f_class->find_column($active_col);
+ # sort column
+ my $sort_col = $field->sort_column;
+ $sort_col =
+ defined $sort_col && $f_class->find_column($sort_col) ? $sort_col :
+ $label_column;
+
+ my $criteria = {};
+ my $primary_key = $f_class->primary_column;
+ # In cases where the f_class is the same as the item's class don't
+ # include item in the option list -- don't want to be able to have item point to itself
+ # Obviously, this doesn't prevent circular references.
+ $criteria->{"$primary_key"} = { '!=', $self->item->id }
+ if $f_class eq ref $self->item;
+
+ # If there's an active column, only select active OR items already selected
+ if ($active_col) {
+ my @or = ( $active_col => 1 );
+ # But also include any existing non-active
+ push @or, ( "$primary_key" => $field->init_value ) # init_value is scalar or array ref
+ if $self->item && defined $field->init_value;
+ $criteria->{'-or'} = \@or;
+ }
+
+ my @rows = $f_class->search( $criteria, { order_by => $sort_col } );
+
+ return [
+ map {
+ my $label = $_->$label_column;
+ $_->id, $active_col && !$_->$active_col ? "[ $label ]" : "$label"
+ } @rows
+ ];
+
+}
+
+=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 ) = @_;
+
+ my $column = $field->name;
+
+ $item ||= $self->item;
+ return if $field->writeonly;
+ return
+ unless $item &&
+ ( $item->can($column) ||
+ ( ref $item eq 'HASH' && exists $item->{$column} ) );
+ my @values;
+ if ( ref $item eq 'HASH' ) {
+ @values = $item->{$column} if ref($item) eq 'HASH';
+ }
+ elsif ( !$item->isa('Class::DBI') ) {
+ @values = $item->$column;
+ }
+ else {
+ @values =
+ map { ref $_ && $_->isa('Class::DBI') ? $_->id : $_ } $item->$column;
+ }
+
+ my $value = @values > 1 ? \@values : shift @values;
+ $field->init_value($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) = @_;
+
+ return unless $self->validate_unique;
+ return 1;
+}
+
+=head2 validate_unique
+
+Checks that the value for the field is not currently in the database.
+
+=cut
+
+sub validate_unique {
+ my ($self) = @_;
+
+ my @unique = map { $_->name } grep { $_->unique } $self->fields;
+ return 1 unless @unique;
+
+ my $item = $self->item;
+
+ my $class = ref($item) || $self->item_class;
+ my $found_error = 0;
+ for my $field ( map { $self->field($_) } @unique ) {
+ next if $field->errors;
+ my $value = $field->value;
+ next unless defined $value;
+ my $name = $field->name;
+ # unique means there can only be on in the database like it.
+ my $match = $class->search( { $name => $value } )->first || next;
+ next if $self->items_same( $item, $match );
+ my $field_error = $field->unique_message ||
+ 'Value must be unique in the database';
+ $field->add_error($field_error);
+ $found_error++;
+ }
+ return $found_error;
+}
+
+sub update_model {
+ my ($self) = @_;
+
+ # Grab either the item or the object class.
+ my $item = $self->item;
+ my $class = ref($item) || $self->item_class;
+ my $updated_or_created;
+
+ # get a hash of all fields
+ my %fields = map { $_->name, $_ } grep { !$_->noupdate } $self->fields;
+ # First process the normal and has_a columns
+ # as that data is directly stored in the object
+ my %data;
+ # Loads columns (including has_a)
+ foreach my $col ( $class->columns('All') ) {
+ next unless exists $fields{$col};
+ my $field = delete $fields{$col};
+ # If the field is flagged "clear" then set to NULL.
+ my $value = $field->value;
+ if ($item) {
+ my $cur = $item->$col;
+ next unless $value || $cur;
+ next if $value && $cur && $value eq $cur;
+ $item->$col($value);
+ }
+ else {
+ $data{$col} = $value;
+ }
+ }
+
+ if ($item) {
+ $item->update;
+ $updated_or_created = 'updated';
+ }
+ else {
+ $item = $class->create( \%data );
+ $self->item($item);
+ $updated_or_created = 'created';
+ }
+
+ # Now check for mapping/has_many in any left over fields
+
+ for my $field_name ( keys %fields ) {
+ next unless $class->meta_info('has_many');
+ next unless my $meta = $class->meta_info('has_many')->{$field_name};
+
+ my $field = delete $fields{$field_name};
+ my $value = $field->value;
+
+ # Figure out which values to keep and which to add
+ my %keep;
+ %keep = map { $_ => 1 } ref $value ? @$value : ($value)
+ if defined $value;
+
+ # Get foreign class and its key that points to $class
+ my $foreign_class = $meta->foreign_class;
+ my $foreign_key = $meta->args->{foreign_key};
+ my $related_key = $meta->args->{mapping}->[0];
+ die "Failed to find related_key for field [$field] in class [$class]"
+ unless $related_key;
+
+ # Delete any items that are not to be kept
+ for ( $foreign_class->search( { $foreign_key => $item } ) ) {
+ $_->delete unless delete $keep{ $_->$related_key };
+ }
+
+ # Add in new ones
+ $foreign_class->create(
+ {
+ $foreign_key => $item,
+ $related_key => $_,
+ }
+ ) for keys %keep;
+ }
+
+ # Save item in form object
+ $self->item($item);
+ 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 ) = @_;
+
+ # returns true if both are undefined
+ return 1 if not defined $item1 and not defined $item2;
+ # return false if either undefined
+ return unless defined $item1 and defined $item2;
+ 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 ) = @_;
+ return join '|', $item->table,
+ map { $_ . '=' . ( $item->$_ || '.' ) } $item->primary_columns;
+}
+
+=head1 AUTHOR
+
+Gerda Shank, gshank at cpan.org
+
+Based on the original source code of L<Form::Processor::Model::CDBI> by Bill Moseley
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl 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
new file mode 100644
index 0000000..5cbd352
--- /dev/null
+++ b/lib/HTML/FormHandler/Model/Object.pm
@@ -0,0 +1,18 @@
+package HTML::FormHandler::Model::Object;
+
+use Moose::Role;
+
+sub update_model {
+ my $self = shift;
+
+ my $item = $self->item;
+ return unless $item;
+ foreach my $field ( $self->all_fields ) {
+ my $name = $field->name;
+ next unless $item->can($name);
+ $item->$name( $field->value );
+ }
+}
+
+use namespace::autoclean;
+1;
diff --git a/lib/HTML/FormHandler/Moose.pm b/lib/HTML/FormHandler/Moose.pm
new file mode 100644
index 0000000..7033621
--- /dev/null
+++ b/lib/HTML/FormHandler/Moose.pm
@@ -0,0 +1,71 @@
+package HTML::FormHandler::Moose;
+
+use Moose;
+use Moose::Exporter;
+use Moose::Util::MetaRole;
+use HTML::FormHandler::Meta::Role;
+
+=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' ],
+ also => 'Moose',
+);
+
+sub init_meta {
+ my $class = shift;
+
+ 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'],
+ );
+ return $meta;
+}
+
+sub has_field {
+ my ( $meta, $name, %options ) = @_;
+ my $names = ( ref($name) eq 'ARRAY' ) ? $name : [ ($name) ];
+
+ $meta->add_to_field_list( { name => $_, %options } ) for @$names;
+}
+
+sub apply {
+ my ( $meta, $arrayref ) = @_;
+
+ $meta->add_to_apply_list( @{$arrayref} );
+}
+
+=head1 AUTHOR
+
+HTML::FormHandler Contributors; see HTML::FormHandler
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
+
+use namespace::autoclean;
+1;
diff --git a/lib/HTML/FormHandler/Moose/Role.pm b/lib/HTML/FormHandler/Moose/Role.pm
new file mode 100644
index 0000000..28c907a
--- /dev/null
+++ b/lib/HTML/FormHandler/Moose/Role.pm
@@ -0,0 +1,66 @@
+package HTML::FormHandler::Moose::Role;
+
+use Moose::Role;
+use Moose::Exporter;
+
+=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' ],
+ also => 'Moose::Role',
+);
+
+sub init_meta {
+ my $class = shift;
+
+ 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'],
+ );
+ return $meta;
+}
+
+sub has_field {
+ my ( $class, $name, %options ) = @_;
+
+ $class->meta->add_to_field_list( { name => $name, %options } );
+}
+
+sub apply {
+ my ( $class, $arrayref ) = @_;
+ $class->meta->add_to_apply_list( @{$arrayref} );
+}
+
+=head1 AUTHOR
+
+Gerda Shank, gshank at cpan.org
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
+
+use namespace::autoclean;
+1;
diff --git a/lib/HTML/FormHandler/Params.pm b/lib/HTML/FormHandler/Params.pm
new file mode 100644
index 0000000..84eb6ca
--- /dev/null
+++ b/lib/HTML/FormHandler/Params.pm
@@ -0,0 +1,125 @@
+package # hide from Pause
+ HTML::FormHandler::Params;
+
+use Moose;
+use Carp;
+
+has 'separator' => ( isa => 'Str', is => 'rw', default => '.' );
+
+sub split_name {
+ my ( $self, $name, $sep ) = @_;
+
+ $sep ||= $self->separator;
+ $sep = "\Q$sep";
+
+ if ( $sep eq '[]' ) {
+ return grep { defined } (
+ $name =~ /
+ ^ (\w+) # root param
+ | \[ (\w+) \] # nested
+ /gx
+ );
+ }
+
+ # These next two regexes are the escaping aware equivalent
+ # to the following:
+ # my ($first, @segments) = split(/\./, $name, -1);
+
+ # m// splits on unescaped '.' chars. Can't fail b/c \G on next
+ # non ./ * -> escaped anything -> non ./ *
+ $name =~ m/^ ( [^\\$sep]* (?: \\(?:.|$) [^\\$sep]* )* ) /gx;
+ my $first = $1;
+ $first =~ s/\\(.)/$1/g; # remove escaping
+
+ my (@segments) = $name =~
+ # . -> ( non ./ * -> escaped anything -> non ./ * )
+ m/\G (?:[$sep]) ( [^\\$sep]* (?: \\(?:.|$) [^\\$sep]* )* ) /gx;
+ # Escapes removed later, can be used to avoid using as array index
+
+ return ( $first, @segments );
+}
+
+sub expand_hash {
+ my ( $self, $flat, $sep ) = @_;
+
+ my $deep = {};
+ $sep ||= $self->separator;
+
+ for my $name ( keys %$flat ) {
+
+ my ( $first, @segments ) = $self->split_name( $name, $sep );
+
+ my $box_ref = \$deep->{$first};
+ for (@segments) {
+ if ( /^(0|[1-9]\d*)$/ ) {
+ $$box_ref = [] unless defined $$box_ref;
+ croak "HFH: param clash for $name=$_"
+ unless ref $$box_ref eq 'ARRAY';
+ $box_ref = \( $$box_ref->[$1] );
+ }
+ else {
+ s/\\(.)/$1/g if $sep; # remove escaping
+ $$box_ref = {} unless defined $$box_ref;
+ $$box_ref = { '' => $$box_ref } if ( !ref $$box_ref );
+ croak "HFH: param clash for $name=$_"
+ unless ref $$box_ref eq 'HASH';
+ $box_ref = \( $$box_ref->{$_} );
+ }
+ }
+ if ( defined $$box_ref ) {
+ croak "HFH: param clash for $name value $flat->{$name}"
+ if ref $$box_ref ne 'HASH';
+ $box_ref = \( $$box_ref->{''} );
+ }
+ $$box_ref = $flat->{$name};
+ }
+ return $deep;
+}
+
+sub collapse_hash {
+ my $self = shift;
+ my $deep = shift;
+ my $flat = {};
+
+ $self->_collapse_hash( $deep, $flat, () );
+ return $flat;
+}
+
+sub join_name {
+ my ( $self, @array ) = @_;
+ my $sep = substr( $self->separator, 0, 1 );
+ return join $sep, @array;
+}
+
+sub _collapse_hash {
+ my ( $self, $deep, $flat, @segments ) = @_;
+
+ if ( !ref $deep ) {
+ my $name = $self->join_name(@segments);
+ $flat->{$name} = $deep;
+ }
+ elsif ( ref $deep eq 'HASH' ) {
+ for ( keys %$deep ) {
+ # escape \ and separator chars (once only, at this level)
+ my $name = $_;
+ if ( defined( my $sep = $self->separator ) ) {
+ $sep = "\Q$sep";
+ $name =~ s/([\\$sep])/\\$1/g;
+ }
+ $self->_collapse_hash( $deep->{$_}, $flat, @segments, $name );
+ }
+ }
+ elsif ( ref $deep eq 'ARRAY' ) {
+ for ( 0 .. $#$deep ) {
+ $self->_collapse_hash( $deep->[$_], $flat, @segments, $_ )
+ if defined $deep->[$_];
+ }
+ }
+ else {
+ croak "Unknown reference type for ", $self->join_name(@segments), ":", ref $deep;
+ }
+}
+
+__PACKAGE__->meta->make_immutable;
+use namespace::autoclean;
+1;
diff --git a/lib/HTML/FormHandler/Render/Simple.pm b/lib/HTML/FormHandler/Render/Simple.pm
new file mode 100644
index 0000000..004ca92
--- /dev/null
+++ b/lib/HTML/FormHandler/Render/Simple.pm
@@ -0,0 +1,431 @@
+package HTML::FormHandler::Render::Simple;
+
+use Moose::Role;
+
+requires( 'sorted_fields', 'field' );
+
+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'],
+ isa => 'HashRef[Str]',
+ is => 'rw',
+ default => sub {
+ {
+ text => 'label',
+ password => 'label',
+ 'select' => 'label',
+ checkbox => 'label',
+ textarea => 'label',
+ radio_group => 'label',
+ compound => 'legend',
+ upload => 'label',
+ };
+ },
+ handles => { get_label_type => 'get' },
+);
+
+sub render {
+ my $self = shift;
+ my $output = $self->render_start;
+
+ foreach my $field ( $self->sorted_fields ) {
+ $output .= $self->render_field($field);
+ }
+
+ $output .= $self->render_end;
+ return $output;
+}
+
+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;
+}
+
+sub render_end {
+ my $self = shift;
+ my $output;
+ $output .= '</fieldset>' if $self->auto_fieldset;
+ $output .= "</form>\n";
+ return $output;
+}
+
+sub render_field {
+ my ( $self, $field ) = @_;
+
+ if ( ref( \$field ) eq 'SCALAR' ) {
+ $field = $self->field($field);
+ }
+ die "must pass field to render_field"
+ unless ( defined $field && $field->isa('HTML::FormHandler::Field') );
+ return '' if $field->widget eq 'no_render';
+ my $rendered_field;
+ my $form_render = 'render_' . $field->widget;
+ if ( $self->can($form_render) ) {
+ $rendered_field = $self->$form_render($field);
+ }
+ elsif ( $field->can('render') ) {
+ $rendered_field = $field->render;
+ }
+ else {
+ die "No widget method found for '" . $field->widget . "' in H::F::Render::Simple";
+ }
+ my $class = '';
+ if ( $field->css_class || $field->has_errors ) {
+ my @css_class;
+ push( @css_class, split( /[ ,]+/, $field->css_class ) ) if $field->css_class;
+ push( @css_class, 'error' ) if $field->has_errors;
+ $class .= ' class="';
+ $class .= join( ' ' => @css_class );
+ $class .= '"';
+ }
+ return $self->render_field_struct( $field, $rendered_field, $class );
+}
+
+sub render_field_struct {
+ my ( $self, $field, $rendered_field, $class ) = @_;
+ my $output = qq{\n<div$class>};
+ my $l_type =
+ defined $self->get_label_type( $field->widget ) ?
+ $self->get_label_type( $field->widget ) :
+ '';
+ if ( $l_type eq 'label' && $field->label ) {
+ $output .= $self->_label($field);
+ }
+ elsif ( $l_type eq 'legend' ) {
+ $output .= '<fieldset class="' . $field->html_name . '">';
+ $output .= '<legend>' . $field->html_filter($field->label) . '</legend>';
+ }
+ $output .= $rendered_field;
+ foreach my $error ($field->all_errors){
+ $output .= qq{\n<span class="error_message">} . $field->html_filter($error) . '</span>';
+ }
+
+ if ( $l_type eq 'legend' ) {
+ $output .= '</fieldset>';
+ }
+ $output .= "</div>\n";
+ return $output;
+}
+
+sub render_text {
+ my ( $self, $field ) = @_;
+ my $output = '<input type="text" name="';
+ $output .= $field->html_name . '"';
+ $output .= ' id="' . $field->id . '"';
+ $output .= ' size="' . $field->size . '"' if $field->size;
+ $output .= ' maxlength="' . $field->maxlength . '"' if $field->maxlength;
+ $output .= ' value="' . $field->html_filter($field->fif) . '"';
+ $output .= $self->_add_html_attributes( $field );
+ $output .= ' />';
+ return $output;
+}
+
+sub render_password {
+ my ( $self, $field ) = @_;
+ my $output = '<input type="password" name="';
+ $output .= $field->html_name . '"';
+ $output .= ' id="' . $field->id . '"';
+ $output .= ' size="' . $field->size . '"' if $field->size;
+ $output .= ' maxlength="' . $field->maxlength . '"' if $field->maxlength;
+ $output .= ' value="' . $field->html_filter($field->fif) . '"';
+ $output .= $self->_add_html_attributes( $field );
+ $output .= ' />';
+ return $output;
+}
+
+sub render_hidden {
+ my ( $self, $field ) = @_;
+ my $output = '<input type="hidden" name="';
+ $output .= $field->html_name . '"';
+ $output .= ' id="' . $field->id . '"';
+ $output .= ' value="' . $field->html_filter($field->fif) . '"';
+ $output .= $self->_add_html_attributes( $field );
+ $output .= ' />';
+ return $output;
+}
+
+sub render_select {
+ my ( $self, $field ) = @_;
+
+ my $output = '<select name="' . $field->html_name . '"';
+ $output .= ' id="' . $field->id . '"';
+ $output .= ' multiple="multiple"' if $field->multiple == 1;
+ $output .= ' size="' . $field->size . '"' if $field->size;
+ $output .= $self->_add_html_attributes( $field );
+ $output .= '>';
+ my $index = 0;
+ if( $field->empty_select ) {
+ $output .= '<option value="">' . $field->empty_select . '</option>';
+ }
+ foreach my $option ( @{ $field->options } ) {
+ $output .= '<option value="' . $field->html_filter($option->{value}) . '" ';
+ $output .= 'id="' . $field->id . ".$index\" ";
+ if ( $field->fif ) {
+ if ( $field->multiple == 1 ) {
+ my @fif;
+ if ( ref $field->fif ) {
+ @fif = @{ $field->fif };
+ }
+ else {
+ @fif = ( $field->fif );
+ }
+ foreach my $optval (@fif) {
+ $output .= 'selected="selected"'
+ if $optval eq $option->{value};
+ }
+ }
+ else {
+ $output .= 'selected="selected"'
+ if $option->{value} eq $field->fif;
+ }
+ }
+ $output .= '>' . $field->html_filter($option->{label}) . '</option>';
+ $index++;
+ }
+ $output .= '</select>';
+ return $output;
+}
+
+sub render_checkbox {
+ my ( $self, $field ) = @_;
+
+ my $output = '<input type="checkbox" name="' . $field->html_name . '"';
+ $output .= ' id="' . $field->id . '"';
+ $output .= ' value="' . $field->html_filter($field->checkbox_value) . '"';
+ $output .= ' checked="checked"' if $field->fif eq $field->checkbox_value;
+ $output .= $self->_add_html_attributes( $field );
+ $output .= ' />';
+ return $output;
+}
+
+sub render_radio_group {
+ my ( $self, $field ) = @_;
+
+ my $output = " <br />";
+ my $index = 0;
+ foreach my $option ( @{ $field->options } ) {
+ $output .= '<input type="radio" value="' . $field->html_filter($option->{value}) . '"';
+ $output .= ' name="' . $field->html_name . '" id="' . $field->id . ".$index\"";
+ $output .= ' checked="checked"' if $option->{value} eq $field->fif;
+ $output .= ' />';
+ $output .= $field->html_filter($option->{label}) . '<br />';
+ $index++;
+ }
+ return $output;
+}
+
+sub render_textarea {
+ my ( $self, $field ) = @_;
+ my $fif = $field->fif || '';
+ my $id = $field->id;
+ my $cols = $field->cols || 10;
+ my $rows = $field->rows || 5;
+ my $name = $field->html_name;
+
+ my $output =
+ qq(<textarea name="$name" id="$id" )
+ . $self->_add_html_attributes($field)
+ . qq(rows="$rows" cols="$cols">)
+ . $field->html_filter($fif)
+ . q(</textarea>);
+
+ return $output;
+}
+
+sub render_upload {
+ my ( $self, $field ) = @_;
+
+ my $output;
+ $output = '<input type="file" name="';
+ $output .= $field->html_name . '"';
+ $output .= ' id="' . $field->id . '"';
+ $output .= $self->_add_html_attributes( $field );
+ $output .= ' />';
+ return $output;
+}
+
+sub _label {
+ my ( $self, $field ) = @_;
+ return '<label class="label" for="' . $field->id . '">' .
+ $field->html_filter($field->label)
+ . ': </label>';
+}
+
+sub render_compound {
+ my ( $self, $field ) = @_;
+
+ my $output = '';
+ foreach my $subfield ( $field->sorted_fields ) {
+ $output .= $self->render_field($subfield);
+ }
+ return $output;
+}
+
+sub render_submit {
+ my ( $self, $field ) = @_;
+
+ my $output = '<input type="submit" name="';
+ $output .= $field->html_name . '"';
+ $output .= ' id="' . $field->id . '"';
+ $output .= $self->_add_html_attributes( $field );
+ $output .= ' value="' . $field->html_filter($field->value) . '" />';
+ return $output;
+}
+
+sub render_reset {
+ my ( $self, $field ) = @_;
+
+ my $output = '<input type="reset" name="';
+ $output .= $field->html_name . '"';
+ $output .= ' id="' . $field->id . '"';
+ $output .= $self->_add_html_attributes( $field );
+ $output .= ' value="' . $field->html_filter($field->value) . '" />';
+ return $output;
+}
+
+sub _add_html_attributes {
+ my ( $self, $field ) = @_;
+
+ my $output = q{};
+ for my $attr ( 'readonly', 'disabled', 'style' ) {
+ $output .= ( $field->$attr ? qq{ $attr="} . $field->$attr . '"' : '' );
+ }
+ $output .= ($field->javascript ? ' ' . $field->javascript : '');
+ return $output;
+}
+
+=head1 AUTHORS
+
+See CONTRIBUTORS in L<HTML::FormHandler>
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
+
+use namespace::autoclean;
+1;
+
diff --git a/lib/HTML/FormHandler/Render/Table.pm b/lib/HTML/FormHandler/Render/Table.pm
new file mode 100644
index 0000000..c3d4779
--- /dev/null
+++ b/lib/HTML/FormHandler/Render/Table.pm
@@ -0,0 +1,94 @@
+package HTML::FormHandler::Render::Table;
+
+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;
+
+ my $output = $self->render_start;
+ foreach my $field ( $self->sorted_fields ) {
+ $output .= $self->render_field($field);
+ }
+ $output .= $self->render_end;
+ return $output;
+}
+
+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;
+}
+
+sub render_end {
+ my $self = shift;
+ my $output .= "</table>\n";
+ $output .= "</form>\n";
+ return $output;
+}
+
+sub render_field_struct {
+ my ( $self, $field, $rendered_field, $class ) = @_;
+ my $output = qq{\n<tr$class>};
+ my $l_type =
+ defined $self->get_label_type( $field->widget ) ?
+ $self->get_label_type( $field->widget ) :
+ '';
+ if ( $l_type eq 'label' ) {
+ $output .= '<td>' . $self->_label($field) . '</td>';
+ }
+ elsif ( $l_type eq 'legend' ) {
+ $output .= '<td>' . $self->_label($field) . '</td></tr>';
+ }
+ if ( $l_type ne 'legend' ) {
+ $output .= '<td>';
+ }
+ $output .= $rendered_field;
+ $output .= qq{\n<span class="error_message">$_</span>} for $field->all_errors;
+ if ( $l_type ne 'legend' ) {
+ $output .= "</td></tr>\n";
+ }
+ return $output;
+}
+
+=head1 AUTHORS
+
+HFH Contributors, see L<HTML::FormHandler>
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
+
+use namespace::autoclean;
+1;
+
diff --git a/lib/HTML/FormHandler/Render/WithTT.pm b/lib/HTML/FormHandler/Render/WithTT.pm
new file mode 100644
index 0000000..471ceb7
--- /dev/null
+++ b/lib/HTML/FormHandler/Render/WithTT.pm
@@ -0,0 +1,114 @@
+package HTML::FormHandler::Render::WithTT;
+
+use Moose::Role;
+use File::ShareDir;
+use Template;
+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',
+);
+sub build_tt_include_path {[]}
+
+has 'tt_config' => (
+ traits => ['Hash'],
+ is => 'rw',
+ lazy => 1,
+ builder => 'build_tt_config',
+);
+sub build_tt_config {
+ my $self = shift;
+ return {
+ INCLUDE_PATH => [
+ @{ $self->tt_include_path },
+ File::ShareDir::dist_dir('HTML-FormHandler') . '/templates/'
+ ]
+ };
+}
+
+# either file name string or string ref?
+has 'tt_template' => ( is => 'rw', isa => 'Str', lazy => 1,
+ builder => 'build_tt_template' );
+sub build_tt_template { 'form.tt' }
+
+has 'tt_engine' => ( is => 'rw', isa => 'Template', lazy => 1,
+ builder => 'build_tt_engine'
+);
+sub build_tt_engine {
+ my $self = shift;
+
+ my $tt_engine = Template->new( $self->tt_config );
+ return $tt_engine;
+}
+
+has 'tt_vars' => ( is => 'rw', traits => ['Hash'],
+ builder => 'build_tt_vars');
+sub build_tt_vars {{}}
+
+has 'default_tt_vars' => ( is => 'ro', isa => 'HashRef',
+ lazy => 1, builder => 'build_default_tt_vars' );
+sub build_default_tt_vars {
+ my $self = shift;
+ return { form => $self->form };
+}
+
+has 'tt_default_options' => (
+ traits => ['Hash'],
+ is => 'rw',
+ isa => 'HashRef',
+ lazy => 1,
+ builder => 'build_tt_default_options',
+);
+sub build_tt_default_options {{}}
+
+
+sub tt_render {
+ my $self = shift;
+
+ my $output;
+ my $vars = { %{$self->default_tt_vars}, %{$self->tt_vars} };
+ $self->tt_engine->process( $self->tt_template, $vars, \$output );
+ return $output;
+}
+
+
+1;
diff --git a/lib/HTML/FormHandler/Result.pm b/lib/HTML/FormHandler/Result.pm
new file mode 100644
index 0000000..33e089a
--- /dev/null
+++ b/lib/HTML/FormHandler/Result.pm
@@ -0,0 +1,79 @@
+package HTML::FormHandler::Result;
+
+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',
+ is => 'ro',
+ weak_ref => 1,
+ # handles => ['render' ]
+);
+
+has 'ran_validation' => ( is => 'rw', isa => 'Bool', default => 0 );
+
+sub fif {
+ my $self = shift;
+ $self->form->fields_fif($self);
+}
+
+=head1 AUTHORS
+
+HTML::FormHandler Contributors; see HTML::FormHandler
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl 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
new file mode 100644
index 0000000..e07d47e
--- /dev/null
+++ b/lib/HTML/FormHandler/Result/Role.pm
@@ -0,0 +1,116 @@
+package HTML::FormHandler::Result::Role;
+
+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 );
+
+# do we need 'accessor' ?
+has 'parent' => ( is => 'rw', weak_ref => 1 );
+
+has 'input' => (
+ is => 'ro',
+ clearer => '_clear_input',
+ writer => '_set_input',
+ predicate => 'has_input',
+);
+
+has 'value' => (
+ is => 'ro',
+ writer => '_set_value',
+ clearer => '_clear_value',
+ predicate => 'has_value',
+);
+
+has '_results' => (
+ traits => ['Array'],
+ isa => 'ArrayRef[HTML::FormHandler::Field::Result]',
+ is => 'rw',
+ default => sub { [] },
+ handles => {
+ results => 'elements',
+ add_result => 'push',
+ num_results => 'count',
+ has_results => 'count',
+ clear_results => 'clear',
+ }
+);
+
+has 'error_results' => (
+ traits => ['Array'],
+ isa => 'ArrayRef', # for HFH::Result and HFH::Field::Result
+ is => 'rw',
+ default => sub { [] },
+ handles => {
+ has_error_results => 'count',
+ num_error_results => 'count',
+ clear_error_results => 'clear',
+ add_error_result => 'push',
+ }
+);
+
+has 'errors' => (
+ traits => ['Array'],
+ is => 'rw',
+ isa => 'ArrayRef[Str]',
+ default => sub { [] },
+ handles => {
+ all_errors => 'elements',
+ push_errors => 'push',
+ num_errors => 'count',
+ has_errors => 'count',
+ clear_errors => 'clear',
+ }
+);
+
+sub validated { !$_[0]->has_error_results && $_[0]->has_input }
+sub is_valid { shift->validated }
+
+sub field {
+ my ( $self, $name, $die ) = @_;
+
+ my $index;
+ # if this is a full_name for a compound field
+ # walk through the fields to get to it
+ if ( $name =~ /\./ ) {
+ my @names = split /\./, $name;
+ my $f = $self;
+ foreach my $fname (@names) {
+ $f = $f->field($fname);
+ return unless $f;
+ }
+ return $f;
+ }
+ else # not a compound name
+ {
+ for my $field ( $self->results ) {
+ return $field if ( $field->name eq $name );
+ }
+ }
+ return unless $die;
+ die "Field '$name' not found in '$self'";
+}
+
+=head1 AUTHORS
+
+HTML::FormHandler Contributors; see HTML::FormHandler
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
+
+use namespace::autoclean;
+1;
diff --git a/lib/HTML/FormHandler/TraitFor/Captcha.pm b/lib/HTML/FormHandler/TraitFor/Captcha.pm
new file mode 100644
index 0000000..7f2a4a3
--- /dev/null
+++ b/lib/HTML/FormHandler/TraitFor/Captcha.pm
@@ -0,0 +1,75 @@
+package HTML::FormHandler::TraitFor::Captcha;
+
+use HTML::FormHandler::Moose::Role;
+use GD::SecurityImage;
+use HTTP::Date;
+
+requires('ctx');
+
+has_field 'captcha' => ( type => 'Captcha', label => 'Verification' );
+
+=head1 NAME
+
+HTML::FormHandler::TraitFor::Captcha - generate and validate captchas
+
+=head1 SYNOPSIS
+
+A role to use in a form to implement a captcha field.
+
+ package MyApp::Form;
+ use HTML::FormHandler::Moose;
+ with 'HTML::FormHandler::TraitFor::Captcha';
+
+or
+
+ my $form = MyApp::Form->new( traits => ['HTML::FormHandler::TraitFor::Captcha'],
+ ctx => $c );
+
+Needs a context object set in the form's 'ctx' attribute which has a session
+hashref in which to store a 'captcha' hashref, such as is provided by Catalyst
+session plugin.
+
+=head1 METHODS
+
+=head2 get_captcha
+
+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
+
+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;
diff --git a/lib/HTML/FormHandler/TraitFor/I18N.pm b/lib/HTML/FormHandler/TraitFor/I18N.pm
new file mode 100644
index 0000000..d6846c5
--- /dev/null
+++ b/lib/HTML/FormHandler/TraitFor/I18N.pm
@@ -0,0 +1,56 @@
+package HTML::FormHandler::TraitFor::I18N;
+
+use base 'Locale::Maketext';
+use HTML::FormHandler::I18N;
+use Moose::Role;
+
+=head3 language_handle, _build_language_handle
+
+Holds a Locale::Maketext language handle
+
+The builder for this attribute gets the Locale::Maketext language
+handle from the environment variable $ENV{LANGUAGE_HANDLE}, or creates
+a default language handler using L<HTML::FormHandler::I18N>. The
+language handle is used in the field's add_error method to allow
+localizing.
+
+You can pass in an existing L<Locale::MakeText> subclass instance
+or create one in a builder.
+
+In a form class:
+
+ sub _build_language_handle { MyApp::I18N::abc_de->new }
+
+Passed into new or process:
+
+ my $lh = MyApp::I18N::abc_de->new;
+ my $form = MyApp::Form->new( language_handle => $lh );
+
+If you do not set the language_handle, then L<Locale::Maketext> and/or
+L<I18N::LangTags> may guess, with unexpected results.
+
+=cut
+
+has 'language_handle' => (
+ isa => 'Locale::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) = @_;
+ $self->language_handle->maketext(@message);
+}
+
+
+1;
diff --git a/lib/HTML/FormHandler/Types.pm b/lib/HTML/FormHandler/Types.pm
new file mode 100644
index 0000000..966e359
--- /dev/null
+++ b/lib/HTML/FormHandler/Types.pm
@@ -0,0 +1,257 @@
+package HTML::FormHandler::Types;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+use MooseX::Types -declare => [
+ 'PositiveNum', 'PositiveInt', 'NegativeNum', 'NegativeInt',
+ 'SingleDigit', 'SimpleStr', 'NonEmptySimpleStr', 'Password',
+ 'StrongPassword', 'NonEmptyStr', 'Email', 'State',
+ 'Zip', 'IPAddress', 'NoSpaces', 'WordChars',
+ 'NotAllDigits', 'Printable', 'SingleWord',
+ 'Collapse', 'Upper', 'Lower', 'Trim',
+];
+
+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" };
+
+subtype PositiveInt, as Int, where { $_ >= 0 }, message { "Must be a positive integer" };
+
+subtype NegativeNum, as Num, where { $_ <= 0 }, message { "Must be a negative number" };
+
+subtype NegativeInt, as Int, where { $_ <= 0 }, message { "Must be a negative integer" };
+
+subtype SingleDigit, as PositiveInt, where { $_ <= 9 }, message { "Must be a single digit" };
+
+subtype SimpleStr,
+ as Str,
+ where { ( length($_) <= 255 ) && ( $_ !~ m/\n/ ) },
+ message { "Must be a single line of no more than 255 chars" };
+
+subtype NonEmptySimpleStr,
+ as SimpleStr,
+ where { length($_) > 0 },
+ message { "Must be a non-empty single line of no more than 255 chars" };
+
+subtype Password,
+ as NonEmptySimpleStr,
+ where { length($_) >= 4 && length($_) <= 255 },
+ message { "Must be between 4 and 255 chars" };
+
+subtype StrongPassword,
+ as Password,
+ where { ( length($_) >= 8 ) && length($_) <= 255 && (m/[^a-zA-Z]/) },
+ message { "Must be between 8 and 255 chars, and contain a non-alpha char" };
+
+subtype NonEmptyStr, as Str, where { length($_) > 0 }, message { "Must not be empty" };
+
+subtype State, as Str, where {
+ my $value = $_;
+ my $state = <<EOF;
+AL AK AZ AR CA CO CT DE FL GA HI ID IL IN IA KS KY LA ME MD
+MA MI MN MS MO MT NE NV NH NJ NM NY NC ND OH OK OR PA PR RI
+SC SD TN TX UT VT VA WA WV WI WY DC AP FP FPO APO GU VI
+EOF
+ return ( $state =~ /\b($value)\b/i );
+}, message { "Not a valid state" };
+
+subtype Email, as Str, where {
+ my $value = shift;
+ require Email::Valid;
+ my $valid;
+ return ( $valid = Email::Valid->address($value) ) &&
+ ( $valid eq $value );
+}, message { "Email is not valid" };
+
+subtype Zip,
+ as Str,
+ where { /^(\s*\d{5}(?:[-]\d{4})?\s*)$/ },
+ message { "Zip is not valid" };
+
+subtype IPAddress, as Str, where {
+ /^(?:(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.){3}(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)$/
+}, message { "Not a valid IP address" };
+
+subtype NoSpaces,
+ as Str,
+ where { ! /\s/ },
+ message { 'Must not contain spaces' };
+
+subtype WordChars,
+ as Str,
+ where { ! /\W/ },
+ message { 'Must be made up of letters, digits, and underscores' };
+
+subtype NotAllDigits,
+ as Str,
+ where { ! /^\d+$/ },
+ message { 'Must not be all digits' };
+
+subtype Printable,
+ as Str,
+ where { /^\p{IsPrint}*\z/ },
+ message { 'Field contains non-printable characters' };
+
+subtype SingleWord,
+ as Str,
+ where { /^\w*\z/ },
+ message { 'Field must contain a single word' };
+
+subtype Collapse,
+ as Str,
+ where{ ! /\s{2,}/ };
+
+coerce Collapse,
+ from Str,
+ via { s/\s+/ /g; return $_; };
+
+subtype Lower,
+ as Str,
+ where { ! /[[:upper:]]/ };
+
+coerce Lower,
+ from Str,
+ via { lc };
+
+subtype Upper,
+ as Str,
+ where { ! /[[:lower:]]/ };
+
+coerce Upper,
+ from Str,
+ via { uc };
+
+subtype Trim,
+ as Str,
+ where { ! /^\s+/ &&
+ ! /\s+$/ };
+
+coerce Trim,
+ from Str,
+ via { s/^\s+// &&
+ s/\s+$//;
+ return $_; };
+
+=head1 AUTHORS
+
+ HTML::FormHandler Contributors; see HTML::FormHandler
+
+=head1 COPYRIGHT
+
+ This library is free software, you can redistribute it and/or modify it under
+ the same terms as Perl itself.
+
+=cut
+
+1;
+
diff --git a/lib/HTML/FormHandler/Validate.pm b/lib/HTML/FormHandler/Validate.pm
new file mode 100644
index 0000000..f638cd9
--- /dev/null
+++ b/lib/HTML/FormHandler/Validate.pm
@@ -0,0 +1,128 @@
+package HTML::FormHandler::Validate;
+
+=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;
+
+has 'required' => ( isa => 'Bool', is => 'rw', default => '0' );
+has 'required_message' => (
+ isa => 'ArrayRef|Str',
+ is => 'rw',
+ lazy => 1,
+ default => sub {
+ return [ '[_1] field is required', shift->label ];
+ }
+);
+has 'unique' => ( isa => 'Bool', is => 'rw', predicate => 'has_unique' );
+has 'unique_message' => ( isa => 'Str', is => 'rw' );
+has 'range_start' => ( isa => 'Int|Undef', is => 'rw' );
+has 'range_end' => ( isa => 'Int|Undef', is => 'rw' );
+
+sub test_ranges {
+ my $field = shift;
+ return 1 if $field->can('options') || $field->has_errors;
+
+ my $value = $field->value;
+
+ return 1 unless defined $value;
+
+ my $low = $field->range_start;
+ my $high = $field->range_end;
+
+ if ( defined $low && defined $high ) {
+ return
+ $value >= $low && $value <= $high ? 1 :
+ $field->add_error( 'value must be between [_1] and [_2]', $low, $high );
+ }
+
+ if ( defined $low ) {
+ return
+ $value >= $low ? 1 :
+ $field->add_error( 'value must be greater than or equal to [_1]', $low );
+ }
+
+ if ( defined $high ) {
+ return
+ $value <= $high ? 1 :
+ $field->add_error( 'value must be less than or equal to [_1]', $high );
+ }
+
+ return 1;
+}
+
+sub validate_field {
+ my $field = shift;
+
+ return unless $field->has_result;
+ $field->clear_errors; # this is only here for testing convenience
+ # See if anything was submitted
+ if ( $field->required && ( !$field->has_input || !$field->input_defined ) ) {
+ if ($field->required) {
+ my $msg = $field->required_message;
+ if ( ref $msg eq 'ARRAY' ) {
+ $field->add_error( @$msg );
+ }
+ else {
+ $field->add_error( $msg );
+ }
+ }
+ if( $field->has_input ) {
+ $field->not_nullable ? $field->_set_value($field->input) : $field->_set_value(undef);
+ }
+ return;
+ }
+ elsif ( $field->DOES('HTML::FormHandler::Field::Repeatable') ) { }
+ elsif ( !$field->has_input ) {
+ return;
+ }
+ elsif ( !$field->input_defined ) {
+ $field->not_nullable ? $field->_set_value($field->input) : $field->_set_value(undef);
+ return;
+ }
+
+ # do building of node
+ if ( $field->DOES('HTML::FormHandler::Fields') ) {
+ $field->_fields_validate;
+ }
+ else {
+ $field->_set_value( $field->input );
+ }
+
+ $field->_inner_validate_field();
+ $field->_apply_actions;
+ $field->validate;
+ $field->test_ranges;
+ $field->_validate($field) # form field validation method
+ if ( $field->has_value && defined $field->value );
+
+ return !$field->has_errors;
+}
+
+sub _inner_validate_field { }
+
+sub validate { 1 }
+
+=head1 AUTHORS
+
+HTML::FormHandler Contributors; see HTML::FormHandler
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
+
+use namespace::autoclean;
+1;
+
diff --git a/lib/HTML/FormHandler/Validate/Actions.pm b/lib/HTML/FormHandler/Validate/Actions.pm
new file mode 100644
index 0000000..7d613b8
--- /dev/null
+++ b/lib/HTML/FormHandler/Validate/Actions.pm
@@ -0,0 +1,159 @@
+package HTML::FormHandler::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'],
+ isa => 'ArrayRef',
+ is => 'rw',
+ default => sub { [] },
+ handles => {
+ add_action => 'push',
+ num_actions =>'count',
+ has_actions => 'count',
+ clear_actions => 'clear',
+ }
+);
+
+sub _build_apply_list {
+ my $self = shift;
+ my @apply_list;
+ foreach my $sc ( reverse $self->meta->linearized_isa ) {
+ my $meta = $sc->meta;
+ if ( $meta->can('calculate_all_roles') ) {
+ foreach my $role ( $meta->calculate_all_roles ) {
+ if ( $role->can('apply_list') && $role->has_apply_list ) {
+ foreach my $apply_def ( @{ $role->apply_list } ) {
+ my %new_apply = %{$apply_def}; # copy hashref
+ push @apply_list, \%new_apply;
+ }
+ }
+ }
+ }
+ if ( $meta->can('apply_list') && $meta->has_apply_list ) {
+ foreach my $apply_def ( @{ $meta->apply_list } ) {
+ my %new_apply = %{$apply_def}; # copy hashref
+ push @apply_list, \%new_apply;
+ }
+ }
+ }
+ $self->add_action(@apply_list);
+}
+
+sub _apply_actions {
+ my $self = shift;
+
+ my $error_message;
+ local $SIG{__WARN__} = sub {
+ my $error = shift;
+ $error_message = $error;
+ return 1;
+ };
+ for my $action ( @{ $self->actions || [] } ) {
+ $error_message = undef;
+ # the first time through value == input
+ my $value = $self->value;
+ my $new_value = $value;
+ # Moose constraints
+ if ( !ref $action || ref $action eq 'MooseX::Types::TypeDecorator' ) {
+ $action = { type => $action };
+ }
+ if ( exists $action->{type} ) {
+ my $tobj;
+ if ( ref $action->{type} eq 'MooseX::Types::TypeDecorator' ) {
+ $tobj = $action->{type};
+ }
+ else {
+ my $type = $action->{type};
+ $tobj = Moose::Util::TypeConstraints::find_type_constraint($type) or
+ die "Cannot find type constraint $type";
+ }
+ if ( $tobj->has_coercion && $tobj->validate($value) ) {
+ eval { $new_value = $tobj->coerce($value) };
+ if ($@) {
+ if ( $tobj->has_message ) {
+ $error_message = $tobj->message->($value);
+ }
+ else {
+ $error_message = $@;
+ }
+ }
+ else {
+ $self->_set_value($new_value);
+ }
+
+ }
+ $error_message ||= $tobj->validate($new_value);
+ }
+ # now maybe: http://search.cpan.org/~rgarcia/perl-5.10.0/pod/perlsyn.pod#Smart_matching_in_detail
+ # actions in a hashref
+ elsif ( ref $action->{check} eq 'CODE' ) {
+ if ( !$action->{check}->($value) ) {
+ $error_message = 'Wrong value';
+ }
+ }
+ elsif ( ref $action->{check} eq 'Regexp' ) {
+ if ( $value !~ $action->{check} ) {
+ $error_message = ["[_1] does not match", $value];
+ }
+ }
+ elsif ( ref $action->{check} eq 'ARRAY' ) {
+ if ( !grep { $value eq $_ } @{ $action->{check} } ) {
+ $error_message = ["[_1] not allowed", $value];
+ }
+ }
+ elsif ( ref $action->{transform} eq 'CODE' ) {
+ $new_value = eval {
+ no warnings 'all';
+ $action->{transform}->($value);
+ };
+ if ($@) {
+ $error_message = $@ || 'error occurred';
+ }
+ else {
+ $self->_set_value($new_value);
+ }
+ }
+ if ( defined $error_message ) {
+ my @message = ref $error_message eq 'ARRAY' ? @$error_message : ($error_message);
+ if ( defined $action->{message} ) {
+ my $act_msg = $action->{message};
+ if ( ref $act_msg eq 'CODEREF' ) {
+ $act_msg = $act_msg->($value);
+ }
+ if ( ref $act_msg eq 'ARRAY' ) {
+ @message = @{$act_msg};
+ }
+ elsif ( ref \$act_msg eq 'SCALAR' ) {
+ @message = ($act_msg);
+ }
+ }
+ $self->add_error(@message);
+ }
+ }
+}
+
+=head1 AUTHORS
+
+HTML::FormHandler Contributors; see HTML::FormHandler
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
+
+use namespace::autoclean;
+1;
diff --git a/lib/HTML/FormHandler/Widget/ApplyRole.pm b/lib/HTML/FormHandler/Widget/ApplyRole.pm
new file mode 100644
index 0000000..20718c3
--- /dev/null
+++ b/lib/HTML/FormHandler/Widget/ApplyRole.pm
@@ -0,0 +1,44 @@
+package HTML::FormHandler::Widget::ApplyRole;
+
+use Moose::Role;
+use File::Spec;
+use Class::MOP;
+
+our $ERROR;
+
+sub apply_widget_role {
+ my ( $self, $target, $widget_name, $dir ) = @_;
+
+ my $render_role = $self->get_widget_role( $widget_name, $dir );
+ $render_role->meta->apply($target) if $render_role;
+}
+
+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},
+ ('HTML::FormHandler::Widget', 'HTML::FormHandlerX::Widget') );
+ foreach my $ns (@name_spaces) {
+ my $render_role = $ns . $ldir . $widget_class;
+ if ( eval { Class::MOP::load_class($render_role) } ) {
+ return $render_role;
+ }
+ }
+ die "not able to load $dir widget $widget_class from " . join(", ", @name_spaces);
+}
+
+# this is for compatibility with widget names like 'radio_group'
+# RadioGroup, Textarea, etc. also work
+sub widget_class {
+ my ( $self, $widget ) = @_;
+ return unless $widget;
+ 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;
diff --git a/lib/HTML/FormHandler/Widget/Field/Checkbox.pm b/lib/HTML/FormHandler/Widget/Field/Checkbox.pm
new file mode 100644
index 0000000..59fd58a
--- /dev/null
+++ b/lib/HTML/FormHandler/Widget/Field/Checkbox.pm
@@ -0,0 +1,21 @@
+package HTML::FormHandler::Widget::Field::Checkbox;
+
+use Moose::Role;
+with 'HTML::FormHandler::Widget::Field::Role::HTMLAttributes';
+
+sub render {
+ my ( $self, $result ) = @_;
+
+ $result ||= $self->result;
+ my $fif = $result->fif;
+ my $output = '<input type="checkbox" name="';
+ $output .= $self->html_name . '" id="' . $self->id . '"';
+ $output .= ' value="' . $self->html_filter($self->checkbox_value) . '"';
+ $output .= ' checked="checked"' if $fif eq $self->checkbox_value;
+ $output .= $self->_add_html_attributes;
+ $output .= ' />';
+ return $self->wrap_field( $result, $output );
+}
+
+use namespace::autoclean;
+1;
diff --git a/lib/HTML/FormHandler/Widget/Field/CheckboxGroup.pm b/lib/HTML/FormHandler/Widget/Field/CheckboxGroup.pm
new file mode 100644
index 0000000..5824548
--- /dev/null
+++ b/lib/HTML/FormHandler/Widget/Field/CheckboxGroup.pm
@@ -0,0 +1,50 @@
+package HTML::FormHandler::Widget::Field::CheckboxGroup;
+
+use Moose::Role;
+
+with 'HTML::FormHandler::Widget::Field::Role::SelectedOption';
+with 'HTML::FormHandler::Widget::Field::Role::HTMLAttributes';
+
+has 'input_without_param' => ( is => 'ro', default => sub {[]} );
+has 'not_nullable' => ( is => 'ro', default => 1 );
+
+sub render {
+ my ( $self, $result ) = @_;
+
+ $result ||= $self->result;
+ my $output = " <br />";
+ my $index = 0;
+ foreach my $option ( @{ $self->options } ) {
+ $output .= '<input type="checkbox" value="' . $option->{value} . '"';
+ $output .= ' name="' . $self->html_name . '" id="' . $self->id . ".$index\"";
+ if ( my $ffif = $result->fif ) {
+ if ( $self->multiple == 1 ) {
+ my @fif;
+ if ( ref $ffif ) {
+ @fif = @{$ffif};
+ }
+ else {
+ @fif = ($ffif);
+ }
+ foreach my $optval (@fif) {
+ $output .= ' checked="checked"'
+ if $self->check_selected_option($option, $optval);
+ }
+ }
+ else {
+ $output .= ' checked="checked"'
+ if $self->check_selected_option($option, $ffif);
+ }
+ }
+ $output .= ' checked="checked"'
+ if $self->check_selected_option($option);
+ $output .= $self->_add_html_attributes;
+ $output .= ' />';
+ $output .= $option->{label} . '<br />';
+ $index++;
+ }
+ return $self->wrap_field( $result, $output );
+}
+
+use namespace::autoclean;
+1;
diff --git a/lib/HTML/FormHandler/Widget/Field/Compound.pm b/lib/HTML/FormHandler/Widget/Field/Compound.pm
new file mode 100644
index 0000000..b4d7429
--- /dev/null
+++ b/lib/HTML/FormHandler/Widget/Field/Compound.pm
@@ -0,0 +1,19 @@
+package HTML::FormHandler::Widget::Field::Compound;
+
+use Moose::Role;
+
+sub render {
+ my ( $self, $result ) = @_;
+
+ $result ||= $self->result;
+ my $output = '';
+ foreach my $subfield ( $self->sorted_fields ) {
+ my $subresult = $result->field( $subfield->name );
+ next unless $subresult;
+ $output .= $subfield->render($subresult);
+ }
+ return $self->wrap_field( $result, $output );
+}
+
+use namespace::autoclean;
+1;
diff --git a/lib/HTML/FormHandler/Widget/Field/Hidden.pm b/lib/HTML/FormHandler/Widget/Field/Hidden.pm
new file mode 100644
index 0000000..45d2423
--- /dev/null
+++ b/lib/HTML/FormHandler/Widget/Field/Hidden.pm
@@ -0,0 +1,22 @@
+package HTML::FormHandler::Widget::Field::Hidden;
+
+use Moose::Role;
+with 'HTML::FormHandler::Widget::Field::Role::HTMLAttributes';
+
+sub render {
+ my ( $self, $result ) = @_;
+
+ $result ||= $self->result;
+ my $output = "\n";
+ $output .= '<input type="hidden" name="';
+ $output .= $self->html_name . '"';
+ $output .= ' id="' . $self->id . '"';
+ $output .= ' value="' . $self->html_filter($result->fif) . '"';
+ $output .= $self->_add_html_attributes;
+ $output .= " />\n";
+
+ return $output;
+}
+
+use namespace::autoclean;
+1;
diff --git a/lib/HTML/FormHandler/Widget/Field/NoRender.pm b/lib/HTML/FormHandler/Widget/Field/NoRender.pm
new file mode 100644
index 0000000..c5a2656
--- /dev/null
+++ b/lib/HTML/FormHandler/Widget/Field/NoRender.pm
@@ -0,0 +1,8 @@
+package HTML::FormHandler::Widget::Field::NoRender;
+
+use Moose::Role;
+
+sub render { '' }
+
+use namespace::autoclean;
+1;
diff --git a/lib/HTML/FormHandler/Widget/Field/Password.pm b/lib/HTML/FormHandler/Widget/Field/Password.pm
new file mode 100644
index 0000000..47fdce6
--- /dev/null
+++ b/lib/HTML/FormHandler/Widget/Field/Password.pm
@@ -0,0 +1,22 @@
+package HTML::FormHandler::Widget::Field::Password;
+
+use Moose::Role;
+with 'HTML::FormHandler::Widget::Field::Role::HTMLAttributes';
+
+sub render {
+ my ( $self, $result ) = @_;
+
+ $result ||= $self->result;
+ my $output = '<input type="password" name="';
+ $output .= $self->html_name . '"';
+ $output .= ' id="' . $self->id . '"';
+ $output .= ' size="' . $self->size . '"' if $self->size;
+ $output .= ' maxlength="' . $self->maxlength . '"' if $self->maxlength;
+ $output .= ' value="' . $self->html_filter($result->fif) . '"';
+ $output .= $self->_add_html_attributes;
+ $output .= ' />';
+ return $self->wrap_field( $result, $output );
+}
+
+use namespace::autoclean;
+1;
diff --git a/lib/HTML/FormHandler/Widget/Field/RadioGroup.pm b/lib/HTML/FormHandler/Widget/Field/RadioGroup.pm
new file mode 100644
index 0000000..8f2b274
--- /dev/null
+++ b/lib/HTML/FormHandler/Widget/Field/RadioGroup.pm
@@ -0,0 +1,25 @@
+package HTML::FormHandler::Widget::Field::RadioGroup;
+
+use Moose::Role;
+
+with 'HTML::FormHandler::Widget::Field::Role::SelectedOption';
+
+sub render {
+ my ( $self, $result ) = @_;
+
+ $result ||= $self->result;
+ my $output = " <br />";
+ my $index = 0;
+ foreach my $option ( @{ $self->options } ) {
+ $output .= '<input type="radio" value="' . $option->{value} . '"';
+ $output .= ' name="' . $self->html_name . '" id="' . $self->id . ".$index\"";
+ $output .= ' checked="checked"' if $self->check_selected_option($option, $result->fif);
+ $output .= ' />';
+ $output .= $option->{label} . '<br />';
+ $index++;
+ }
+ return $self->wrap_field( $result, $output );
+}
+
+use namespace::autoclean;
+1;
diff --git a/lib/HTML/FormHandler/Widget/Field/Reset.pm b/lib/HTML/FormHandler/Widget/Field/Reset.pm
new file mode 100644
index 0000000..77fe3e9
--- /dev/null
+++ b/lib/HTML/FormHandler/Widget/Field/Reset.pm
@@ -0,0 +1,22 @@
+package HTML::FormHandler::Widget::Field::Reset;
+
+use Moose::Role;
+with 'HTML::FormHandler::Widget::Field::Role::HTMLAttributes';
+
+has 'no_render_label' => ( is => 'ro', lazy => 1, default => 1 );
+
+sub render {
+ my ( $self, $result ) = @_;
+
+ $result ||= $self->result;
+ my $output = '<input type="reset" name="';
+ $output .= $self->html_name . '"';
+ $output .= ' id="' . $self->id . '"';
+ $output .= ' value="' . $self->value . '"';
+ $output .= $self->_add_html_attributes;
+ $output .= ' />';
+ return $self->wrap_field( $result, $output );
+}
+
+use namespace::autoclean;
+1;
diff --git a/lib/HTML/FormHandler/Widget/Field/Role/HTMLAttributes.pm b/lib/HTML/FormHandler/Widget/Field/Role/HTMLAttributes.pm
new file mode 100644
index 0000000..08ff20a
--- /dev/null
+++ b/lib/HTML/FormHandler/Widget/Field/Role/HTMLAttributes.pm
@@ -0,0 +1,16 @@
+package HTML::FormHandler::Widget::Field::Role::HTMLAttributes;
+
+use Moose::Role;
+
+sub _add_html_attributes {
+ my $self = shift;
+
+ my $output = q{};
+ for my $attr ( 'readonly', 'disabled', 'style' ) {
+ $output .= ( $self->$attr ? qq{ $attr="} . $self->$attr . '"' : '' );
+ }
+ $output .= ($self->javascript ? ' ' . $self->javascript : '');
+ return $output;
+}
+
+1;
diff --git a/lib/HTML/FormHandler/Widget/Field/Role/SelectedOption.pm b/lib/HTML/FormHandler/Widget/Field/Role/SelectedOption.pm
new file mode 100644
index 0000000..d84db0d
--- /dev/null
+++ b/lib/HTML/FormHandler/Widget/Field/Role/SelectedOption.pm
@@ -0,0 +1,20 @@
+package HTML::FormHandler::Widget::Field::Role::SelectedOption;
+
+use Moose::Role;
+use namespace::autoclean;
+
+sub check_selected_option {
+ my ( $self, $option, $fif ) = @_;
+ my $selected_key = defined($option->{'selected'}) ?
+ $option->{'selected'}
+ : $option->{'checked'};
+ if ( defined $selected_key ) {
+ return $selected_key;
+ } elsif ( defined $fif ) {
+ return $fif eq $option->{'value'};
+ } else {
+ return;
+ }
+}
+
+1;
diff --git a/lib/HTML/FormHandler/Widget/Field/Select.pm b/lib/HTML/FormHandler/Widget/Field/Select.pm
new file mode 100644
index 0000000..f850a4a
--- /dev/null
+++ b/lib/HTML/FormHandler/Widget/Field/Select.pm
@@ -0,0 +1,54 @@
+package HTML::FormHandler::Widget::Field::Select;
+
+use Moose::Role;
+
+with 'HTML::FormHandler::Widget::Field::Role::SelectedOption';
+with 'HTML::FormHandler::Widget::Field::Role::HTMLAttributes';
+
+sub render {
+ my ( $self, $result ) = @_;
+
+ $result ||= $self->result;
+ my $output = '<select name="' . $self->html_name . '"';
+ $output .= ' id="' . $self->id . '"';
+ $output .= ' multiple="multiple"' if $self->multiple == 1;
+ $output .= ' size="' . $self->size . '"' if $self->size;
+ $output .= $self->_add_html_attributes;
+ $output .= '>';
+ my $index = 0;
+ if( $self->empty_select ) {
+ $output .= '<option value="">' . $self->empty_select . '</option>';
+ }
+ foreach my $option ( @{ $self->{options} } ) {
+ $output .= '<option value="' . $option->{value} . '" ';
+ $output .= 'id="' . $self->id . ".$index\" ";
+ if ( my $ffif = $self->html_filter($result->fif) ) {
+ if ( $self->multiple == 1 ) {
+ my @fif;
+ if ( ref $ffif ) {
+ @fif = @{$ffif};
+ }
+ else {
+ @fif = ($ffif);
+ }
+ foreach my $optval (@fif) {
+ $output .= 'selected="selected"'
+ if $self->check_selected_option($option, $optval);
+ }
+ }
+ else {
+ $output .= 'selected="selected"'
+ if $self->check_selected_option($option, $ffif);
+ }
+ }
+ $output .= 'selected="selected"'
+ if $self->check_selected_option($option);
+ $output .= '>' . $option->{label} . '</option>';
+ $index++;
+ }
+ $output .= '</select>';
+ return $self->wrap_field( $result, $output );
+}
+
+use namespace::autoclean;
+1;
diff --git a/lib/HTML/FormHandler/Widget/Field/Submit.pm b/lib/HTML/FormHandler/Widget/Field/Submit.pm
new file mode 100644
index 0000000..5d25a8f
--- /dev/null
+++ b/lib/HTML/FormHandler/Widget/Field/Submit.pm
@@ -0,0 +1,22 @@
+package HTML::FormHandler::Widget::Field::Submit;
+
+use Moose::Role;
+with 'HTML::FormHandler::Widget::Field::Role::HTMLAttributes';
+
+has 'no_render_label' => ( is => 'ro', lazy => 1, default => 1 );
+
+sub render {
+ my ( $self, $result ) = @_;
+
+ $result ||= $self->result;
+ my $output = '<input type="submit" name="';
+ $output .= $self->html_name . '"';
+ $output .= ' id="' . $self->id . '"';
+ $output .= ' value="' . $self->value . '"';
+ $output .= $self->_add_html_attributes;
+ $output .= ' />';
+ return $self->wrap_field( $result, $output );
+}
+
+use namespace::autoclean;
+1;
diff --git a/lib/HTML/FormHandler/Widget/Field/Text.pm b/lib/HTML/FormHandler/Widget/Field/Text.pm
new file mode 100644
index 0000000..6dd8d0d
--- /dev/null
+++ b/lib/HTML/FormHandler/Widget/Field/Text.pm
@@ -0,0 +1,22 @@
+package HTML::FormHandler::Widget::Field::Text;
+
+use Moose::Role;
+with 'HTML::FormHandler::Widget::Field::Role::HTMLAttributes';
+
+sub render {
+ my ( $self, $result ) = @_;
+
+ $result ||= $self->result;
+ my $output = '<input type="text" name="';
+ $output .= $self->html_name . '"';
+ $output .= ' id="' . $self->id . '"';
+ $output .= ' size="' . $self->size . '"' if $self->size;
+ $output .= ' maxlength="' . $self->maxlength . '"' if $self->maxlength;
+ $output .= ' value="' . $self->html_filter($result->fif) . '"';
+ $output .= $self->_add_html_attributes;
+ $output .= ' />';
+ return $self->wrap_field( $result, $output );
+}
+
+use namespace::autoclean;
+1;
diff --git a/lib/HTML/FormHandler/Widget/Field/Textarea.pm b/lib/HTML/FormHandler/Widget/Field/Textarea.pm
new file mode 100644
index 0000000..0d0b20f
--- /dev/null
+++ b/lib/HTML/FormHandler/Widget/Field/Textarea.pm
@@ -0,0 +1,27 @@
+package HTML::FormHandler::Widget::Field::Textarea;
+
+use Moose::Role;
+with 'HTML::FormHandler::Widget::Field::Role::HTMLAttributes';
+
+sub render {
+ my ( $self, $result ) = @_;
+
+ $result ||= $self->result;
+ my $fif = $self->html_filter($result->fif) || '';
+ my $id = $self->id;
+ my $cols = $self->cols || 10;
+ my $rows = $self->rows || 5;
+ my $name = $self->html_name;
+
+ my $output =
+ qq(<textarea name="$name" id="$id" )
+ . $self->_add_html_attributes
+ . qq(rows="$rows" cols="$cols">)
+ . $self->html_filter($fif)
+ . q(</textarea>);
+
+ return $self->wrap_field( $result, $output );
+}
+
+use namespace::autoclean;
+1;
diff --git a/lib/HTML/FormHandler/Widget/Field/Upload.pm b/lib/HTML/FormHandler/Widget/Field/Upload.pm
new file mode 100644
index 0000000..e2a51ab
--- /dev/null
+++ b/lib/HTML/FormHandler/Widget/Field/Upload.pm
@@ -0,0 +1,20 @@
+package HTML::FormHandler::Widget::Field::Upload;
+
+use Moose::Role;
+with 'HTML::FormHandler::Widget::Field::Role::HTMLAttributes';
+
+sub render {
+ my ( $self, $result ) = @_;
+
+ $result ||= $self->result;
+ my $output;
+ $output = '<input type="file" name="';
+ $output .= $self->html_name . '"';
+ $output .= ' id="' . $self->id . '"';
+ $output .= $self->_add_html_attributes;
+ $output .= ' />';
+ return $self->wrap_field($result, $output);
+}
+
+use namespace::autoclean;
+1;
diff --git a/lib/HTML/FormHandler/Widget/Form/Simple.pm b/lib/HTML/FormHandler/Widget/Form/Simple.pm
new file mode 100644
index 0000000..d141fcc
--- /dev/null
+++ b/lib/HTML/FormHandler/Widget/Form/Simple.pm
@@ -0,0 +1,78 @@
+package HTML::FormHandler::Widget::Form::Simple;
+
+use Moose::Role;
+
+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 );
+
+sub render {
+ my ($self) = @_;
+
+ my $result;
+ my $form;
+ if ( $self->DOES('HTML::FormHandler::Result') ) {
+ $result = $self;
+ $form = $self->form;
+ }
+ else {
+ $result = $self->result;
+ $form = $self;
+ }
+ 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;
+ $output .= $fld_result->render;
+ }
+
+ $output .= $self->render_end;
+ return $output;
+}
+
+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;
+}
+
+sub render_end {
+ my $self = shift;
+ my $output;
+ $output .= '</fieldset>' if $self->form->auto_fieldset;
+ $output .= "</form>\n";
+ return $output;
+}
+
+=head1 AUTHORS
+
+See CONTRIBUTORS in L<HTML::FormHandler>
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
+
+use namespace::autoclean;
+1;
+
diff --git a/lib/HTML/FormHandler/Widget/Form/Table.pm b/lib/HTML/FormHandler/Widget/Form/Table.pm
new file mode 100644
index 0000000..2d52549
--- /dev/null
+++ b/lib/HTML/FormHandler/Widget/Form/Table.pm
@@ -0,0 +1,56 @@
+package HTML::FormHandler::Widget::Form::Table;
+
+use Moose::Role;
+with 'HTML::FormHandler::Widget::Form::Simple' =>
+ { excludes => [ 'render_start', 'render_end' ] };
+
+=head1 NAME
+
+HTML::FormHandler::Widget::Form::Table - render a form with a table layout
+
+=head1 SYNOPSIS
+
+Set in your form:
+
+ has '+widget_form' => ( default => 'Table' );
+
+Use in a template:
+
+ [% form.render %]
+
+=cut
+
+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;
+}
+
+sub render_end {
+ my $self = shift;
+ my $output .= "</table>\n";
+ $output .= "</form>\n";
+ return $output;
+}
+
+=head1 AUTHORS
+
+HFH Contributors, see L<HTML::FormHandler>
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
+
+use namespace::autoclean;
+1;
+
diff --git a/lib/HTML/FormHandler/Widget/Wrapper/Base.pm b/lib/HTML/FormHandler/Widget/Wrapper/Base.pm
new file mode 100644
index 0000000..ea0700a
--- /dev/null
+++ b/lib/HTML/FormHandler/Widget/Wrapper/Base.pm
@@ -0,0 +1,27 @@
+package HTML::FormHandler::Widget::Wrapper::Base;
+
+use Moose::Role;
+
+sub render_label {
+ my $self = shift;
+ return '<label class="label" for="' . $self->id . '">' . $self->label . ': </label>';
+}
+
+sub render_class {
+ my ( $self, $result ) = @_;
+
+ $result ||= $self->result;
+ my $class = '';
+ if ( $self->css_class || $result->has_errors ) {
+ my @css_class;
+ push( @css_class, split( /[ ,]+/, $self->css_class ) ) if $self->css_class;
+ push( @css_class, 'error' ) if $result->has_errors;
+ $class .= ' class="';
+ $class .= join( ' ' => @css_class );
+ $class .= '"';
+ }
+ return $class;
+}
+
+use namespace::autoclean;
+1;
diff --git a/lib/HTML/FormHandler/Widget/Wrapper/None.pm b/lib/HTML/FormHandler/Widget/Wrapper/None.pm
new file mode 100644
index 0000000..e460d3c
--- /dev/null
+++ b/lib/HTML/FormHandler/Widget/Wrapper/None.pm
@@ -0,0 +1,8 @@
+package HTML::FormHandler::Widget::Wrapper::None;
+
+use Moose::Role;
+
+sub wrap_field { $_[2] }
+
+use namespace::autoclean;
+1;
diff --git a/lib/HTML/FormHandler/Widget/Wrapper/Simple.pm b/lib/HTML/FormHandler/Widget/Wrapper/Simple.pm
new file mode 100644
index 0000000..0d3c453
--- /dev/null
+++ b/lib/HTML/FormHandler/Widget/Wrapper/Simple.pm
@@ -0,0 +1,53 @@
+package HTML::FormHandler::Widget::Wrapper::Simple;
+
+use Moose::Role;
+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 ) = @_;
+
+ my $start_tag = $self->get_tag('wrapper_start') || '<div<%class%>>';
+ my $class = $self->render_class($result);
+ $start_tag =~ s/<%class%>/$class/g;
+ my $output = "\n" . $start_tag;
+ if ( $self->has_flag('is_compound') ) {
+ $output .= '<fieldset class="' . $self->html_name . '">';
+ $output .= '<legend>' . $self->label . '</legend>';
+ }
+ elsif ( !$self->has_flag('no_render_label') && $self->label ) {
+ $output .= $self->render_label;
+ }
+ $output .= $rendered_widget;
+ $output .= qq{\n<span class="error_message">$_</span>} for $result->all_errors;
+ if ( $self->has_flag('is_compound') ) {
+ $output .= '</fieldset>';
+ }
+ my $end_tag = $self->get_tag('wrapper_end') || '</div>';
+ $output .= $end_tag . "\n";
+ return $output;
+}
+
+no Moose::Role;
+1;
diff --git a/lib/HTML/FormHandler/Widget/Wrapper/Table.pm b/lib/HTML/FormHandler/Widget/Wrapper/Table.pm
new file mode 100644
index 0000000..086d8f8
--- /dev/null
+++ b/lib/HTML/FormHandler/Widget/Wrapper/Table.pm
@@ -0,0 +1,29 @@
+package HTML::FormHandler::Widget::Wrapper::Table;
+
+use Moose::Role;
+with 'HTML::FormHandler::Widget::Wrapper::Base';
+
+sub wrap_field {
+ my ( $self, $result, $rendered_widget ) = @_;
+
+ my $class = $self->render_class($result);
+ my $output = "\n<tr$class>";
+ if ( $self->has_flag('is_compound') ) {
+ $output .= '<td>' . $self->render_label . '</td></tr>';
+ }
+ elsif ( !$self->has_flag('no_render_label') && $self->label ) {
+ $output .= '<td>' . $self->render_label . '</td>';
+ }
+ if ( !$self->has_flag('is_compound') ) {
+ $output .= '<td>';
+ }
+ $output .= $rendered_widget;
+ $output .= qq{\n<span class="error_message">$_</span>} for $result->all_errors;
+ if ( !$self->has_flag('is_compound') ) {
+ $output .= "</td></tr>\n";
+ }
+ return $output;
+}
+
+use namespace::autoclean;
+1;
diff --git a/share/templates/form.tt b/share/templates/form.tt
new file mode 100644
index 0000000..be21227
--- /dev/null
+++ b/share/templates/form.tt
@@ -0,0 +1 @@
+[% form.render %]
diff --git a/share/templates/widget/checkbox.tt b/share/templates/widget/checkbox.tt
new file mode 100644
index 0000000..1bf983a
--- /dev/null
+++ b/share/templates/widget/checkbox.tt
@@ -0,0 +1,2 @@
+<input type="checkbox" name="[% f.html_name %]" id="[% f.id %] value="[% f.checkbox_value %]"
+ [% IF f.fif == f.checkbox_value %]selected="selected"[% END %]>
diff --git a/share/templates/widget/checkbox_group.tt b/share/templates/widget/checkbox_group.tt
new file mode 100644
index 0000000..0f9bd41
--- /dev/null
+++ b/share/templates/widget/checkbox_group.tt
@@ -0,0 +1,9 @@
+<label class="label [% IF field.has_errors %]fld_error[% END %]" for="[% f.html_name %]">[% f.label %]</label>
+[% FOR option IN f.options %]
+ <input type="checkbox" value="[% option.value %]" name="[% f.name %]"
+ [% FOREACH selval IN f.fif %]
+ [% IF selval == option.value %]selected="selected"[% END %]
+ [% END %]>
+ [% option.label | html %]>
+[% END %]
+
diff --git a/share/templates/widget/form_end.tt b/share/templates/widget/form_end.tt
new file mode 100644
index 0000000..5582354
--- /dev/null
+++ b/share/templates/widget/form_end.tt
@@ -0,0 +1 @@
+</form>
diff --git a/share/templates/widget/form_start.tt b/share/templates/widget/form_start.tt
new file mode 100644
index 0000000..c83885c
--- /dev/null
+++ b/share/templates/widget/form_start.tt
@@ -0,0 +1,5 @@
+<form id="[% form.name %]" method="[% form.http_method %]"
+ [% IF form.action %]action="[% form.action %]"[% END %]
+ [% IF form.enctype %]enctype="[% form.enctype %]"[% END %]
+>
+
diff --git a/share/templates/widget/hidden.tt b/share/templates/widget/hidden.tt
new file mode 100644
index 0000000..4128cee
--- /dev/null
+++ b/share/templates/widget/hidden.tt
@@ -0,0 +1 @@
+<input type="hidden" name="[% f.html_name %]" id="[% f.id %]" value="[% f.fif %]" />
diff --git a/share/templates/widget/password.tt b/share/templates/widget/password.tt
new file mode 100644
index 0000000..282adc4
--- /dev/null
+++ b/share/templates/widget/password.tt
@@ -0,0 +1,3 @@
+<label class="label [% IF f.has_errors %]fld_error[% END %]" for="[% f.html_name %]">[% f.label %]</label>
+<input type="password" name="[% f.html_name %]" id="[% f.id %]" value="[% f.fif %]">
+
diff --git a/share/templates/widget/radio.tt b/share/templates/widget/radio.tt
new file mode 100644
index 0000000..f6ae032
--- /dev/null
+++ b/share/templates/widget/radio.tt
@@ -0,0 +1,7 @@
+<label class="label [% IF f.has_errors %]fld_error[% END %]" for="[% f.html_name %]">[% f.label %]</label>
+[% FOR option IN f.options %]
+ <input type="radio" value="[% option.label %]"
+ [% IF option.value == f.fif %] selected="selected"[% END %]>
+ [% option.label | html %]>
+[% END %]
+
diff --git a/share/templates/widget/radio_group.tt b/share/templates/widget/radio_group.tt
new file mode 100644
index 0000000..27a778e
--- /dev/null
+++ b/share/templates/widget/radio_group.tt
@@ -0,0 +1,8 @@
+<label class="label" for="[% f.id %]">[% f.label %]</label>
+[% FOR option IN f.options %]
+ <input type="radio" value="[% option.value %]"
+ name="[% f.name %]"
+ [% IF option.value == f.fif %] checked="checked" [% END %]
+ [% option.label %]<br />
+[% END %]
+
diff --git a/share/templates/widget/reset.tt b/share/templates/widget/reset.tt
new file mode 100644
index 0000000..f010d32
--- /dev/null
+++ b/share/templates/widget/reset.tt
@@ -0,0 +1,2 @@
+<input type="reset" name="[% f.html_name %]" id="[% f.id %]" value="[% f.fif %]">
+
diff --git a/share/templates/widget/select.tt b/share/templates/widget/select.tt
new file mode 100644
index 0000000..6c2403d
--- /dev/null
+++ b/share/templates/widget/select.tt
@@ -0,0 +1,12 @@
+<label class="label [% IF field.has_errors %]fld_error[% END %]" for="[% f.html_name %]">[% f.label %]</label>
+<select name="[% f.html_name %]"
+ [% IF f.multiple %] multiple="multiple" size="[% f.size %]" [% END %]>
+ [% 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 %]
+</select>
+
diff --git a/share/templates/widget/submit.tt b/share/templates/widget/submit.tt
new file mode 100644
index 0000000..f07c0cd
--- /dev/null
+++ b/share/templates/widget/submit.tt
@@ -0,0 +1,2 @@
+<input type="submit" name="[% f.html_name %]" id="[% f.id %]" value="[% f.value %]">
+
diff --git a/share/templates/widget/text.tt b/share/templates/widget/text.tt
new file mode 100644
index 0000000..747af7c
--- /dev/null
+++ b/share/templates/widget/text.tt
@@ -0,0 +1,3 @@
+<label class="label [% IF f.has_errors %]fld_error[% END %]" for="[% f.html_name %]">[% f.label %]</label>
+<input type="text" name="[% f.html_name %]" id="[% f.id %]" value="[% f.fif %]">
+
diff --git a/share/templates/widget/textarea.tt b/share/templates/widget/textarea.tt
new file mode 100644
index 0000000..65c6ac9
--- /dev/null
+++ b/share/templates/widget/textarea.tt
@@ -0,0 +1,4 @@
+<label class="label [% IF f.has_errors %]fld_error[% END %]" for="[% f.html_name %]">[% f.label %]</label>
+<textarea name="[% f.html_name %]" id="[% f.id %]" rows="[% f.rows %]" cols="[% f.cols %]">
+[% f.fif %]
+</textarea>
diff --git a/share/templates/widget/upload.tt b/share/templates/widget/upload.tt
new file mode 100644
index 0000000..9f46fef
--- /dev/null
+++ b/share/templates/widget/upload.tt
@@ -0,0 +1,2 @@
+<label class="label [% IF f.has_errors %]fld_error[% END %]" for="[% f.html_name %]">[% f.label %]</label>
+<input type="file" name="[% f.html_name %]" id="[% f.html_name %]" />
diff --git a/t/01app.t b/t/01app.t
new file mode 100644
index 0000000..5ed581c
--- /dev/null
+++ b/t/01app.t
@@ -0,0 +1,12 @@
+use Test::More;
+
+use_ok( 'HTML::FormHandler::Model' );
+use_ok( 'HTML::FormHandler' );
+use_ok( 'HTML::FormHandler::Field' );
+use_ok( 'HTML::FormHandler::Field::Select' );
+use_ok( 'HTML::FormHandler::Field::Compound' );
+use_ok( 'HTML::FormHandler::Field::Repeatable' );
+
+use_ok( 'HTML::FormHandler::Model::CDBI' );
+
+done_testing;
diff --git a/t/compound_field.t b/t/compound_field.t
new file mode 100644
index 0000000..b3f45ce
--- /dev/null
+++ b/t/compound_field.t
@@ -0,0 +1,160 @@
+use Test::More;
+
+use lib 't/lib';
+
+use_ok( 'HTML::FormHandler::Field::Duration');
+
+my $field = HTML::FormHandler::Field::Duration->new( name => 'duration' );
+
+ok( $field, 'get compound field');
+
+my $input = {
+ hours => 1,
+ minutes => 2,
+};
+
+$field->_set_input($input);
+
+is_deeply( $field->input, $input, 'field input is correct');
+
+is_deeply( $field->fif, $input, 'field fif is same');
+
+{
+ package Duration::Form;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has_field 'name' => ( type => 'Text' );
+ has_field 'duration' => ( type => 'Duration' );
+ has_field 'duration.hours' => ( type => 'Nested' );
+ has_field 'duration.minutes' => ( type => 'Nested' );
+
+}
+
+my $form = Duration::Form->new;
+ok( $form, 'get compound form' );
+ok( $form->field('duration'), 'duration field' );
+ok( $form->field('duration.hours'), 'duration.hours field' );
+
+my $params = { name => 'Testing', 'duration.hours' => 2, 'duration.minutes' => 30 };
+
+$form->process( params => $params );
+ok( $form->validated, 'form validated' );
+
+is_deeply($form->fif, $params, 'get fif with right value');
+is( $form->field('duration')->value->hours, 2, 'duration value is correct');
+
+{
+ package Form::Start;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has_field 'name' => ( type => 'Text' );
+ has_field 'start_date' => ( type => 'DateTime' );
+ has_field 'start_date.month' => ( type => 'Month' );
+ has_field 'start_date.day' => ( type => 'MonthDay' );
+ has_field 'start_date.year' => ( type => 'Year' );
+
+ sub validate_start_date_month
+ {
+ my ( $self, $field ) = @_;
+ $field->add_error("That month is not available")
+ if( $field->value == 8 );
+ }
+
+}
+
+my $dtform = Form::Start->new;
+ok( $dtform, 'datetime form' );
+$params = { name => 'DT_testing', 'start_date.month' => '10',
+ 'start_date.day' => '2', 'start_date.year' => '2008' };
+$dtform->process( params => $params );
+ok( $dtform->validated, 'form validated' );
+is( $dtform->field('start_date')->value->mdy, '10-02-2008', 'datetime value');
+$params->{'start_date.month'} = 8;
+$dtform->process( params => $params );
+ok( !$dtform->validated, 'form did not validate' );
+ok( $dtform->has_errors, 'form has error' );
+is_deeply( [$dtform->errors], ['That month is not available'], 'correct error' );
+
+
+{
+ package Field::MyCompound;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler::Field::Compound';
+
+ has_field 'aaa';
+ has_field 'bbb';
+}
+
+
+{
+ package Form::TestValues;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has_field 'compound' => ( type => '+Field::MyCompound', apply => [ { check => sub { $_[0]->{aaa} eq 'aaa'}, message => 'Must be "aaa"' } ] );
+}
+$form = Form::TestValues->new;
+ok( $form, 'Compound form with separate fields declarations created' );
+
+$params = {
+ 'compound.aaa' => 'aaa',
+ 'compound.bbb' => 'bbb',
+};
+$form->process( params => $params );
+is_deeply( $form->values, { compound => { aaa => 'aaa', bbb => 'bbb' } }, 'Compound with separate fields - values in hash' );
+is_deeply( $form->fif, $params, 'get fif from compound field' );
+$form->process( params => { 'compound.aaa' => undef } );
+ok( !$form->field( 'compound' )->has_errors, 'Not required compound with empty sub values is not checked');
+
+{
+
+ package Compound;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler::Field::Compound';
+
+ has_field 'year' => (
+ type => 'Integer',
+ required => 1,
+ );
+
+ has_field 'month' => (
+ type => 'Integer',
+ range_start => 1,
+ range_end => 12,
+ );
+
+ has_field 'day' => (
+ type => 'Integer',
+ range_start => 1,
+ range_end => 31,
+ );
+
+ sub default {
+ return {
+ year => undef,
+ month => undef,
+ day => undef
+ };
+ }
+}
+
+{
+
+ package Form;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+ has_field 'date' => ( type => '+Compound', required => 1 );
+ has_field 'foo';
+}
+
+my $f = Form->new;
+$f->process( { 'date.day' => '18', 'date.month' => '2', 'date.year' => '2010' } );
+is_deeply( $f->field('date')->value, { year => 2010, month => 2, day => 18 }, 'correct value' );
+
+$f = Form->new;
+$f->process( { foo => 'testing' } );
+is_deeply( $f->field('date')->value, { year => undef, month => undef, day => undef }, 'correct default' );
+
+done_testing;
diff --git a/t/constraints.t b/t/constraints.t
new file mode 100644
index 0000000..a86dd52
--- /dev/null
+++ b/t/constraints.t
@@ -0,0 +1,110 @@
+use strict;
+use warnings;
+use Test::More;
+use lib 't/lib';
+
+{
+
+ package My::Form;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ use Moose::Util::TypeConstraints;
+
+ subtype 'Natural'
+ => as 'Int'
+ => where { $_ > 0 };
+
+ subtype 'NaturalLessThanTen'
+ => as 'Natural'
+ => where { $_ < 10 }
+ => message { "This number ($_) is not less than ten!" };
+
+ coerce 'Num'
+ => from 'Str'
+ => via { 0+$_ };
+
+ enum 'RGBColors' => qw(red green blue);
+
+ no Moose::Util::TypeConstraints;
+
+ has_field 'empty_field' => (
+ apply => [ { check => qr/aaa/, message => 'Must contain aaa' } ],
+ );
+ has_field 'regex_error' => (
+ apply => [ { check => qr/xyz/ } ],
+ );
+ has_field 'regex_correct' => (
+ apply => [ { check => qr/aaa/, message => 'Must contain aaa' } ],
+ );
+ has_field 'set_error' => (
+ apply => [
+ {
+ check => [ 'aaa', 'bbb' ],
+ message => 'Must be "aaa" or "bbb"'
+ }
+ ]
+ );
+ has_field 'set_correct' => (
+ apply => [
+ {
+ check => [ 'aaa', 'bbb' ],
+ message => 'Must be "aaa" or "bbb"'
+ }
+ ]
+ );
+ has_field 'callback_error' => (
+ apply => [
+ {
+ check => sub { if ( $_[0] =~ /(\d+)/ ) { return $1 > 10 } },
+ message => 'Must contain number greater than 10',
+ }
+ ]
+ );
+ has_field 'callback_pass' => (
+ apply => [
+ {
+ check => sub { if ( $_[0] =~ /(\d+)/ ) { return $1 > 10 } },
+ message => 'Must contain number greater than 10',
+ }
+ ]
+ );
+ has_field 'less_than_ten_error' => (
+ apply => [ 'NaturalLessThanTen' ]
+ );
+ has_field 'less_than_ten_pass' => (
+ apply => [ 'NaturalLessThanTen' ]
+ );
+}
+
+my $form = My::Form->new();
+ok( $form, 'get form' );
+
+my $params = {
+ empty_field => '',
+ regex_error => 'bbb',
+ regex_correct => 'bbb aaa',
+ set_error => 'ccc',
+ set_correct => 'aaa',
+ callback_error => 'asdf 2',
+ callback_pass => 'asdf 20 asd',
+ less_than_ten_error => 10,
+ less_than_ten_pass => 9,
+};
+$form->process($params);
+# ok( $form->field('empty_field')->has_errors, 'empty does not pass required constraint' );
+ok( $form->field('regex_error')->has_errors, 'regexp constraint - error' );
+ok( !$form->field('regex_correct')->has_errors, 'regexp constraint - pass' );
+ok( $form->field('regex_correct')->has_value, 'constraints passed - has_value is true' );
+ok( !$form->field('set_correct')->has_errors, 'set correct' );
+ok( $form->field('set_error')->has_errors, 'set error' );
+ok( $form->field('callback_error')->has_errors, 'callback constraint - error' );
+ok( !$form->field('callback_pass')->has_errors, 'callback constraint - pass' );
+ok( $form->field('less_than_ten_error')->has_errors, 'type constraint - error' );
+my $message = $form->field('less_than_ten_error')->errors->[0];
+is( $message, "This number (10) is not less than ten!", 'type constraint - error message' );
+ok( !$form->field('less_than_ten_pass')->has_errors, 'type constraint - pass' );
+#warn Dumper( $form ); use Data::Dumper;
+is_deeply( $form->fif, $params, 'fif is correct');
+
+done_testing;
diff --git a/t/dates.t b/t/dates.t
new file mode 100644
index 0000000..362d854
--- /dev/null
+++ b/t/dates.t
@@ -0,0 +1,159 @@
+use strict;
+use warnings;
+use Test::More;
+
+
+BEGIN {
+ eval "use DateTime::Format::Strptime";
+ plan skip_all => 'DateTime::Format::Strptime required' if $@;
+}
+
+#
+# DateMDY
+#
+my $class = 'HTML::FormHandler::Field::DateMDY';
+use_ok($class);
+my $field = $class->new( name => 'test_field', );
+ok( defined $field, 'new() called for DateMDY' );
+$field->_set_input('10/02/2009');
+$field->validate_field;
+ok( $field->validated, 'No errors 1' );
+ok( $field->value->isa('DateTime'), 'isa DateTime' );
+$field->clear_result;
+$field->_set_input('14/40/09');
+$field->validate_field;
+ok( $field->has_errors, 'Has error 1' );
+is( $field->fif, '14/40/09', 'Correct value' );
+$field->clear_result;
+$field->_set_input('02/29/2009');
+$field->validate_field;
+ok( $field->has_errors, 'Has error 2' );
+is( $field->fif, '02/29/2009', 'isa DateTime' );
+$field->clear_result;
+$field->_set_input('12/31/2008');
+$field->validate_field;
+ok( $field->validated, 'No errors 2' );
+is( $field->fif, $field->value->strftime("%m/%d/%Y", 'fif ok' ), 'fif ok');
+$field->clear_result;
+$field->_set_input('07/07/09');
+ok( $field->validated, 'No errors 3' );
+$field->clear_result;
+$field->_deflate_and_set_value( DateTime->new( year => 2008, month => 12, day => 31 ) );
+is( $field->fif, '12/31/2008', 'fif from value ok');
+
+
+#
+# Date
+#
+$class = 'HTML::FormHandler::Field::Date';
+use_ok($class);
+$field = $class->new( name => 'test_field', format => "mm/dd/yy" );
+ok( defined $field, 'new() called for DateMDY' );
+$field->_set_input('02/10/2009');
+$field->validate_field;
+ok( $field->validated, 'No errors 1' );
+ok( $field->value->isa('DateTime'), 'isa DateTime' );
+$field->clear_result;
+$field->date_start('2009-10-01');
+$field->_set_input('08/01/2009');
+$field->validate_field;
+ok( $field->has_errors, 'Date is too early' );
+is( $field->fif, '08/01/2009', 'Correct value' );
+$field->clear_date_start;
+$field->clear_result;
+$field->date_end('2010-01-01');
+$field->_set_input('02/01/2010');
+$field->validate_field;
+ok( $field->has_errors, 'date is too late');
+$field->_set_input('02/29/2009');
+$field->validate_field;
+ok( $field->has_errors, 'Not a valid date' );
+is( $field->fif, '02/29/2009', 'isa DateTime' );
+$field->clear_result;
+$field->_set_input('12/31/2008');
+$field->validate_field;
+ok( $field->validated, 'No errors 2' );
+is( $field->fif, $field->value->strftime("%m/%d/%Y", 'fif ok' ), 'fif ok');
+$field->clear_result;
+$field->_deflate_and_set_value( DateTime->new( year => 2008, month => 12, day => 31 ) );
+is( $field->fif, '12/31/2008', 'fif from deflated value ok');
+$field->format("%d-%m-%Y");
+$field->_set_input('07-07-09');
+$field->validate_field;
+ok( $field->validated, 'No errors 3' );
+#$field->clear_result;
+#$field->_deflate_and_set_value( DateTime->new( year => 2008, month => 12, day => 31 ) );
+is( $field->fif, '07-07-09', 'fif ok');
+
+
+{
+ package Test::Date;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+ with 'HTML::FormHandler::Render::Simple';
+
+ has_field 'end_date' => ( type => 'Date' );
+}
+
+my $form = Test::Date->new;
+ok( $form, 'form with date created' );
+ok( $form->render_field('end_date'), 'date field renders' );
+
+#
+# DateTime
+#
+$class = 'HTML::FormHandler::Field::DateTime';
+use_ok($class);
+#$field = $class->new( name => 'test_field', format => "mm/dd/yy" );
+$field = $class->new( name => 'test_field', field_list => [ year => 'Integer',
+ month => 'Integer', day => 'Integer' ] );
+ok( defined $field, 'new() called for DateTime' );
+$field->_set_input({ month => 2, day => 10, year => 2009 });
+$field->test_validate_field;
+ok( $field->validated, 'No errors 1' );
+ok( $field->value && $field->value->isa('DateTime'), 'isa DateTime' );
+is( $field->value->ymd, '2009-02-10', 'correct DateTime' );
+
+$field = $class->new( name => 'test_field', field_list => [ year => 'Integer',
+ month => { type => 'Integer', range_start => 9, range_end => 12 }, day => 'Integer' ] );
+ok( $field, 'field compiles and builds' );
+
+$field->clear_result;
+my $date_hash = { month => 5, day => 10, year => 2009 };
+$field->_set_input($date_hash);
+$field->test_validate_field;
+ok( $field->has_errors, 'Date is wrong month' );
+is( $field->fif, $date_hash, 'Correct value' );
+
+$field->clear_result;
+$date_hash = { month => 10, day => 32, year => 2009 };
+$field->_set_input($date_hash);
+$field->test_validate_field;
+ok( $field->has_errors, 'Date is wrong month' );
+like( $field->errors->[0], qr/Not a valid/, 'DateTime error message' );
+is( $field->fif, $date_hash, 'Correct value' );
+
+{
+ package Test::DateTime;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has_field 'foo';
+ has_field 'my_date' => ( type => 'DateTime' );
+ has_field 'my_date.month';
+ has_field 'my_date.year';
+ has_field 'my_date.day';
+}
+$form = Test::DateTime->new;
+my $dt = DateTime->new( year => '2010', month => '02', day => '22' );
+$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;
+is( $fif->{'my_date.day'}, '22', 'right fif day');
+$fif->{'my_date.day'} = '15';
+$form->process( params => $fif );
+ok( $form->validated, 'form validated' );
+is( $form->field('my_date')->value->mdy, '02-15-2010', 'right value for my_date' );
+
+done_testing;
diff --git a/t/defaults.t b/t/defaults.t
new file mode 100644
index 0000000..ff3735f
--- /dev/null
+++ b/t/defaults.t
@@ -0,0 +1,105 @@
+use Test::More;
+use lib 't/lib';
+
+
+{
+ package My::Form;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has '+name' => ( default => 'testform_' );
+ has_field 'optname' => ( temp => 'First' );
+ has_field 'reqname' => ( required => 1 );
+ has_field 'somename';
+}
+
+
+my $form = My::Form->new( init_object => {reqname => 'Starting Perl',
+ optname => 'Over Again' } );
+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',
+ 'get right fif with init_object');
+
+{
+ package My::Form;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has '+name' => ( default => 'initform_' );
+ has_field 'foo';
+ has_field 'bar';
+ has_field 'baz';
+ has_field 'bax' => ( default => 'default_bax' );
+ has '+init_object' => ( default => sub { { foo => 'initfoo' } } );
+ sub default_bar { 'init_value_bar' }
+ sub init_value_baz { 'init_value_baz' }
+}
+
+$form = My::Form->new;
+ok( $form->field('foo')->value, 'initfoo' );
+ok( $form->field('bar')->value, 'init_value_bar' );
+ok( $form->field('baz')->value, 'init_value_baz' );
+ok( $form->field('bax')->value, 'default_bax' );
+
+{
+ package Mock::Object;
+ use Moose;
+ has 'foo' => ( is => 'rw' );
+ has 'bar' => ( is => 'rw' );
+ has 'baz' => ( is => 'rw' );
+}
+{
+ package Test::Object;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+ with 'HTML::FormHandler::Model::Object';
+ has_field 'foo';
+ has_field 'bar';
+ has_field 'baz';
+ 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'},
+ { value => 2, label => 'Two'},
+ { value => 3, label => 'Three'},
+ ]
+ );
+
+ sub init_object {
+ { bar => 'initbar' }
+ }
+
+}
+
+my $obj = Mock::Object->new( foo => 'myfoo', bar => 'mybar', baz => 'mybaz' );
+
+$form = Test::Object->new;
+$form->process( item => $obj, item_id => 1, params => {} );
+is( $form->field('foo')->value, 'myfoo', 'field value from item');
+is( $form->field('bar')->value, 'mybar', 'field value from item');
+is( $form->field('bax')->value, 'bax_from_default', 'non-item field value from default' );
+is( $form->field('zero')->value, 0, 'zero default works');
+is_deeply( $form->field('foo_list')->value, [1,3], 'multiple default works' );
+
+{
+ package Test::Form;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has 'quuz' => ( is => 'ro', default => 'some_quux' );
+ has_field 'foo';
+ has_field 'bar';
+
+ sub init_object {
+ my $self = shift;
+ return { foo => $self->quuz, bar => 'bar!' };
+ }
+}
+$form = Test::Form->new;
+is( $form->field('foo')->value, 'some_quux', 'field initialized by init_object' );
+
+
+done_testing;
diff --git a/t/deflate.t b/t/deflate.t
new file mode 100644
index 0000000..4f3cc51
--- /dev/null
+++ b/t/deflate.t
@@ -0,0 +1,51 @@
+use strict;
+use warnings;
+use Test::More;
+
+{
+ package Test::Field;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler::Field::Compound';
+
+ has_field 'one';
+ has_field 'two';
+ has_field 'three';
+
+ 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;
+ }
+ } ]
+ );
+}
+{
+ package Test::Deflate;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has_field 'foo' => ( type => '+Test::Field' );
+ has_field 'bar';
+}
+
+my $form = Test::Deflate->new;
+ok( $form, 'form builds' );
+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?' );
+$form->process( params => { bar => 'aabbcc', 'foo.one' => 'x', 'foo.two' => 'xx', 'foo.three' => 'xxx' } );
+ok( $form->validated, 'form validated' );
+is_deeply( $form->value, { bar => 'aabbcc', foo => 'one-x-two-xx-three-xxx' }, 'right value' );
+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' );
+
+done_testing;
diff --git a/t/dependency.t b/t/dependency.t
new file mode 100644
index 0000000..1657008
--- /dev/null
+++ b/t/dependency.t
@@ -0,0 +1,52 @@
+use Test::More;
+
+use DateTime;
+
+{
+ package My::Form;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has_field 'name' => ( required => 1 );
+ has_field 'age' => ( required => 1 );
+ has_field 'comment';
+ has_field 'address';
+ has_field 'city';
+ has_field 'state';
+ has_field 'zip';
+ has_field 'cc_no';
+ has_field 'cc_expires';
+
+ has '+dependency' => ( default => sub {
+ [
+ [ 'address', 'city', 'state', 'zip' ],
+ [ 'cc_no', 'cc_expires' ],
+ ]
+ }
+ );
+
+}
+
+my $form = My::Form->new;
+ok( $form, 'get form' );
+
+my $params = {
+ name => 'John Doe',
+ age => '44',
+ state => 'NY',
+};
+
+my $validated = $form->process( $params );
+ok( !$validated, 'not validated' );
+
+my @error_fields = $form->error_fields;
+my $error_count = @error_fields;
+is( $error_count, 3, 'number of errors is 3');
+
+foreach my $field (@error_fields)
+{
+ my $name = $field->name;
+ is( $field->errors->[0], $field->label . ' field is required', "required field: $name");
+}
+
+done_testing;
diff --git a/t/dynamic.t b/t/dynamic.t
new file mode 100644
index 0000000..19d380a
--- /dev/null
+++ b/t/dynamic.t
@@ -0,0 +1,92 @@
+use strict;
+use warnings;
+use Test::More;
+
+use HTML::FormHandler;
+
+my @select_options = ( {value => 1, label => 'One'}, {value => 2, label => 'Two'}, {value => 3, label => 'Three'} );
+my $args = {
+ name => 'test',
+ field_list => [
+ 'username' => {
+ type => 'Text',
+ apply => [ { check => qr/^[0-9a-z]*/, message => 'Contains invalid characters' } ],
+ },
+ 'password' => {
+ type => 'Password',
+ },
+ 'a_number' => {
+ type => 'IntRange',
+ range_min => 12,
+ range_max => 291,
+ },
+ 'on_off' => {
+ type => 'Checkbox',
+ checkbox_value => 'yes',
+ input_without_param => 'no'
+ },
+ 'long_text' => {
+ type => 'TextArea',
+ },
+ 'hidden_text' => {
+ type => 'Hidden',
+ default => 'bob',
+ },
+ 'upload_file' => {
+ type => 'Upload',
+ # valid_extensions => [ "jpg", "gif", "png" ],
+ max_size => 262144,
+ },
+ 'a_select' => {
+ type => 'Select',
+ options => \@select_options,
+ },
+ 'b_select' => {
+ type => 'Select',
+ options => \@select_options,
+ multiple => 1,
+ size => 4,
+ },
+ 'c_select' => {
+ type => 'Select',
+ options => \@select_options,
+ widget => 'radio_group',
+ },
+ 'd_select' => {
+ type => 'Select',
+ options => \@select_options,
+ multiple => 1,
+ widget => 'checkbox_group'
+ },
+ 'sub' => {
+ type => 'Compound',
+ },
+ 'sub.user' => {
+ type => 'Text',
+ apply => [ { check => qr/^[0-9a-z]*/, message => 'Not a valid user' } ],
+ },
+ 'sub.name' => {
+ type => 'Text',
+ apply => [ { check => qr/^[0-9a-z]*/, message => 'Not a valid name' } ],
+ },
+ 'reset' => {
+ type => 'Reset',
+ },
+ 'submit' => {
+ type => 'Submit',
+ },
+ 'a_link' => {
+ type => 'Display',
+ html => '<a href="http://google.com/">get me out of here</>',
+ },
+ ]
+};
+my $form = HTML::FormHandler->new( %$args );
+
+ok( $form, 'form builds ok' );
+
+my $renderedform = $form->render;
+ok( $renderedform, 'form renders' );
+like( $renderedform, qr/Reset/, 'reset rendered' );
+
+done_testing;
diff --git a/t/errors.t b/t/errors.t
new file mode 100644
index 0000000..655e74b
--- /dev/null
+++ b/t/errors.t
@@ -0,0 +1,130 @@
+use strict;
+use warnings;
+use Test::More;
+
+use_ok( 'HTML::FormHandler' );
+
+{
+ package My::Form;
+ use Moose;
+ extends 'HTML::FormHandler';
+ has '+name' => ( default => 'testform_' );
+ sub field_list {
+ return [
+ reqname => {
+ type => 'Text',
+ required => 1,
+ required_message => 'You must supply a reqname',
+ },
+ fruit => 'Select',
+ optname => 'Text',
+ silly_name => {
+ type =>'Text',
+ set_validate => 'valid_silly'
+ }
+ ];
+ }
+ sub options_fruit {
+ return (
+ 1 => 'apples',
+ 2 => 'oranges',
+ 3 => 'kiwi',
+ );
+ }
+ sub valid_silly
+ {
+ my ( $self, $field ) = @_;
+ $field->add_error( 'Not a valid silly_name' )
+ unless $field->value eq 'TeStInG';
+ }
+}
+
+my $form = My::Form->new;
+
+my $bad_1 = {
+ optname => 'not req',
+ fruit => 4,
+ silly_name => 'what??',
+};
+
+ok( !$form->process( $bad_1 ), 'bad 1' );
+
+ok( $form->has_errors, 'form has error' );
+
+ok( $form->field('fruit')->has_errors, 'fruit has error' );
+
+ok( $form->field('reqname')->has_errors, 'reqname has error' );
+
+ok( !$form->field('optname')->has_errors, 'optname has no error' );
+ok( $form->field('silly_name')->has_errors, 'silly_name has error' );
+ok( $form->has_errors, 'form has errors' );
+
+my @fields = $form->error_fields;
+ok( @fields, 'error fields' );
+
+my @errors = $form->errors;
+is_deeply( \@errors, [
+ 'You must supply a reqname',
+ '\'4\' is not a valid value',
+ 'Not a valid silly_name' ],
+ 'errors from form' );
+
+is( $form->num_errors, 3, 'number of errors' );
+
+my @field_names = $form->error_field_names;
+is_deeply( \@field_names,
+ [ 'reqname', 'fruit', 'silly_name' ],
+ 'error field names' );
+
+is( $form->field('fruit')->id, "fruit", 'field has id' );
+
+{
+ package Repeatable::Form;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has_field 'my_test';
+ has_field 'addresses' => ( type => 'Repeatable', auto_id => 1 );
+ has_field 'addresses.street';
+ has_field 'addresses.city';
+ has_field 'addresses.country';
+
+ sub validate_addresses_city
+ {
+ my ( $self, $field ) = @_;
+ $field->add_error("Invalid City: " . $field->value)
+ if( $field->value !~ /City/ );
+ }
+}
+
+my $init_object = {
+ my_test => 'repeatable_errors',
+ addresses => [
+ {
+ street => 'First Street',
+ city => 'Prime',
+ country => 'Utopia',
+ id => 0,
+ },
+ {
+ street => 'Second Street',
+ city => 'Secondary',
+ country => 'Graustark',
+ id => 1,
+ },
+ {
+ street => 'Third Street',
+ city => 'Tertiary City',
+ country => 'Atlantis',
+ id => 2,
+ }
+ ]
+};
+
+$form = Repeatable::Form->new;
+ok( $form, 'form created');
+$form->process( $init_object );
+ok( !$form->validated, 'form did not validate' );
+is( $form->num_errors, 2, 'form has two errors' );
+
+done_testing;
diff --git a/t/field_item.t b/t/field_item.t
new file mode 100644
index 0000000..7b5ad30
--- /dev/null
+++ b/t/field_item.t
@@ -0,0 +1,124 @@
+use strict;
+use warnings;
+use Test::More;
+
+
+my $struct = {
+ username => 'Joe Blow',
+ occupation => 'Programmer',
+ tags => ['Perl', 'programming', 'Moose' ],
+ employer => {
+ name => 'TechTronix',
+ country => 'Utopia',
+ },
+ options => {
+ flags => {
+ opt_in => 1,
+ email => 0,
+ },
+ cc_cards => [
+ {
+ type => 'Visa',
+ number => '4248999900001010',
+ },
+ {
+ type => 'MasterCard',
+ number => '4335992034971010',
+ },
+ ],
+ },
+ addresses => [
+ {
+ street => 'First Street',
+ city => 'Prime City',
+ country => 'Utopia',
+ id => 0,
+ },
+ {
+ street => 'Second Street',
+ city => 'Secondary City',
+ country => 'Graustark',
+ id => 1,
+ },
+ {
+ street => 'Third Street',
+ city => 'Tertiary City',
+ country => 'Atlantis',
+ id => 2,
+ }
+ ]
+};
+
+
+{
+ package Structured::Form;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has_field 'username';
+ has_field 'occupation';
+ has_field 'tags' => ( type => 'Repeatable' );
+ has_field 'tags.contains' => ( type => 'Text' );
+ has_field 'employer' => ( type => 'Compound' );
+ has_field 'employer.name';
+ has_field 'employer.country';
+ has_field 'options' => ( type => 'Compound' );
+ has_field 'options.flags' => ( type => 'Compound' );
+ has_field 'options.flags.opt_in' => ( type => 'Boolean' );
+ has_field 'options.flags.email' => ( type => 'Boolean' );
+ has_field 'options.cc_cards' => ( type => 'Repeatable' );
+ has_field 'options.cc_cards.type';
+ has_field 'options.cc_cards.number';
+ has_field 'addresses' => ( type => 'Repeatable' );
+ has_field 'addresses.street';
+ has_field 'addresses.city';
+ has_field 'addresses.country';
+ has_field 'addresses.id';
+
+}
+
+my $form = Structured::Form->new;
+ok( $form, 'form created' );
+
+$form->process( init_object => $struct, params => {} );
+
+ok( !$form->validated, 'form validated');
+is_deeply( $form->field('employer')->item, { name => 'TechTronix', country => 'Utopia', }, 'has item');
+is_deeply( $form->field('addresses')->item, $struct->{addresses}, 'item for repeatable' );
+
+
+my $fif = {
+ 'addresses.0.city' => 'Prime City',
+ 'addresses.0.country' => 'Utopia',
+ 'addresses.0.id' => 0,
+ 'addresses.0.street' => 'First Street',
+ 'addresses.1.city' => 'Secondary City',
+ 'addresses.1.country' => 'Graustark',
+ 'addresses.1.id' => 1,
+ 'addresses.1.street' => 'Second Street',
+ 'addresses.2.city' => 'Tertiary City',
+ 'addresses.2.country' => 'Atlantis',
+ 'addresses.2.id' => 2,
+ 'addresses.2.street' => 'Third Street',
+ 'employer.country' => 'Utopia',
+ 'employer.name' => 'TechTronix',
+ 'occupation' => 'Programmer',
+ 'options.cc_cards.0.number' => '4248999900001010',
+ 'options.cc_cards.0.type' => 'Visa',
+ 'options.cc_cards.1.number' => '4335992034971010',
+ 'options.cc_cards.1.type' => 'MasterCard',
+ 'options.flags.email' => 0,
+ 'options.flags.opt_in' => 1,
+ 'tags.0' => 'Perl',
+ 'tags.1' => 'programming',
+ 'tags.2' => 'Moose',
+ 'username' => 'Joe Blow'
+};
+
+$form->process( item => $struct, params => $fif );
+
+ok( $form->validated, 'form processed from fif' );
+is_deeply( $form->field('employer')->item, { name => 'TechTronix', country => 'Utopia', }, 'has item');
+is_deeply( $form->field('addresses')->item, $struct->{addresses}, 'item for repeatable' );
+
+done_testing;
diff --git a/t/field_traits.t b/t/field_traits.t
new file mode 100644
index 0000000..5353529
--- /dev/null
+++ b/t/field_traits.t
@@ -0,0 +1,85 @@
+use strict;
+use warnings;
+use Test::More;
+
+use lib ('t/lib');
+
+{
+ package Form::RoleForm;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+ use HTML::FormHandler::Field;
+
+ after 'BUILDARGS' => sub {
+ my $fmeta = HTML::FormHandler::Field->meta;
+ $fmeta->make_mutable;
+ Moose::Util::apply_all_roles( $fmeta, ('Field::Role::Test'));
+ $fmeta->make_immutable;
+ };
+ has_field 'bar' => (foo_attr => 'xxx');
+ has_field 'foo' => (bar_attr => 'yyy');;
+}
+
+{
+ package Field::Role::Test;
+
+ use Moose::Role;
+
+ has 'foo_attr' => ( isa => 'Str', is => 'rw' );
+ has 'bar_attr' => ( isa => 'Str', is => 'rw' );
+}
+
+{
+ package MyApp::Field::Test;
+ use Moose::Role;
+ sub got_here { 1 }
+}
+
+my $form = Form::RoleForm->new( field_traits => ['MyApp::Field::Test'] );
+
+ok( $form, 'form created' );
+is( $form->field('bar')->foo_attr, 'xxx', 'attribute set ok' );
+ok( $form->field('bar')->foo_attr('test'), 'has extra attribute' );
+is( $form->field('bar')->foo_attr, 'test', 'attribute was set' );
+ok( $form->field('foo')->got_here && $form->field('bar')->got_here, 'base field role applied' );
+
+{
+ package My::Render;
+ use Moose::Role;
+ has 'my_attr' => ( is => 'rw', isa => 'Str' );
+ sub html {
+ my $self = shift;
+ return "<h2>Pick something, quick!</h2>";
+ }
+
+}
+
+{
+ package MyApp::Widget::Field::Text;
+ use Moose::Role;
+ has 'widget_attr' => ( is => 'rw' );
+ sub render {
+ my $self = shift;
+ return $self->widget_attr || 'empty attr';
+ }
+}
+
+use HTML::FormHandler;
+$form = HTML::FormHandler->new(
+ widget_name_space => ['MyApp::Widget'],
+ field_list => [
+ foo => { type => 'Text', required => 1, widget_attr => 'A Test!' },
+ baz => { type => 'Display', traits => ['My::Render'], my_attr => 'something' },
+ bar => { type => 'Select', options => [{value => 1, label => 'bar1'},
+ {value => 2, label => 'bar2' }] },
+ ],
+);
+
+ok( $form, 'dynamic form created' );
+is( $form->field('baz')->my_attr, 'something', 'attribute added by trait was set' );
+is( $form->field('baz')->html, "<h2>Pick something, quick!</h2>", 'new method works' );
+is( $form->field('foo')->widget_attr, 'A Test!', 'widget attribute applied' );
+is( $form->field('foo')->render, 'A Test!', 'widget renders using attribute' );
+
+
+done_testing;
diff --git a/t/field_types.t b/t/field_types.t
new file mode 100644
index 0000000..ff778eb
--- /dev/null
+++ b/t/field_types.t
@@ -0,0 +1,43 @@
+use strict;
+use warnings;
+use Test::More;
+
+use HTML::FormHandler::Types (':all');
+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');
+$field->validate_field;
+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;
+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;
+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;
+is( $field->value, 'This is a test');
+
+done_testing;
+
diff --git a/t/fields.t b/t/fields.t
new file mode 100644
index 0000000..0b18673
--- /dev/null
+++ b/t/fields.t
@@ -0,0 +1,492 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+$ENV{LANG} = 'en_us'; # in case user has set LANG to de_de
+
+#
+# Boolean
+#
+my $class = 'HTML::FormHandler::Field::Boolean';
+use_ok($class);
+my $field = $class->new( name => 'test', );
+ok( defined $field, 'new() called' );
+$field->_set_input(1);
+$field->validate_field;
+ok( !$field->has_errors, 'Test for errors 1' );
+is( $field->value, 1, 'Test true == 1' );
+$field->_set_input(0);
+$field->validate_field;
+ok( !$field->has_errors, 'Test for errors 2' );
+is( $field->value, 0, 'Test true == 0' );
+$field->_set_input('checked');
+$field->validate_field;
+ok( !$field->has_errors, 'Test for errors 3' );
+is( $field->value, 1, 'Test true == 1' );
+$field->_set_input('0');
+$field->validate_field;
+ok( !$field->has_errors, 'Test for errors 4' );
+is( $field->value, 0, 'Test true == 0' );
+
+# checkbox
+$class = 'HTML::FormHandler::Field::Checkbox';
+use_ok($class);
+$field = $class->new( name => 'test', );
+ok( defined $field, 'new() called' );
+$field->_set_input(1);
+$field->validate_field;
+ok( !$field->has_errors, 'Test for errors 1' );
+is( $field->value, 1, 'input 1 is 1' );
+$field->_set_input(0);
+$field->validate_field;
+ok( !$field->has_errors, 'Test for errors 2' );
+is( $field->value, 0, 'input 0 is 0' );
+$field->_set_input('checked');
+$field->validate_field;
+ok( !$field->has_errors, 'Test for errors 3' );
+is( $field->value, 'checked', 'value is "checked"' );
+$field->_set_input(undef);
+$field->validate_field;
+ok( !$field->has_errors, 'Test for errors 4' );
+is( $field->value, 0, 'input undef is 0' );
+$field = $class->new(
+ name => 'test_field2',
+ required => 1
+);
+$field->_set_input(0);
+$field->validate_field;
+ok( $field->has_errors, 'required field fails with 0' );
+
+
+
+# hidden
+
+$class = 'HTML::FormHandler::Field::Hidden';
+use_ok( $class );
+$field = $class->new( name => 'test_field',);
+ok( defined $field, 'new() called' );
+my $string = 'Some text';
+$field->_set_input( $string );
+$field->validate_field;
+ok( !$field->has_errors, 'Test for errors 1' );
+is( $field->value, $string, 'is value input string');
+$field->_set_input( '' );
+$field->validate_field;
+ok( !$field->has_errors, 'Test for errors 2' );
+is( $field->value, undef, 'is value input string');
+$field->required(1);
+$field->validate_field;
+ok( $field->has_errors, 'Test for errors 3' );
+$field->_set_input('hello');
+$field->required(1);
+$field->validate_field;
+ok( !$field->has_errors, 'Test for errors 3' );
+is( $field->value, 'hello', 'Check again' );
+$field->maxlength( 3 );
+$field->validate_field;
+ok( $field->has_errors, 'Test for too long' );
+$field->maxlength( 5 );
+$field->validate_field;
+ok( !$field->has_errors, 'Test for right length' );
+$field->minlength( 10 );
+$field->validate_field;
+ok( $field->has_errors, 'Test not long enough' );
+$field->minlength( 5 );
+$field->validate_field;
+ok( !$field->has_errors, 'Test just long enough' );
+$field->minlength( 4 );
+$field->validate_field;
+ok( !$field->has_errors, 'Test plenty long enough' );
+
+# integer
+
+$class = 'HTML::FormHandler::Field::Integer';
+use_ok( $class );
+$field = $class->new( name => 'test_field',);
+ok( defined $field, 'new() called' );
+$field->_set_input( 1 );
+$field->validate_field;
+ok( !$field->has_errors, 'Test for errors 1' );
+is( $field->value, 1, 'Test value == 1' );
+$field->_set_input( 0 );
+$field->validate_field;
+ok( !$field->has_errors, 'Test for errors 2' );
+is( $field->value, 0, 'Test value == 0' );
+$field->_set_input( 'checked' );
+$field->validate_field;
+ok( $field->has_errors, 'Test non integer' );
+$field->_set_input( '+10' );
+$field->validate_field;
+ok( !$field->has_errors, 'Test positive' );
+is( $field->value, 10, 'Test value == 10' );
+$field->_set_input( '-10' );
+$field->validate_field;
+ok( !$field->has_errors, 'Test negative' );
+is( $field->value, -10, 'Test value == -10' );
+$field->_set_input( '-10.123' );
+$field->validate_field;
+ok( $field->has_errors, 'Test real number' );
+$field->range_start( 10 );
+$field->_set_input( 9 );
+$field->validate_field;
+ok( $field->has_errors, 'Test 9 < 10 fails' );
+$field->_set_input( 100 );
+$field->validate_field;
+ok( !$field->has_errors, 'Test 100 > 10 passes ' );
+$field->range_end( 20 );
+$field->_set_input( 100 );
+$field->validate_field;
+ok( $field->has_errors, 'Test 10 <= 100 <= 20 fails' );
+$field->range_end( 20 );
+$field->_set_input( 15 );
+$field->validate_field;
+ok( !$field->has_errors, 'Test 10 <= 15 <= 20 passes' );
+$field->_set_input( 10 );
+$field->validate_field;
+ok( !$field->has_errors, 'Test 10 <= 10 <= 20 passes' );
+$field->_set_input( 20 );
+$field->validate_field;
+ok( !$field->has_errors, 'Test 10 <= 20 <= 20 passes' );
+$field->_set_input( 21 );
+$field->validate_field;
+ok( $field->has_errors, 'Test 10 <= 21 <= 20 fails' );
+$field->_set_input( 9 );
+$field->validate_field;
+ok( $field->has_errors, 'Test 10 <= 9 <= 20 fails' );
+
+
+# intrange.t
+
+$class = 'HTML::FormHandler::Field::IntRange';
+use_ok( $class );
+$field = $class->new(
+ name => 'test_field',
+ range_start => 30,
+ range_end => 39,
+);
+ok( defined $field, 'new() called' );
+$field->_set_input( 30 );
+$field->validate_field;
+ok( !$field->has_errors, '30 in range' );
+$field->_set_input( 39 );
+$field->validate_field;
+ok( !$field->has_errors, '39 in range' );
+$field->_set_input( 35 );
+$field->validate_field;
+ok( !$field->has_errors, '35 in range' );
+$field->_set_input( 29 );
+$field->validate_field;
+ok( $field->has_errors, '29 out of range' );
+$field->_set_input( 40 );
+$field->validate_field;
+ok( $field->has_errors, '40 out of range' );
+
+# minute
+
+$class = 'HTML::FormHandler::Field::Minute';
+use_ok( $class );
+$field = $class->new( name => 'test_field',);
+ok( defined $field, 'new() called' );
+$field->_set_input( 0 );
+$field->validate_field;
+ok( !$field->has_errors, '0 in range' );
+$field->_set_input( 59 );
+$field->validate_field;
+ok( !$field->has_errors, '59 in range' );
+$field->_set_input( 12 );
+$field->validate_field;
+ok( !$field->has_errors, '12 in range' );
+$field->_set_input( -1 );
+$field->validate_field;
+ok( $field->has_errors, '-1 out of range' );
+$field->_set_input( 60 );
+$field->validate_field;
+ok( $field->has_errors, '60 out of range' );
+
+# money
+
+$class = 'HTML::FormHandler::Field::Money';
+use_ok( $class );
+$field = $class->new( name => 'test_field',);
+ok( defined $field, 'new() called' );
+$field->_set_input( ' $123.45 ' );
+$field->validate_field;
+ok( !$field->has_errors, 'Test for errors " $123.00 "' );
+is( $field->value, 123.45, 'Test value == 123.45' );
+$field->_set_input( ' $12x3.45 ' );
+$field->validate_field;
+ok( $field->has_errors, 'Test for errors " $12x3.45 "' );
+is( $field->errors->[0], 'Value cannot be converted to money', 'get error' );
+$field->_set_input( 2345 );
+$field->validate_field;
+is( $field->value, '2345.00', 'transformation worked: 2345 => 2345.00' );
+
+
+# monthday
+
+$class = 'HTML::FormHandler::Field::MonthDay';
+use_ok( $class );
+$field = $class->new( name => 'test_field',);
+ok( defined $field, 'new() called' );
+$field->_set_input( 1 );
+$field->validate_field;
+ok( !$field->has_errors, '1 in range' );
+$field->_set_input( 31 );
+$field->validate_field;
+ok( !$field->has_errors, '31 in range' );
+$field->_set_input( 12 );
+$field->validate_field;
+ok( !$field->has_errors, '12 in range' );
+$field->_set_input( 0 );
+$field->validate_field;
+ok( $field->has_errors, '0 out of range' );
+$field->_set_input( 32 );
+$field->validate_field;
+ok( $field->has_errors, '32 out of range' );
+
+# monthname
+
+$class = 'HTML::FormHandler::Field::MonthName';
+use_ok( $class );
+$field = $class->new( name => 'test_field',);
+ok( defined $field, 'new() called' );
+for ( 1 .. 12 ) {
+ $field->_set_input( $_ );
+ $field->validate_field;
+ ok( !$field->has_errors, $_ . ' is valid' );
+}
+$field->_set_input( 0 );
+$field->validate_field;
+ok( $field->has_errors, '0 is not valid day of the week' );
+$field->_set_input( 13 );
+$field->validate_field;
+ok( $field->has_errors, '13 is not valid day of the week' );
+
+#month
+
+$class = 'HTML::FormHandler::Field::Month';
+use_ok( $class );
+$field = $class->new( name => 'test_field',);
+ok( defined $field, 'new() called' );
+$field->_set_input( 1 );
+$field->validate_field;
+ok( !$field->has_errors, '1 in range' );
+$field->_set_input( 12 );
+$field->validate_field;
+ok( !$field->has_errors, '59 in range' );
+$field->_set_input( 6 );
+$field->validate_field;
+ok( !$field->has_errors, '6 in range' );
+$field->_set_input( 0 );
+$field->validate_field;
+ok( $field->has_errors, '0 out of range' );
+$field->_set_input( 13 );
+$field->validate_field;
+ok( $field->has_errors, '60 out of range' );
+$field->_set_input( 'March' );
+$field->validate_field;
+ok( $field->has_errors, 'March is not numeric' );
+is( $field->errors->[0], "'March' is not a valid value", 'is error message' );
+
+
+# multiple
+
+$class = 'HTML::FormHandler::Field::Multiple';
+use_ok( $class );
+$field = $class->new( name => 'test_field',);
+ok( defined $field, 'new() called' );
+$field->options([
+ { value => 1, label => 'one' },
+ { value => 2, label => 'two' },
+ { value => 3, label => 'three' },
+]);
+ok( $field->options, 'options method called' );
+$field->_set_input( 1 );
+$field->validate_field;
+ok( !$field->has_errors, 'Test for errors 1' );
+is_deeply( $field->value, [1], 'Test 1 => [1]' );
+$field->_set_input( [1] );
+$field->validate_field;
+ok( !$field->has_errors, 'Test for errors 2' );
+ok( eq_array( $field->value, [1], 'test array' ), 'Check [1]');
+$field->_set_input( [1,2] );
+$field->validate_field;
+ok( !$field->has_errors, 'Test for errors 3' );
+ok( eq_array( $field->value, [1,2], 'test array' ), 'Check [1,2]');
+$field->_set_input( [1,2,4] );
+$field->validate_field;
+ok( $field->has_errors, 'Test for errors 4' );
+is( $field->errors->[0], "'4' is not a valid value", 'Error message' );
+
+# password tested separately. requires a form.
+
+# posinteger
+
+$class = 'HTML::FormHandler::Field::PosInteger';
+use_ok( $class );
+$field = $class->new( name => 'test_field',);
+ok( defined $field, 'new() called' );
+$field->_set_input( 1 );
+$field->validate_field;
+ok( !$field->has_errors, 'Test for errors 1' );
+is( $field->value, 1, 'Test value == 1' );
+$field->_set_input( 0 );
+$field->validate_field;
+ok( !$field->has_errors, 'Test for errors 2' );
+is( $field->value, 0, 'Test value == 0' );
+$field->_set_input( 'checked' );
+$field->validate_field;
+ok( $field->has_errors, 'Test non integer' );
+$field->_set_input( '+10' );
+$field->validate_field;
+ok( !$field->has_errors, 'Test positive' );
+is( $field->value, 10, 'Test value == 10' );
+$field->_set_input( '-10' );
+$field->validate_field;
+ok( $field->has_errors, 'Test negative' );
+$field->_set_input( '-10.123' );
+$field->validate_field;
+ok( $field->has_errors, 'Test real number ' );
+
+# second
+
+$class = 'HTML::FormHandler::Field::Second';
+use_ok( $class );
+$field = $class->new( name => 'test_field',);
+ok( defined $field, 'new() called' );
+$field->_set_input( 0 );
+$field->validate_field;
+ok( !$field->has_errors, '0 in range' );
+$field->_set_input( 59 );
+$field->validate_field;
+ok( !$field->has_errors, '59 in range' );
+$field->_set_input( 12 );
+$field->validate_field;
+ok( !$field->has_errors, '12 in range' );
+$field->_set_input( -1 );
+$field->validate_field;
+ok( $field->has_errors, '-1 out of range' );
+$field->_set_input( 60 );
+$field->validate_field;
+ok( $field->has_errors, '60 out of range' );
+
+# select
+
+$class = 'HTML::FormHandler::Field::Select';
+use_ok( $class );
+$field = $class->new( name => 'test_field',);
+ok( defined $field, 'new() called' );
+ok( $field->options, 'Test for init_options failure in 0.09' );
+my $options = [
+ { value => 1, label => 'one' },
+ { value => 2, label => 'two' },
+ { value => 3, label => 'three' },
+];
+$field->options($options);
+ok( $field->options, 'Test for set options failure' );
+$field->_set_input( 1 );
+$field->validate_field;
+ok( !$field->has_errors, 'Test for errors 1' );
+is( $field->value, 1, 'Test true == 1' );
+$field->_set_input( [1] );
+$field->validate_field;
+ok( $field->has_errors, 'Test for errors array' );
+$field->_set_input( [1,4] );
+$field->validate_field;
+ok( $field->has_errors, 'Test for errors 4' );
+is( $field->errors->[0], 'This field does not take multiple values', 'Error message' );
+$field = $class->new( name => 'test_prompt', 'empty_select' => "Choose a Number",
+ options => $options, required => 1 );
+is( $field->num_options, 3, 'right number of options');
+like( $field->render, qr/Choose/, 'contains empty selection' );
+
+# textarea
+
+$class = 'HTML::FormHandler::Field::TextArea';
+use_ok( $class );
+$field = $class->new( name => 'comments', cols => 40, rows => 3 );
+ok( $field, 'get TextArea field');
+$field->_set_input("Testing, testing, testing... This is a test");
+$field->validate_field;
+ok( !$field->has_errors, 'field has no errors');
+
+# text
+
+$class = 'HTML::FormHandler::Field::Text';
+use_ok( $class );
+$field = $class->new( name => 'test',);
+ok( defined $field, 'new() called' );
+$string = 'Some text';
+$field->_set_input( $string );
+$field->validate_field;
+ok( !$field->has_errors, 'Test for errors 1' );
+is( $field->value, $string, 'is value input string');
+$field->_set_input( '' );
+$field->validate_field;
+ok( !$field->has_errors, 'Test for errors 2' );
+is( $field->value, undef, 'is value input string');
+$field->required(1);
+$field->validate_field;
+ok( $field->has_errors, 'Test for errors 3' );
+$field->_set_input('hello');
+$field->required(1);
+$field->validate_field;
+ok( !$field->has_errors, 'Test for errors 3' );
+is( $field->value, 'hello', 'Check again' );
+$field->maxlength( 3 );
+$field->validate_field;
+is( $field->errors->[0], 'Field should not exceed 3 characters. You entered 5', 'Test for too long' );
+$field->maxlength( 5 );
+$field->validate_field;
+ok( !$field->has_errors, 'Test for right length' );
+$field->minlength( 10 );
+$field->minlength_message('[_3] field must be at least [quant,_1,character]');
+$field->validate_field;
+is( $field->errors->[0], 'Test field must be at least 10 characters', 'Test not long enough' );
+$field->minlength( 5 );
+$field->validate_field;
+ok( !$field->has_errors, 'Test just long enough' );
+$field->minlength( 4 );
+$field->validate_field;
+ok( !$field->has_errors, 'Test plenty long enough' );
+$field = $class->new( name => 'test_not_nullable', not_nullable => 1);
+$field->input('');
+$field->validate_field;
+is( $field->value, '', 'empty string');
+
+# weekday
+
+$class = 'HTML::FormHandler::Field::Weekday';
+use_ok( $class );
+$field = $class->new( name => 'test_field',);
+ok( defined $field, 'new() called' );
+for ( 0 .. 6 ) {
+ $field->_set_input( $_ );
+ $field->validate_field;
+ ok( !$field->has_errors, $_ . ' is valid' );
+}
+$field->_set_input( -1 );
+$field->validate_field;
+ok( $field->has_errors, '-1 is not valid day of the week' );
+$field->_set_input( 7 );
+$field->validate_field;
+ok( $field->has_errors, '7 is not valid day of the week' );
+
+# year
+
+$class = 'HTML::FormHandler::Field::Year';
+use_ok( $class );
+$field = $class->new( name => 'test_field' );
+ok( defined $field, 'new() called' );
+$field->_set_input( 0 );
+$field->validate_field;
+ok( $field->has_errors, '0 is bad year' );
+$field->_set_input( (localtime)[5] + 1900 );
+$field->validate_field;
+ok ( !$field->has_errors, 'Now is just a fine year' );
+$field->_set_input( 2100 );
+$field->validate_field;
+ok( $field->has_errors, '2100 makes the author really old' );
+
+done_testing;
diff --git a/t/filters.t b/t/filters.t
new file mode 100644
index 0000000..52ae616
--- /dev/null
+++ b/t/filters.t
@@ -0,0 +1,145 @@
+use strict;
+use warnings;
+
+use Test::More;
+use lib 't/lib';
+
+use DateTime;
+use Scalar::Util qw(blessed);
+
+{
+ package My::Form;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ use Moose::Util::TypeConstraints;
+
+ subtype 'MyStr'
+ => as 'Str'
+ => where { /^a/ };
+
+ subtype 'MyInt'
+ => as 'Int';
+
+ coerce 'MyInt'
+ => from 'MyStr'
+ => via { return $1 if /(\d+)/ };
+
+ type 'MyDateTime'
+ => message { 'This is not a correct date' }
+ => where { blessed $_[0] && $_[0]->isa( 'DateTime' ) };
+ coerce 'MyDateTime'
+ => from 'HashRef'
+ => via { DateTime->new( $_ ) };
+
+ has_field 'coderef_transform'=> (
+ apply => [{ transform => \&my_transform }]
+ );
+ has_field 'sprintf_filter' => (
+ apply => [ { transform => sub{ sprintf '<%.1g>', $_[0] } } ]
+ );
+ has_field 'regex_trim' => (
+ 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' } ],
+ );
+ has_field 'date_time' => (
+ type => 'Compound',
+ apply => [ { 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', );
+
+ has_field 'coerce_error' => (
+ apply => [ 'MyInt' ]
+ );
+ has_field 'coerce_pass' => (
+ apply => [ 'MyInt' ]
+ );
+
+ has_field 'date_coercion_pass' => (
+ type => 'Compound',
+ apply => [ 'MyDateTime' ],
+ );
+ has_field 'date_coercion_pass.year' => ( type => 'Text', );
+ has_field 'date_coercion_pass.month' => ( type => 'Text', );
+ has_field 'date_coercion_pass.day' => ( type => 'Text', );
+
+ has_field 'date_coercion_error' => (
+ type => 'Compound',
+ apply => [ 'MyDateTime' ],
+ );
+ has_field 'date_coercion_error.year' => ( type => 'Text', );
+ has_field 'date_coercion_error.month' => ( type => 'Text', );
+ has_field 'date_coercion_error.day' => ( type => 'Text', );
+
+ has_field 'date_time_fif' => (
+ type => 'Compound',
+ apply => [ { transform => sub{ DateTime->new( $_[0] ) } } ],
+ inflation => sub { { year => 1000, month => 1, day => 1 } },
+ fif_from_value => 1,
+ );
+ has_field 'date_time_fif.year' => ( fif_from_value => 1 );
+ has_field 'date_time_fif.month';
+ has_field 'date_time_fif.day' => ( fif_from_value => 1 );
+
+ sub my_transform {
+ $_[0] =~ s/testing/IT WORKED/g;
+ return $_[0];
+ }
+}
+
+
+my $form = My::Form->new();
+ok( $form, 'get form' );
+
+my $params = {
+ sprintf_filter => '100',
+ regex_trim => " xxxy \n",
+ coderef_transform => 'testing',
+ date_time_error => 'aaa',
+ 'date_time.year' => 2009,
+ 'date_time.month' => 4,
+ 'date_time.day' => 16,
+ coerce_error => 'b10',
+ coerce_pass => 'a10',
+ 'date_coercion_pass.year' => 2009,
+ 'date_coercion_pass.month' => 4,
+ 'date_coercion_pass.day' => 16,
+ 'date_coercion_error.year' => 2009,
+ 'date_coercion_error.month' => 20,
+ 'date_coercion_error.day' => 16,
+ 'date_time_fif.year' => 2009,
+ 'date_time_fif.month' => 4,
+ 'date_time_fif.day' => 16,
+};
+$form->process($params);
+
+like( $form->field('sprintf_filter')->value, qr/<1e\+0+2>/, 'sprintf filter' );
+is( $form->field('regex_trim')->value, 'xxxy', 'regex trim' );
+is( $form->field('coderef_transform')->value, 'IT WORKED', 'coderef transform' );
+ok( $form->field('date_time_error')->has_errors, 'DateTime error catched' );
+is( $form->field('date_time_error')->errors->[0], 'Not a valid DateTime', 'error message');
+is( ref $form->field('date_time')->value, 'DateTime', 'DateTime object created' );
+ok( $form->field('coerce_error')->has_errors, 'no suitable coercion - error' );
+is( $form->field('coerce_pass')->value, 10, 'coercion filter' );
+is( ref $form->field('date_coercion_pass')->value, 'DateTime', 'values coerced to DateTime object' );
+ok( $form->field('date_coercion_error')->has_errors, 'DateTime coercion error' );
+my $message = $form->field('date_coercion_error')->errors->[0];
+is( $message, 'This is not a correct date', 'Error message for coercion' );
+
+is( $form->field( 'date_time_fif.year' )->fif, 2009, 'fif for year' );
+$params->{'date_time_fif.year'} = 2009;
+$params->{'date_time_fif.day'} = 16;
+is_deeply( $form->fif, $params, 'fif is correct' );
+is( $form->value->{date_time_fif}->year, 2009, 'right value' );
+
+done_testing;
diff --git a/t/form_handler.t b/t/form_handler.t
new file mode 100644
index 0000000..a425bd7
--- /dev/null
+++ b/t/form_handler.t
@@ -0,0 +1,181 @@
+use strict;
+use warnings;
+use Test::More;
+
+use_ok('HTML::FormHandler');
+
+{
+
+ package My::Form;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has '+name' => ( default => 'testform_' );
+ has_field 'optname' => ( temp => 'First' );
+ has_field 'reqname' => ( required => 1 );
+ has_field 'somename';
+ has_field 'my_selected' => ( type => 'Checkbox' );
+ has_field 'must_select' => ( type => 'Checkbox', required => 1 );
+
+ sub field_list
+ {
+ return [
+ fruit => 'Select',
+ optname => { temp => 'Second' }
+ ];
+ }
+
+ sub options_fruit
+ {
+ return (
+ 1 => 'apples',
+ 2 => 'oranges',
+ 3 => 'kiwi',
+ );
+ }
+}
+
+my $form = My::Form->new;
+
+is( $form->field('optname')->temp, 'Second', 'got second optname field' );
+
+ok( !$form->process, 'Empty data' );
+
+my $good = {
+ reqname => 'hello',
+ optname => 'not req',
+ fruit => 2,
+ must_select => 1,
+};
+
+ok( $form->process($good), 'Good data' );
+is( $form->field('somename')->value, undef, 'no value for somename' );
+ok( !$form->field('somename')->has_value, 'predicate no value' );
+$good->{somename} = 'testing';
+$form->process($good);
+is( $form->field('somename')->value, 'testing', 'use input for extra data' );
+is( $form->field('my_selected')->value, 0, 'correct value for unselected checkbox' );
+
+ok( !$form->process( {} ), 'form doesn\'t validate with empty params' );
+is( $form->num_errors, 0, 'form doesn\'t have errors with empty params' );
+
+my $bad_1 = {
+ reqname => '',
+ optname => 'not req',
+ fruit => 4,
+};
+
+ok( !$form->process($bad_1), 'bad 1' );
+ok( $form->field('fruit')->has_errors, 'fruit has error' );
+ok( $form->field('reqname')->has_errors, 'reqname has error' );
+ok( $form->field('must_select')->has_errors, 'must_select has error' );
+ok( !$form->field('optname')->has_errors, 'optname has no error' );
+is( $form->field('fruit')->id, "fruit", 'field has id' );
+is( $form->field('fruit')->label, 'Fruit', 'field label' );
+
+ok( !$form->process( {} ), 'no leftover params' );
+is( $form->num_errors, 0, 'no leftover errors' );
+ok( !$form->field('reqname')->has_errors, 'no leftover error in field' );
+ok( !$form->field('optname')->fif, 'no lefover fif values' );
+
+my $init_object = {
+ reqname => 'Starting Perl',
+ optname => 'Over Again'
+};
+
+$form = My::Form->new( init_object => $init_object );
+is( $form->field('optname')->value, 'Over Again', 'value with int_obj' );
+$form->process( params => {} );
+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
+# initial object (as opposed to hash), but it used to behave
+# differently for a hash, which seems wrong
+# TODO verify behavior is correct
+my $init_obj_plus_defaults = {
+ 'fruit' => undef,
+ 'must_select' => 0,
+ 'my_selected' => 0,
+ 'optname' => 'Over Again',
+ 'reqname' => 'Starting Perl',
+ 'somename' => undef,
+};
+is_deeply( $form->value, $init_obj_plus_defaults, 'value with empty params' );
+$init_object->{my_selected} = 0; # checkboxes must be forced to 0
+my %fif = %$init_object;
+$fif{somename} = '';
+$fif{fruit} = '';
+$fif{must_select} = 0;
+is_deeply( $form->fif, \%fif, 'get right fif with init_object' );
+# make sure that checkbox is 0 in values
+$init_object->{must_select} = 1;
+$fif{must_select} = 1;
+ok( $form->process($init_object), 'form validates with params' );
+#my %init_obj_value = (%$init_object, fruit => undef );
+#is_deeply( $form->value, \%init_obj_value, 'value init obj' );
+is_deeply( $form->value, $init_object, 'value init obj' );
+is_deeply( $form->fif, \%fif, 'get right fif with init_object' );
+
+$form->clear;
+ok( !$form->has_value, 'Form value cleared' );
+ok( !$form->has_input, 'Form input cleared' );
+
+# check that form is cleared if fif is done before process
+$form->fif;
+$form->process($init_object);
+is_deeply( $form->fif, \%fif, 'get right fif when process preceded by fif');
+
+$form = HTML::FormHandler->new( field_list => [ foo => { type => 'Text', required => 1 } ] );
+
+if ( !$form->process( params => { bar => 1, } ) )
+{
+ # On some versions, the above process() returned false, but
+ # error_fields did not return anything.
+ my @fields = $form->error_fields;
+ if ( is( scalar @fields, 1, "there is an error field" ) )
+ {
+ my @errors = $fields[0]->all_errors;
+ is( scalar @errors, 1, "there is an error" );
+
+ is( $errors[0], $fields[0]->label . " field is required", "error messages match" );
+ }
+ else
+ {
+ fail("there is an error");
+ fail("error messages match");
+ }
+}
+
+# 'image' input produces { foo => bar, 'foo.x' => 42, 'foo.y' => 23 }
+$form = HTML::FormHandler->new( name => 'baz', html_prefix => 1, field_list => [ 'foo' ] );
+eval{ $form->process( params => { 'baz.foo' => 'bar', 'baz.foo.x' => 42, 'baz.foo.y' => 23 } ) };
+ok( !$@, 'image field processed' ) or diag $@;
+is_deeply( $form->field( 'foo' )->value, { '' => 'bar', x => 42, y => 23 }, 'image field' );
+
+{
+ package Test::Form;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has_field 'foo';
+ has_field 'bar';
+
+ sub validate {
+ my $self = shift;
+ if( $self->field('foo')->value eq 'cow' ) {
+ $self->field('foo')->value('bovine');
+ }
+ }
+}
+$form = Test::Form->new;
+$form->process( { foo => 'cow', bar => 'horse' } );
+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
new file mode 100644
index 0000000..c0cb019
--- /dev/null
+++ b/t/form_options.t
@@ -0,0 +1,126 @@
+use strict;
+use warnings;
+use Test::More;
+use HTML::FormHandler::Field::Text;
+
+
+{
+ package Test::Form;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has '+name' => ( default => 'options_form' );
+ has_field 'test_field' => (
+ type => 'Text',
+ label => 'TEST',
+ id => 'f99',
+ );
+ has_field 'fruit' => ( type => 'Select' );
+ has_field 'vegetables' => ( type => 'Multiple', input_without_param => [], not_nullable => 1 );
+ has_field 'empty' => ( type => 'Multiple' );
+ has_field 'build_attr' => ( type => 'Select' );
+
+ sub init_value_fruit { 2 }
+
+ # the following sometimes happens with db options
+ sub options_empty { ([]) }
+
+ has 'options_fruit' => ( is => 'rw', traits => ['Array'],
+ default => sub { [1 => 'apples', 2 => 'oranges',
+ 3 => 'kiwi'] } );
+
+ sub options_vegetables {
+ return (
+ 1 => 'lettuce',
+ 2 => 'broccoli',
+ 3 => 'carrots',
+ 4 => 'peas',
+ );
+ }
+
+ has 'options_build_attr' => ( is => 'ro', traits => ['Array'], lazy_build => 1 );
+
+ sub _build_options_build_attr {
+ return [
+ 1 => 'testing',
+ 2 => 'moose',
+ 3 => 'attr builder',
+ ];
+ }
+}
+
+
+my $form = Test::Form->new;
+ok( $form, 'create form');
+
+my $veg_options = [ {'label' => 'lettuce',
+ 'value' => 1 },
+ {'label' => 'broccoli',
+ 'value' => 2 },
+ {'label' => 'carrots',
+ 'value' => 3 },
+ {'label' => 'peas',
+ 'value' => 4 } ];
+my $field_options = $form->field('vegetables')->options;
+is_deeply( $field_options, $veg_options,
+ 'get options for vegetables' );
+
+my $fruit_options = [ {'label' => 'apples',
+ 'value' => 1 },
+ {'label' => 'oranges',
+ 'value' => 2 },
+ {'label' => 'kiwi',
+ 'value' => 3 } ];
+$field_options = $form->field('fruit')->options;
+is_deeply( $field_options, $fruit_options,
+ 'get options for fruit' );
+
+my $build_attr_options = [ {'label' => 'testing',
+ 'value' => 1 },
+ {'label' => 'moose',
+ 'value' => 2 },
+ {'label' => 'attr builder',
+ 'value' => 3 } ];
+$field_options = $form->field('build_attr')->options;
+is_deeply( $field_options, $build_attr_options,
+ 'get options for fruit' );
+
+my $params = {
+ fruit => 2,
+ vegetables => [2,4],
+ empty => '',
+};
+
+is( $form->field('fruit')->value, 2, 'initial value ok');
+
+$form->process( params => {},
+ init_object => { vegetables => undef, fruit => undef, build_attr => undef } );
+$field_options = $form->field('vegetables')->options;
+is_deeply( $field_options, $veg_options,
+ 'get options for vegetables after process' );
+$field_options = $form->field('fruit')->options;
+is_deeply( $field_options, $fruit_options,
+ 'get options for fruit after process' );
+$field_options = $form->field('build_attr')->options;
+is_deeply( $field_options, $build_attr_options,
+ 'get options for fruit after process' );
+
+
+$form->process( $params );
+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 => '', empty => '', build_attr => '' },
+ 'fif is correct');
+is_deeply( $form->values, { fruit => 2, vegetables => [2, 4], empty => undef },
+ 'values are correct');
+
+$params = {
+ fruit => 2,
+};
+$form->process($params);
+is_deeply( $form->field('vegetables')->value, [], 'value for vegetables correct' );
+
+
+done_testing;
diff --git a/t/formhandlerx.t b/t/formhandlerx.t
new file mode 100644
index 0000000..89b02e4
--- /dev/null
+++ b/t/formhandlerx.t
@@ -0,0 +1,52 @@
+use strict;
+use warnings;
+use Test::More;
+use Test::Exception;
+
+{
+ package HTML::FormHandlerX::Widget::Field::TesT;
+ use Moose::Role;
+ sub render { '<p>field rendered...</p>' }
+
+}
+
+{
+ package HTML::FormHandlerX::Field::TesT;
+ use Moose;
+ extends 'HTML::FormHandler::Field::Text';
+
+ has '+widget' => ( default => 'TesT' );
+}
+
+{
+ package Test::HTML::FormHandler::TextFormHandlerX;
+
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has_field 'field_name' => (
+ type => 'TesT',
+ required => 1,
+ );
+}
+
+my $form = Test::HTML::FormHandler::TextFormHandlerX->new;
+ok( $form, 'created Form' );
+my %params = (
+ field_name => 'This is a field',
+);
+$form->process(params=>\%params);
+is( $form->field('field_name')->widget, 'TesT', 'got right widget name' );
+is( $form->field('field_name')->render, '<p>field rendered...</p>', 'field rendered' );
+
+{
+ package Test::Fail;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has_field 'foo' => ( type => 'Fail' );
+}
+
+dies_ok( sub { Test::Fail->new }, 'form dies with invalid field' );
+
+done_testing;
diff --git a/t/has_field.t b/t/has_field.t
new file mode 100644
index 0000000..eb091fa
--- /dev/null
+++ b/t/has_field.t
@@ -0,0 +1,36 @@
+use Test::More;
+
+use lib 't/lib';
+
+use_ok( 'HTML::FormHandler' );
+
+use_ok( 'Form::Two' );
+my $form = Form::Two->new;
+ok( $form, 'get subclassed form' );
+is( $form->field('optname')->temp, 'Txxt', 'field new attribute');
+ok( $form->field('reqname'), 'get old field' );
+is( $form->field('reqname')->temp, 'Abc', 'new attribute' );
+is( $form->field('reqname')->required, 1, 'old attribute');
+ok( $form->field('fruit'), 'fruit field' );
+
+use_ok( 'Form::Test' );
+$form = Form::Test->new;
+ok( $form, 'get base form' );
+ok( !$form->field('new_field'), 'no new field');
+ok( $form->field('optname'), 'base field exists');
+
+# forms with multiple inheritance
+use_ok( 'Form::Multiple' );
+$form = Form::Multiple->new;
+ok( $form, 'create multiple inheritance form' );
+ok( $form->field('city'), 'field from superclass exists' );
+ok( $form->field('telephone'), 'field from other superclass exists' );
+
+# forms with roles
+use_ok( 'Form::MultipleRole');
+$form = Form::MultipleRole->new;
+ok( $form, 'get form with roles' );
+ok( $form->field('street'), 'field from Address role' );
+ok( $form->field('email'), 'field from Person role' );
+
+done_testing;
diff --git a/t/has_field_arrayref.t b/t/has_field_arrayref.t
new file mode 100644
index 0000000..7cb6b01
--- /dev/null
+++ b/t/has_field_arrayref.t
@@ -0,0 +1,41 @@
+package Test::HTML::FormHandler::HasFieldArrayRef;
+
+use HTML::FormHandler::Moose;
+extends 'HTML::FormHandler';
+
+has_field [qw/home work mobile/] => (type=>'Text', required=>1);
+
+no HTML::FormHandler::Moose;
+
+use Test::More;
+
+ok my $form1 = Test::HTML::FormHandler::HasFieldArrayRef->new,
+ 'Created Form';
+
+ok my %params1 = (
+ home => '1112223333',
+ work => '4445556666',
+ mobile => '7778889999',
+), 'Created Params Hash';
+
+ok my $result1 = $form1->process(params=>\%params1),
+ 'got good result';
+
+ok !$form1->has_errors,
+ 'No errors';
+
+ok my $form2 = Test::HTML::FormHandler::HasFieldArrayRef->new,
+ 'Created Form';
+
+ok my %params2 = (
+ home => '1112223333',
+ work => '4445556666',
+), 'Created Params Hash';
+
+ok ! (my $result2 = $form2->process(params=>\%params2)),
+ 'got correct failing result';
+
+ok $form2->has_errors,
+ 'Yes there are errors';
+
+done_testing;
diff --git a/t/has_many.t b/t/has_many.t
new file mode 100644
index 0000000..ebe6d42
--- /dev/null
+++ b/t/has_many.t
@@ -0,0 +1,185 @@
+use strict;
+use warnings;
+use Test::More;
+
+use_ok( 'HTML::FormHandler::Field::Repeatable' );
+use_ok( 'HTML::FormHandler::Field::Repeatable::Instance' );
+
+{
+ package Repeatable::Form;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has_field 'my_test';
+ has_field 'addresses' => ( type => 'Repeatable', auto_id => 1 );
+ has_field 'addresses.street';
+ has_field 'addresses.city';
+ has_field 'addresses.country';
+ has_field 'addresses.sector' => ( type => 'Select' );
+
+ has_field 'apples' => ( type => 'Repeatable' );
+ has_field 'apples.id' => ( type => 'Select' );
+
+ sub options_addresses_sector
+ {
+ [ 1 => 'East',
+ 2 => 'West',
+ 3 => 'South'
+ ]
+ }
+
+ sub options_apples_id {
+ [ 1 => 'Red',
+ 2 => 'Green',
+ ]
+ }
+}
+
+my $form = Repeatable::Form->new;
+
+ok( $form, 'created hasmany form');
+
+$form = Repeatable::Form->new;
+ok( $form->field('addresses')->has_fields, 'created form again with fields');
+
+# empty form, creating new record
+$form->process( params => {} );
+ok( $form->field('addresses')->field('0')->field('city'), 'empty field exists' );
+is( $form->field('addresses')->field('0')->field('sector')->num_options, 3, 'right number of options');
+
+my $init_object = {
+ addresses => [
+ {
+ street => 'First Street',
+ city => 'Prime City',
+ country => 'Utopia',
+ id => 0,
+ },
+ {
+ street => 'Second Street',
+ city => 'Secondary City',
+ country => 'Graustark',
+ id => 1,
+ },
+ {
+ street => 'Third Street',
+ city => 'Tertiary City',
+ country => 'Atlantis',
+ id => 2,
+ }
+ ],
+ apples => [
+ {},
+ ]
+};
+
+$form = Repeatable::Form->new( init_object => $init_object );
+ok( $form, 'created form from initial 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;
+$init_object->{addresses}->[2]->{sector} = undef;
+$init_object->{apples}->[0]->{id} = undef;
+is_deeply( $form->values, $init_object, 'get values back out' );
+delete $init_object->{my_test};
+is_deeply( $form->field('addresses')->value, $init_object->{addresses}, 'hasmany field value');
+is_deeply( $form->field('addresses')->field('0')->value, $init_object->{addresses}->[0],
+ 'instance field value' );
+is( $form->field('addresses')->field('0')->field('sector')->num_options, 3, 'right number of options');
+is( $form->field('addresses')->field('0')->field('city')->value, 'Prime City',
+ 'compound subfield value');
+
+my $fif = {
+ 'addresses.0.street' => 'First Street',
+ 'addresses.0.city' => 'Prime City',
+ 'addresses.0.country' => 'Utopia',
+ 'addresses.0.id' => '0',
+ 'addresses.0.sector' => '',
+ 'addresses.1.street' => 'Second Street',
+ 'addresses.1.city' => 'Secondary City',
+ 'addresses.1.country' => 'Graustark',
+ 'addresses.1.id' => '1',
+ 'addresses.1.sector' => '',
+ 'addresses.2.street' => 'Third Street',
+ 'addresses.2.city' => 'Tertiary City',
+ 'addresses.2.country' => 'Atlantis',
+ 'addresses.2.id' => '2',
+ 'addresses.2.sector' => '',
+ 'my_test' => '',
+ 'apples.0.id' => '',
+};
+
+is_deeply( $form->fif, $fif, 'get fill in form');
+$fif->{'addresses.0.city'} = 'Primary City';
+$fif->{'addresses.2.country'} = 'Grand Fenwick';
+delete $fif->{my_test};
+$form->clear;
+$form->process($fif);
+ok($form->validated, 'validate fif');
+$fif->{my_test} = '';
+is_deeply( $form->fif, $fif, 'still get right fif');
+$init_object->{addresses}->[0]->{city} = 'Primary City';
+$init_object->{addresses}->[2]->{country} = 'Grand Fenwick';
+$init_object->{apples} = [ undef ];
+is_deeply( $form->values, $init_object, 'still get right values');
+
+$fif = {
+ 'addresses.0.street' => 'First Street',
+ 'addresses.0.city' => 'Prime City',
+ 'addresses.0.country' => 'Utopia',
+ 'addresses.0.id' => '0',
+ 'addresses.0.sector' => undef,
+ 'addresses.2.street' => 'Third Street',
+ 'addresses.2.city' => 'Tertiary City',
+ 'addresses.2.country' => 'Atlantis',
+ 'addresses.2.id' => '2',
+ 'addresses.2.sector' => undef,
+};
+
+$form->process($fif);
+
+ok( $form->validated, 'form validated' );
+is( $form->field('addresses')->num_fields, 2, 'right number of fields');
+
+$fif = {
+ 'addresses.0.street' => 'Main Street',
+ 'addresses.0.city' => 'Prime City',
+ 'addresses.0.country' => 'Utopia',
+ 'addresses.0.id' => '0',
+ 'addresses.0.sector' => undef,
+};
+
+ok( $form->process($fif), 'process a single repeatable element');
+is( $form->field('addresses')->field('0')->field('street')->value, 'Main Street', 'get value');
+is( $form->field('addresses')->field('0')->field('sector')->num_options, 3, 'right number of options');
+
+my $values = {
+ 'addresses' => [
+ {
+ 'city' => 'Prime City',
+ 'country' => 'Utopia',
+ 'id' => 0,
+ 'street' => 'Main Street',
+ 'sector' => undef,
+ },
+ ],
+ apples => []
+};
+is_deeply( $form->values, $values, 'get right values' );
+
+my $no_repeat = {
+ my_test => 'test'
+};
+$form->process( $no_repeat );
+is_deeply( $form->value()->{addresses}, [], 'Addresses deleted not in params' );
+
+$form->process({});
+ok( exists $form->value->{addresses}[0], 'Addresses are back' );
+is( $form->field('addresses')->field('0')->field('sector')->num_options, 3, 'right number of options');
+$form->clear_init_object;
+$form->process( { my_test => 'test' } );
+is_deeply( $form->value()->{addresses}, [], 'Addresses deleted' );
+
+done_testing;
diff --git a/t/inactive_fields.t b/t/inactive_fields.t
new file mode 100644
index 0000000..23fd307
--- /dev/null
+++ b/t/inactive_fields.t
@@ -0,0 +1,40 @@
+use strict;
+use warnings;
+use Test::More;
+
+{
+ package Test::Form;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has_field 'bar';
+ has_field 'foo' => ( inactive => 1 );
+ has_field 'foo_checkbox' => ( type => 'Checkbox', inactive => 1 );
+}
+
+my $form = Test::Form->new;
+ok( $form, 'form builds' );
+
+is( $form->num_fields, 3, 'right number of fields' );
+is( scalar @{$form->sorted_fields}, 1, 'right number of sorted fields' );
+
+$form->field('foo')->clear_inactive;
+is( scalar @{$form->sorted_fields}, 2, 'right number of sorted fields after clear_inactive' );
+
+my $fif = {
+ bar => 'bar_test',
+ foo => 'foo_test',
+};
+$form->process($fif);
+ok( $form->validated, 'form validated' );
+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 );
+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/input_param.t b/t/input_param.t
new file mode 100644
index 0000000..29f0f5e
--- /dev/null
+++ b/t/input_param.t
@@ -0,0 +1,40 @@
+package Test::HTML::FormHandler::InputParam;
+
+use HTML::FormHandler::Moose;
+extends 'HTML::FormHandler';
+
+has_field 'base_name' => (
+ type => 'Text',
+ required => 1,
+ input_param=> 'input_name',
+);
+
+use Test::More;
+
+ok my $form1 = Test::HTML::FormHandler::InputParam->new,
+ 'Created Form';
+
+ok my %params1 = (
+ input_name => 'This is a mapped input',
+), 'Created Params Hash';
+
+ok my $result1 = $form1->process(params=>\%params1),
+ 'got good result';
+
+ok !$form1->has_errors,
+ 'No errors';
+
+ok my $form2 = Test::HTML::FormHandler::InputParam->new,
+ 'Created Form';
+
+ok my %params2 = (
+ base_name => 'This is a mapped input',
+), 'Created Params Hash';
+
+ok ! (my $result2 = $form2->process(params=>\%params2)),
+ 'got correct failing result';
+
+ok $form2->has_errors,
+ 'Yes there are errors';
+
+done_testing;
diff --git a/t/lib/BookDB/Form/Upload.pm b/t/lib/BookDB/Form/Upload.pm
new file mode 100644
index 0000000..43776bd
--- /dev/null
+++ b/t/lib/BookDB/Form/Upload.pm
@@ -0,0 +1,11 @@
+package BookDB::Form::Upload;
+
+use HTML::FormHandler::Moose;
+extends 'HTML::FormHandler';
+
+has '+enctype' => ( default => 'multipart/form-data');
+
+has_field 'file' => ( type => 'Upload' );
+has_field 'submit' => ( type => 'Submit', value => 'Upload' );
+
+1;
diff --git a/t/lib/Field/Address.pm b/t/lib/Field/Address.pm
new file mode 100644
index 0000000..f3bc4f5
--- /dev/null
+++ b/t/lib/Field/Address.pm
@@ -0,0 +1,12 @@
+package Field::Address;
+
+use HTML::FormHandler::Moose;
+extends 'HTML::FormHandler::Field::Compound';
+
+has_field 'street';
+has_field 'city';
+has_field 'country';
+
+
+no HTML::FormHandler::Moose;
+1;
diff --git a/t/lib/Field/AltText.pm b/t/lib/Field/AltText.pm
new file mode 100644
index 0000000..dbff807
--- /dev/null
+++ b/t/lib/Field/AltText.pm
@@ -0,0 +1,25 @@
+package Field::AltText;
+
+use Moose;
+extends 'HTML::FormHandler::Field::Text';
+
+
+has 'another_attribute' => ( isa => 'Str', is => 'rw' );
+
+sub validate
+{
+ my $field = shift;
+
+ return unless $field->SUPER::validate;
+
+ my $input = $field->input;
+ my $check = $field->another_attribute;
+ # do something silly
+ return $field->add_error('Fails AltText validation')
+ unless $input =~ m/$check/;
+
+ return 1;
+}
+
+no Moose;
+1;
diff --git a/t/lib/Field/MyField.pm b/t/lib/Field/MyField.pm
new file mode 100644
index 0000000..3db2201
--- /dev/null
+++ b/t/lib/Field/MyField.pm
@@ -0,0 +1,11 @@
+package Field::MyField;
+
+use HTML::FormHandler::Moose;
+extends 'HTML::FormHandler::Field::Text';
+
+has '+widget' => ( default => 'password' );
+has '+min_length' => ( default => 6 );
+
+__PACKAGE__->meta->make_immutable;
+no Moose;
+1;
diff --git a/t/lib/Form/Address.pm b/t/lib/Form/Address.pm
new file mode 100644
index 0000000..90715bd
--- /dev/null
+++ b/t/lib/Form/Address.pm
@@ -0,0 +1,12 @@
+package Form::Address;
+
+use HTML::FormHandler::Moose;
+extends 'HTML::FormHandler';
+
+has_field 'street';
+has_field 'city';
+has_field 'state';
+has_field 'zip';
+
+no HTML::FormHandler::Moose;
+1;
diff --git a/t/lib/Form/AddressRole.pm b/t/lib/Form/AddressRole.pm
new file mode 100644
index 0000000..9734898
--- /dev/null
+++ b/t/lib/Form/AddressRole.pm
@@ -0,0 +1,11 @@
+package Form::AddressRole;
+
+use HTML::FormHandler::Moose::Role;
+
+has_field 'street';
+has_field 'city';
+has_field 'state';
+has_field 'zip';
+
+no HTML::FormHandler::Moose::Role;
+1;
diff --git a/t/lib/Form/Multiple.pm b/t/lib/Form/Multiple.pm
new file mode 100644
index 0000000..cd1d0ba
--- /dev/null
+++ b/t/lib/Form/Multiple.pm
@@ -0,0 +1,8 @@
+package Form::Multiple;
+
+use Moose;
+extends ('Form::Person', 'Form::Address');
+
+
+no Moose;
+1;
diff --git a/t/lib/Form/MultipleRole.pm b/t/lib/Form/MultipleRole.pm
new file mode 100644
index 0000000..b93c614
--- /dev/null
+++ b/t/lib/Form/MultipleRole.pm
@@ -0,0 +1,10 @@
+package Form::MultipleRole;
+
+use HTML::FormHandler::Moose;
+extends 'HTML::FormHandler';
+with 'Form::PersonRole';
+with 'Form::AddressRole';
+
+
+no HTML::FormHandler::Moose;
+1;
diff --git a/t/lib/Form/MyForm.pm b/t/lib/Form/MyForm.pm
new file mode 100644
index 0000000..b3c6f7f
--- /dev/null
+++ b/t/lib/Form/MyForm.pm
@@ -0,0 +1,10 @@
+package Form::MyForm;
+use strict;
+use warnings;
+
+use HTML::FormHandler;
+
+use HTML::FormHandler::Moose;
+extends 'HTML::FormHandler';
+
+has_field 'optname' => ( min_length => 5, required => 1 );
diff --git a/t/lib/Form/Person.pm b/t/lib/Form/Person.pm
new file mode 100644
index 0000000..b9df573
--- /dev/null
+++ b/t/lib/Form/Person.pm
@@ -0,0 +1,11 @@
+package Form::Person;
+
+use HTML::FormHandler::Moose;
+extends 'HTML::FormHandler';
+
+has_field 'name';
+has_field 'telephone';
+has_field 'email';
+
+no HTML::FormHandler::Moose;
+1;
diff --git a/t/lib/Form/PersonRole.pm b/t/lib/Form/PersonRole.pm
new file mode 100644
index 0000000..ddd4752
--- /dev/null
+++ b/t/lib/Form/PersonRole.pm
@@ -0,0 +1,10 @@
+package Form::PersonRole;
+
+use HTML::FormHandler::Moose::Role;
+
+has_field 'name';
+has_field 'telephone';
+has_field 'email';
+
+no HTML::FormHandler::Moose::Role;
+1;
diff --git a/t/lib/Form/Test.pm b/t/lib/Form/Test.pm
new file mode 100644
index 0000000..ccc2197
--- /dev/null
+++ b/t/lib/Form/Test.pm
@@ -0,0 +1,23 @@
+package Form::Test;
+
+use HTML::FormHandler::Moose;
+extends 'HTML::FormHandler';
+
+has '+name' => ( default => 'TestForm');
+
+has_field 'reqname' => ( type => 'Text', required => 1 );
+has_field 'optname' => ( type => 'Text' );
+has_field 'fruit' => ( type => 'Select' );
+
+
+sub options_fruit {
+ return (
+ 1 => 'apples',
+ 2 => 'oranges',
+ 3 => 'kiwi',
+ );
+}
+
+no HTML::FormHandler::Moose;
+1;
+
diff --git a/t/lib/Form/Two.pm b/t/lib/Form/Two.pm
new file mode 100644
index 0000000..d4c23c5
--- /dev/null
+++ b/t/lib/Form/Two.pm
@@ -0,0 +1,12 @@
+package Form::Two;
+
+use HTML::FormHandler::Moose;
+extends 'Form::Test';
+
+has '+name' => ( default => 'FormTwo' );
+has_field 'new_field' => ( required => 1 );
+has_field 'optname' => ( temp => 'Txxt' );
+has_field '+reqname' => ( temp => 'Abc' );
+
+no HTML::FormHandler::Moose;
+1;
diff --git a/t/lib/MyApp/I18N/abc_de.pm b/t/lib/MyApp/I18N/abc_de.pm
new file mode 100644
index 0000000..6c87a4d
--- /dev/null
+++ b/t/lib/MyApp/I18N/abc_de.pm
@@ -0,0 +1,11 @@
+package MyApp::I18N::abc_de;
+use base 'HTML::FormHandler::I18N';
+
+# Auto define lexicon
+our %Lexicon = (
+ '_AUTO' => 1,
+ 'You lost, insert coin' => 'Loser! coin needed',
+ 'Test field' => 'Asdf lkjh',
+);
+
+1;
diff --git a/t/lib/Perl/Critic/Policy/FormHandler/Deprecations.pm b/t/lib/Perl/Critic/Policy/FormHandler/Deprecations.pm
new file mode 100644
index 0000000..5040bfc
--- /dev/null
+++ b/t/lib/Perl/Critic/Policy/FormHandler/Deprecations.pm
@@ -0,0 +1,182 @@
+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/lib/Widget/Field/Omega.pm b/t/lib/Widget/Field/Omega.pm
new file mode 100644
index 0000000..bb0e598
--- /dev/null
+++ b/t/lib/Widget/Field/Omega.pm
@@ -0,0 +1,10 @@
+package Widget::Field::Omega;
+
+use Moose::Role;
+
+sub render
+{
+ return "<h1>You got here!</h1>";
+}
+
+1;
diff --git a/t/lib/Widget/Field/TestWidget.pm b/t/lib/Widget/Field/TestWidget.pm
new file mode 100644
index 0000000..17ab325
--- /dev/null
+++ b/t/lib/Widget/Field/TestWidget.pm
@@ -0,0 +1,10 @@
+package Widget::Field::TestWidget;
+
+use Moose::Role;
+
+sub render
+{
+ return "<p>The test succeeded.</p>";
+}
+
+1;
diff --git a/t/list.t b/t/list.t
new file mode 100644
index 0000000..58447a9
--- /dev/null
+++ b/t/list.t
@@ -0,0 +1,39 @@
+use strict;
+use warnings;
+use Test::More;
+
+use_ok('HTML::FormHandler::Field::Repeatable');
+
+{
+ package List::Form;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has_field 'tags' => ( type => 'Repeatable' );
+ has_field 'tags.contains';
+
+}
+
+my $form = List::Form->new;
+
+ok( $form, 'form created' );
+
+my $params = {
+ tags => ['linux', 'algorithms', 'loops'],
+};
+$form->process($params);
+
+ok( $form->validated, 'form validated' );
+
+is( $form->field('tags')->field('0')->value, 'linux', 'get correct value' );
+
+my $fif = {
+ 'tags.0' => 'linux',
+ 'tags.1' => 'algorithms',
+ 'tags.2' => 'loops',
+};
+is_deeply( $form->fif, $fif, 'fif is correct' );
+
+is_deeply( $form->values, $params, 'values are correct' );
+
+done_testing;
diff --git a/t/password.t b/t/password.t
new file mode 100644
index 0000000..9b473b4
--- /dev/null
+++ b/t/password.t
@@ -0,0 +1,128 @@
+use strict;
+use warnings;
+use Test::More;
+use lib 't/lib';
+
+use_ok( 'HTML::FormHandler::Field::Text' );
+
+my $field = HTML::FormHandler::Field::Text->new(
+ name => 'password',
+ type => 'Text',
+ required => 1,
+ password => 1,
+);
+
+is( $field->password, 1, 'password is set');
+
+$field->_set_value('abcdef');
+is( $field->value, 'abcdef', 'set and get value' );
+
+is( $field->fif, '', 'no fif for password');
+
+$field = HTML::FormHandler::Field::Text->new(
+ name => 'not_password',
+ type => 'Text',
+ required => 1,
+);
+
+is( $field->password, undef, 'password is not set');
+
+$field->_set_value('abcdef');
+is( $field->value, 'abcdef', 'set and get value' );
+
+is( $field->fif, 'abcdef', 'get fif');
+
+use HTML::FormHandler;
+use_ok( 'HTML::FormHandler::Field::Password' );
+
+{
+ package My::Form;
+
+ use Moose;
+ extends 'HTML::FormHandler';
+
+ sub field_list {
+ return [
+ login => 'Text',
+ username => 'Text',
+ password => { type => 'Password',
+ ne_username => 'username',
+ minlength => 6,
+ },
+ ];
+ }
+
+}
+
+
+my $form = My::Form->new;
+
+$field = $form->field('password');
+
+my $params = {
+ username => 'my4username',
+ password => 'something'
+};
+
+$form->process( $params );
+
+ok( $field, 'got password field' );
+
+$field->_set_input( '2192ab201def' );
+$field->validate_field;
+ok( !$field->has_errors, 'Test for errors 1' );
+
+$field->_set_input( 'ab1' );
+$field->validate_field;
+ok( $field->has_errors, 'too short' );
+
+$field->_set_input( 'my4username' );
+$field->validate_field;
+ok( $field->has_errors, 'matches username' );
+
+$field->_set_input( '' );
+$field->validate_field;
+ok( !$field->has_errors, 'empty password accepted' );
+is($field->noupdate, 1, 'noupdate has been set on password field' );
+
+my $pass = 'my4user5name';
+$field->_set_input( $pass );
+$field->validate_field;
+ok( !$field->has_errors, 'just right' );
+is ( $field->value, $pass, 'Input and value match' );
+
+
+
+{
+ package Password::Form;
+
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has '+field_name_space' => ( default => 'Field' );
+ has_field 'password' => ( type => 'Password', required => 1 );
+ has_field '_password' => ( type => 'PasswordConf', );
+
+}
+
+$form = Password::Form->new;
+ok( $form, 'form created' );
+
+$params = {
+ password => ''
+};
+
+$form->process( params => $params );
+ok( !$form->validated, 'form validated' );
+
+ok( !$form->field('password')->noupdate, q[noupdate is 'false' on password field] );
+
+ok( $form->field('_password')->has_errors, 'Password confirmation has errors' );
+
+$form->process( params => { password => 'aaaaaa', _password => 'bbbb' } );
+ok( $form->field('_password')->has_errors, 'Password confirmation has errors' );
+
+$form->process( params => { password => 'aaaaaa', _password => 'aaaaaa' } );
+ok( $form->validated, 'password confirmation validated' );
+
+done_testing;
diff --git a/t/render.t b/t/render.t
new file mode 100644
index 0000000..90055cd
--- /dev/null
+++ b/t/render.t
@@ -0,0 +1,213 @@
+use strict;
+use warnings;
+use Test::More;
+
+use HTML::FormHandler::Field::Text;
+
+
+{
+ package Test::Form;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+ with 'HTML::FormHandler::Render::Simple';
+
+ has '+name' => ( default => 'testform' );
+ has_field 'test_field' => (
+ size => 20,
+ label => 'TEST',
+ id => 'f99',
+ );
+ has_field 'number';
+ has_field 'fruit' => ( type => 'Select' );
+ has_field 'vegetables' => ( type => 'Multiple' );
+ has_field 'opt_in' => ( type => 'Select', widget => 'radio_group',
+ options => [{ value => 0, label => 'No'}, { value => 1, label => 'Yes'} ] );
+ has_field 'starch' => ( type => 'Multiple', widget => 'checkbox_group',
+ options => [{ value => 1, label => 'One'}, { value => 2, label => 'Two'},
+ { value => 3, label => 'Three' },
+ ] );
+ has_field 'active' => ( type => 'Checkbox' );
+ has_field 'comments' => ( type => 'TextArea' );
+ has_field 'hidden' => ( type => 'Hidden' );
+ has_field 'selected' => ( type => 'Boolean' );
+ has_field 'start_date' => ( type => 'DateTime' );
+ has_field 'start_date.month' => ( type => 'Integer', range_start => 1,
+ range_end => 12 );
+ has_field 'start_date.day' => ( type => 'Integer', range_start => 1,
+ range_end => 31 );
+ has_field 'start_date.year' => ( type => 'Integer', range_start => 2000,
+ range_end => 2020 );
+
+ has_field 'two_errors' => (
+ apply => [
+ { check => [ ], message => 'First constraint error' },
+ { check => [ ], message => 'Second constraint error' }
+ ]
+ );
+
+ has_field 'submit' => ( type => 'Submit', value => 'Update' );
+
+ has '+dependency' => ( default => sub { [ ['start_date.month',
+ 'start_date.day', 'start_date.year'] ] } );
+ has_field 'no_render' => ( widget => 'no_render' );
+ sub options_fruit {
+ return (
+ 1 => 'apples',
+ 2 => 'oranges',
+ 3 => 'kiwi',
+ );
+ }
+
+ sub options_vegetables {
+ return (
+ 1 => 'lettuce',
+ 2 => 'broccoli',
+ 3 => 'carrots',
+ 4 => 'peas',
+ );
+ }
+}
+
+
+my $form = Test::Form->new;
+ok( $form, 'create form');
+
+my $params = {
+ test_field => 'something',
+ number => 0,
+ fruit => 2,
+ vegetables => [2,4],
+ active => 'now',
+ comments => 'Four score and seven years ago...',
+ hidden => '1234',
+ selected => '1',
+ 'start_date.month' => '7',
+ 'start_date.day' => '14',
+ 'start_date.year' => '2006',
+ two_errors => 'aaa',
+ opt_in => 0,
+};
+
+$form->process( $params );
+
+is_deeply( $form->field('starch')->input_without_param, [], 'checkbox group settings' );
+is( $form->field('starch')->not_nullable, 1, 'checkbox group settings' );
+is_deeply( $form->value->{starch}, [], 'checkbox group value' );
+
+is( $form->render_field( $form->field('number') ),
+ '
+<div><label class="label" for="number">Number: </label><input type="text" name="number" id="number" value="0" /></div>
+',
+ "value '0' is rendered"
+);
+
+my $output1 = $form->render_field( $form->field('test_field') );
+is( $output1,
+ '
+<div><label class="label" for="f99">TEST: </label><input type="text" name="test_field" id="f99" size="20" value="something" /></div>
+',
+ 'output from text field');
+
+my $output2 = $form->render_field( $form->field('fruit') );
+is( $output2,
+ '
+<div><label class="label" for="fruit">Fruit: </label><select name="fruit" id="fruit"><option value="1" id="fruit.0" >apples</option><option value="2" id="fruit.1" selected="selected">oranges</option><option value="3" id="fruit.2" >kiwi</option></select></div>
+',
+ 'output from select field');
+
+my $output3 = $form->render_field( $form->field('vegetables') );
+is( $output3,
+ '
+<div><label class="label" for="vegetables">Vegetables: </label><select name="vegetables" id="vegetables" multiple="multiple" size="5"><option value="1" id="vegetables.0" >lettuce</option><option value="2" id="vegetables.1" selected="selected">broccoli</option><option value="3" id="vegetables.2" >carrots</option><option value="4" id="vegetables.3" selected="selected">peas</option></select></div>
+',
+'output from select multiple field');
+
+my $output4 = $form->render_field( $form->field('active') );
+is( $output4,
+ '
+<div><label class="label" for="active">Active: </label><input type="checkbox" name="active" id="active" value="1" /></div>
+',
+ 'output from checkbox field');
+
+my $output5 = $form->render_field( $form->field('comments') );
+is( $output5,
+ '
+<div><label class="label" for="comments">Comments: </label><textarea name="comments" id="comments" rows="5" cols="10">Four score and seven years ago...</textarea></div>
+',
+ 'output from textarea' );
+
+my $output6 = $form->render_field( $form->field('hidden') );
+is( $output6,
+ '
+<div><input type="hidden" name="hidden" id="hidden" value="1234" /></div>
+',
+ 'output from hidden field' );
+
+my $output7 = $form->render_field( $form->field('selected') );
+is( $output7,
+ '
+<div><label class="label" for="selected">Selected: </label><input type="checkbox" name="selected" id="selected" value="1" checked="checked" /></div>
+',
+ 'output from boolean' );
+
+my $output8 = $form->render_field( $form->field('start_date') );
+is( $output8,
+ '
+<div><fieldset class="start_date"><legend>Start date</legend>
+<div><label class="label" for="start_date.month">Month: </label><input type="text" name="start_date.month" id="start_date.month" size="8" value="7" /></div>
+
+<div><label class="label" for="start_date.day">Day: </label><input type="text" name="start_date.day" id="start_date.day" size="8" value="14" /></div>
+
+<div><label class="label" for="start_date.year">Year: </label><input type="text" name="start_date.year" id="start_date.year" size="8" value="2006" /></div>
+</fieldset></div>
+',
+ 'output from DateTime' );
+
+my $output9 = $form->render_field( $form->field('submit') );
+is( $output9, '
+<div><input type="submit" name="submit" id="submit" value="Update" /></div>
+', 'output from Submit');
+
+my $output10 = $form->render_field( $form->field('opt_in') );
+is( $output10, '
+<div><label class="label" for="opt_in">Opt in: </label> <br /><input type="radio" value="0" name="opt_in" id="opt_in.0" checked="checked" />No<br /><input type="radio" value="1" name="opt_in" id="opt_in.1" />Yes<br /></div>
+', 'output from radio group' );
+
+my $output11 = $form->render_start;
+is( $output11,'<form id="testform" method="post" >
+<fieldset class="main_fieldset">', 'Form start OK' );
+
+my $output = $form->render;
+ok( $output, 'get rendered output from form');
+
+is( $form->render_field( $form->field('no_render')), '', 'no_render' );
+
+{
+ package Test::Field::Rendering;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has_field 'my_html' => ( type => 'Display', html => '<h2>You got here!</h2>' );
+ has_field 'explanation' => ( type => 'Display' );
+ has_field 'between' => ( type => 'Display', set_html => 'between_html' );
+
+ sub html_explanation {
+ my ( $self, $field ) = @_;
+ return "<p>I have an explanation somewhere around here...</p>";
+ }
+
+ sub between_html {
+ my ( $self, $field ) = @_;
+ return "<div>Somewhere, over the rainbow...</div>";
+ }
+
+}
+
+$form = Test::Field::Rendering->new;
+is( $form->field('my_html')->render, '<h2>You got here!</h2>', 'display field renders' );
+is( $form->field('explanation')->render, '<p>I have an explanation somewhere around here...</p>',
+ 'display field renders with form method' );
+is( $form->field('between')->render, '<div>Somewhere, over the rainbow...</div>',
+ 'set_html field renders' );
+
+done_testing;
diff --git a/t/render_escaping.t b/t/render_escaping.t
new file mode 100644
index 0000000..b5e759f
--- /dev/null
+++ b/t/render_escaping.t
@@ -0,0 +1,177 @@
+use strict;
+use warnings;
+use Test::More;
+
+use HTML::FormHandler::Field::Text;
+
+
+{
+ package Test::Form;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+ with 'HTML::FormHandler::Render::Simple';
+
+ has '+name' => ( default => 'testform' );
+ has_field 'test_field' => (
+ size => 20,
+ label => '"TEST"',
+ id => 'f99',
+ );
+ has_field 'number';
+ has_field 'fruit' => ( type => 'Select' );
+ has_field 'vegetables' => ( type => 'Multiple' );
+ has_field 'opt_in' => ( type => 'Select', widget => 'radio_group',
+ options => [{ value => 0, label => '<No>'}, { value => 1, label => '<Yes>'} ] );
+ has_field 'active' => ( type => 'Checkbox' );
+ has_field 'comments' => ( type => 'TextArea' );
+ has_field 'hidden' => ( type => 'Hidden' );
+ has_field 'selected' => ( type => 'Boolean' );
+ has_field 'start_date' => ( type => 'DateTime' );
+ has_field 'start_date.month' => ( type => 'Integer', range_start => 1,
+ range_end => 12 );
+ has_field 'start_date.day' => ( type => 'Integer', range_start => 1,
+ range_end => 31 );
+ has_field 'start_date.year' => ( type => 'Integer', range_start => 2000,
+ range_end => 2020 );
+
+ has_field 'two_errors' => (
+ apply => [
+ { check => [ ], message => 'First constraint error' },
+ { check => [ ], message => 'Second constraint error' }
+ ]
+ );
+
+ has_field 'submit' => ( type => 'Submit', value => 'Update' );
+
+ has '+dependency' => ( default => sub { [ ['start_date.month',
+ 'start_date.day', 'start_date.year'] ] } );
+ has_field 'no_render' => ( widget => 'no_render' );
+ sub options_fruit {
+ return (
+ 1 => '"apples"',
+ 2 => '<oranges>',
+ 3 => '&kiwi&',
+ );
+ }
+
+ sub options_vegetables {
+ return (
+ 1 => '<lettuce>',
+ 2 => 'broccoli',
+ 3 => 'carrots',
+ 4 => 'peas',
+ );
+ }
+}
+
+
+my $form = Test::Form->new;
+ok( $form, 'create form');
+
+my $params = {
+ test_field => 'something<br>',
+ number => 0,
+ fruit => 2,
+ vegetables => [2,4],
+ active => 'now',
+ comments => 'Four score and seven years ago...</textarea>',
+ hidden => '<1234>',
+ selected => '1',
+ 'start_date.month' => '7',
+ 'start_date.day' => '14',
+ 'start_date.year' => '2006',
+ two_errors => 'aaa',
+ opt_in => 0,
+};
+
+$form->process( $params );
+
+is( $form->render_field( $form->field('number') ),
+ '
+<div><label class="label" for="number">Number: </label><input type="text" name="number" id="number" value="0" /></div>
+',
+ "value '0' is rendered"
+);
+
+my $output1 = $form->render_field( $form->field('test_field') );
+is( $output1,
+ '
+<div><label class="label" for="f99">"TEST": </label><input type="text" name="test_field" id="f99" size="20" value="something<br>" /></div>
+',
+ 'output from text field');
+
+my $output2 = $form->render_field( $form->field('fruit') );
+is( $output2,
+ '
+<div><label class="label" for="fruit">Fruit: </label><select name="fruit" id="fruit"><option value="1" id="fruit.0" >"apples"</option><option value="2" id="fruit.1" selected="selected"><oranges></option><option value="3" id="fruit.2" >&kiwi&</option></select></div>
+',
+ 'output from select field');
+
+my $output3 = $form->render_field( $form->field('vegetables') );
+is( $output3,
+ '
+<div><label class="label" for="vegetables">Vegetables: </label><select name="vegetables" id="vegetables" multiple="multiple" size="5"><option value="1" id="vegetables.0" ><lettuce></option><option value="2" id="vegetables.1" selected="selected">broccoli</option><option value="3" id="vegetables.2" >carrots</option><option value="4" id="vegetables.3" selected="selected">peas</option></select></div>
+',
+'output from select multiple field');
+
+my $output4 = $form->render_field( $form->field('active') );
+is( $output4,
+ '
+<div><label class="label" for="active">Active: </label><input type="checkbox" name="active" id="active" value="1" /></div>
+',
+ 'output from checkbox field');
+
+my $output5 = $form->render_field( $form->field('comments') );
+is( $output5,
+ '
+<div><label class="label" for="comments">Comments: </label><textarea name="comments" id="comments" rows="5" cols="10">Four score and seven years ago...</textarea></textarea></div>
+',
+ 'output from textarea' );
+
+my $output6 = $form->render_field( $form->field('hidden') );
+is( $output6,
+ '
+<div><input type="hidden" name="hidden" id="hidden" value="<1234>" /></div>
+',
+ 'output from hidden field' );
+
+my $output7 = $form->render_field( $form->field('selected') );
+is( $output7,
+ '
+<div><label class="label" for="selected">Selected: </label><input type="checkbox" name="selected" id="selected" value="1" checked="checked" /></div>
+',
+ 'output from boolean' );
+
+my $output8 = $form->render_field( $form->field('start_date') );
+is( $output8,
+ '
+<div><fieldset class="start_date"><legend>Start date</legend>
+<div><label class="label" for="start_date.month">Month: </label><input type="text" name="start_date.month" id="start_date.month" size="8" value="7" /></div>
+
+<div><label class="label" for="start_date.day">Day: </label><input type="text" name="start_date.day" id="start_date.day" size="8" value="14" /></div>
+
+<div><label class="label" for="start_date.year">Year: </label><input type="text" name="start_date.year" id="start_date.year" size="8" value="2006" /></div>
+</fieldset></div>
+',
+ 'output from DateTime' );
+
+my $output9 = $form->render_field( $form->field('submit') );
+is( $output9, q{
+<div><input type="submit" name="submit" id="submit" value="Update" /></div>
+}, 'output from Submit');
+
+my $output10 = $form->render_field( $form->field('opt_in') );
+is( $output10, q{
+<div><label class="label" for="opt_in">Opt in: </label> <br /><input type="radio" value="0" name="opt_in" id="opt_in.0" checked="checked" /><No><br /><input type="radio" value="1" name="opt_in" id="opt_in.1" /><Yes><br /></div>
+}, 'output from radio group' );
+
+my $output11 = $form->render_start;
+is( $output11,'<form id="testform" method="post" >
+<fieldset class="main_fieldset">', 'Form start OK' );
+
+my $output = $form->render;
+ok( $output, 'get rendered output from form');
+
+is( $form->render_field( $form->field('no_render')), '', 'no_render' );
+
+done_testing;
diff --git a/t/render_filter.t b/t/render_filter.t
new file mode 100644
index 0000000..4c203f2
--- /dev/null
+++ b/t/render_filter.t
@@ -0,0 +1,58 @@
+use strict;
+use warnings;
+use Test::More;
+
+use HTML::FormHandler::Field::Text;
+
+my $field = HTML::FormHandler::Field::Text->new( name => 'test' );
+
+my $string = '"J.Doe" <jdoe at gmail.com>';
+
+my $output = $field->html_filter($string);
+is( $output, '"J.Doe" <jdoe at gmail.com>', 'output ok' );
+
+{
+ package Test::RenderFilter;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has_field 'foo';
+ has_field 'bar';
+
+ sub render_filter {
+ my ( $self, $string ) = @_;
+ $string =~ s/my/MY/g;
+ return $string;
+ }
+}
+
+my $form = Test::RenderFilter->new;
+ok( $form, 'form builds' );
+
+$form->process( params => { foo => 'This is my test' } );
+like( $form->field('foo')->render, qr/MY/, 'rendering was filters' );
+
+{
+ package Test::FieldFilter;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has_field 'foo' => ( render_filter => \&foo_render );
+ has_field 'bar' => ( render_filter => sub { shift } );
+ sub foo_render {
+ my $string = shift;
+ $string =~ s/yours/YOURS/g;
+ return $string;
+ }
+}
+
+$form = Test::FieldFilter->new;
+$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' );
+is( $form->field('foo')->render, '
+<div><label class="label" for="foo">Foo: </label><input type="text" name="foo" id="foo" value="What\'s mine is YOURS" /></div>
+', 'renders ok' );
+
+done_testing;
diff --git a/t/render_result.t b/t/render_result.t
new file mode 100644
index 0000000..b68184e
--- /dev/null
+++ b/t/render_result.t
@@ -0,0 +1,144 @@
+use strict;
+use warnings;
+use Test::More;
+use Test::Differences;
+#use IO::All;
+
+use_ok('HTML::FormHandler::Result');
+
+{
+ package Test::Form;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has '+widget_form' => ( default => 'Simple' );
+ has '+name' => ( default => 'testform' );
+ has_field 'test_field' => (
+ size => 20,
+ label => 'TEST',
+ id => 'f99',
+ );
+ has_field 'number';
+ has_field 'fruit' => ( type => 'Select' );
+ has_field 'vegetables' => ( type => 'Multiple' );
+ has_field 'opt_in' => ( type => 'Select', widget => 'radio_group',
+ options => [{ value => 0, label => 'No'}, { value => 1, label => 'Yes'} ] );
+ has_field 'active' => ( type => 'Checkbox' );
+ has_field 'comments' => ( type => 'TextArea' );
+ has_field 'hidden' => ( type => 'Hidden' );
+ has_field 'selected' => ( type => 'Boolean' );
+ has_field 'start_date' => ( type => 'DateTime' );
+ has_field 'start_date.month' => ( type => 'Integer', range_start => 1,
+ range_end => 12 );
+ has_field 'start_date.day' => ( type => 'Integer', range_start => 1,
+ range_end => 31 );
+ has_field 'start_date.year' => ( type => 'Integer', range_start => 2000,
+ range_end => 2020 );
+
+ has_field 'two_errors' => (
+ apply => [
+ { check => [ ], message => 'First constraint error' },
+ { check => [ ], message => 'Second constraint error' }
+ ]
+ );
+
+ has_field 'submit' => ( type => 'Submit', value => 'Update' );
+
+ has '+dependency' => ( default => sub { [ ['start_date.month',
+ 'start_date.day', 'start_date.year'] ] } );
+ has_field 'no_render' => ( widget => 'no_render' );
+ sub options_fruit {
+ return (
+ 1 => 'apples',
+ 2 => 'oranges',
+ 3 => 'kiwi',
+ );
+ }
+
+ sub options_vegetables {
+ return (
+ 1 => 'lettuce',
+ 2 => 'broccoli',
+ 3 => 'carrots',
+ 4 => 'peas',
+ );
+ }
+}
+
+my $form = Test::Form->new;
+ok( $form, 'create form');
+
+
+my $params1 = {
+ test_field => 'something',
+ number => 0,
+ fruit => 2,
+ vegetables => [2,4],
+ active => 'now',
+ comments => 'Four score and seven years ago...',
+ hidden => '1234',
+ selected => '1',
+ 'start_date.month' => '7',
+ 'start_date.day' => '14',
+ 'start_date.year' => '2006',
+ two_errors => 'aaa',
+ opt_in => 0,
+};
+
+$form->process( $params1 );
+
+my $outputf = $form->render;
+ok( $outputf, 'get rendered output from form');
+
+my $result1 = $form->result;
+ok( $result1, 'get result' );
+
+my $outputr = $result1->render;
+ok( $outputr, 'get render from result');
+
+eq_or_diff( $outputf, $outputr, 'no diff form and result');
+
+my $params2 = {
+ test_field => 'anything',
+ number => 2,
+ fruit => 3,
+ vegetables => [2,4],
+ active => 'now',
+ comments => 'Four centuries and seven years ago...',
+ hidden => '5678',
+ selected => '0',
+ 'start_date.month' => '9',
+ 'start_date.day' => '14',
+ 'start_date.year' => '2008',
+ two_errors => 'aaa',
+ opt_in => 1,
+};
+
+
+my $result2 = $form->run($params2);
+my $outputr2 = $result1->render;
+eq_or_diff( $outputr, $outputr2, 'no diff second execution');
+
+#$outputr > io('first_result.txt');
+#$outputr2 > io('second_result.txt');
+#my $diff = `diff first_result.txt second_result.txt`;
+#diag( $diff );
+
+$form->process($params1);
+
+eq_or_diff( $result1->field('test_field')->render, $form->field('test_field')->render, 'no diff test_field' );
+eq_or_diff( $result1->field('number')->render, $form->field('number')->render, 'no diff number' );
+eq_or_diff( $result1->field('fruit')->render, $form->field('fruit')->render, 'no diff fruit' );
+eq_or_diff( $result1->field('vegetables')->render, $form->field('vegetables')->render, 'no diff vegetables' );
+eq_or_diff( $result1->field('active')->render, $form->field('active')->render, 'no diff active' );
+eq_or_diff( $result1->field('comments')->render, $form->field('comments')->render, 'no diff comments' );
+eq_or_diff( $result1->field('hidden')->render, $form->field('hidden')->render, 'no diff hidden' );
+eq_or_diff( $result1->field('selected')->render, $form->field('selected')->render, 'no diff selected' );
+eq_or_diff( $result1->field('start_date.month')->render, $form->field('start_date.month')->render, 'no diff start_date.month' );
+eq_or_diff( $result1->field('start_date.day')->render, $form->field('start_date.day')->render, 'no diff start_date.day' );
+eq_or_diff( $result1->field('start_date.year')->render, $form->field('start_date.year')->render, 'no diff start_date.year' );
+eq_or_diff( $result1->field('two_errors')->render, $form->field('two_errors')->render, 'no diff two_errors' );
+eq_or_diff( $result1->field('opt_in')->render, $form->field('opt_in')->render, 'no diff opt_in' );
+
+
+done_testing;
diff --git a/t/render_table.t b/t/render_table.t
new file mode 100644
index 0000000..fa43ffd
--- /dev/null
+++ b/t/render_table.t
@@ -0,0 +1,72 @@
+use strict;
+use warnings;
+use Test::More;
+
+use HTML::FormHandler::Field::Text;
+
+
+{
+ package Test::Form;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+ with 'HTML::FormHandler::Render::Table';
+
+ has '+name' => ( default => 'renderform' );
+ has_field 'test_field' => (
+ type => 'Text',
+ label => 'TEST',
+ id => 'f99',
+ );
+ has_field 'number';
+ has_field 'fruit' => ( type => 'Select' );
+ has_field 'vegetables' => ( type => 'Multiple' );
+ has_field 'opt_in' => ( type => 'Select', widget => 'radio_group',
+ options => [{ value => 0, label => 'No'}, { value => 1, label => 'Yes'} ] );
+ has_field 'active' => ( type => 'Checkbox' );
+ has_field 'comments' => ( type => 'TextArea' );
+ has_field 'hidden' => ( type => 'Hidden' );
+ has_field 'selected' => ( type => 'Boolean' );
+ has_field 'start_date' => ( type => 'DateTime' );
+ has_field 'start_date.month' => ( type => 'Integer', range_start => 1,
+ range_end => 12 );
+ has_field 'start_date.day' => ( type => 'Integer', range_start => 1,
+ range_end => 31 );
+ has_field 'start_date.year' => ( type => 'Integer', range_start => 2000,
+ range_end => 2020 );
+
+ has_field 'two_errors' => (
+ apply => [
+ { check => [ ], message => 'First constraint error' },
+ { check => [ ], message => 'Second constraint error' }
+ ]
+ );
+
+ has_field 'submit' => ( type => 'Submit', value => 'Update' );
+
+ has '+dependency' => ( default => sub { [ ['start_date.month',
+ 'start_date.day', 'start_date.year'] ] } );
+ has_field 'no_render' => ( widget => 'no_render' );
+ sub options_fruit {
+ return (
+ 1 => 'apples',
+ 2 => 'oranges',
+ 3 => 'kiwi',
+ );
+ }
+
+ sub options_vegetables {
+ return (
+ 1 => 'lettuce',
+ 2 => 'broccoli',
+ 3 => 'carrots',
+ 4 => 'peas',
+ );
+ }
+}
+
+my $form = Test::Form->new;
+ok( $form, 'create form');
+
+ok( $form->render, 'get table rendered output from form');
+
+done_testing;
diff --git a/t/render_widgets.t b/t/render_widgets.t
new file mode 100644
index 0000000..574edf0
--- /dev/null
+++ b/t/render_widgets.t
@@ -0,0 +1,305 @@
+use strict;
+use warnings;
+use Test::More;
+use Test::Exception;
+
+use lib 't/lib';
+
+use HTML::FormHandler::Field::Text;
+
+{
+
+ package Test::Form;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has '+name' => ( default => 'testform' );
+ has_field 'test_field' => (
+ size => 20,
+ label => 'TEST',
+ id => 'f99',
+ );
+ has_field 'number';
+ has_field 'fruit' => ( type => 'Select' );
+ has_field 'vegetables' => ( type => 'Multiple' );
+ has_field 'opt_in' => (
+ type => 'Select',
+ widget => 'radio_group',
+ options => [
+ {
+ value => 0,
+ label => 'No',
+ # this can depend on something else,
+ # with fixed value will cause field be
+ # always checked even after process
+ checked => 1,
+ },
+ { value => 1, label => 'Yes' },
+ ]
+ );
+ has_field 'active' => ( type => 'Checkbox' );
+ has_field 'comments' => ( type => 'TextArea' );
+ has_field 'hidden' => ( type => 'Hidden' );
+ has_field 'selected' => ( type => 'Boolean' );
+ has_field 'start_date' => ( type => 'DateTime' );
+ has_field 'start_date.month' => (
+ type => 'Integer',
+ range_start => 1,
+ range_end => 12
+ );
+ has_field 'start_date.day' => (
+ type => 'Integer',
+ range_start => 1,
+ range_end => 31
+ );
+ has_field 'start_date.year' => (
+ type => 'Integer',
+ range_start => 2000,
+ range_end => 2020
+ );
+
+ has_field 'two_errors' => (
+ apply => [
+ { check => [], message => 'First constraint error' },
+ { check => [], message => 'Second constraint error' }
+ ]
+ );
+
+ has_field 'submit' => ( type => 'Submit', value => 'Update' );
+
+ has '+dependency' => (
+ default => sub {
+ [ [ 'start_date.month', 'start_date.day', 'start_date.year' ] ];
+ }
+ );
+ has_field 'no_render' => ( widget => 'no_render' );
+ has_field 'plain' => ( widget_wrapper => 'None' );
+
+ sub options_fruit {
+ return (
+ 1 => 'apples',
+ 2 => 'oranges',
+ 3 => 'kiwi',
+ );
+ }
+
+ sub options_vegetables {
+ return (
+ 1 => 'lettuce',
+ 2 => 'broccoli',
+ 3 => 'carrots',
+ 4 => 'peas',
+ );
+ }
+}
+
+my $form = Test::Form->new;
+ok( $form, 'create form' );
+
+my $output10 = $form->field('opt_in')->render;
+is(
+ $output10, '
+<div><label class="label" for="opt_in">Opt in: </label> <br /><input type="radio" value="0" name="opt_in" id="opt_in.0" checked="checked" />No<br /><input type="radio" value="1" name="opt_in" id="opt_in.1" />Yes<br /></div>
+', 'output from radio group'
+);
+
+my $params = {
+ test_field => 'something',
+ number => 0,
+ fruit => 2,
+ vegetables => [ 2, 4 ],
+ active => 'now',
+ comments => 'Four score and seven years ago...',
+ hidden => '1234',
+ selected => '1',
+ 'start_date.month' => '7',
+ 'start_date.day' => '14',
+ 'start_date.year' => '2006',
+ two_errors => 'aaa',
+ opt_in => 0,
+ plain => 'No divs!!',
+};
+
+$form->process($params);
+
+is(
+ $form->field('number')->render,
+ '
+<div><label class="label" for="number">Number: </label><input type="text" name="number" id="number" value="0" /></div>
+',
+ "value '0' is rendered"
+);
+
+my $output1 = $form->field('test_field')->render;
+is(
+ $output1,
+ '
+<div><label class="label" for="f99">TEST: </label><input type="text" name="test_field" id="f99" size="20" value="something" /></div>
+',
+ 'output from text field'
+);
+
+my $output2 = $form->field('fruit')->render;
+is(
+ $output2,
+ '
+<div><label class="label" for="fruit">Fruit: </label><select name="fruit" id="fruit"><option value="1" id="fruit.0" >apples</option><option value="2" id="fruit.1" selected="selected">oranges</option><option value="3" id="fruit.2" >kiwi</option></select></div>
+',
+ 'output from select field'
+);
+
+my $output3 = $form->field('vegetables')->render;
+is(
+ $output3,
+ '
+<div><label class="label" for="vegetables">Vegetables: </label><select name="vegetables" id="vegetables" multiple="multiple" size="5"><option value="1" id="vegetables.0" >lettuce</option><option value="2" id="vegetables.1" selected="selected">broccoli</option><option value="3" id="vegetables.2" >carrots</option><option value="4" id="vegetables.3" selected="selected">peas</option></select></div>
+',
+ 'output from select multiple field'
+);
+
+my $output4 = $form->field('active')->render;
+is(
+ $output4,
+ '
+<div><label class="label" for="active">Active: </label><input type="checkbox" name="active" id="active" value="1" /></div>
+',
+ 'output from checkbox field'
+);
+
+my $output5 = $form->field('comments')->render;
+is(
+ $output5,
+ '
+<div><label class="label" for="comments">Comments: </label><textarea name="comments" id="comments" rows="5" cols="10">Four score and seven years ago...</textarea></div>
+',
+ 'output from textarea'
+);
+
+my $output6 = $form->field('hidden')->render;
+is(
+ $output6,
+ '
+<input type="hidden" name="hidden" id="hidden" value="1234" />
+',
+ 'output from hidden field'
+);
+
+my $output7 = $form->field('selected')->render;
+is(
+ $output7,
+ '
+<div><label class="label" for="selected">Selected: </label><input type="checkbox" name="selected" id="selected" value="1" checked="checked" /></div>
+',
+ 'output from boolean'
+);
+
+my $output8 = $form->field('start_date')->render;
+is(
+ $output8,
+ '
+<div><fieldset class="start_date"><legend>Start date</legend>
+<div><label class="label" for="start_date.month">Month: </label><input type="text" name="start_date.month" id="start_date.month" size="8" value="7" /></div>
+
+<div><label class="label" for="start_date.day">Day: </label><input type="text" name="start_date.day" id="start_date.day" size="8" value="14" /></div>
+
+<div><label class="label" for="start_date.year">Year: </label><input type="text" name="start_date.year" id="start_date.year" size="8" value="2006" /></div>
+</fieldset></div>
+',
+ 'output from DateTime'
+);
+
+my $output9 = $form->field('submit')->render;
+is(
+ $output9, '
+<div><input type="submit" name="submit" id="submit" value="Update" /></div>
+', 'output from Submit'
+);
+
+$output10 = $form->field('opt_in')->render;
+is(
+ $output10, '
+<div><label class="label" for="opt_in">Opt in: </label> <br /><input type="radio" value="0" name="opt_in" id="opt_in.0" checked="checked" />No<br /><input type="radio" value="1" name="opt_in" id="opt_in.1" />Yes<br /></div>
+', 'output from radio group'
+);
+
+my $output11 = $form->render_start;
+is(
+ $output11, '<form id="testform" method="post" >
+<fieldset class="main_fieldset">', 'Form start OK'
+);
+
+my $output = $form->render;
+ok( $output, 'get rendered output from form' );
+
+is( $form->field('no_render')->render, '', 'no_render' );
+
+is( $form->field('plain')->render, '<input type="text" name="plain" id="plain" value="No divs!!" />', 'renders without wrapper');
+
+
+{
+
+ package Test::Widgets;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has '+widget_name_space' => ( default => sub { ['Widget'] } );
+
+ has_field 'alpha' => ( widget => 'test_widget' );
+ has_field 'omega' => ( widget => 'Omega' );
+ has_field 'iota';
+}
+
+$form = Test::Widgets->new;
+ok( $form, 'get form with custom widgets' );
+is( $form->field('alpha')->render, '<p>The test succeeded.</p>', 'alpha rendered ok' );
+is( $form->field('omega')->render, '<h1>You got here!</h1>', 'omega rendered ok' );
+
+{
+
+ package Test::NoWidget;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has '+widget_name_space' => ( default => sub { ['Widget'] } );
+ has_field 'no_widget' => ( widget => 'no_widget' );
+}
+dies_ok( sub { Test::NoWidget->new }, 'dies on no widget' );
+throws_ok( sub { Test::NoWidget->new }, qr/not able to load/, 'no widget throws message' );
+
+$form = Test::Form->new( widget_form => 'Table', widget_wrapper => 'Table' );
+ok( $form->can('render'), 'form has table widget' );
+like( $form->field('number')->render, qr/<td>/, 'field has table wrapper');
+$form->process($params);
+my $outputT = $form->render;
+ok( $outputT, 'output from table rendering' );
+
+{
+
+ package Test::Tags;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has_field 'foo';
+ has '+widget_tags' => (
+ default => sub {
+ {
+ wrapper_start => '<p>',
+ wrapper_end => '</p>',
+ };
+ }
+ );
+ has_field 'bar' => ( widget_tags =>
+ {wrapper_start => '<span>', wrapper_end => '</span>'});
+}
+
+$form = Test::Tags->new;
+$form->process( { foo => 'bar' } );
+is( $form->field('foo')->render, '
+<p><label class="label" for="foo">Foo: </label><input type="text" name="foo" id="foo" value="bar" /></p>
+', 'renders with different tags');
+
+is( $form->field('bar')->render, '
+<span><label class="label" for="bar">Bar: </label><input type="text" name="bar" id="bar" value="" /></span>
+', 'field renders with custom widget_tags' );
+
+done_testing;
diff --git a/t/render_withtt.t b/t/render_withtt.t
new file mode 100644
index 0000000..c34d6fa
--- /dev/null
+++ b/t/render_withtt.t
@@ -0,0 +1,37 @@
+use strict;
+use warnings;
+use Test::More;
+use File::ShareDir;
+
+BEGIN {
+ plan skip_all => 'Template Toolkit to rest Render::WithTT'
+ unless eval { require Template };
+}
+
+use_ok('HTML::FormHandler::Render::WithTT');
+
+my $dir = File::ShareDir::dist_dir('HTML-FormHandler') . '/templates/';
+ok( $dir, 'found template dir' );
+
+{
+ package Test::Form;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+ with 'HTML::FormHandler::Render::WithTT';
+
+ sub build_tt_template { 'form.tt' }
+ sub build_tt_include_path { ['share/templates'] }
+
+ has_field 'foo';
+ has_field 'bar';
+ has_field 'submit' => ( type => 'Submit' );
+
+}
+
+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' );
+
+done_testing;
diff --git a/t/result.t b/t/result.t
new file mode 100644
index 0000000..e0180b2
--- /dev/null
+++ b/t/result.t
@@ -0,0 +1,139 @@
+use strict;
+use warnings;
+use Test::More;
+
+use_ok('HTML::FormHandler');
+
+{
+
+ package My::Form;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has '+name' => ( default => 'testform_' );
+ has_field 'optname' => ( temp => 'First' );
+ has_field 'reqname' => ( required => 1 );
+ has_field 'somename';
+ has_field 'my_selected' => ( type => 'Checkbox' );
+ has_field 'must_select' => ( type => 'Checkbox', required => 1 );
+ has_field 'fruit' => ( type => 'Select' );
+ has_field 'optname' => ( temp => 'Second' );
+ sub options_fruit
+ {
+ return (
+ 1 => 'apples',
+ 2 => 'oranges',
+ 3 => 'kiwi',
+ );
+ }
+}
+
+my $form = My::Form->new;
+
+is( $form->field('optname')->temp, 'Second', 'got second optname field' );
+
+ok( !$form->process, 'Empty data' );
+ok( $form->result, 'result exists' );
+ok( $form->field('optname'), 'result field exists' );
+
+my $good = {
+ reqname => 'hello',
+ optname => 'not req',
+ fruit => 2,
+ must_select => 1,
+};
+
+$form->process($good);
+ok( $form->validated, 'Good data' );
+my $result = $form->result;
+ok( $result, 'got result object' );
+ok( $result->validated, 'result validated');
+ok( $result->has_input, 'result still has input');
+my $num_errors = $form->num_errors;
+
+$result = $form->run($good);
+ok( !$form->has_result, 'has result after been cleared');
+ok( !$form->validated, 'form has been cleared' );
+
+# field still points to existing result
+ok( !$form->field('reqname')->input, 'no input for field');
+ok( !$form->field('reqname')->value, 'no value for field');
+ok( $result->validated, 'result still has result' );
+is( $result->num_errors, $num_errors, 'number of errors is correct');
+is( $result->field('somename')->value, undef, 'no value for somename' );
+ok( !$result->field('somename')->has_value, 'predicate no value' );
+
+$good->{my_selected} = 0;
+$good->{somename} = '';
+is_deeply( $result->fif, $good, 'fif is correct' );
+delete $good->{my_selected};
+
+$form->process({});
+ok( !$form->field('reqname')->input, 'no input for field');
+
+$good->{somename} = 'testing';
+$result = $form->run($good);
+is( $result->field('somename')->value, 'testing', 'use input for extra data' );
+is( $result->field('my_selected')->value, 0, 'correct value for unselected checkbox' );
+
+$result = $form->run( {} );
+
+ok( !$result->validated, 'form doesn\'t validate with empty params' );
+is( $result->num_errors, 0, 'form doesn\'t have errors with empty params' );
+
+
+my $bad_1 = {
+ reqname => '',
+ optname => 'not req',
+ fruit => 4,
+};
+
+$result = $form->run($bad_1);
+ok( !$result->validated, 'bad 1' );
+ok( $result->field('fruit')->has_errors, 'fruit has error' );
+ok( $result->field('reqname')->has_errors, 'reqname has error' );
+ok( $result->field('must_select')->has_errors, 'must_select has error' );
+ok( !$result->field('optname')->has_errors, 'optname has no error' );
+
+$result = $form->run;
+ok( !$result->validated, 'no leftover params' );
+is( $result->num_errors, 0, 'no leftover errors' );
+ok( !$result->field('reqname')->has_errors, 'no leftover error in field' );
+ok( !$result->field('optname')->fif, 'no lefover fif values' );
+
+my $init_object = {
+ reqname => 'Starting Perl',
+ optname => 'Over Again'
+};
+$form = My::Form->new( init_object => $init_object );
+is( $form->field('optname')->value, 'Over Again', 'get right value from form' );
+$result = $form->run( params => {} );
+ok( !$result->validated, 'form did not validate' );
+my $values = {
+ 'fruit' => undef,
+ 'must_select' => 0,
+ 'my_selected' => 0,
+ 'optname' => 'Over Again',
+ 'reqname' => 'Starting Perl',
+ 'somename' => undef
+};
+is_deeply( $result->value, $values, 'get right values from form' );
+
+$init_object->{my_selected} = 0;
+$init_object->{must_select} = 1;
+$result = $form->run($init_object);
+ok( $result->validated, 'form validates with params' );
+is_deeply( $result->value, $init_object, 'get right values from result' );
+
+ok( !$form->has_value, 'Form value cleared' );
+ok( !$form->has_input, 'Form input cleared' );
+
+$form = HTML::FormHandler->new( field_list => [ foo => { type => 'Text', required => 1 } ] );
+
+# 'image' input produces { foo => bar, 'foo.x' => 42, 'foo.y' => 23 }
+$form = HTML::FormHandler->new( name => 'baz', html_prefix => 1, field_list => [ 'foo' ] );
+eval{ $result = $form->run( params => { 'baz.foo' => 'bar', 'baz.foo.x' => 42, 'baz.foo.y' => 23 } ) };
+ok( !$@, 'image field processed' ) or diag $@;
+is_deeply( $result->field( 'foo' )->value, { '' => 'bar', x => 42, y => 23 }, 'image input value correct' );
+
+done_testing;
diff --git a/t/result_compound.t b/t/result_compound.t
new file mode 100644
index 0000000..3476fa2
--- /dev/null
+++ b/t/result_compound.t
@@ -0,0 +1,69 @@
+use strict;
+use warnings;
+use Test::More;
+
+
+my $struct = {
+ username => 'Joe Blow',
+ occupation => 'Programmer',
+ tags => ['Perl', 'programming', 'Moose' ],
+ employer => {
+ name => 'TechTronix',
+ country => 'Utopia',
+ },
+};
+
+
+{
+ package Structured::Form;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has_field 'username';
+ has_field 'occupation';
+ has_field 'tags' => ( type => 'Repeatable' );
+ has_field 'tags.contains' => ( type => 'Text' );
+ has_field 'employer' => ( type => 'Compound' );
+ has_field 'employer.name';
+ has_field 'employer.country';
+
+}
+
+my $form = Structured::Form->new;
+ok( $form, 'form created' );
+$form->process( params => $struct );
+ok( $form->validated, 'form validated');
+
+is_deeply( $form->field('tags')->value, ['Perl', 'programming', 'Moose' ],
+ 'list field tags has right values' );
+my $result = $form->result;
+is( $result->num_results, 4, 'right number of results');
+
+my $first_tag = $result->field('tags.0');
+is( ref $first_tag, 'HTML::FormHandler::Field::Result', 'get result object');
+is( $first_tag->value, 'Perl', 'result has right value' );
+is( $first_tag->parent, $result->field('tags'), 'correct parent for ');
+
+my $employer = $result->field('employer');
+my $employer_name = $result->field('employer.name');
+is( $employer_name->parent, $employer, 'correct parent for compound field');
+
+my $fif = {
+ 'employer.country' => 'Utopia',
+ 'employer.name' => 'TechTronix',
+ 'occupation' => 'Programmer',
+ 'tags.0' => 'Perl',
+ 'tags.1' => 'programming',
+ 'tags.2' => 'Moose',
+ 'username' => 'Joe Blow'
+};
+
+is_deeply( $form->fif, $fif, 'fif is correct' );
+
+$result = $form->run( $fif );
+
+ok( $result->validated, 'form processed from fif' );
+
+is_deeply( $result->value, $struct, 'values round-tripped from fif');
+
+done_testing;
diff --git a/t/result_errors.t b/t/result_errors.t
new file mode 100644
index 0000000..4f8b530
--- /dev/null
+++ b/t/result_errors.t
@@ -0,0 +1,28 @@
+use strict;
+use warnings;
+use Test::More;
+
+{
+ package Test::Form;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has_field 'foo';
+ has_field 'foo_required' => ( required => 1 );
+}
+
+my $form = Test::Form->new;
+ok( $form, 'got form');
+my $result = $form->run( params => { foo => 'bar' } );
+ok( !$result->validated, 'did not validate' );
+ok( $result->field('foo_required')->has_errors, 'foo has error' );
+ok( $result->has_errors, 'result has errors' );
+is( $result->num_errors, 1, 'number of errors is correct' );
+is( $result->errors->[0], 'Foo required field is required', 'result field has error' );
+is( $result->field('foo_required')->render, '
+<div class="error"><label class="label" for="foo_required">Foo required: </label><input type="text" name="foo_required" id="foo_required" value="" />
+<span class="error_message">Foo required field is required</span></div>
+', 'error field has error' );
+
+
+done_testing;
diff --git a/t/structured.t b/t/structured.t
new file mode 100644
index 0000000..248edbd
--- /dev/null
+++ b/t/structured.t
@@ -0,0 +1,129 @@
+use strict;
+use warnings;
+use Test::More;
+
+
+my $struct = {
+ username => 'Joe Blow',
+ occupation => 'Programmer',
+ tags => ['Perl', 'programming', 'Moose' ],
+ employer => {
+ name => 'TechTronix',
+ country => 'Utopia',
+ },
+ options => {
+ flags => {
+ opt_in => 1,
+ email => 0,
+ },
+ cc_cards => [
+ {
+ type => 'Visa',
+ number => '4248999900001010',
+ },
+ {
+ type => 'MasterCard',
+ number => '4335992034971010',
+ },
+ ],
+ },
+ addresses => [
+ {
+ street => 'First Street',
+ city => 'Prime City',
+ country => 'Utopia',
+ id => 0,
+ },
+ {
+ street => 'Second Street',
+ city => 'Secondary City',
+ country => 'Graustark',
+ id => 1,
+ },
+ {
+ street => 'Third Street',
+ city => 'Tertiary City',
+ country => 'Atlantis',
+ id => 2,
+ }
+ ]
+};
+
+
+{
+ package Structured::Form;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has_field 'username';
+ has_field 'occupation';
+ has_field 'tags' => ( type => 'Repeatable' );
+ has_field 'tags.contains' => ( type => 'Text' );
+ has_field 'employer' => ( type => 'Compound' );
+ has_field 'employer.name';
+ has_field 'employer.country';
+ has_field 'options' => ( type => 'Compound' );
+ has_field 'options.flags' => ( type => 'Compound' );
+ has_field 'options.flags.opt_in' => ( type => 'Boolean' );
+ has_field 'options.flags.email' => ( type => 'Boolean' );
+ has_field 'options.cc_cards' => ( type => 'Repeatable' );
+ has_field 'options.cc_cards.type';
+ has_field 'options.cc_cards.number';
+ has_field 'addresses' => ( type => 'Repeatable' );
+ has_field 'addresses.street';
+ has_field 'addresses.city';
+ has_field 'addresses.country';
+ has_field 'addresses.id';
+
+}
+
+my $form = Structured::Form->new;
+ok( $form, 'form created' );
+
+$form->process( params => $struct );
+
+ok( $form->validated, 'form validated');
+
+is_deeply( $form->field('tags')->value, ['Perl', 'programming', 'Moose' ],
+ 'list field tags has right values' );
+is( $form->field('addresses.0.city')->value, 'Prime City', 'get address field OK' );
+
+is( $form->field('options.flags.opt_in')->value, 1, 'get opt_in flag');
+
+my $fif = {
+ 'addresses.0.city' => 'Prime City',
+ 'addresses.0.country' => 'Utopia',
+ 'addresses.0.id' => 0,
+ 'addresses.0.street' => 'First Street',
+ 'addresses.1.city' => 'Secondary City',
+ 'addresses.1.country' => 'Graustark',
+ 'addresses.1.id' => 1,
+ 'addresses.1.street' => 'Second Street',
+ 'addresses.2.city' => 'Tertiary City',
+ 'addresses.2.country' => 'Atlantis',
+ 'addresses.2.id' => 2,
+ 'addresses.2.street' => 'Third Street',
+ 'employer.country' => 'Utopia',
+ 'employer.name' => 'TechTronix',
+ 'occupation' => 'Programmer',
+ 'options.cc_cards.0.number' => '4248999900001010',
+ 'options.cc_cards.0.type' => 'Visa',
+ 'options.cc_cards.1.number' => '4335992034971010',
+ 'options.cc_cards.1.type' => 'MasterCard',
+ 'options.flags.email' => 0,
+ 'options.flags.opt_in' => 1,
+ 'tags.0' => 'Perl',
+ 'tags.1' => 'programming',
+ 'tags.2' => 'Moose',
+ 'username' => 'Joe Blow'
+};
+
+is_deeply( $form->fif, $fif, 'fif is correct' );
+
+$form->process( $fif );
+
+ok( $form->validated, 'form processed from fif' );
+
+is_deeply( $form->values, $struct, 'values round-tripped from fif');
+
+done_testing;
diff --git a/t/types.t b/t/types.t
new file mode 100644
index 0000000..46aefe9
--- /dev/null
+++ b/t/types.t
@@ -0,0 +1,138 @@
+use strict;
+use warnings;
+use Test::More;
+use Test::Exception;
+
+use HTML::FormHandler::Types (':all');
+
+$ENV{LANG} = 'en_us'; # in case user has LANG set
+
+{
+ package Test::Form;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+ use HTML::FormHandler::Types (':all');
+ use Moose::Util::TypeConstraints;
+
+ subtype 'GreaterThan10'
+ => as 'Int'
+ => where { $_ > 10 }
+ => message { "This number ($_) is not greater than 10" };
+
+ has 'posint' => ( is => 'rw', isa => PositiveInt);
+ has_field 'test' => ( apply => [ PositiveInt ] );
+ has_field 'text_gt' => ( apply=> [ 'GreaterThan10' ] );
+ has_field 'text_both' => ( apply => [ PositiveInt, 'GreaterThan10' ] );
+ has_field 'state' => ( apply => [ State ] );
+
+}
+
+my $form = Test::Form->new;
+
+ok( $form, 'get form');
+$form->posint(100);
+
+my $params = {
+ test => '-100',
+ text_gt => 5,
+ text_both => 6,
+ state => 'GG',
+};
+
+$form->process($params);
+ok( !$form->validated, 'form did not validate' );
+ok( $form->field('test')->has_errors, 'errors on MooseX type');
+ok( $form->field('text_gt')->has_errors, 'errors on subtype');
+ok( $form->field('text_both')->has_errors, 'errors on both');
+ok( $form->field('state')->has_errors, 'errors on state' );
+
+$params = {
+ test => 100,
+ text_gt => 21,
+ text_both => 15,
+ state => 'NY',
+};
+
+$form->process($params);
+ok( $form->validated, 'form validated' );
+ok( !$form->field('test')->has_errors, 'no errors on MooseX type');
+ok( !$form->field('text_gt')->has_errors, 'no errors on subtype');
+ok( !$form->field('text_both')->has_errors, 'no errors on both');
+ok( !$form->field('state')->has_errors, 'no errors on state' );
+
+# State
+my $field = HTML::FormHandler::Field->new( name => 'Test1', apply => [ State ] );
+ok( $field, 'created field with type' );
+$field->_set_input('GG');
+ok( !$field->validate_field, 'field did not validate');
+is( $field->errors->[0], 'Not a valid state', 'correct error message for State' );
+$field->_set_input('NY');
+ok( $field->validate_field, 'state field validated');
+# Email
+SKIP: {
+ eval { require Email::Valid };
+ skip "Email::Valid not installed", 3 if $@;
+ $field = HTML::FormHandler::Field->new( name => 'Test', apply => [ Email ] );
+ $field->_set_input('gail at gmail.com');
+ ok( $field->validate_field, 'email field validated' );
+ ok( !$field->has_errors, 'email field is valid');
+ $field->_set_input('not_an_email');
+ $field->validate_field;
+ is( $field->errors->[0], 'Email is not valid', 'error from Email' );
+}
+my @test = (
+ IPAddress => \&IPAddress =>
+ [qw(0.0.0.0 01.001.0.00 198.168.0.101 255.255.255.255)],
+ [qw(1 2.33 4.56.789 198.300.0.101 0.-1.13.255)],
+ 'Not a valid IP address',
+ NoSpaces => \&NoSpaces =>
+ [qw(a 1 _+~ *), '#'], ['a b', "x\ny", "foo\tbar"],
+ 'Must not contain spaces',
+ WordChars => \&WordChars =>
+ [qw(abc 8 ___ 90_i 0)],
+ ['a b', "x\ny", "foo\tbar", 'c++', 'C#', '$1,000,000'],
+ 'Must be made up of letters, digits, and underscores',
+ NotAllDigits => \&NotAllDigits =>
+ [qw(a 1a . a=1 1.23), 'a 1'], [qw(0 1 12 03450)],
+ 'Must not be all digits',
+# does not work at all!!!
+# Printable => \&Printable =>
+# [qw(a 1 $ % *), '# ?'], [0x00, "foo\tbar", "x\ny"],
+# 'Field contains non-printable characters',
+ SingleWord => \&SingleWord =>
+ [qw(a 1a _ a_1 1_234)], ['a b', '1.23', 'a=1'],
+ 'Field must contain a single word',
+);
+
+while (my ($name, $type, $good, $bad, $error_msg) = splice @test, 0, 5) {
+ $field = HTML::FormHandler::Field->new(name => 'Test', apply => [&$type]);
+ for (@$good) {
+ $field->_set_input($_);
+ ok($field->validate_field, "$name validated");
+ ok(!$field->has_errors, "$name field is valid");
+ }
+ for (@$bad) {
+ $field->_set_input($_);
+ ok(!$field->validate_field, "$name validation failed");
+ is($field->errors->[0], $error_msg, "error from $name");
+ }
+}
+
+ at test = (
+ Lower => \&Lower =>
+ [A => 'a', AB => 'ab', Abc => 'abc', abc => 'abc', 'A-z' => 'a-z', '1 + X' => '1 + x'],
+ Upper => \&Upper =>
+ [a => 'A', ab => 'AB', Abc => 'ABC', ABC => 'ABC', 'A-z' => 'A-Z', '1 + x' => '1 + X'],
+);
+
+while (my ($name, $type, $trans) = splice @test, 0, 3) {
+ my @trans = @$trans;
+ $field = HTML::FormHandler::Field->new(name => 'Test', apply => [&$type]);
+ while (my ($from, $to) = splice @trans, 0, 2) {
+ $field->_set_input($from);
+ ok($field->validate_field, "$name validated");
+ is($field->value, $to , "$name field transformation");
+ }
+}
+
+done_testing;
diff --git a/t/validate_coderef.t b/t/validate_coderef.t
new file mode 100644
index 0000000..0aa458b
--- /dev/null
+++ b/t/validate_coderef.t
@@ -0,0 +1,72 @@
+use strict;
+use warnings;
+use Test::More;
+use Try::Tiny;
+
+# this is an example of a validation that should live outside of the
+# form, yet needs to be called in the form's validate routine
+
+{
+
+ package SignupForm;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has check_name_availability => (
+ traits => ['Code'],
+ isa => 'CodeRef',
+ required => 1,
+ handles => { name_available => 'execute', },
+ );
+
+ has_field 'name';
+ has_field 'email';
+
+ sub validate {
+ my $self = shift;
+ my $name = $self->value->{name};
+ if ( defined $name && length $name && !$self->name_available($name) ) {
+ $self->field('name')->add_error('That name is taken already');
+ }
+ }
+
+}
+
+{
+ package MyApp::Signup;
+ use Moose;
+
+ has 'form' => ( is => 'ro', builder => 'build_form' );
+ sub build_form {
+ my $self = shift;
+ return SignupForm->new(
+ {
+ check_name_availability => sub {
+ my $name = shift;
+ return $self->username_available($name);
+ },
+ }
+ );
+
+ }
+ sub username_available {
+ my ( $self, $name ) = @_;
+ return $name eq 'Sam' ? 1 : 0;
+ }
+
+}
+
+my $obj = MyApp::Signup->new;
+
+ok( $obj->form, 'form built' );
+
+my $params = { name => 'Sam', email => 'sam at gmail.com' };
+
+$obj->form->process( params => $params );
+ok( $obj->form->validated, 'form validated' );
+
+$params->{name} = 'Jane';
+$obj->form->process( params => $params );
+ok( !$obj->form->validated, 'form did not validate' );
+
+done_testing;
diff --git a/t/xt/02pod.t b/t/xt/02pod.t
new file mode 100644
index 0000000..1647794
--- /dev/null
+++ b/t/xt/02pod.t
@@ -0,0 +1,7 @@
+use Test::More;
+
+eval "use Test::Pod 1.14";
+plan skip_all => 'Test::Pod 1.14 required' if $@;
+plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD};
+
+all_pod_files_ok();
diff --git a/t/xt/add_field.t b/t/xt/add_field.t
new file mode 100644
index 0000000..0fa7a71
--- /dev/null
+++ b/t/xt/add_field.t
@@ -0,0 +1,40 @@
+use Test::More tests => 2;
+
+use HTML::FormHandler::Field::Text;
+use HTML::FormHandler::Field;
+
+{
+ package My::Form;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has '+name' => ( default => 'testform' );
+ sub field_list {
+ [
+ meat => 'Text',
+ starch => { required => 1 },
+ fruit => 'Select',
+ ]
+ }
+
+ sub options_fruit {
+ return (
+ 1 => 'apples',
+ 2 => 'oranges',
+ 3 => 'kiwi',
+ );
+ }
+}
+
+my $form = My::Form->new;
+
+ok( $form, 'get form' );
+
+my $field = HTML::FormHandler::Field::Text->new( name => 'Testfield' );
+
+$form->push_field($field);
+
+ok( $form->field('Testfield'), 'form now has test field' );
+
+
+
diff --git a/t/xt/captcha.t b/t/xt/captcha.t
new file mode 100644
index 0000000..f00b373
--- /dev/null
+++ b/t/xt/captcha.t
@@ -0,0 +1,70 @@
+use strict;
+use warnings;
+use Test::More;
+
+BEGIN {
+ eval "use GD::SecurityImage";
+ plan skip_all => 'GD::SecurityImage required' if $@;
+}
+
+use_ok( 'HTML::FormHandler::Field::Captcha' );
+
+{
+ package Test::Captcha;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+ with 'HTML::FormHandler::TraitFor::Captcha';
+ with 'HTML::FormHandler::Render::Simple';
+
+ has_field 'some_field';
+ has_field 'subject';
+ has_field '+captcha' => ( id => 'captcha' );
+
+ sub validate_subject {
+ my ( $self, $field ) = @_;
+ $field->add_error("Incorrect")
+ unless $field->value eq 'Correct';
+ }
+
+}
+
+{
+ package Mock::Ctx;
+ use Moose;
+ has 'session' => ( isa => 'HashRef', is => 'rw' );
+}
+
+my $ctx = Mock::Ctx->new;
+ok( $ctx, 'get mock ctx' );
+
+my $form = Test::Captcha->new( ctx => $ctx );
+ok( $form, 'get form' );
+my $rnd = $ctx->{session}->{captcha}->{rnd};
+ok( $rnd, 'captcha is in session' );
+
+my $params = { some_field => 'test', subject => 'Correct', captcha => '1234' };
+$form->process( ctx => $ctx, params => $params );
+ok( !$form->validated, 'form did not validate with wrong captcha');
+
+my $rnd2 = $ctx->{session}->{captcha}->{rnd};
+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 );
+# 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' );
+
+$params->{subject} = 'Correct';
+$form->process( ctx => $ctx, params => $params );
+ok( $form->validated, 'form validated; old captcha, valid fields' );
+
+my $render = $form->render_field('captcha');
+is( $render, '
+<div class="captcha"><label class="label" for="captcha">Verification: </label><img src="/captcha/test"/><input id="captcha" name="captcha"></div>
+', 'captcha renders ok' );
+
+
+done_testing;
+
diff --git a/t/xt/chbox_group.t b/t/xt/chbox_group.t
new file mode 100644
index 0000000..0a070b5
--- /dev/null
+++ b/t/xt/chbox_group.t
@@ -0,0 +1,34 @@
+use strict;
+use warnings;
+use Test::More;
+
+use_ok('HTML::FormHandler::Widget::Field::CheckboxGroup');
+
+{
+ package Test::CheckboxGroup;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has_field 'foo_list' => ( type => 'Multiple', widget => 'CheckboxGroup' );
+
+ sub options_foo_list {
+ [
+ 1 => 'ShamWow',
+ 2 => 'SliderStation',
+ 3 => 'SlapChop',
+ 4 => 'Zorbeez',
+ 5 => 'OrangeGlow',
+ ]
+ }
+}
+
+my $form = Test::CheckboxGroup->new;
+ok( $form, 'form builds' );
+$form->process( { foo_list => [ 2, 4 ] } );
+ok( $form->validated, 'form validates' );
+my $rendered = $form->field('foo_list')->render;
+ok( $rendered, 'field renders' );
+my $rendered_form = $form->render;
+ok( $rendered_form, 'form renders' );
+
+done_testing;
diff --git a/t/xt/check_selected_option.t b/t/xt/check_selected_option.t
new file mode 100644
index 0000000..89e6a41
--- /dev/null
+++ b/t/xt/check_selected_option.t
@@ -0,0 +1,64 @@
+use strict;
+use warnings;
+use Test::More;
+
+use_ok('HTML::FormHandler::Widget::Field::Role::SelectedOption');
+
+{
+ package MyFoo;
+
+ use Moose;
+
+ with '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/t/xt/custom_fields.t
new file mode 100644
index 0000000..c4e33a8
--- /dev/null
+++ b/t/xt/custom_fields.t
@@ -0,0 +1,57 @@
+use strict;
+use warnings;
+use Test::More;
+
+
+{
+ package Test::MonthYear;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has_field 'my_date' => ( type => 'DateTime' );
+ has_field 'my_date.month' => ( type => 'Month' );
+ has_field 'my_date.year' => ( type => 'Year' );
+ has_field 'submit' => ( type => 'Submit' );
+
+}
+
+my $form = Test::MonthYear->new;
+ok( $form, 'form builds' );
+
+my $rendered_form = $form->render;
+
+{
+ package Test::Field::MonthYear;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler::Field::DateTime';
+
+ has_field 'month' => ( type => 'Month' );
+ has_field 'year' => ( type => 'Year' );
+}
+
+{
+ package Test::Widget::Field::MonthYear;
+ use Moose::Role;
+ sub render {
+ my $self = shift;
+ return '<p>Create your rendering here...</p>';
+ }
+}
+
+{
+ package Test::Form::MonthYearField;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has '+field_name_space' => ( default => 'Test::Field' );
+ has '+widget_name_space' => ( default => sub { ['Test::Widget'] } );
+ has_field 'my_date' => ( type => '+MonthYear', widget => 'MonthYear' );
+
+}
+
+$form = Test::Form::MonthYearField->new;
+ok( $form, 'form builds' );
+ok( $form->field('my_date'), 'the field is there' );
+is( $form->field('my_date')->render, '<p>Create your rendering here...</p>', 'renders ok' );
+
+done_testing;
diff --git a/t/xt/deprecations.t b/t/xt/deprecations.t
new file mode 100644
index 0000000..70a5ef2
--- /dev/null
+++ b/t/xt/deprecations.t
@@ -0,0 +1,15 @@
+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/email.t b/t/xt/email.t
new file mode 100644
index 0000000..4895c0e
--- /dev/null
+++ b/t/xt/email.t
@@ -0,0 +1,36 @@
+use strict;
+use warnings;
+use Test::More;
+
+BEGIN
+{
+ eval "use Email::Valid";
+ plan skip_all => 'Email::Valid required' if $@;
+ plan tests => 7;
+}
+
+$ENV{LANG} = 'en_us'; # in case user has LANG set
+
+my $class = 'HTML::FormHandler::Field::Email';
+use_ok($class);
+my $field = $class->new( name => 'test_field', );
+ok( defined $field, 'new() called' );
+
+$field->_set_input('foo at bar.com');
+$field->validate_field;
+ok( !$field->has_errors, 'Test for errors 1' );
+is( $field->value, 'foo at bar.com', 'value returned' );
+
+$field->_set_input('foo at bar');
+$field->validate_field;
+ok( $field->has_errors, 'Test for errors 2' );
+is(
+ $field->errors->[0],
+ 'Email should be of the format someuser at example.com',
+ 'Test error message'
+);
+
+$field->_set_input('someuser at example.com');
+$field->validate_field;
+ok( !$field->has_errors, 'Test for errors 3' );
+
diff --git a/t/xt/field_list.t b/t/xt/field_list.t
new file mode 100644
index 0000000..3752c34
--- /dev/null
+++ b/t/xt/field_list.t
@@ -0,0 +1,24 @@
+use strict;
+use warnings;
+use Test::More tests => 4;
+
+use HTML::FormHandler;
+
+my $field_list = [
+ id => {
+ type => 'Text',
+ required => 1,
+ },
+ submit => 'Submit',
+];
+
+my $form = HTML::FormHandler->new( field_list => $field_list );
+
+ok( $form, 'created form OK the first time');
+ok( $form->field('id'), 'id field exists' );
+
+$form = HTML::FormHandler->new( field_list => [@{$field_list}, new_field => 'Text'] );
+
+ok( $form, 'created form OK the second time' );
+ok( $form->field('id'), 'id field exists' );
+
diff --git a/t/xt/init.t b/t/xt/init.t
new file mode 100644
index 0000000..98b5d72
--- /dev/null
+++ b/t/xt/init.t
@@ -0,0 +1,38 @@
+use strict;
+use warnings;
+use Test::More tests => 7;
+
+{
+ package My::Other::Form;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has '+name' => ( default => 'testform_' );
+ has_field 'optname' => ( temp => 'First' );
+ has_field 'reqname' => ( required => 1 );
+ has_field 'somename';
+
+ sub default_reqname {
+ my $self = shift;
+ return 'From Method';
+ }
+ sub default_somename {
+ my $self = shift;
+ return 'SN from meth';
+ }
+}
+
+my $init_object = { reqname => 'Starting Perl', optname => 'Over Again' };
+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 );
+ok( $form->validated, 'form with init_obj & params validated' );
+is( $form->field('reqname')->init_value, 'From Method', 'correct init_value');
+is( $form->field('optname')->init_value, 'Over Again', 'correct init_value no meth');
+is( $form->field('somename')->init_value, 'SN from meth', 'correct for init_obj undef');
+is( $form->field('somename')->value, 'Exists', 'correct value for init_obj undef');
+
+$form = My::Other::Form->new( init_object => $init_object );
+is( $form->field('somename')->init_value, 'SN from meth', 'correct init_value new w init_obj');
diff --git a/t/xt/load_field.t b/t/xt/load_field.t
new file mode 100644
index 0000000..473334c
--- /dev/null
+++ b/t/xt/load_field.t
@@ -0,0 +1,64 @@
+use strict;
+use warnings;
+use Test::More;
+use lib 't/lib';
+
+
+{
+ package My::Form;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ # this form specifies the form name
+ has '+field_name_space' => ( default => 'Field' );
+
+ has_field 'field_one' => ( type => '+AltText', another_attribute => 'one' );
+ has_field 'field_two' => ( type => '+AltText', another_attribute => 'two' );
+ has_field 'field_three' => ( type => '+AltText', another_attribute => 'three' );
+
+}
+
+my $form = My::Form->new;
+ok( $form, 'get form' );
+
+my $params = {
+ field_one => 'one two three four',
+ field_two => 'one three four',
+ field_three => 'one three four',
+};
+
+$form->process( $params );
+
+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],
+ 'Fails AltText validation', 'get error message' );
+
+ok( !$form->field('field_three')->has_errors, 'field three has no error');
+
+{
+ package Field::Text;
+ use Moose;
+ extends 'HTML::FormHandler::Field::Text';
+ has 'my_attr' => ( is => 'rw' );
+}
+
+{
+ package Test::Form;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ # this form specifies the form name
+ has '+field_name_space' => ( default => sub { ['Test', 'Field', 'FieldX']} );
+
+ has_field 'field_text' => ( type => '+Text', my_attr => 'test' );
+
+}
+
+$form = Test::Form->new;
+is( $form->field('field_text')->my_attr, 'test', 'finds right field' );
+
+done_testing;
diff --git a/t/xt/locale.t b/t/xt/locale.t
new file mode 100644
index 0000000..fbe1fd4
--- /dev/null
+++ b/t/xt/locale.t
@@ -0,0 +1,124 @@
+use strict;
+use warnings;
+use Test::More;
+use Test::Exception;
+use HTML::FormHandler::Field::Text;
+
+use lib ('t/lib');
+
+# ensure $ENV is properly set up
+my @LH_VARS = ('LANGUAGE_HANDLE', 'HTTP_ACCEPT_LANGUAGE', 'LANG', 'LANGUAGE' );
+my %LOC_ENV;
+$LOC_ENV{$_} = delete $ENV{$_} for @LH_VARS;
+
+# a primitive translation package
+{
+ package HTML::FormHandler::I18N::xx_xx;
+ use base 'HTML::FormHandler::I18N';
+
+ # Auto define lexicon
+ our %Lexicon = (
+ '_AUTO' => 1,
+ 'You lost, insert coin' => 'Not won, coin needed',
+ 'Test field' => 'Grfg svryq',
+ );
+}
+
+# a simple demo form
+{
+ package Test::Form;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has_field 'test_field';
+}
+
+my $form;
+
+
+################ Locale -none-
+
+$ENV{LANGUAGE} = 'en-US';
+
+# create form w/o locale must work
+lives_ok { $form = Test::Form->new } 'create form w/o locale lives';
+ok($form, 'create form w/o locale');
+is(ref($form->language_handle), 'HTML::FormHandler::I18N::en_us', 'locale en_us');
+
+# ensure we know / don't know the translations
+$HTML::FormHandler::I18N::en_us::Lexicon{'You lost, insert coin'} = 'XX Dummy 42';
+$HTML::FormHandler::I18N::en_us::Lexicon{'Must insert a [_1] coin'} = 'Want a [_1] coin';
+delete $HTML::FormHandler::I18N::en_us::Lexicon{'Test field'};
+delete $HTML::FormHandler::I18N::en_us::Lexicon{'You won'};
+
+# translating a known error works
+$form->field('test_field')->clear_errors;
+$form->field('test_field')->add_error('You lost, insert coin');
+is_deeply($form->field('test_field')->errors, ['XX Dummy 42'], 'error is translated into en_us');
+
+# translating a known label
+is($form->field('test_field')->label, 'Test field', 'Label w/o translation = ok');
+
+# translating a known error with a positional parameter
+$form->field('test_field')->clear_errors;
+$form->field('test_field')->add_error('Must insert a [_1] coin', 'cleaned');
+is_deeply($form->field('test_field')->errors, ['Want a cleaned coin'], 'error w/parameter is translated into en_us');
+
+# translating an unknown error also works
+$form->field('test_field')->clear_errors;
+$form->field('test_field')->add_error('You won');
+is_deeply($form->field('test_field')->errors, ['You won'], 'error is translated into en_us');
+
+# translating an error with bracket issues
+$form->field('test_field')->clear_errors;
+dies_ok( sub { $form->field('test_field')->add_error('You are not authorized for this archive. See: [<a href="/help/auth">more information</a>], [<a href="/need_auth">request authorization</a>]') }, 'dies on maketext error' );
+
+################ Locale xx_xx set via ENV{LANGUAGE_HANDLE}
+$ENV{LANGUAGE_HANDLE} = HTML::FormHandler::I18N->get_handle('xx_xx');
+
+# create form w/ locale must work
+undef $form;
+lives_ok { $form = Test::Form->new } 'create form w/ locale lives';
+ok($form, 'create form w/ locale');
+is(ref($form->language_handle), 'HTML::FormHandler::I18N::xx_xx', 'locale xx_xx');
+
+# translating a known error works
+$form->field('test_field')->clear_errors;
+$form->field('test_field')->add_error('You lost, insert coin');
+is_deeply($form->field('test_field')->errors, ['Not won, coin needed'], 'error is translated into xx_xx');
+
+# translating an unknown error also works
+$form->field('test_field')->clear_errors;
+$form->field('test_field')->add_error('You won');
+is_deeply($form->field('test_field')->errors, ['You won'], 'error is translated into xx_xx');
+
+# translating a known label
+is($form->field('test_field')->label, 'Grfg svryq', 'label rot13 to xx_xx');
+
+# remove from environment variable, so we can use builder
+delete $ENV{LANGUAGE_HANDLE};
+{
+ package MyApp::Test::Form;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+ use MyApp::I18N::abc_de;
+
+ sub _build_language_handle { MyApp::I18N::abc_de->new }
+ has_field 'foo';
+ has_field 'bar';
+ sub validate_foo {
+ my ( $self, $field ) = @_;
+ $field->add_error('You lost, insert coin');
+ }
+}
+
+$form = MyApp::Test::Form->new;
+
+ok( $form, 'form built' );
+$form->process( params => { foo => 'test' } );
+is( $form->field('foo')->errors->[0], 'Loser! coin needed', 'right message' );
+is( ref $form->language_handle, 'MyApp::I18N::abc_de', 'using right lh');
+
+$ENV{$_} = 'en-US' for @LH_VARS;
+
+done_testing;
diff --git a/t/xt/model_cdbi.t b/t/xt/model_cdbi.t
new file mode 100644
index 0000000..96b305f
--- /dev/null
+++ b/t/xt/model_cdbi.t
@@ -0,0 +1,13 @@
+use Test::More tests => 2;
+
+use_ok( 'HTML::FormHandler::Model::CDBI' );
+
+{
+ package Test::CDBI;
+ use Moose;
+ extends 'HTML::FormHandler::Model::CDBI';
+
+}
+
+my $form = Test::CDBI->new;
+ok( $form, 'get form from CDBI model' );
diff --git a/t/xt/multiple_forms.t b/t/xt/multiple_forms.t
new file mode 100644
index 0000000..21fe92e
--- /dev/null
+++ b/t/xt/multiple_forms.t
@@ -0,0 +1,76 @@
+use Test::More tests => 9;
+
+
+use_ok( 'HTML::FormHandler' );
+
+{
+ package My::Form::One;
+ use HTML::FormHandler::Moose;
+
+ extends 'HTML::FormHandler';
+
+ # this form specifies the form name
+ has '+name' => ( default => 'One' );
+ has '+html_prefix' => ( default => 1 );
+
+ has_field 'field_one';
+ has_field 'field_two';
+ has_field 'field_three';
+}
+my $form1 = My::Form::One->new;
+ok( $form1, 'get first form' );
+
+{
+ package My::Form::Two;
+ use Moose;
+ extends 'HTML::FormHandler';
+
+ # this form uses the default random form name generation
+ has '+html_prefix' => ( default => 1 );
+
+ sub field_list {
+ [
+ field_one => 'Text',
+ field_two => 'Text',
+ field_three => 'Text',
+ ]
+ }
+}
+my $form2 = My::Form::Two->new;
+ok( $form2, 'get second form' );
+
+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 =>
+ 'First field in second form',
+ $form2->field('field_two')->html_name =>
+ 'Second field in second form',
+ $form2->field('field_three')->html_name =>
+ 'Third field in second form',
+};
+$form1->process( $params );
+ok( $form1->validated, 'validated first form' );
+is( $form1->field('field_one')->value, 'First field in first form',
+ 'value of field in first form is correct' );
+my $fif_params = $form1->fif;
+is_deeply( $fif_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',
+ }, 'fif params correct');
+
+$form2->process( $params );
+ok( $form2->validated, 'validated second form' );
+is( $form2->field('field_three')->value, 'Third field in second form',
+ 'value of field in second form is correct' );
+
+$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 = My::Form::Two->new( params => $params );
+ok( !$form2->has_params, 'has_params checks only params intented for the form');
+
diff --git a/t/xt/order.t b/t/xt/order.t
new file mode 100644
index 0000000..d30ac56
--- /dev/null
+++ b/t/xt/order.t
@@ -0,0 +1,27 @@
+use Test::More tests => 3;
+
+
+use_ok( 'HTML::FormHandler' );
+
+{
+ package My::Form;
+ use Moose;
+ extends 'HTML::FormHandler';
+
+ sub field_list {
+ [
+ field_one => 'Text',
+ field_two => 'Text',
+ field_three => 'Text',
+ field_four => 'Text',
+ field_five => 'Text',
+ ]
+ }
+}
+
+my $form = My::Form->new;
+
+is( $form->field('field_one')->order, 1, 'first field order');
+is( $form->field('field_five')->order, 5, 'last field order');
+
+
diff --git a/t/xt/params.t b/t/xt/params.t
new file mode 100644
index 0000000..ba04497
--- /dev/null
+++ b/t/xt/params.t
@@ -0,0 +1,85 @@
+use Test::More tests => 6;
+
+use_ok( 'HTML::FormHandler::Params' );
+
+my $_params = HTML::FormHandler::Params->new;
+
+my $p1 = {
+ 'book.author' => 'J.Doe',
+ 'book.title' => 'Doing something',
+ 'book.date' => '2002',
+};
+
+my $p1_exp = $_params->expand_hash( $p1 );
+
+is_deeply( $p1_exp, { book => { author => 'J.Doe',
+ title => 'Doing something',
+ date => '2002' } }, 'get expanded has' );
+
+my $p2 = {
+ 'books.0.author' => 'Jane Doe',
+ 'books.0.title' => 'Janes Book',
+ 'books.0.date' => '2003',
+ 'books.1.author' => 'Miss Muffet',
+ 'books.1.title' => 'Sitting on a Tuffet',
+ 'books.1.date' => '2004'
+};
+
+my $p_hash = {
+ books => [
+ { author => 'Jane Doe',
+ title => 'Janes Book',
+ date => '2003',
+ },
+ {
+ author => 'Miss Muffet',
+ title => 'Sitting on a Tuffet',
+ date => '2004',
+ }
+ ]
+};
+
+my $p2_exp = $_params->expand_hash( $p2 );
+is_deeply( $p2_exp, $p_hash, 'get expanded hash for dot notation' );
+
+my $p3 = {
+ 'books+0+author' => 'Jane Doe',
+ 'books+0+title' => 'Janes Book',
+ 'books+0+date' => '2003',
+ 'books+1+author' => 'Miss Muffet',
+ 'books+1+title' => 'Sitting on a Tuffet',
+ 'books+1+date' => '2004'
+};
+
+my $p3_exp = $_params->expand_hash( $p3, '+' );
+is_deeply( $p3_exp, $p_hash, 'get expanded hash for plus notation' );
+
+
+my $p4 = {
+ 'books[0]author' => 'Jane Doe',
+ 'books[0]title' => 'Janes Book',
+ 'books[0]date' => '2003',
+ 'books[1]author' => 'Miss Muffet',
+ 'books[1]title' => 'Sitting on a Tuffet',
+ 'books[1]date' => '2004'
+};
+
+my $p4_exp = $_params->expand_hash( $p4, '[]' );
+is_deeply( $p4_exp, $p_hash, 'get expanded hash for bracket notation' );
+
+my $p5 = {
+ 'book.author' => 'Jane Doe',
+ 'book.title' => 'Janes Book',
+ 'book.date' => '2003',
+};
+
+my $p5_hash = {
+ book =>
+ { author => 'Jane Doe',
+ title => 'Janes Book',
+ date => '2003',
+ },
+ };
+my $p5_exp = $_params->expand_hash( $p5 );
+is_deeply( $p5_exp, $p5_hash, 'get hash from single brackets');
+
diff --git a/t/xt/submit.t b/t/xt/submit.t
new file mode 100644
index 0000000..779b7e0
--- /dev/null
+++ b/t/xt/submit.t
@@ -0,0 +1,43 @@
+use strict;
+use warnings;
+use Test::More;
+
+use_ok( 'HTML::FormHandler::Field::Submit' );
+
+my $field = HTML::FormHandler::Field::Submit->new(name => 'submit');
+is( $field->value, 'Save', 'get right value');
+ok( $field->result, 'returns result');
+
+{
+ package Test::Submit;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+ with 'HTML::FormHandler::Render::Simple';
+
+ has '+name' => (default => 'test_submit');
+ has_field 'some_field';
+ has_field 'submit' => ( type => 'Submit', value => 'Submit' );
+}
+
+my $form = Test::Submit->new;
+ok( $form, 'get form');
+my $params = { some_field => 'test' };
+$form->process($params);
+my $result = $form->result;
+is( $result->num_results, 2, 'two results');
+is( $form->field('submit')->input, undef, 'no input for submit field');
+$form->process( { some_field => 'test', submit => 'Submit' } );
+is( $form->field('submit')->input, 'Submit', 'input for submit field');
+my $rendered = $form->render;
+is( $rendered,
+ '<form id="test_submit" method="post" >
+<fieldset class="main_fieldset">
+<div><label class="label" for="some_field">Some field: </label><input type="text" name="some_field" id="some_field" value="test" /></div>
+
+<div><input type="submit" name="submit" id="submit" value="Submit" /></div>
+</fieldset></form>
+',
+'form renders');
+
+
+done_testing;
diff --git a/t/xt/upload.t b/t/xt/upload.t
new file mode 100644
index 0000000..90e08db
--- /dev/null
+++ b/t/xt/upload.t
@@ -0,0 +1,96 @@
+use strict;
+use warnings;
+use Test::More;
+
+use_ok('HTML::FormHandler::Field::Upload');
+
+{
+ package Mock::Upload;
+ use Moose;
+ use File::Copy ();
+ use IO::File ();
+ use File::Spec::Unix;
+
+ has filename => ( is => 'rw' );
+ has size => ( is => 'rw' );
+ has tempname => ( is => 'rw' );
+ has basename => ( is => 'ro', lazy_build => 1 );
+ has fh => (
+ is => 'rw',
+ required => 1,
+ lazy => 1,
+ default => sub {
+ my $self = shift;
+ my $fh = IO::File->new( $self->tempname, IO::File::O_RDONLY );
+ unless ( defined $fh ) {
+ my $filename = $self->tempname;
+ die "Can't open '$filename': '$!'";
+ }
+ return $fh;
+ },
+ );
+
+ sub _build_basename {
+ my $self = shift;
+ my $basename = $self->filename;
+ $basename =~ s|\\|/|g;
+ $basename = ( File::Spec::Unix->splitpath($basename) )[2];
+ $basename =~ s|[^\w\.-]+|_|g;
+ return $basename;
+ }
+
+ sub copy_to {
+ my $self = shift;
+ return File::Copy::copy( $self->tempname, @_ );
+ }
+
+ sub link_to {
+ my ( $self, $target ) = @_;
+ return CORE::link( $self->tempname, $target );
+ }
+
+ sub slurp {
+ my ( $self, $layer ) = @_;
+ unless ($layer) {
+ $layer = ':raw';
+ }
+ my $content = undef;
+ my $handle = $self->fh;
+ binmode( $handle, $layer );
+ while ( $handle->sysread( my $buffer, 8192 ) ) {
+ $content .= $buffer;
+ }
+ return $content;
+ }
+}
+{
+
+ package My::Form::Upload;
+ use HTML::FormHandler::Moose;
+ extends 'HTML::FormHandler';
+
+ has '+enctype' => ( default => 'multipart/form-data');
+
+ has_field 'file' => ( type => 'Upload' );
+ has_field 'submit' => ( type => 'Submit', value => 'Upload' );
+}
+
+my $form = My::Form::Upload->new;
+ok( $form, 'created form with upload field' );
+
+is( $form->field('file')->render, '
+<div><label class="label" for="file">File: </label><input type="file" name="file" id="file" /></div>
+', 'renders ok' );
+
+my $upload = Mock::Upload->new( filename => 'test.txt', size => 1024 );
+
+$form->process( params => { file => $upload } );
+ok( $form->validated, 'form validated' );
+
+$upload->size( 20000000 );
+$form->process( params => { file => $upload } );
+ok( !$form->validated, 'form did not validate' );
+
+
+
+done_testing;
--
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