HTML-FormHandler-0.40050/ 0000755 0000770 0000770 00000000000 12221042077 014134 5 ustar gshank gshank HTML-FormHandler-0.40050/Changes 0000644 0000770 0000770 00000073113 12221042076 015433 0 ustar gshank gshank 0.40050 Thu Sep 26, 2013
*** 'widget_tags' in a field have been deprecated for a long time; removing.
There are still widget_tags in the form and compound fields.
Use 'tags' in a field instead.
*** Initial support of Bootstrap3 - still EXPERIMENTAL. Do not use in
production yet. Changes in interface may occur over the next few weeks.
Supporting Bootstrap 3.0 required a surprising amount of minor refactoring:
Bootstrap3 checkboxes and radio elements now have an additional div wrapping them.
This required setting flags in the wrapper that could be seen by the
field widgets. Used 'wrapper_tags' attribute, which is not the most satisfying
solution but does work. The former 'controls' div now doesn't have the
'controls' class, but is used for sizing. Added new attribute
'element_wrapper_class' to provide these classes. Split out addition of
classes to the wrapper and element into 'add_standard_wrapper_classes' and
'add_standard_element_classes', because B3.0 now wants 'has-error' and
'has-warning' instead of the former 'error' class. 'control-group' was
changed to 'form-group'. The 'form-control' class has been added to
text, password, textarea, and select fields.
Add 'preserve_case' attribute to Email field
0.40028 Sat Sep 21, 2013
Fixed bug when rendering blocks with 'run' (results)
Sort the deflated values of SelectCSV field
Allow passing Email::Valid params to Email field
Typos fixed
Add 'use_init_obj_when_no_accessor_in_item' flag for dual-purpose init_obj
0.40027 Thu Aug 8, 2013
Add 'options_ref' method for using options in TT templates
Add unique messages to field messages hash
0.40026 Wed Jul 3, 2013
Add Italian message file
Doc tweaks
Add errors_by_id and errors_by_name convenience methods
0.40025 Thu May 9, 2013
Add skip in t/setup_form_config.t unless YAML::Syck (Config::Any)
0.40024 Tue May 7, 2013
Add 'no_option_validation' flag to select field.
Remove HtmlArea field. (Has always been broken, and there were complaints about
not prereqing HTML::Tidy, which I won't do due to difficulty of installing)
Change 'use' of GD::SecurityImage to a 'require'. (Will not prereq this one either.)
0.40023 Tue Apr 30, 2013
Add Brazilian Portuguese translation file
Fix bug in process of re-loading repeatables without primary keys after db update
Add TextCSV field for multiple values in a text field (useful with js libraries)
0.40022 Mon Mar 18, 2013
Remove 'writeonly' flag from Display field, because fix to not pull
values from an item/init_object with that flag meant that values were not
being applied to Display fields, when people were relying on that.
Switch to using github issues instead of RT
0.40021 Mon Mar 4, 2013
Don't validate disabled fields
check for existence of field in match_when before getting $field->fif,
improve error message
add type_attr to Select field; update t/render/ff.t to use it
cleanup select field options_method building
0.40020 Sun Feb 20, 2013
More support for repeatable javascript:
Tweak Bootsrap wrapper to check do_wrapper instead of do_label when rendering
'controls' div
Reminder: It's always a good idea to make your own set of of widgets so that
updates don't throw off your rendering. This change was hardly noticeable
in the FH testcases, but it's possible you were relying on the old behavior
for CSS.
Add 'controls_div' to Simple wrapper.
Add RmElement example field.
0.40019 Fri Feb 8, 2013
Move back 'before_element' tag; breaks existing rendering. Add additional
'before_element_inside_div' tag instead.
0.40018 Thur Feb 7, 2013
Don't put 'control-group' on Bootstrap hidden field div because of spacing issues
Support for repeatable add/remove javascript
add 'setup_for_js' flag to Field::Repeatable
add HTML::FormHandler::Render::RepeatableJs
add HTML::FormHandler::Field::AddElement
add before_wrapper and after_wrapper tags
add 'id' to wrappers of compound fields
update Display field to use 'render_method'
allow applying wrapper widget even if field has render method
Fix positioning of 'before_element' tag in Bootstrap wrapper
0.40017 Sat Dec 1, 2012
Fix bad html in Span widget
Fix unitialized warning processing has_field with '+'
Use get_default_value in Submit/Reset field
Improve doc for bootstrap theme, use BootstrapFormMessages role
Add lazy to render_filter for random failures in 5.17.6
0.40016 Mon Oct 15, 2012
Fix bug with DBIC model interface
0.40015 Sun Oct 14, 2012
Remove extraneous use of Data::Printer
Correct spelling of PadWalker
0.40014 Sat Oct 13, 2012
Add useful message and die in field widgets with no result
Use string instead of object in LANGUAGE_HANDLE
Fix bug in required_when when value is 0
Allow using arrayref for sort_column.
Select field as_label for multiple fields.
Minor doc fixes
Bug - option group label attributes
Add info_message to form and rendering.
Add 'use_fields_for_input_without_param' flag
Call inflate_default_method on repeatable elements
0.40013 Sun Jun 24, 2012
Re-write elimination of PrimaryKey field from repeatable value,
add 'no_value_if_empty' attribute
Fix bug with labels '0' not being displayed
Change 'missing' to an attribute.
Submit field has 'submit' html5_type_attr
Add html5_type_attr to Hidden, Reset, and Password fields
Add new behavior for compound fields and 'not_nullable' flag,
where compound field value is not set to undef when all
subfields are empty. This is needed for some kinds of db
relationships, to ensure that subfields are set to null.
0.40012 Fri Jun 15, 2012
Bug cloning merging repeatable instances; form reference garbage collected
Doc typos
0.40011 Tue Jun 5, 2012
Remove automatic building of field results. If you have field tests, you
need to add $field->build_result after creating field with 'new'.
Possible memory cycle if result is accessed when not built.
Add 'required_when'
Add Bulgarian message file (dpetrov)
Bootstrap input_append/prepend: no linefeeds between input
Add input_append_button tag to Bootstrap wrapper
Correct camelcase for widgets in two fields
Add 'value_when_empty' for multiple select
Add SelectCSV multiple field
Change Select to use sort_options_method for sorting
0.40010 Sun May 20, 2012
Add 'when' clause to apply actions
Fix memory leak on fields with defaults due to missing 'my' causing
$self to be closed over so that RAM was leaked if forms were constructed
but never processed. (in default_ & validate_
methods)
0.40009 Mon May 14, 2012
Re-implement improved version of 'reload_after_update'.
0.40008 Fri May 11, 2012
Add 'missing' method to Field
Use result in Bootstrap render_form_messages
Fix Render::Table
Propagate errors when they're added, so $form->has_errors
works in sub validate
Use do_render_label in Bootstrap wrapper to allow setting
label class/attributes
Add subfield convenience method.
Remove 'reload_after_update'. Didn't work anyway. Bug: duplicate
results with repeatables. (avoid with reload_after_update => 0)
Re-factor RadioGroup widget to allow individually rendered options
Support option groups in 'Select', 'RadioGroup' & 'CheckboxGroup' widgets
0.40007 Tues Apr 24, 2012
Re-factor widget to provide 'render_element' method
Various doc updates
Move 'by_flag' processing into '_merge_updates'
Handle disabled fields better; result_from_fields if no input
Fix bug: html_attributes callback called with 'input' instead of 'element'
0.40006 Tues Apr 10, 2012
Render::Table incorrect table start
Minor doc cleanup
Add 'build_label_method'
Re-do merging of widget_tags
Implement experimental 'include' list for Form/Compound fields
Refactor merge_updates and update_subfields to handle contains
Add 'by_type' to update_subfields
0.40005 Mon Mar 26, 2012
prevent undef from being passed to maketext
expand use of 'posted' flag to check false values
add wrap_label method
0.40004 Fri Mar 23, 2012
Don't put element attributes on select options
Make render_list lazy
Better defaults for compound fields
Provide package name for die when not extending
Add block_list to provide blocks
Defaults for repeatable fields
0.40003 Wed Mar 14, 2012
Move dfv test that fails prereqs
0.40002 Tue Mar 13, 2012
Put form wrappers that are fieldsets inside form tag; outside not legal HTML
Doc updates
Add 'NonEditable' field and 'Span' field widget
Patch HTMLAttributes (compatibility for older style custom widgets)
0.40001 Wed Mar 7, 2012
Remove \K in regex for ucc_widget; doesn't work pre 5.10
Switch DateTime field to use inflate_default_method
0.40000 Tue Mar 6, 2012
**** There are many changes to rendering, many of them incompatible.
These changes *will* break existing form rendering.
You must check that your rendering works before upgrading. Making a copy
of the old code (the widget and rendering roles) may be helpful (or use
the compatibility libraries -- see below).
I always prefer to maintain backward compatibility if possible, but
a number of the improvements were not possible without breaking
compatibility, so I did a lot of changes at once.
Compatibility libraries are provided to help support rendering that relied
on the earlier libriaries at:
git://github.com/gshank/html-formhandler_pre-0.40_compat.git
README at: https://github.com/gshank/html-formhandler_pre-0.40_compat/blob/master/README
Add Twitter Bootstrap 2.0 widget wrapper
Add 'no_update' flag to allow skipping model_update.
Remove 'deflate_to' flag; provide new inflation/deflation methods.
see HTML::FormHandler::Manual::InflationDeflation
New 'build_id_method' to provide different builder method for field IDs.
'auto_fieldset' and 'no_auto_fieldset' no longer used. No automatic fieldsets.
Can be added with do_wrapper => 1 and a tag of wrapper_tag => 'fieldset'
Localize the value of the reset button.
Tests and fix for form 'validate_' and 'default_' method
for repeatables fields.
Change default radiogroup rendering to not use elements. Add back
with tag radio_br_after => 1
Switch to using coderef for deflate_method; custom fields with deflate sub
will need to be modified.
Add block rendering (HTML::FormHandler::Blocks)
Re-do code for default & validate method construction; now provides
'default_method' and 'validate_method' coderef setting
Remove 'init_value_*' from Field (deprecated for years).
Use Hash::Merge in merging update field info on creation
Fix bug in copying tags to fields by cloning field definitions
Switch to using name 'element_attr' in fields instead of 'html_attr'
Put wrapper class 'hfh-repinst' on Repeatable Instances unless they already have a wrapper class
Remove 'javascript' field attribute. Put into *_attr hashref.
Automatically put 'error' on element and wrapper.
Switch to having the 'class' as a separate attribute from the _attr collection.
Use 'element_class', 'wrapper_class' & 'label_class' arrayrefs
Switch to having widget names by default be camel case; provide convenience
methods for templates - uwidget, uwrapper, twidget, twrapper.
** this change will affect existing template systems, if they use the
$field->widget method to get the widget name. See example templates.
and conversion methods 'ucc_widget' and 'cc_widget' in HTML::FormHandler::Render::Util
Create t/share/templates/form/form_in_one.tt
Switch default rendering of checkbox to have label wrap input. Checkboxes are
complicated. See t/render/checkbox.t for various options.
Add 'build_update_subfields' to 'update_fields' processing to allow moving
more of rendering settings into a separate role
Change form 'html_attr' to 'form_element_attr', and use builder
Change interface of html_field_attributes to also return attr (instead of just in-place)
Remove 'label_no_colon', make labels without colon the default.
Add widget tag 'label_after'. Use "label_after => ': '" for old behavior
Add widget tag 'label_tag'. Default 'label'.
Widget_tags replaced with 'form_tags' in form and 'tags' in Field.
takes builder 'build_form_tags' instead of default
Repeatable elements get automatic 'div' wrapper
Remove attribute 'auto_fieldset'; wrapping form is no longer a default;
Add back with sub build_do_form_wrapper {1},
and form_tags => { wrapper_tag => 'fieldset' }
Remove automatic wrapping of compounds.
Enable wrapping with do_wrapper => 1 (there's also do_label => 1)
Put form wrapper around form tag instead of inside
wrapper_start and wrapper_end tags not used to skip wrapper; use do_wrapper => 0
The 'get_tag' method now returns '' instead of undef if tag doesn't exist.
0.36001 Tues Jan 24, 2012
Add two more widget tags: 'no_auto_fieldset' and 'no_compound_wrapper'
Remove automatic addition of 'class="label"' to labels; if you want that
behavior, add it in with form sub field_html_attributes.
Add 'SKIP' to t/config.t test for Template.
Update Captcha so it might actually work.
0.36000 Sun Jan 22, 2012
Switch to using 'process_attrs' function to process attributes in rendering;
*** There were lots of updates to rendering. You should verify your custom
rendering, to make sure that nothing has broken. The '_add_html_attributes'
method is no longer used.
Add shorthand method for setting defaults in fields
Add widget_tags 'label_no_colon' & 'wrapper_tag'
Update and reorganize TT templates
Add flags 'use_defaults_over_obj' & 'use_init_obj_over_item'
Add 'num_extra' to Repeatable
Update Turkish message file; add Float field
Add lazy to 'html' attribute in Display field
Add 'label_attr' and 'wrapper_attr' to Field
Add 'Array' trait to field_name_space and widget_name_space
Bug with selected/checked hash key in Multiple; switch to creating default
Bug with repeatable contains; not using full name for accessor.
Die if using HTML::FormHandler::Moose without HTML::FormHandler
Field::TextArea extends Field::Text to reuse its validations (min/max length)
Add is_html5 attribute to forms which causes forms to have the additional
HTML 5 attributes which can be used by HTML 5 capable clients for validation
0.35005 Sat Oct 8, 2011
Fix bug repeatable result not returned for num_when_empty
Fix bug repeatable required flag not propagated
Fix bug building nested compound fields
Allow html attributes on radio group elements
Undefined string warning in select rendering
Add Japanese message file
0.35004 Wed Oct 5, 2011
Fix bug setting multiple selects with init_object
Provide html_attr for form attributes
Use Moose type for field_name_space and widget_name_space
0.35003 Wed Sep 7, 2011
Fix bug constructing classes for Class::Load, revealed by Class::Load 0.10
0.35002 Mon Aug 8, 2011
Change to use Class::Load due to speed.
0.35001 Mon Jul 25, 2011
Undid setting processed flag when building result in BUILD. Breaks
existing apps. Re-thinking that part for now.
0.35000 Thu Jul 21, 2011
Add support for tabindex attribute.
Generic html attribute setting (html_attr)
Set 'processed' flag when building results in BUILD to fix problem
with garbage collected results.
*** it's possible that this may break code if field values were being
set outside of FormHandler, or params were set on new. Pass params
on process. Set fields inside FormHandler, or run clear first, then
set values. In general, it works best to update fields inside a
FormHandler class, in a method or method modifier.
Building results in 'new' happened originally because people expected
to be able to do $form->render after new, without process. But you're
better off always running 'process'.
Add flag 'no_preload' to skip building results in new (BUILD) if not needed
Add flag 'no_widgets' to skip applying widgets to fields if not needed
Fix for Date fields in compounds.
Types Printable & SingleWord use class messages
Add link to the bug tracker into the HELP section in the Pod.
Change how field_traits work: apply traits to field objects, add
new class method apply_traits (Stephen Thirlwall)
0.34001 Mon May 16, 2011
Fiz another memory cycle using Select field
Tweak code creating results for Field testing
0.34000 Mon May 16, 2011
Fixed memory cycles; 1 in HFH code, others by requiring Moose 2.0007
Localize value of a button
Allow limited use of has_many multiple select
Add SimpleInline & TableInline widgets to not wrap compound fields
0.33002 Tues Feb 22, 2011
Accidentally left off compatibility for 'required_message' attribute
messages => { required => '...' } is new style and worked
0.33001 Mon Feb 21, 2011
Remove unnecessary with of HFH::Validate::Actions
0.33000 Mon Feb 21, 2011
bug - empty_select check defined
Add button field, widget, template
Check html attributes for definedness not truth
Add ability to set field inactive on new & process
in addition to setting active
Move 'no_render_label' into Field
Use form's language_handle in fields
Improve PrimaryKey doc
Return empty hashref from $form->value instead of undef
Merge experimental Wizard into master
Render disabled select options
Repeatable contains rendering incorrectly, skipping empty elements
Add rendering of form_errors to widgets and Render::Simple
*** If you were using form_errors (there are none by default)
and were using HFH rendering, check for compatibility
Allow specifying full class for widget with '+'
Document removing wrapper div from Simple wrapper
Re-do how field messages are stored and accessed. Use messages => {...}
instead of various _message attributes
Add utilities in util to pull out class messages and check I18N
Update I18N messages files (those that were provided by translators)
Change render_filter Coderef setting because of leak;
*** Possible incompatibility: if you have a form render_filter,
change to function instead of method
Change _localize to a Coderef to allow easier changing.
*** If you have a custom _localize method, check for compatibility
0.32005 Wed Oct 20, 2010
Removed '//'; incompatible with earlier versions of Perl
0.32004 Wed Oct 20, 2010
Minor doc cleanup
Switch away from MooseX::Traits; memory leak because of non-cached
composed classes
0.32003 Sun Oct 3, 2010
Fix syntax for 'with', excludes => -excludes
Use labels in radio group widgets
Add 'is_active' and 'is_inactive' convenience methods in Field
Select options - check defined instead of truth
Misc minor doc and test improvements
Coderef allowed for messages in apply actions
Limit removing of numbers when constructing method names
Use html_filter when rendering labels
Allow undefining min_size and max_size in upload field
Return in render_filter if string is not defined
Change rendering of repeatable subfields
0.32002 Thu July 29, 2010
Update to handle newer Moose (error msg with Moose::Util::MetaRole API)
Swich to Dist::Zilla
Add customization of form tag attributes
Add test prereqs
0.32001 Fri June 25, 2010
Add prereqs for DateTime::Format::Strptime and Email::Valid
0.32000 Fri June 25, 2010
Accept arrayref messages in add_error
Add initial fieldset wrapper
Flag (localize_labels) in Select field for rendering; localize empty_select
Add posted flag for forms containing only fields with no params when unselected
Add 'update_fields' methods and 'update_field_list' for preference-type field updates
Fix incorrect error message in duration field
Use LANGUAGE_HANDLE instead of LANG in tests
Add 'input_class' for class attribute on input fields
Allow deflation in fif, flag 'deflate_to' => 'value'/'fif'
Fix bug with unselected Select field (move input_without_param & not_nullable into field)
Add resultset example to cookbook
Doc to look at input for multiple submit fields
Fix bug in _set_dependency; use 'has_some_value' to determine emptiness
Add form_errors for non-field errors
Remove deprecated 'min_length' attribute ('minlength' is supported)
Allow upload field to be passed a file handle
Pass values to Display field (for display-only db fields)
Change I18N to allow duck_type classes; add test for Data::Localize
Added 'peek' diagnostic function for viewing field & result trees
Fix bug with extra results in repeatable elements
Strip empty pks and empty elements from repeatable values (avoid DB errors)
Localize value of submit button
Make '+' unnecessary in front of field name space types
0.31003 Fri May 7, 2010
Change precedence of defaults over item/init_object; add 'default_over_obj' for
cases where that behavior is desired.
Fix errors in filtering HTML in rendering
Call deflation in InitResult::_result_from_obj
Split localization of labels into separate 'loc_label' method
Call loc_label where label is used in error messages
Enable empty strings for wrapper_start and wrapper_end
Set locale to en_us where needed in test
Fix widget_name_space use in fields
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_' 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_ to default_
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
HTML-FormHandler-0.40050/dist.ini 0000644 0000770 0000770 00000003137 12221042076 015603 0 ustar gshank gshank ; Everything starting with ';' is a comment
name = HTML-FormHandler
main_module = lib/HTML/FormHandler.pm
author = FormHandler Contributors - see HTML::FormHandler
license = Perl_5
copyright_holder = Gerda Shank
copyright_year = 2013
version = 0.40050
[@Git]
tag_format = %v
[@Basic]
[InstallGuide]
[MetaJSON]
[MetaResources]
bugtracker.web = http://github.com/gshank/html-formhandler/issues
; If you have a repository...
repository.url = git://github.com/gshank/html-formhandler.git
repository.web = http://github.com/gshank/html-formhandler
repository.type = git
; You have to have Dist::Zilla::Plugin:: for these to work
[PodWeaver]
[NoTabsTests]
[EOLTests]
[Signature]
[CheckChangeLog]
[Prereqs]
Class::Load = 0.06
Carp = 0
Moose = 2.0007
Locale::Maketext = 1.09
DateTime = 0
DateTime::Format::Strptime = 0
MooseX::Getopt = 0.16
MooseX::Types = 0.20
MooseX::Types::Common = 0
MooseX::Types::LoadableClass = 0.006
aliased = 0
File::Spec = 0
File::ShareDir = 0
Try::Tiny = 0
namespace::autoclean = 0.09
Email::Valid = 0
Sub::Exporter = 0
HTML::TreeBuilder = 3.23
Sub::Name = 0
Data::Clone = 0
JSON = 0
[Prereqs / TestRequires]
Test::More = 0.94
Test::Differences = 0
Test::Exception = 0
Test::Memory::Cycle = 1.04
PadWalker = 0
HTML-FormHandler-0.40050/INSTALL 0000644 0000770 0000770 00000001726 12221042076 015172 0 ustar gshank gshank
This is the Perl distribution HTML-FormHandler.
Installing HTML-FormHandler is straightforward.
## Installation with cpanm
If you have cpanm, you only need one line:
% cpanm HTML::FormHandler
If you are installing into a system-wide directory, you may need to pass the
"-S" flag to cpanm, which uses sudo to install the module:
% cpanm -S HTML::FormHandler
## Installing with the CPAN shell
Alternatively, if your CPAN shell is set up, you should just be able to do:
% cpan HTML::FormHandler
## Manual installation
As a last resort, you can manually install it. Download the tarball, untar it,
then build it:
% perl Makefile.PL
% make && make test
Then install it:
% make install
If you are installing into a system-wide directory, you may need to run:
% sudo make install
## Documentation
HTML-FormHandler documentation is available as POD.
You can run perldoc from a shell to read the documentation:
% perldoc HTML::FormHandler
HTML-FormHandler-0.40050/lib/ 0000755 0000770 0000770 00000000000 12221042077 014702 5 ustar gshank gshank HTML-FormHandler-0.40050/lib/HTML/ 0000755 0000770 0000770 00000000000 12221042077 015446 5 ustar gshank gshank HTML-FormHandler-0.40050/lib/HTML/FormHandler/ 0000755 0000770 0000770 00000000000 12221042077 017647 5 ustar gshank gshank HTML-FormHandler-0.40050/lib/HTML/FormHandler/Base.pm 0000644 0000770 0000770 00000001324 12221042077 021057 0 ustar gshank gshank package HTML::FormHandler::Base;
# ABSTRACT: stub
use Moose;
with 'HTML::FormHandler::Widget::Form::Simple';
# here to make it possible to combine the Blocks role with a role
# setting the render_list without an 'excludes'
sub has_render_list { }
sub build_render_list {[]}
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Base - stub
=head1 VERSION
version 0.40050
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Blocks.pm 0000644 0000770 0000770 00000011601 12221042077 021421 0 ustar gshank gshank package HTML::FormHandler::Blocks;
# ABSTRACT: arrange form layout using blocks
use Moose::Role;
use Try::Tiny;
use Class::Load qw/ load_optional_class /;
use namespace::autoclean;
use Data::Clone;
use HTML::FormHandler::Widget::Block;
has 'blocks' => (
isa => 'HashRef[Object]',
is => 'ro',
lazy => 1,
traits => ['Hash'],
builder => 'build_blocks',
handles => {
has_blocks => 'count',
add_block => 'set',
block => 'get',
block_exists => 'exists',
},
);
sub build_blocks { {} }
has 'block_list' => ( is => 'rw', isa => 'ArrayRef', lazy => 1, builder => 'build_block_list' );
sub build_block_list {[]}
has 'render_list' => (
is => 'rw',
isa => 'ArrayRef[Str]',
traits => ['Array'],
lazy => 1,
builder => 'build_render_list',
handles => {
has_render_list => 'count',
add_to_render_list => 'push',
all_render_list => 'elements',
get_render_list => 'get',
}
);
sub get_renderer {
my ( $self, $name ) = @_;
die "must provide a name to get_renderer" unless $name;
my $obj = $self->block($name);
return $obj if ref $obj;
$obj = $self->field_from_index($name);
return $obj if ref $obj;
die "did not find a field or block with name $name\n";
}
after '_build_fields' => sub {
my $self = shift;
my $meta_blist = $self->_build_meta_block_list;
if( @$meta_blist ) {
foreach my $block_attr (@$meta_blist) {
$self->make_block($block_attr);
}
}
my $blist = $self->block_list;
if( @$blist ) {
foreach my $block_attr (@$blist) {
$self->make_block($block_attr);
}
}
};
sub make_block {
my ( $self, $block_attr ) = @_;
my $type = $block_attr->{type} ||= '';
my $name = $block_attr->{name};
die "You must supply a name for a block" unless $name;
my $do_update;
if ( $name =~ /^\+(.*)/ ) {
$block_attr->{name} = $name = $1;
$do_update = 1;
}
my $class;
if( $type ) {
$class = $self->get_widget_role($type, 'Block');
}
else {
$class = 'HTML::FormHandler::Widget::Block';
}
$block_attr->{form} = $self->form if $self->form;
my $block = $self->form->block( $block_attr->{name} );
if ( defined $block && $do_update ) {
delete $block_attr->{name};
foreach my $key ( keys %{$block_attr} ) {
$block->$key( $block_attr->{$key} )
if $block->can($key);
}
}
else # new block
{
$block = $class->new(%$block_attr);
$self->add_block( $name, $block );
}
}
# loops through all inherited classes and composed roles
# to find blocks specified with 'has_block'
sub _build_meta_block_list {
my $self = shift;
my @block_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('block_list') && $role->has_block_list ) {
foreach my $block_def ( @{ $role->block_list } ) {
push @block_list, $block_def;
}
}
}
}
if ( $meta->can('block_list') && $meta->has_block_list ) {
foreach my $block_def ( @{ $meta->block_list } ) {
push @block_list, $block_def;
}
}
}
return clone( \@block_list );
}
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Blocks - arrange form layout using blocks
=head1 VERSION
version 0.40050
=head1 SYNOPSIS
This is a role which provides the ability to render your form in
arbitrary 'blocks', instead of by fields. This role is included
by default in HTML::FormHandler.
package MyApp::Form;
use HTML::FormHandler::Moose;
extends 'HTML::FormHandler';
sub build_render_list {[ 'foo', 'fset' ]}
has_field 'foo';
has_field 'bar';
has_field 'nox';
has_block 'fset' => ( tag => 'fieldset', render_list => ['bar', 'nox'] );;
....
$form->render;
Blocks live in the HTML::FormHandler::Widget::Block:: namespace. The default,
non-typed block is L. Provide a type for
custom blocks:
has_block 'my_block' => ( type => 'CustomBlock', render_list => [...] );
You can also build blocks with a 'block_list' attribute, or the builder for it,
'build_block_list'.
Rendering with blocks is supported by the rendering widgets. Render::Simple doesn't
do it, though it would be possible to make your own custom renderer.
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/BuildFields.pm 0000644 0000770 0000770 00000040132 12221042077 022373 0 ustar gshank gshank package HTML::FormHandler::BuildFields;
# ABSTRACT: role to build field array
use Moose::Role;
use Try::Tiny;
use Class::Load qw/ load_optional_class /;
use namespace::autoclean;
use HTML::FormHandler::Merge ('merge');
use Data::Clone;
has 'fields_from_model' => ( isa => 'Bool', is => 'rw' );
has 'field_list' => ( isa => 'HashRef|ArrayRef', is => 'rw', default => sub { {} } );
has 'build_include_method' => ( is => 'ro', isa => 'CodeRef', traits => ['Code'],
default => sub { \&default_build_include }, handles => { build_include => 'execute_method' } );
has 'include' => ( is => 'rw', isa => 'ArrayRef', traits => ['Array'], builder => 'build_include',
lazy => 1, handles => { has_include => 'count' } );
sub default_build_include { [] }
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;
if( $flist ) {
if( ref($flist) eq 'ARRAY' && ref( $flist->[0] ) eq 'HASH' ) {
$self->_process_field_array( $flist );
}
else {
$self->_process_field_list( $flist );
}
}
my $mlist = $self->model_fields if $self->fields_from_model;
$self->_process_field_list( $mlist ) if $mlist;
return unless $self->has_fields;
$self->_order_fields;
}
# 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 } ) {
push @$field_list, $fld_def;
}
}
}
}
if ( $meta->can('field_list') && $meta->has_field_list ) {
foreach my $fld_def ( @{ $meta->field_list } ) {
push @$field_list, $fld_def;
}
}
}
return $field_list if scalar @$field_list;
}
sub _process_field_list {
my ( $self, $flist ) = @_;
if ( ref $flist eq 'ARRAY' ) {
$self->_process_field_array( $self->_array_fields( $flist ) );
}
}
# munges the field_list array into an array of field attributes
sub _array_fields {
my ( $self, $fields ) = @_;
$fields = clone( $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 ) = @_;
# clone and, optionally, filter fields
$fields = $self->clean_fields( $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++;
}
}
sub clean_fields {
my ( $self, $fields ) = @_;
if( $self->has_include ) {
my @fields;
my %include = map { $_ => 1 } @{ $self->include };
foreach my $fld ( @$fields ) {
push @fields, clone($fld) if exists $include{$fld->{name}};
}
return \@fields;
}
return clone( $fields );
}
# 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 ) = @_;
my $type = $field_attr->{type} ||= 'Text';
my $name = $field_attr->{name};
my $do_update;
if ( $name =~ /^\+(.*)/ ) {
$field_attr->{name} = $name = $1;
$do_update = 1;
}
my $class = $self->_find_field_class( $type, $name );
my $parent = $self->_find_parent( $field_attr );
$field_attr = $self->_merge_updates( $field_attr, $class ) unless $do_update;
my $field = $self->_update_or_create( $parent, $field_attr, $class, $do_update );
$self->form->add_to_index( $field->full_name => $field ) if $self->form;
}
sub _make_adhoc_field {
my ( $self, $class, $field_attr ) = @_;
# remove and save form & parent, because if the form class has a 'clone'
# method, Data::Clone::clone will clone the form
my $parent = delete $field_attr->{parent};
my $form = delete $field_attr->{form};
$field_attr = $self->_merge_updates( $field_attr, $class );
$field_attr->{parent} = $parent;
$field_attr->{form} = $form;
my $field = $self->new_field_with_traits( $class, $field_attr );
return $field;
}
sub _find_field_class {
my ( $self, $type, $name ) = @_;
my $field_ns = $self->field_name_space;
my @classes;
# '+'-prefixed fields could be full namespaces
if ( $type =~ s/^\+// )
{
push @classes, $type;
}
foreach my $ns ( @$field_ns, 'HTML::FormHandler::Field', 'HTML::FormHandlerX::Field' )
{
push @classes, $ns . "::" . $type;
}
# look for Field in possible namespaces
my $class;
foreach my $try ( @classes ) {
last if $class = load_optional_class($try) ? $try : undef;
}
die "Could not load field class '$type' for field '$name'"
unless $class;
return $class;
}
sub _find_parent {
my ( $self, $field_attr ) = @_;
# parent and name correction for names with dots
my $parent;
if ( $field_attr->{name} =~ /\./ ) {
my @names = split /\./, $field_attr->{name};
my $simple_name = pop @names;
my $parent_name = join '.', @names;
# use special 'field' method call that starts from
# $self, because names aren't always starting from
# the form
$parent = $self->field($parent_name, undef, $self);
if ($parent) {
die "The parent of field " . $field_attr->{name} . " is not a Compound Field"
unless $parent->isa('HTML::FormHandler::Field::Compound');
$field_attr->{name} = $simple_name;
}
else {
die "did not find parent for field " . $field_attr->{name};
}
}
elsif ( !( $self->form && $self == $self->form ) ) {
# set parent
$parent = $self;
}
# get full_name
my $full_name = $field_attr->{name};
$full_name = $parent->full_name . "." . $field_attr->{name}
if $parent;
$field_attr->{full_name} = $full_name;
return $parent;
}
sub _merge_updates {
my ( $self, $field_attr, $class ) = @_;
# If there are field_traits at the form level, prepend them
my $field_updates;
unshift @{$field_attr->{traits}}, @{$self->form->field_traits} if $self->form;
# use full_name for updates from form, name for updates from compound field
my $full_name = delete $field_attr->{full_name} || $field_attr->{name};
my $name = $field_attr->{name};
my $single_updates = {}; # updates that apply to a single field
my $all_updates = {}; # updates that apply to all fields
# get updates from form update_subfields and widget_tags
if ( $self->form ) {
$field_updates = $self->form->update_subfields;
if ( keys %$field_updates ) {
$all_updates = $field_updates->{all} || {};
$single_updates = $field_updates->{$full_name};
if ( exists $field_updates->{by_flag} ) {
$all_updates = $self->by_flag_updates( $field_attr, $class, $field_updates, $all_updates );
}
if ( exists $field_updates->{by_type} &&
exists $field_updates->{by_type}->{$field_attr->{type}} ) {
$all_updates = merge( $field_updates->{by_type}->{$field_attr->{type}}, $all_updates );
}
}
# merge widget tags into 'all' updates
if( $self->form->has_widget_tags ) {
$all_updates = merge( $all_updates, { tags => $self->form->widget_tags } );
}
}
# get updates from compound field update_subfields and widget_tags
if ( $self->has_flag('is_compound') ) {
my $comp_field_updates = $self->update_subfields;
my $comp_all_updates = {};
my $comp_single_updates = {};
# -- compound 'all' updates --
if ( keys %$comp_field_updates ) {
$comp_all_updates = $comp_field_updates->{all} || {};
# don't use full_name. varies depending on parent field name
$comp_single_updates = $comp_field_updates->{$name} || {};
if ( exists $field_updates->{by_flag} ) {
$comp_all_updates = $self->by_flag_updates( $field_attr, $class, $comp_field_updates, $comp_all_updates );
}
if ( exists $comp_field_updates->{by_type} &&
exists $comp_field_updates->{by_type}->{$field_attr->{type}} ) {
$comp_all_updates = merge( $comp_field_updates->{by_type}->{$field_attr->{type}}, $comp_all_updates );
}
}
if( $self->has_widget_tags ) {
$comp_all_updates = merge( $comp_all_updates, { tags => $self->widget_tags } );
}
# merge form 'all' updates, compound field higher precedence
$all_updates = merge( $comp_all_updates, $all_updates )
if keys %$comp_all_updates;
# merge single field updates, compound field higher precedence
$single_updates = merge( $comp_single_updates, $single_updates )
if keys %$comp_single_updates;
}
# attributes set on a specific field through update_subfields override has_fields
# attributes set by 'all' only happen if no field attributes
$field_attr = merge( $field_attr, $all_updates ) if keys %$all_updates;
$field_attr = merge( $single_updates, $field_attr ) if keys %$single_updates;
# get the widget and widget_wrapper from form
unless( $self->form && $self->form->no_widgets ) {
# widget
my $widget = $field_attr->{widget};
unless( $widget ) {
my $attr = $class->meta->find_attribute_by_name( 'widget' );
$widget = $attr->default if $attr;
}
$widget = '' if $widget eq 'None';
# widget wrapper
my $widget_wrapper = $field_attr->{widget_wrapper};
unless( $widget_wrapper ) {
my $attr = $class->meta->get_attribute('widget_wrapper');
$widget_wrapper = $attr->default if $attr;
$widget_wrapper ||= $self->form->widget_wrapper if $self->form;
$widget_wrapper ||= 'Simple';
$field_attr->{widget_wrapper} = $widget_wrapper;
}
# add widget and wrapper roles to field traits
if ( $widget ) {
my $widget_role = $self->get_widget_role( $widget, 'Field' );
push @{$field_attr->{traits}}, $widget_role;
}
if ( $widget_wrapper ) {
my $wrapper_role = $self->get_widget_role( $widget_wrapper, 'Wrapper' );
push @{$field_attr->{traits}}, $wrapper_role;
}
}
return $field_attr;
}
sub by_flag_updates {
my ( $self, $field_attr, $class, $field_updates, $all_updates ) = @_;
my $by_flag = $field_updates->{by_flag};
if ( exists $by_flag->{contains} && $field_attr->{is_contains} ) {
$all_updates = merge( $field_updates->{by_flag}->{contains}, $all_updates );
}
elsif ( exists $by_flag->{repeatable} && $class->meta->find_attribute_by_name('is_repeatable') ) {
$all_updates = merge( $field_updates->{by_flag}->{repeatable}, $all_updates );
}
elsif ( exists $by_flag->{compound} && $class->meta->find_attribute_by_name('is_compound') ) {
$all_updates = merge( $field_updates->{by_flag}->{compound}, $all_updates );
}
return $all_updates;
}
# update, replace, or create field
# Create makes the field object and passes in the properties as constructor args.
# Update changed 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 ) = @_;
$parent ||= $self->form;
$field_attr->{parent} = $parent;
$field_attr->{form} = $self->form if $self->form;
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;
foreach my $key ( keys %{$field_attr} ) {
next if $key eq 'name' || $key eq 'form' || $key eq 'parent' ||
$key eq 'full_name' || $key eq 'type';
$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->add_repeatable_field($field)
if ( $field->form && $field->has_flag('is_repeatable') );
return $field;
}
sub new_field_with_traits {
my ( $self, $class, $field_attr ) = @_;
my $traits = delete $field_attr->{traits} || [];
if( @$traits ) {
$class = $class->with_traits( @$traits );
}
my $field = $class->new( %{$field_attr} );
return $field;
}
sub _order_fields {
my $self = shift;
# 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++;
}
}
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::BuildFields - role to build field array
=head1 VERSION
version 0.40050
=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.
Internal code only. This role has no user interfaces.
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/BuildPages.pm 0000644 0000770 0000770 00000015124 12221042077 022227 0 ustar gshank gshank package HTML::FormHandler::BuildPages;
# ABSTRACT: used in Wizard
use Moose::Role;
use Try::Tiny;
use Class::Load qw/ load_optional_class /;
use namespace::autoclean;
has 'page_list' => (
isa => 'ArrayRef',
is => 'rw',
traits => ['Array'],
default => sub { [] },
);
sub has_page_list {
my ( $self ) = @_;
my $page_list = $self->page_list;
return unless $page_list && ref $page_list eq 'ARRAY';
return $page_list if ( scalar @{$page_list} );
return;
}
after '_build_fields' => sub {
my $self = shift;
my $meta_plist = $self->_build_meta_page_list;
$self->_process_page_array( $meta_plist, 0 ) if $meta_plist;
my $plist = $self->has_page_list;
$self->_process_page_list($plist) if $plist;
return unless $self->has_pages;
};
sub _process_page_list {
my ( $self, $plist ) = @_;
if ( ref $plist eq 'ARRAY' ) {
my @plist_copy = @{$plist};
$self->_process_page_array( $self->_array_pages( \@plist_copy ) );
return;
}
my %plist_copy = %{$plist};
$plist = \%plist_copy;
}
sub _array_pages {
my ( $self, $pages ) = @_;
my @new_pages;
while (@$pages) {
my $name = shift @$pages;
my $attr = shift @$pages;
unless ( ref $attr eq 'HASH' ) {
$attr = { type => $attr };
}
push @new_pages, { name => $name, %$attr };
}
return \@new_pages;
}
sub _process_page_array {
my ( $self, $pages ) = @_;
my $num_pages = scalar @$pages;
my $num_dots = 0;
my $count_pages = 0;
while ( $count_pages < $num_pages ) {
foreach my $page (@$pages) {
my $count = ( $page->{name} =~ tr/\.// );
next unless $count == $num_dots;
$self->_make_page($page);
$count_pages++;
}
$num_dots++;
}
}
sub _make_page {
my ( $self, $page_attr ) = @_;
$page_attr->{type} ||= 'Simple';
my $type = $page_attr->{type};
my $name = $page_attr->{name};
return unless $name;
my $do_update;
if ( $name =~ /^\+(.*)/ ) {
$page_attr->{name} = $name = $1;
$do_update = 1;
}
my @page_name_space;
my $page_ns = $self->page_name_space;
if( $page_ns ) {
@page_name_space = ref $page_ns eq 'ARRAY' ? @$page_ns : $page_ns;
}
my @classes;
# '+'-prefixed fields could be full namespaces
if ( $type =~ s/^\+// )
{
push @classes, $type;
}
foreach my $ns ( @page_name_space, 'HTML::FormHandler::Page', 'HTML::FormHandlerX::Page' )
{
push @classes, $ns . "::" . $type;
}
# look for Page in possible namespaces
my $class;
foreach my $try ( @classes ) {
last if $class = load_optional_class($try) ? $try : undef;
}
die "Could not load page class '$type' for field '$name'"
unless $class;
$page_attr->{form} = $self->form if $self->form;
# parent and name correction for names with dots
if ( $page_attr->{name} =~ /\./ ) {
my @names = split /\./, $page_attr->{name};
my $simple_name = pop @names;
my $parent_name = join '.', @names;
my $parent = $self->page($parent_name);
if ($parent) {
$page_attr->{parent} = $parent;
$page_attr->{name} = $simple_name;
}
}
elsif ( !( $self->form && $self == $self->form ) ) {
# set parent
$page_attr->{parent} = $self;
}
$self->_update_or_create_page( $page_attr->{parent} || $self->form,
$page_attr, $class, $do_update );
}
sub _update_or_create_page {
my ( $self, $parent, $page_attr, $class, $do_update ) = @_;
my $index = $parent->page_index( $page_attr->{name} );
my $page;
if ( defined $index ) {
if ($do_update) # this page started with '+'. Update.
{
$page = $parent->page( $page_attr->{name} );
die "Page to update for " . $page_attr->{name} . " not found"
unless $page;
delete $page_attr->{name};
foreach my $key ( keys %{$page_attr} ) {
$page->$key( $page_attr->{$key} )
if $page->can($key);
}
}
else # replace existing page
{
$page = $self->new_page_with_traits( $class, $page_attr);
$parent->set_page_at( $index, $page );
}
}
else # new page
{
$page = $self->new_page_with_traits( $class, $page_attr);
$parent->push_page($page);
}
}
sub new_page_with_traits {
my ( $self, $class, $page_attr ) = @_;
my $widget = $page_attr->{widget};
my $page;
unless( $widget ) {
my $attr = $class->meta->find_attribute_by_name( 'widget' );
if ( $attr ) {
$widget = $attr->default;
}
}
my @traits;
if( $page_attr->{traits} ) {
@traits = @{$page_attr->{traits}};
delete $page_attr->{traits};
}
if( $widget ) {
my $widget_role = $self->get_widget_role( $widget, 'Page' );
push @traits, $widget_role;
}
if( @traits ) {
$page = $class->new_with_traits( traits => \@traits, %{$page_attr} );
}
else {
$page = $class->new( %{$page_attr} );
}
return $page;
}
# loops through all inherited classes and composed roles
# to find pages specified with 'has_page'
sub _build_meta_page_list {
my $self = shift;
my @page_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('page_list') && $role->has_page_list ) {
foreach my $page_def ( @{ $role->page_list } ) {
my %new_page = %{$page_def}; # copy hashref
push @page_list, \%new_page;
}
}
}
}
if ( $meta->can('page_list') && $meta->has_page_list ) {
foreach my $page_def ( @{ $meta->page_list } ) {
my %new_page = %{$page_def}; # copy hashref
push @page_list, \%new_page;
}
}
}
return \@page_list if scalar @page_list;
}
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::BuildPages - used in Wizard
=head1 VERSION
version 0.40050
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/ 0000755 0000770 0000770 00000000000 12221042077 020672 5 ustar gshank gshank HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/AddElement.pm 0000644 0000770 0000770 00000004410 12221042077 023231 0 ustar gshank gshank package HTML::FormHandler::Field::AddElement;
# ABSTRACT: Field to support repeatable javascript add
use HTML::FormHandler::Moose;
extends 'HTML::FormHandler::Field::Display';
use HTML::FormHandler::Render::Util ('process_attrs');
has 'repeatable' => ( is => 'rw', isa => 'Str', required => 1 );
has '+do_wrapper' => ( default => 1 );
has '+value' => ( default => 'Add Element' );
sub build_render_method {
return sub {
my ( $self, $result ) = @_;
$result ||= $self->result;
my $rep_field = $self->parent->field($self->repeatable);
die "Invalid repeatable name in field " . $self->name unless $rep_field;
my $value = $self->html_filter($self->_localize($self->value));
my $attrs = $self->element_attributes($result);
push @{$attrs->{class}}, ( 'add_element', 'btn' );
$attrs->{'data-rep-id'} = $rep_field->id;
$attrs->{id} = $self->id;
my $attr_str = process_attrs($attrs);
my $wrapper_tag = $self->get_tag('wrapper_tag') || 'div';
my $output = qq{<$wrapper_tag$attr_str>$value};
$output = $self->wrap_field($self->result, $output);
return $output;
};
}
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::AddElement - Field to support repeatable javascript add
=head1 VERSION
version 0.40050
=head1 SYNOPSIS
EXAMPLE field for rendering an AddElement field for
doing javascript additions of repeatable elements.
You probably want to make your own.
The main requirements are that the button have 1) the
'add_element' class, 2) a 'data-rep-id' attribute that
contains the id of the repeatable to which you want to
add an element.
=head1 NAME
HTML::FormHandler::Field::AddElement
=head1 ATTRIBUTES
has_field 'add_element' => ( type => 'AddElement', repeatable => 'foo',
value => 'Add another foo',
);
=head2 repeatable
Requires the name of a Repeatable sibling field.
=head2 value
The value of the button that's rendered, 'Add Element' by default.
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/Boolean.pm 0000644 0000770 0000770 00000001567 12221042077 022620 0 ustar gshank gshank package HTML::FormHandler::Field::Boolean;
# ABSTRACT: a true or false field
use Moose;
extends 'HTML::FormHandler::Field::Checkbox';
our $VERSION = '0.03';
sub value {
my $self = shift;
my $v = $self->next::method(@_);
return $v ? 1 : 0;
}
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::Boolean - a true or false field
=head1 VERSION
version 0.40050
=head1 DESCRIPTION
This field returns 1 if true, 0 if false. The widget type is 'Checkbox'.
Similar to Checkbox, except only returns values of 1 or 0.
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/BoolSelect.pm 0000644 0000770 0000770 00000001545 12221042077 023270 0 ustar gshank gshank package HTML::FormHandler::Field::BoolSelect;
# ABSTRACT: Boolean select field
use Moose;
extends 'HTML::FormHandler::Field::Select';
has '+empty_select' => ( default => 'Select One' );
sub build_options { [
{ value => 1, label => 'True'},
{ value => 0, label => 'False' }
]};
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::BoolSelect - Boolean select field
=head1 VERSION
version 0.40050
=head1 SYNOPSIS
A Boolean select field with three states: null, 1, 0.
Empty select is 'Select One'.
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/Button.pm 0000644 0000770 0000770 00000001515 12221042077 022505 0 ustar gshank gshank package HTML::FormHandler::Field::Button;
# ABSTRACT: button field
use Moose;
extends 'HTML::FormHandler::Field::NoValue';
has '+widget' => ( default => 'Button' );
has '+value' => ( default => 'Button' );
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::Button - button field
=head1 VERSION
version 0.40050
=head1 SYNOPSIS
Use this field to declare a button field in your form.
has_field 'button' => ( type => 'Button', value => 'Press Me!' );
Uses the 'button' widget.
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/Captcha.pm 0000644 0000770 0000770 00000006617 12221042077 022605 0 ustar gshank gshank package HTML::FormHandler::Field::Captcha;
# ABSTRACT: captcha field with GD::SecurityImage
use Moose;
extends 'HTML::FormHandler::Field';
use HTTP::Date;
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 '+widget' => ( default => 'Captcha' );
has '+noupdate' => ( default => 1 );
our $class_messages = {
'captcha_verify_failed' => 'Verification incorrect. Try again.',
};
sub get_class_messages {
my $self = shift;
return {
%{ $self->next::method },
%$class_messages,
}
}
sub get_default_value {
my $self = shift;
my $captcha = $self->form->get_captcha;
# setting the widget after the field is instantiated
# doesn't actually work. The Captcha widget checks for
# this setting though.
if ($captcha) {
if ( $captcha->{validated} ) {
$self->required(0);
$self->widget('NoRender');
}
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($self->get_message('captcha_verify_failed'));
$self->gen_captcha;
}
else {
$captcha->{validated} = 1;
}
return !$self->has_errors;
}
sub fif { }
sub gen_captcha {
my $self = shift;
require GD::SecurityImage;
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;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::Captcha - captcha field with GD::SecurityImage
=head1 VERSION
version 0.40050
=head1 SYNOPSIS
A Captcha class using GD::SecurityImage.
Requires 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.
package MyApp::Form::Post;
use HTML::FormHandler::Moose;
with 'HTML::FormHandler::TraitFor::Captcha';
You can set the following attributes on the 'captcha' field:
height, width, scramble, lines, gd_font
Example:
has 'captcha' => ( height => '24', width => '70' );
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/Checkbox.pm 0000644 0000770 0000770 00000004314 12221042077 022760 0 ustar gshank gshank package HTML::FormHandler::Field::Checkbox;
# ABSTRACT: a checkbox field type
use HTML::FormHandler::Moose;
extends 'HTML::FormHandler::Field';
our $VERSION = '0.02';
has '+widget' => ( default => 'Checkbox' );
has 'checkbox_value' => ( is => 'rw', default => 1 );
has '+input_without_param' => ( default => 0 );
has '+type_attr' => ( default => 'checkbox' );
has 'option_label' => ( is => 'rw' );
sub value {
my $field = shift;
return $field->next::method(@_) if @_;
my $v = $field->next::method();
return defined $v ? $v : 0;
}
sub validate {
my $self = shift;
$self->add_error($self->get_message('required'), $self->loc_label) if( $self->required && !$self->value );
return;
}
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::Checkbox - a checkbox field type
=head1 VERSION
version 0.40050
=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.
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/Compound.pm 0000644 0000770 0000770 00000007710 12221042077 023021 0 ustar gshank gshank package HTML::FormHandler::Field::Compound;
# ABSTRACT: field consisting of subfields
use Moose;
extends 'HTML::FormHandler::Field';
with 'HTML::FormHandler::Fields';
with 'HTML::FormHandler::BuildFields';
with 'HTML::FormHandler::InitResult';
has '+widget' => ( default => 'Compound' );
has 'is_compound' => ( is => 'ro', isa => 'Bool', default => 1 );
has 'item' => ( is => 'rw', clearer => 'clear_item' );
has '+do_wrapper' => ( default => 0 );
has '+do_label' => ( default => 0 );
has 'primary_key' => ( is => 'rw', isa => 'ArrayRef',
predicate => 'has_primary_key', );
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 ) {
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;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::Compound - field consisting of subfields
=head1 VERSION
version 0.40050
=head1 SYNOPSIS
This field class is designed as the base (parent) class for fields with
multiple subfields. Examples are L
and L.
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 and the validate method.
=head2 widget
Widget type is 'compound'
=head2 build_update_subfields
You can set 'defaults' or other settings in a 'build_update_subfields' method,
which contains attribute settings that will be merged with field definitions
when the fields are built. Use the 'by_flag' key with 'repeatable', 'compound',
and 'contains' subkeys, or use the 'all' key for settings which apply to all
subfields in the compound field.
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/Date.pm 0000644 0000770 0000770 00000012536 12221042077 022114 0 ustar gshank gshank package HTML::FormHandler::Field::Date;
# ABSTRACT: a date field with formats
use Moose;
extends 'HTML::FormHandler::Field::Text';
use DateTime;
use DateTime::Format::Strptime;
our $VERSION = '0.03';
has '+html5_type_attr' => ( default => 'date' );
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' );
has '+deflate_method' => ( default => sub { \&date_deflate } );
# 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
};
our $class_messages = {
'date_early' => 'Date is too early',
'date_late' => 'Date is too late',
};
sub get_class_messages {
my $self = shift;
return {
%{ $self->next::method },
%$class_messages,
}
}
sub date_deflate {
my ( $self, $value ) = @_;
# if not a DateTime, assume correctly formatted string and return
return $value 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($self->get_message('date_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($self->get_message('date_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;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::Date - a date field with formats
=head1 VERSION
version 0.40050
=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" );
Customize error messages 'date_early' and 'date_late':
has_field 'start_date' => ( type => 'Date,
messages => { date_early => 'Pick a later date',
date_late => 'Pick an earlier date', } );
If form has 'is_html5' flag active it will render
instead of type="text"
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/DateMDY.pm 0000644 0000770 0000770 00000001460 12221042077 022460 0 ustar gshank gshank package HTML::FormHandler::Field::DateMDY;
# ABSTRACT: m/d/y date field
use HTML::FormHandler::Moose;
extends 'HTML::FormHandler::Field::Date';
has '+format' => ( default => '%m/%d/%Y' );
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::DateMDY - m/d/y date field
=head1 VERSION
version 0.40050
=head1 SYNOPSIS
For date fields in the format nn/nn/nnnn. This simply inherits
from L and sets the format
to "%m/%d/%Y".
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/DateTime.pm 0000644 0000770 0000770 00000005250 12221042077 022726 0 ustar gshank gshank package HTML::FormHandler::Field::DateTime;
# ABSTRACT: compound DateTime field
use Moose;
extends 'HTML::FormHandler::Field::Compound';
use DateTime;
use Try::Tiny;
our $VERSION = '0.04';
has '+widget' => ( default => 'Compound' );
has '+inflate_default_method' => ( default => sub { \&datetime_inflate } );
our $class_messages = {
'datetime_invalid' => 'Not a valid DateTime',
};
sub get_class_messages {
my $self = shift;
return {
%{ $self->next::method },
%$class_messages,
}
}
sub datetime_inflate {
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( $self->get_message('datetime_invalid') );
};
if( $dt ) {
$self->_set_value($dt);
}
else {
$self->_set_value( {@dt_parms} );
}
}
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::DateTime - compound DateTime field
=head1 VERSION
version 0.40050
=head1 DESCRIPTION
This is a compound field that requires you to define the subfields
for month/day/year/hour/minute. Widget type is 'compound'.
If you want to use drop-down select boxes for your DateTime, you
can select 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 );
Customizable error: 'datetime_invalid' (default = "Not a valid DateTime")
See the 'Date' field for a single input date field.
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/Display.pm 0000644 0000770 0000770 00000005307 12221042077 022642 0 ustar gshank gshank package HTML::FormHandler::Field::Display;
# ABSTRACT: display only field
use Moose;
extends 'HTML::FormHandler::Field::NoValue';
use namespace::autoclean;
has 'html' => ( is => 'rw', isa => 'Str', builder => 'build_html', lazy => 1 );
sub build_html {''}
has 'set_html' => ( isa => 'Str', is => 'ro');
has '+do_label' => ( default => 0 );
has 'render_method' => (
traits => ['Code'],
is => 'ro',
isa => 'CodeRef',
lazy => 1,
predicate => 'does_render_method',
handles => { 'render' => 'execute_method' },
builder => 'build_render_method',
);
sub build_render_method {
my $self = shift;
my $set_html = $self->set_html;
$set_html ||= "html_" . HTML::FormHandler::Field::convert_full_name($self->full_name);
return sub { my $self = shift; $self->form->$set_html($self); }
if ( $self->form && $self->form->can($set_html) );
return sub {
my $self = shift;
return $self->html;
};
}
sub _result_from_object {
my ( $self, $result, $value ) = @_;
$self->_set_result($result);
$self->value($value);
$result->_set_field_def($self);
return $result;
}
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::Display - display only field
=head1 VERSION
version 0.40050
=head1 SYNOPSIS
This class can be used for fields that are display only. It will
render the value returned by a form's 'html_' method,
or the field's 'html' attribute.
has_field 'explanation' => ( type => 'Display',
html => '
This is an explanation...
' );
or in a form:
has_field 'explanation' => ( type => 'Display' );
sub html_explanation {
my ( $self, $field ) = @_;
if( $self->something ) {
return '
This type of explanation...
';
}
else {
return '
Another type of explanation...
';
}
}
#----
has_field 'username' => ( type => 'Display' );
sub html_username {
my ( $self, $field ) = @_;
return '
User: ' . $field->value . '
';
}
or set the name of the rendering method:
has_field 'explanation' => ( type => 'Display', set_html => 'my_explanation' );
sub my_explanation {
....
}
or provide a 'render_method':
has_field 'my_button' => ( type => 'Display', render_method => \&render_my_button );
sub render_my_button {
my $self = shift;
....
return '...';
}
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/Duration.pm 0000644 0000770 0000770 00000003353 12221042077 023021 0 ustar gshank gshank package HTML::FormHandler::Field::Duration;
# ABSTRACT: DateTime::Duration from HTML form values
use Moose;
extends 'HTML::FormHandler::Field::Compound';
use DateTime;
our $VERSION = '0.01';
our $class_messages = {
'duration_invalid' => 'Invalid value for [_1]: [_2]',
};
sub get_class_messages {
my $self = shift;
return {
%{ $self->next::method },
%$class_messages,
}
}
sub validate {
my ($self) = @_;
my @dur_parms;
foreach my $child ( $self->all_fields ) {
unless ( $child->has_value && $child->value =~ /^\d+$/ ) {
$self->add_error( $self->get_message('duration_invalid'), $self->loc_label, $child->loc_label );
next;
}
push @dur_parms, ( $child->accessor => $child->value );
}
# set the value
my $duration = DateTime::Duration->new(@dur_parms);
$self->_set_value($duration);
}
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::Duration - DateTime::Duration from HTML form values
=head1 VERSION
version 0.40050
=head1 SubFields
Subfield names:
years, months, weeks, days, hours, minutes, seconds, nanoseconds
For example:
has_field 'duration' => ( type => 'Duration' );
has_field 'duration.hours' => ( type => 'Hour' );
has_field 'duration.minutes' => ( type => 'Minute' );
Customize error message 'duration_invalid' (default 'Invalid value for [_1]: [_2]')
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/Email.pm 0000644 0000770 0000770 00000004510 12221042077 022257 0 ustar gshank gshank package HTML::FormHandler::Field::Email;
# ABSTRACT: validates email using Email::Valid
use HTML::FormHandler::Moose;
extends 'HTML::FormHandler::Field::Text';
use Email::Valid;
our $VERSION = '0.02';
our $class_messages = {
'email_format' => 'Email should be of the format [_1]',
};
has '+html5_type_attr' => ( default => 'email' );
has 'email_valid_params' => (
is => 'rw',
isa => 'HashRef',
);
has 'preserve_case' => (
is => 'rw',
isa => 'Bool',
);
sub get_class_messages {
my $self = shift;
return {
%{ $self->next::method },
%$class_messages,
}
}
apply(
[
{
transform => sub {
my ( $value, $field ) = @_;
return $value
if $field->preserve_case;
return lc( $value );
}
},
{
check => sub {
my ( $value, $field ) = @_;
my $checked = Email::Valid->address(
%{ $field->email_valid_params || {} },
-address => $value,
);
$field->value($checked)
if $checked;
},
message => sub {
my ( $value, $field ) = @_;
return [$field->get_message('email_format'), 'someuser@example.com'];
},
}
]
);
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::Email - validates email using Email::Valid
=head1 VERSION
version 0.40050
=head1 DESCRIPTION
Validates that the input looks like an email address using L.
Widget type is 'text'.
If form has 'is_html5' flag active it will render
instead of type="text"
This field has an 'email_valid_params' attribute that accepts a hash
reference of extra values passed to L when
validating email addresses.
If you want to preserve the case of the email address, set the
'preserve_case' attribute.
=head1 DEPENDENCIES
L
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/File.pm 0000644 0000770 0000770 00000001623 12221042077 022111 0 ustar gshank gshank package HTML::FormHandler::Field::File;
# ABSTRACT: simple file field; does no processing
use Moose;
extends 'HTML::FormHandler::Field';
has '+widget' => ( default => 'Upload' );
has '+type_attr' => ( default => 'file' );
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::File - simple file field; does no processing
=head1 VERSION
version 0.40050
=head1 SYNOPSIS
This field does nothing and is here mainly for testing purposes. If you use this
field you'll have to handle the actual uploaded file yourself.
See L
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/Float.pm 0000644 0000770 0000770 00000010130 12221042077 022270 0 ustar gshank gshank package HTML::FormHandler::Field::Float;
# ABSTRACT: validate a float value
use HTML::FormHandler::Moose;
extends 'HTML::FormHandler::Field::Text';
our $VERSION = '0.02';
has '+size' => ( default => 8 );
has 'precision' => ( isa => 'Int|Undef', is => 'rw', default => 2 );
has 'decimal_symbol' => ( isa => 'Str', is => 'rw', default => '.');
has 'decimal_symbol_for_db' => ( isa => 'Str', is => 'rw', default => '.');
has '+inflate_method' => ( default => sub { \&inflate_float } );
has '+deflate_method' => ( default => sub { \&deflate_float } );
our $class_messages = {
'float_needed' => 'Must be a number. May contain numbers, +, - and decimal separator \'[_1]\'',
'float_size' => 'Total size of number must be less than or equal to [_1], but is [_2]',
'float_precision' => 'May have a maximum of [quant,_1,digit] after the decimal point, but has [_2]',
};
sub get_class_messages {
my $self = shift;
return {
%{ $self->next::method },
%$class_messages,
}
}
sub inflate_float {
my ( $self, $value ) = @_;
return $value unless defined $value;
$value =~ s/^\+//;
return $value;
}
sub deflate_float {
my ( $self, $value ) = @_;
return $value unless defined $value;
my $symbol = $self->decimal_symbol;
my $symbol_db = $self->decimal_symbol_for_db;
$value =~ s/\Q$symbol_db\E/$symbol/x;
return $value;
}
sub validate {
my $field = shift;
#return unless $field->next::method;
my ($integer_part, $decimal_part) = ();
my $value = $field->value;
my $symbol = $field->decimal_symbol;
my $symbol_db = $field->decimal_symbol_for_db;
if ($value =~ m/^-?([0-9]+)(\Q$symbol\E([0-9]+))?$/x) { # \Q ... \E - All the characters between the \Q and the \E are interpreted as literal characters.
$integer_part = $1;
$decimal_part = defined $3 ? $3 : '';
}
else {
return $field->add_error( $field->get_message('float_needed'), $symbol );
}
if ( my $allowed_size = $field->size ) {
my $total_size = length($integer_part) + length($decimal_part);
return $field->add_error( $field->get_message('float_size'),
$allowed_size, $total_size )
if $total_size > $allowed_size;
}
if ( my $allowed_precision = $field->precision ) {
return $field->add_error( $field->get_message('float_precision'),
$allowed_precision, length $decimal_part)
if length $decimal_part > $allowed_precision;
}
# Inflate to database accepted format
$value =~ s/\Q$symbol\E/$symbol_db/x;
$field->_set_value($value);
return 1;
}
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
=pod
=head1 NAME
HTML::FormHandler::Field::Float - validate a float value
=head1 VERSION
version 0.40050
=head1 DESCRIPTION
This accepts a positive or negative float/integer. Negative numbers may
be prefixed with a dash. By default a max of eight digits including 2 precision
are accepted. Default decimal symbol is ','.
Widget type is 'text'.
# For example 1234,12 has size of 6 and precision of 2
# and separator symbol of ','
has_field 'test_result' => (
type => 'Float',
size => 8, # Total size of number including decimal part.
precision => 2, # Size of the part after decimal symbol.
decimal_symbol => '.', # Decimal symbol accepted in web page form
decimal_symbol_for_db => '.', # For inflation. Decimal symbol accepted in DB, which automatically converted to.
range_start => 0,
range_end => 100
);
=head2 messages
float_needed
float_size
float_precision
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
__END__
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/Hidden.pm 0000644 0000770 0000770 00000001516 12221042077 022426 0 ustar gshank gshank package HTML::FormHandler::Field::Hidden;
# ABSTRACT: hidden field
use Moose;
extends 'HTML::FormHandler::Field::Text';
our $VERSION = '0.01';
has '+widget' => ( default => 'Hidden' );
has '+do_label' => ( default => 0 );
has '+html5_type_attr' => ( default => 'hidden' );
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::Hidden - hidden field
=head1 VERSION
version 0.40050
=head1 DESCRIPTION
This is a text field that uses the 'hidden' widget type, for HTML
of type 'hidden'.
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/Hour.pm 0000644 0000770 0000770 00000001414 12221042077 022145 0 ustar gshank gshank package HTML::FormHandler::Field::Hour;
# ABSTRACT: accept integer from 0 to 23
use Moose;
extends 'HTML::FormHandler::Field::IntRange';
our $VERSION = '0.03';
has '+range_start' => ( default => 0 );
has '+range_end' => ( default => 23 );
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::Hour - accept integer from 0 to 23
=head1 VERSION
version 0.40050
=head1 DESCRIPTION
Enter an integer from 0 to 23 hours.
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/Integer.pm 0000644 0000770 0000770 00000003311 12221042077 022623 0 ustar gshank gshank package HTML::FormHandler::Field::Integer;
# ABSTRACT: validate an integer value
use HTML::FormHandler::Moose;
extends 'HTML::FormHandler::Field::Text';
our $VERSION = '0.02';
has '+size' => ( default => 8 );
has '+html5_type_attr' => ( default => 'number' );
our $class_messages = {
'integer_needed' => 'Value must be an integer',
};
sub get_class_messages {
my $self = shift;
return {
%{ $self->next::method },
%$class_messages,
}
}
apply(
[
{
transform => sub {
my $value = shift;
$value =~ s/^\+//;
return $value;
}
},
{
check => sub { $_[0] =~ /^-?[0-9]+$/ },
message => sub {
my ( $value, $field ) = @_;
return $field->get_message('integer_needed');
},
}
]
);
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::Integer - validate an integer value
=head1 VERSION
version 0.40050
=head1 DESCRIPTION
This accepts 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'.
If form has 'is_html5' flag active it will render
instead of type="text"
The 'range_start' and 'range_end' attributes may be used to limit valid numbers.
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/IntRange.pm 0000644 0000770 0000770 00000003163 12221042077 022742 0 ustar gshank gshank package HTML::FormHandler::Field::IntRange;
# ABSTRACT: integer range in select list
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 ];
}
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::IntRange - integer range in select list
=head1 VERSION
version 0.40050
=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 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/Minute.pm 0000644 0000770 0000770 00000001542 12221042077 022473 0 ustar gshank gshank package HTML::FormHandler::Field::Minute;
# ABSTRACT: input range from 0 to 59
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' );
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::Minute - input range from 0 to 59
=head1 VERSION
version 0.40050
=head1 DESCRIPTION
Generate a select list for entering a minute value.
Widget type is 'select'.
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/Money.pm 0000644 0000770 0000770 00000003573 12221042077 022327 0 ustar gshank gshank package HTML::FormHandler::Field::Money;
# ABSTRACT: US currency-like values
use HTML::FormHandler::Moose;
extends 'HTML::FormHandler::Field::Text';
our $VERSION = '0.01';
has '+html5_type_attr' => ( default => 'number' );
our $class_messages = {
'money_convert' => 'Value cannot be converted to money',
'money_real' => 'Value must be a real number',
};
sub get_class_messages {
my $self = shift;
return {
%{ $self->next::method },
%$class_messages,
}
}
apply(
[
{
transform => sub {
my $value = shift;
$value =~ s/^\$//;
return $value;
}
},
{
transform => sub { sprintf '%.2f', $_[0] },
message => sub {
my ( $value, $field ) = @_;
return [$field->get_message('money_convert'), $value];
},
},
{
check => sub { $_[0] =~ /^-?\d+\.?\d*$/ },
message => sub {
my ( $value, $field ) = @_;
return [$field->get_message('money_real'), $value];
},
}
]
);
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::Money - US currency-like values
=head1 VERSION
version 0.40050
=head1 DESCRIPTION
Validates that a positive or negative real value is entered.
Formatted with two decimal places.
Uses a period for the decimal point. Widget type is 'text'.
If form has 'is_html5' flag active it will render
instead of type="text"
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/Month.pm 0000644 0000770 0000770 00000001423 12221042077 022315 0 ustar gshank gshank package HTML::FormHandler::Field::Month;
# ABSTRACT: select list 1 to 12
use Moose;
extends 'HTML::FormHandler::Field::IntRange';
our $VERSION = '0.01';
has '+range_start' => ( default => 1 );
has '+range_end' => ( default => 12 );
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::Month - select list 1 to 12
=head1 VERSION
version 0.40050
=head1 DESCRIPTION
Select list for range of 1 to 12. Widget type is 'select'
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/MonthDay.pm 0000644 0000770 0000770 00000001415 12221042077 022754 0 ustar gshank gshank package HTML::FormHandler::Field::MonthDay;
# ABSTRACT: select list 1 to 31
use Moose;
extends 'HTML::FormHandler::Field::IntRange';
our $VERSION = '0.01';
has '+range_start' => ( default => 1 );
has '+range_end' => ( default => 31 );
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::MonthDay - select list 1 to 31
=head1 VERSION
version 0.40050
=head1 DESCRIPTION
Generates a select list for integers 1 to 31.
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/MonthName.pm 0000644 0000770 0000770 00000002010 12221042077 023107 0 ustar gshank gshank package HTML::FormHandler::Field::MonthName;
# ABSTRACT: select list with month names
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 ];
}
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::MonthName - select list with month names
=head1 VERSION
version 0.40050
=head1 DESCRIPTION
Generates a list of English month names.
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/Multiple.pm 0000644 0000770 0000770 00000003061 12221042077 023023 0 ustar gshank gshank package HTML::FormHandler::Field::Multiple;
# ABSTRACT: multiple select list
use Moose;
extends 'HTML::FormHandler::Field::Select';
our $VERSION = '0.01';
has '+multiple' => ( default => 1 );
has '+size' => ( default => 5 );
has '+sort_options_method' => ( default => sub { \&default_sort_options } );
sub default_sort_options {
my ( $self, $options ) = @_;
return $options unless scalar @$options && defined $self->value;
my $value = $self->deflate($self->value);
return $options unless scalar @$value;
# This places the currently selected options at the top of the list
# Makes the drop down lists a bit nicer
my %selected = map { $_ => 1 } @$value;
my @out = grep { $selected{ $_->{value} } } @$options;
push @out, grep { !$selected{ $_->{value} } } @$options;
return \@out;
}
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::Multiple - multiple select list
=head1 VERSION
version 0.40050
=head1 DESCRIPTION
This is a convenience field that inherits from the Select field and
pre-sets some attributes. It sets the 'multiple' flag,
sets the 'size' attribute to 5, and sets the 'sort_options_method' to
move the currently selected options to the top of the options list.
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/Nested.pm 0000644 0000770 0000770 00000001447 12221042077 022460 0 ustar gshank gshank package HTML::FormHandler::Field::Nested;
# ABSTRACT: for nested elements of compound fields
use Moose;
extends 'HTML::FormHandler::Field::Text';
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::Nested - for nested elements of compound fields
=head1 VERSION
version 0.40050
=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.
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/NonEditable.pm 0000644 0000770 0000770 00000001703 12221042077 023415 0 ustar gshank gshank package HTML::FormHandler::Field::NonEditable;
# ABSTRACT: reset field
use Moose;
extends 'HTML::FormHandler::Field::NoValue';
has '+widget' => ( default => 'Span' );
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::NonEditable - reset field
=head1 VERSION
version 0.40050
=head1 SYNOPSIS
Another flavor of a display field, but unlike L
it's intended to be rendered somewhat more like a "real" field, like the
'non-editable' "fields" in Bootstrap.
has_field 'source' => ( type => 'NonEditable', value => 'Outsourced' );
By default uses the 'Span' widget.
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/NoValue.pm 0000644 0000770 0000770 00000003335 12221042077 022605 0 ustar gshank gshank package HTML::FormHandler::Field::NoValue;
# ABSTRACT: base class for submit field
use Moose;
extends 'HTML::FormHandler::Field';
has 'html' => ( is => 'rw', isa => 'Str', default => '' );
has 'value' => (
is => 'rw',
predicate => 'has_value',
clearer => 'clear_value',
);
sub _result_from_fields {
my ( $self, $result ) = @_;
my $value = $self->get_default_value;
if ( $value ) {
$self->value($value);
}
$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 '+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;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::NoValue - base class for submit field
=head1 VERSION
version 0.40050
=head1 SYNOPSIS
This is the base class for the Submit & Reset fields. It can be used for fields that
do not produce valid 'values'. It should not be used for fields that
produce a value or need validating.
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/Password.pm 0000644 0000770 0000770 00000005657 12221042077 023047 0 ustar gshank gshank package HTML::FormHandler::Field::Password;
# ABSTRACT: password field
use HTML::FormHandler::Moose;
extends 'HTML::FormHandler::Field::Text';
our $VERSION = '0.04';
has '+widget' => ( default => 'Password' );
has '+password' => ( default => 1 );
has 'ne_username' => ( isa => 'Str', is => 'rw' );
has '+type_attr' => ( default => 'password' );
has '+html5_type_attr' => ( default => 'password' );
our $class_messages = {
'required' => 'Please enter a password in this field',
'password_ne_username' => 'Password must not match [_1]',
};
sub get_class_messages {
my $self = shift;
my $messages = {
%{ $self->next::method },
%$class_messages,
};
$messages->{required} = $self->required_message
if $self->required_message;
return $messages;
}
after 'validate_field' => sub {
my $self = shift;
if ( !$self->required && !( defined( $self->value ) && length( $self->value ) ) ) {
$self->noupdate(1);
$self->clear_errors;
}
};
sub validate {
my $self = shift;
$self->noupdate(0);
return unless $self->next::method;
my $value = $self->value;
if ( $self->form && $self->ne_username ) {
my $username = $self->form->get_param( $self->ne_username );
return $self->add_error( $self->get_message('password_ne_username'), $self->ne_username )
if $username && $username eq $value;
}
return 1;
}
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::Password - password field
=head1 VERSION
version 0.40050
=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 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.
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/PasswordConf.pm 0000644 0000770 0000770 00000004237 12221042077 023646 0 ustar gshank gshank package HTML::FormHandler::Field::PasswordConf;
# ABSTRACT: password confirmation
use HTML::FormHandler::Moose;
extends 'HTML::FormHandler::Field::Text';
our $VERSION = '0.03';
has '+widget' => ( default => 'Password' );
has '+password' => ( default => 1 );
has '+required' => ( default => 1 );
has 'password_field' => ( isa => 'Str', is => 'rw', default => 'password' );
has 'pass_conf_message' => ( isa => 'Str', is => 'rw' );
our $class_messages = {
required => 'Please enter a password confirmation',
pass_conf_not_matched => 'The password confirmation does not match the password',
};
sub get_class_messages {
my $self = shift;
my $messages = {
%{ $self->next::method },
%$class_messages,
};
$messages->{pass_conf_not_matched} = $self->pass_conf_message
if $self->pass_conf_message;
return $messages;
}
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->get_message('pass_conf_not_matched') );
return;
}
return 1;
}
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::PasswordConf - password confirmation
=head1 VERSION
version 0.40050
=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 method).
=head2 password_field
Set this attribute to the name of your password field (default 'password')
Customize error message 'pass_conf_not_matched' or 'required'
has_field '_password' => ( type => 'PasswordConf',
messages => { required => 'You must enter the password a second time' },
);
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/PosInteger.pm 0000644 0000770 0000770 00000002335 12221042077 023312 0 ustar gshank gshank package HTML::FormHandler::Field::PosInteger;
# ABSTRACT: positive integer field
use HTML::FormHandler::Moose;
extends 'HTML::FormHandler::Field::Integer';
our $VERSION = '0.02';
our $class_messages = {
'integer_positive' => 'Value must be a positive integer',
};
sub get_class_messages {
my $self = shift;
return {
%{ $self->next::method },
%$class_messages,
}
}
apply(
[
{
check => sub { $_[0] >= 0 },
message => sub {
my ( $value, $field ) = @_;
return $field->get_message('integer_positive');
},
}
]
);
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::PosInteger - positive integer field
=head1 VERSION
version 0.40050
=head1 DESCRIPTION
Tests that the input is an integer and has a positive value.
Customize error message 'integer_positive'.
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/PrimaryKey.pm 0000644 0000770 0000770 00000002570 12221042077 023330 0 ustar gshank gshank package HTML::FormHandler::Field::PrimaryKey;
# ABSTRACT: primary key field
use Moose;
extends 'HTML::FormHandler::Field';
has 'is_primary_key' => ( isa => 'Bool', is => 'ro', default => '1' );
has '+widget' => ( default => 'Hidden' );
has '+do_label' => ( default => 0 );
has '+no_value_if_empty' => ( default => 1 );
sub BUILD {
my $self = shift;
if ( $self->has_parent ) {
if ( $self->parent->has_primary_key ) {
push @{ $self->parent->primary_key }, $self;
}
else {
$self->parent->primary_key( [ $self ] );
}
}
}
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::PrimaryKey - primary key field
=head1 VERSION
version 0.40050
=head1 SYNOPSIS
This field is for providing the primary key for Repeatable fields:
has_field 'addresses' => ( type => 'Repeatable' );
has_field 'addresses.address_id' => ( type => 'PrimaryKey' );
Do not use this field to hold the primary key of the form's main db object (item).
That primary key is in the 'item_id' attribute.
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/Repeatable/ 0000755 0000770 0000770 00000000000 12221042077 022736 5 ustar gshank gshank HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/Repeatable/Instance.pm 0000644 0000770 0000770 00000002170 12221042077 025040 0 ustar gshank gshank package # hide from Pause
HTML::FormHandler::Field::Repeatable::Instance;
# ABSTRACT: used internally by repeatable fields
use Moose;
extends 'HTML::FormHandler::Field::Compound';
sub BUILD {
my $self = shift;
$self->add_wrapper_class('hfh-repinst')
unless $self->has_wrapper_class;
}
sub build_tags {{ wrapper => 1 }}
has '+do_label' => ( default => 0 );
has '+do_wrapper' => ( default => 1 );
has '+no_value_if_empty' => ( default => 1 );
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::Repeatable::Instance - used internally by repeatable fields
=head1 VERSION
version 0.40050
=head1 SYNOPSIS
This is a simple container class to hold an instance of a Repeatable field.
It will have a name like '0', '1'... Users should not need to use this class.
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/Repeatable.pm 0000644 0000770 0000770 00000033411 12221042077 023276 0 ustar gshank gshank package HTML::FormHandler::Field::Repeatable;
# ABSTRACT: repeatable (array) field
use Moose;
extends 'HTML::FormHandler::Field::Compound';
use aliased 'HTML::FormHandler::Field::Repeatable::Instance';
use HTML::FormHandler::Field::PrimaryKey;
use HTML::FormHandler::Merge ('merge');
use Data::Clone ('data_clone');
has 'contains' => (
isa => 'HTML::FormHandler::Field',
is => 'rw',
predicate => 'has_contains',
);
has 'init_contains' => ( is => 'rw', isa => 'HashRef', traits => ['Hash'],
default => sub {{}},
handles => { has_init_contains => 'count' },
);
has 'num_when_empty' => ( isa => 'Int', is => 'rw', default => 1 );
has 'num_extra' => ( isa => 'Int', is => 'rw', default => 0 );
has 'setup_for_js' => ( isa => 'Bool', is => 'rw' );
has 'index' => ( isa => 'Int', is => 'rw', default => 0 );
has 'auto_id' => ( isa => 'Bool', is => 'rw', default => 0 );
has 'is_repeatable' => ( isa => 'Bool', is => 'ro', default => 1 );
has '+widget' => ( default => 'Repeatable' );
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->is_inactive );
# Validate each field and "inflate" input -> value.
$field->validate_field; # this calls the field's 'validate' routine
push @value_array, $field->value if $field->has_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->field('contains')->is_contains(1);
$self->contains( $self->field('contains') );
}
else {
$self->contains( $self->create_element );
}
}
$self->clear_fields;
}
sub create_element {
my ($self) = @_;
my $instance;
my $instance_attr = {
name => 'contains',
parent => $self,
type => 'Repeatable::Instance',
is_contains => 1,
};
# primary_key array is used for reloading after database update
$instance_attr->{primary_key} = $self->primary_key
if $self->has_primary_key;
if( $self->has_init_contains ) {
$instance_attr = merge( $self->init_contains, $instance_attr );
}
if( $self->form ) {
$instance_attr->{form} = $self->form;
$instance = $self->form->_make_adhoc_field(
'HTML::FormHandler::Field::Repeatable::Instance',
$instance_attr );
}
else {
$instance = Instance->new( %$instance_attr );
}
# copy the fields from this field into the instance
$instance->add_field( $self->all_fields );
foreach my $fld ( $instance->all_fields ) {
$fld->parent($instance);
}
# set required flag
$instance->required( $self->required );
# auto_id has no way to change widgets...deprecate this?
if ( $self->auto_id ) {
unless ( grep $_->can('is_primary_key') && $_->is_primary_key, $instance->all_fields ) {
my $field;
my $field_attr = { name => 'id', parent => $instance };
if ( $self->form ) { # this will pull in the widget role
$field_attr->{form} = $self->form;
$field = $self->form->_make_adhoc_field(
'HTML::FormHandler::Field::PrimaryKey', $field_attr );
}
else { # the following won't have a widget role applied
$field = HTML::FormHandler::Field::PrimaryKey->new( %$field_attr );
}
$instance->add_field($field);
}
}
$_->parent($instance) for $instance->all_fields;
return $instance;
}
sub clone_element {
my ( $self, $index ) = @_;
my $field = $self->contains->clone( errors => [], error_fields => [] );
$field->name($index);
$field->parent($self);
if ( $field->has_fields ) {
$self->clone_fields( $field, [ $field->all_fields ] );
}
return $field;
}
sub clone_fields {
my ( $self, $parent, $fields ) = @_;
my @field_array;
$parent->fields( [] );
foreach my $field ( @{$fields} ) {
my $new_field = $field->clone( errors => [], error_fields => [] );
if ( $new_field->has_fields ) {
$self->clone_fields( $new_field, [ $new_field->all_fields ] );
}
$new_field->parent($parent);
$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( [] );
my $index = 0;
if ( ref $input eq 'ARRAY' ) {
# build appropriate instance array
foreach my $element ( @{$input} ) {
next if not defined $element; # skip empty slots
my $field = $self->clone_element($index);
my $result = HTML::FormHandler::Field::Result->new(
name => $index,
parent => $self->result
);
$result = $field->_result_from_input( $result, $element, 1 );
$self->result->add_result($result);
$self->add_field($field);
$index++;
}
}
$self->index($index);
$self->_setup_for_js if $self->setup_for_js;
$self->result->_set_field_def($self);
return $self->result;
}
sub _setup_for_js {
my $self = shift;
return unless $self->form;
my $full_name = $self->full_name;
my $index_level =()= $full_name =~ /{index\d+}/g;
$index_level++;
my $field_name = "{index-$index_level}";
my $field = $self->_add_extra($field_name);
my $rendered = $field->render;
# remove extra result & field, now that it's rendered
$self->result->_pop_result;
$self->_pop_field;
# set the information in the form
# $self->index is the index of the next instance
$self->form->set_for_js( $self->full_name,
{ index => $self->index, html => $rendered, level => $index_level } );
}
# this is called when there is an init_object or a 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 $field = $self->clone_element($index);
my $result =
HTML::FormHandler::Field::Result->new( name => $index, parent => $self->result );
if( $field->has_inflate_default_method ) {
$element = $field->inflate_default($element);
}
$result = $field->_result_from_object( $result, $element );
push @new_values, $result->value;
$self->add_field($field);
$self->result->add_result( $field->result );
$index++;
}
if( my $num_extra = $self->num_extra ) {
while ($num_extra ) {
$self->_add_extra($index);
$num_extra--;
$index++;
}
}
$self->index($index);
$self->_setup_for_js if $self->setup_for_js;
$values = \@new_values if scalar @new_values;
$self->_set_value($values);
$self->result->_set_field_def($self);
return $self->result;
}
sub _add_extra {
my ($self, $index) = @_;
my $field = $self->clone_element($index);
my $result =
HTML::FormHandler::Field::Result->new( name => $index, parent => $self->result );
$result = $field->_result_from_fields($result);
$self->result->add_result($result) if $result;
$self->add_field($field);
return $field;
}
sub add_extra {
my ( $self, $count ) = @_;
$count = 1 if not defined $count;
my $index = $self->index;
while ( $count ) {
$self->_add_extra($index);
$count--;
$index++;
}
$self->index($index);
}
# create an empty field
sub _result_from_fields {
my ( $self, $result ) = @_;
# check for defaults
if ( my @values = $self->get_default_value ) {
return $self->_result_from_object( $result, \@values );
}
$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 $field = $self->clone_element($index);
my $result =
HTML::FormHandler::Field::Result->new( name => $index, parent => $self->result );
$result = $field->_result_from_fields($result);
$self->result->add_result($result) if $result;
$self->add_field($field);
$index++;
$count--;
}
$self->index($index);
$self->_setup_for_js if $self->setup_for_js;
$self->result->_set_field_def($self);
return $result;
}
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::Repeatable - repeatable (array) field
=head1 VERSION
version 0.40050
=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';
In a form, for an array of single fields (not directly equivalent to a
database relationship) use the 'contains' pseudo field name:
has_field 'tags' => ( type => 'Repeatable' );
has_field 'tags.contains' => ( type => 'Text',
apply => [ { check => ['perl', 'programming', 'linux', 'internet'],
message => 'Not a valid tag' } ]
);
or use 'contains' with single fields which are compound fields:
has_field 'addresses' => ( type => 'Repeatable' );
has_field 'addresses.contains' => ( type => '+MyAddress' );
If the MyAddress field contains fields 'address_id', 'street', 'city', and
'state', then this syntax is functionally equivalent to the first method
where the fields are declared with dots ('addresses.city');
You can pass attributes to the 'contains' field by supplying an 'init_contains' hashref.
has_field 'addresses' => ( type => 'Repeatable,
init_contains => { wrapper_attr => { class => ['hfh', 'repinst'] } },
);
=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 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.
=head2 Complications
When new elements are created by a Repeatable field in a database form
an attempt is made to re-load the Repeatable field from the database, because
otherwise the repeatable elements will not have primary keys. Although this
works, if you have included other fields in your repeatable elements
that do *not* come from the database, the defaults/values must be
able to be loaded in a way that works when the form is initialized from
the database item. This is only an issue if you re-present the form
after the database update succeeds.
=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 num_extra
When the field results are built from an existing object (item or init_object)
an additional number of repeatable elements will be created equal to this
number. Default is 0.
=item add_extra
When a form is submitted and the field results are built from the input
parameters, it's not clear when or if an additional repeatable element might
be wanted. The method 'add_extra' will add an empty repeatable element.
$form->process( params => {....} );
$form->field('my_repeatable')->add_extra(1);
This might be useful if the form is being re-presented to the user.
=item setup_for_js
setup_for_js => 1
Saves information in the form for javascript to use when adding repeatable elements.
If using the example javascript, you also must set 'do_wrapper' in the
Repeatable field and use the Bootstrap widget wrapper (or wrap the repeatable
elements in a 'controls' div by setting tags => { controls_div => 1 }.
See t/repeatable/js.t for an example. See also
L and L.
=back
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/Reset.pm 0000644 0000770 0000770 00000001657 12221042077 022323 0 ustar gshank gshank package HTML::FormHandler::Field::Reset;
# ABSTRACT: reset field
use Moose;
extends 'HTML::FormHandler::Field::NoValue';
has '+widget' => ( default => 'Reset' );
has '+value' => ( default => 'Reset' );
has '+type_attr' => ( default => 'reset' );
has '+html5_type_attr' => ( default => 'reset' );
sub do_label {0}
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::Reset - reset field
=head1 VERSION
version 0.40050
=head1 SYNOPSIS
Use this field to declare a reset field in your form.
has_field 'reset' => ( type => 'Reset', value => 'Restore' );
Uses the 'reset' widget.
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/Result.pm 0000644 0000770 0000770 00000003411 12221042077 022505 0 ustar gshank gshank package HTML::FormHandler::Field::Result;
# ABSTRACT: result class for fields
use Moose;
with 'HTML::FormHandler::Result::Role';
has 'value' => (
is => 'ro',
writer => '_set_value',
clearer => '_clear_value',
predicate => 'has_value',
);
has 'field_def' => (
is => 'ro',
isa => 'HTML::FormHandler::Field',
writer => '_set_field_def',
);
has 'missing' => ( is => 'rw', isa => 'Bool' );
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);
}
sub peek {
my ( $self, $indent ) = @_;
$indent ||= '';
my $name = $self->field_def ? $self->field_def->full_name : $self->name;
my $type = $self->field_def ? $self->field_def->type : 'unknown';
my $string = $indent . "result " . $name . " type: " . $type . "\n";
$string .= $indent . "....value => " . $self->value . "\n" if $self->has_value;
if( $self->has_results ) {
$indent .= ' ';
foreach my $res ( $self->results ) {
$string .= $res->peek( $indent );
}
}
return $string;
}
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::Result - result class for fields
=head1 VERSION
version 0.40050
=head1 SYNOPSIS
Result class for L
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/RmElement.pm 0000644 0000770 0000770 00000004042 12221042077 023120 0 ustar gshank gshank package HTML::FormHandler::Field::RmElement;
# ABSTRACT: field to support repeatable javascript remove
use HTML::FormHandler::Moose;
extends 'HTML::FormHandler::Field::Display';
use HTML::FormHandler::Render::Util ('process_attrs');
has '+do_wrapper' => ( default => 1 );
has '+value' => ( default => 'Remove' );
sub build_render_method {
return sub {
my ( $self, $result ) = @_;
$result ||= $self->result;
my $value = $self->html || $self->html_filter($self->_localize($self->value));
my $attrs = $self->element_attributes($result);
push @{$attrs->{class}}, ( 'rm_element', 'btn' );
$attrs->{'data-rep-elem-id'} = $self->parent->id;
$attrs->{id} = $self->id;
my $attr_str = process_attrs($attrs);
my $wrapper_tag = $self->get_tag('wrapper_tag') || 'div';
my $output = qq{<$wrapper_tag$attr_str>$value};
$output = $self->wrap_field($self->result, $output);
return $output;
};
}
__PACKAGE__->meta->make_immutable;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::RmElement - field to support repeatable javascript remove
=head1 VERSION
version 0.40050
=head1 SYNOPSIS
EXAMPLE field for rendering an RmElement field for
doing javascript removals of repeatable elements.
You probably want to make your own.
The main requirements are that the button have 1) the
'rm_element' class, 2) a 'data-rep-elem-id' attribute that
contains the id of the repeatable instance that you want
to remove (C<< $self->parent->id >>).
This field should be a subfield of the Repeatable, probably
either first or last.
=head1 NAME
HTML::FormHandler::Field::RmElement
=head1 ATTRIBUTES
has_field 'rm_element' => ( type => 'RmElement',
value => 'Remove',
);
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/Second.pm 0000644 0000770 0000770 00000001417 12221042077 022446 0 ustar gshank gshank package HTML::FormHandler::Field::Second;
# ABSTRACT: select list 0 to 59
use Moose;
extends 'HTML::FormHandler::Field::IntRange';
our $VERSION = '0.01';
has '+range_start' => ( default => 0 );
has '+range_end' => ( default => 59 );
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::Second - select list 0 to 59
=head1 VERSION
version 0.40050
=head1 DESCRIPTION
A select field for seconds in the range of 0 to 59.
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/Select.pm 0000644 0000770 0000770 00000050255 12221042077 022456 0 ustar gshank gshank package HTML::FormHandler::Field::Select;
# ABSTRACT: select fields
use Moose;
extends 'HTML::FormHandler::Field';
use Carp;
our $VERSION = '0.03';
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 options_ref { [shift->options] }
# this is used for rendering
has 'options_index' => ( traits => ['Counter'], isa => 'Num',
is => 'rw', default => 0,
handles => { inc_options_index => 'inc', dec_options_index => 'dec',
reset_options_index => 'reset' },
);
sub clear_data {
my $self = shift;
$self->next::method();
$self->reset_options_index;
}
sub build_options { [] }
has 'options_from' => ( isa => 'Str', is => 'rw', default => 'none' );
has 'do_not_reload' => ( isa => 'Bool', is => 'ro' );
has 'no_option_validation' => ( isa => 'Bool', is => 'rw' );
sub BUILD {
my $self = shift;
$self->build_options_method;
if( $self->options && $self->has_options ) {
$self->options_from('build');
$self->default_from_options([$self->options]);
}
$self->input_without_param; # vivify
}
has 'options_method' => (
traits => ['Code'],
is => 'ro',
isa => 'CodeRef',
writer => '_set_options_method',
predicate => 'has_options_method',
handles => { 'get_options' => 'execute_method' },
);
sub build_options_method {
my $self = shift;
my $set_options = $self->set_options;
$set_options ||= "options_" . HTML::FormHandler::Field::convert_full_name($self->full_name);
if ( $self->form && $self->form->can($set_options) ) {
my $attr = $self->form->meta->find_method_by_name( $set_options );
if ( $attr and $attr->isa('Moose::Meta::Method::Accessor') ) {
$self->_set_options_method( sub { my $self = shift; $self->form->$set_options; } );
}
else {
$self->_set_options_method( sub { my $self = shift; $self->form->$set_options($self); } );
}
}
}
has 'sort_options_method' => (
traits => ['Code'],
is => 'rw',
isa => 'CodeRef',
predicate => 'has_sort_options_method',
handles => {
sort_options => 'execute_method',
},
);
has 'set_options' => ( isa => 'Str', is => 'ro');
has 'multiple' => ( isa => 'Bool', is => 'rw', default => '0' );
# following is for unusual case where a multiple select is a has_many type relation
has 'has_many' => ( isa => 'Str', is => 'rw' );
has 'size' => ( isa => 'Int|Undef', is => 'rw' );
has 'label_column' => ( isa => 'Str', is => 'rw', default => 'name' );
has 'localize_labels' => ( isa => 'Bool', is => 'rw' );
has 'active_column' => ( isa => 'Str', is => 'rw', default => 'active' );
has 'auto_widget_size' => ( isa => 'Int', is => 'rw', default => '0' );
has 'sort_column' => ( isa => 'Str|ArrayRef[Str]', is => 'rw' );
has '+widget' => ( default => 'Select' );
sub html_element { 'select' }
has '+type_attr' => ( default => 'select' );
has 'empty_select' => ( isa => 'Str', is => 'rw' );
has '+deflate_method' => ( default => sub { \&select_deflate } );
has '+input_without_param' => ( lazy => 1, builder => 'build_input_without_param' );
sub build_input_without_param {
my $self = shift;
if( $self->multiple ) {
$self->not_nullable(1);
return [];
}
else {
return '';
}
}
has 'value_when_empty' => ( is => 'ro', lazy => 1, builder => 'build_value_when_empty' );
sub build_value_when_empty {
my $self = shift;
return [] if $self->multiple;
return undef;
}
our $class_messages = {
'select_not_multiple' => 'This field does not take multiple values',
'select_invalid_value' => '\'[_1]\' is not a valid value',
};
sub get_class_messages {
my $self = shift;
return {
%{ $self->next::method },
%$class_messages,
}
}
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 $self = shift;
my $value = $self->value;
return unless defined $value;
if ( $self->multiple ) {
my @labels;
my %value_hash;
@value_hash{@$value} = ();
for ( $self->options ) {
if ( exists $value_hash{$_->{value}} ) {
push @labels, $_->{label};
delete $value_hash{$_->{value}};
last unless keys %value_hash;
}
}
my $str = join(', ', @labels);
return $str;
}
else {
for ( $self->options ) {
return $_->{label} if $_->{value} eq $value;
}
}
return;
}
sub _inner_validate_field {
my ($self) = @_;
my $value = $self->value;
return unless defined $value; # nothing to check
if ( ref $value eq 'ARRAY' &&
!( $self->can('multiple') && $self->multiple ) )
{
$self->add_error( $self->get_message('select_not_multiple') );
return;
}
elsif ( ref $value ne 'ARRAY' && $self->multiple ) {
$value = [$value];
$self->_set_value($value);
}
return if $self->no_option_validation;
# create a lookup hash
my %options;
foreach my $opt ( @{ $self->options } ) {
if ( exists $opt->{group} ) {
foreach my $group_opt ( @{ $opt->{options} } ) {
$options{$group_opt->{value}} = 1;
}
}
else {
$options{$opt->{value}} = 1;
}
}
if( $self->has_many ) {
$value = [map { $_->{$self->has_many} } @$value];
}
for my $value ( ref $value eq 'ARRAY' ? @$value : ($value) ) {
unless ( $options{$value} ) {
$self->add_error($self->get_message('select_invalid_value'), $value);
return;
}
}
return 1;
}
sub _result_from_object {
my ( $self, $result, $item ) = @_;
$result = $self->next::method( $result, $item );
$self->_load_options;
$result->_set_value($self->default)
if( defined $self->default && not $result->has_value );
return $result;
}
sub _result_from_fields {
my ( $self, $result ) = @_;
$result = $self->next::method($result);
$self->_load_options;
$result->_set_value($self->default)
if( defined $self->default && not $result->has_value );
return $result;
}
sub _result_from_input {
my ( $self, $result, $input, $exists ) = @_;
$input = ref $input eq 'ARRAY' ? $input : [$input]
if $self->multiple;
$result = $self->next::method( $result, $input, $exists );
$self->_load_options;
$result->_set_value($self->default)
if( defined $self->default && not $result->has_value );
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->has_options_method ) {
@options = $self->get_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_ is returning an already constructed array of hashrefs
if ( ref $options[0] eq 'HASH' ) {
$opts = \@options;
$self->default_from_options($opts);
}
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) {
# sort options if sort method exists
$opts = $self->sort_options($opts) if $self->has_sort_options_method;
$self->options($opts);
}
}
# This is because setting 'checked => 1' or 'selected => 1' in an options
# hashref is the equivalent of setting a default on the field. Originally
# that was handled only in rendering, but it moved knowledge about where
# the 'fif' value came from into the renderer, which was bad. So instead
# we're setting the defaults from the options.
# It's probably better to use 'defaults' to start with, but since there are
# people using this method, this at least normalizes it.
sub default_from_options {
my ( $self, $options ) = @_;
my @defaults = map { $_->{value} } grep { $_->{checked} || $_->{selected} } @$options;
if( scalar @defaults ) {
if( $self->multiple ) {
$self->default(\@defaults);
}
else {
$self->default($defaults[0]);
}
}
}
before 'value' => sub {
my $self = shift;
return undef unless $self->has_result;
my $value = $self->result->value;
if( $self->multiple ) {
if ( !defined $value || $value eq '' || ( ref $value eq 'ARRAY' && scalar @$value == 0 ) ) {
$self->_set_value( $self->value_when_empty );
}
elsif ( $self->has_many && scalar @$value && ref($value->[0]) ne 'HASH' ) {
my @new_values;
foreach my $ele (@$value) {
push @new_values, { $self->has_many => $ele };
}
$self->_set_value( \@new_values );
}
}
};
sub select_deflate {
my ( $self, $value ) = @_;
return $value unless ( $self->has_many && $self->multiple );
# the following is for the edge case of a has_many select
return $value unless ref($value) eq 'ARRAY' && scalar @$value && ref($value->[0]) eq 'HASH';
return [map { $_->{$self->has_many} } @$value];
}
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::Select - select fields
=head1 VERSION
version 0.40050
=head1 DESCRIPTION
This is a field that includes a list of possible valid options.
This can be used for select and multiple-select fields.
Widget type is 'select'.
Because select lists and checkbox_groups do not return an HTTP
parameter when the entire list is unselected, the Select field
must assume that the lack of a param means unselection. So to
avoid setting a Select field, it must be set to inactive, not
merely not included in the HTML for a form.
This field type can also be used for fields that use the
'radio_group' widget, and the 'checkbox_group' widget (for
selects with multiple flag turned on, or that use the Multiple
field).
=head2 options
The 'options' array can come from a number of different places:
=over 4
=item From a field declaration
In a field declaration:
has_field 'opt_in' => ( type => 'Select', widget => 'RadioGroup',
options => [{ value => 0, label => 'No'}, { value => 1, label => 'Yes'} ] );
=item From a field class 'build_options' method
In a custom field class:
package MyApp::Field::WeekDay;
use Moose;
extends 'HTML::FormHandler::Field::Select';
....
sub build_options {
my $i = 0;
my @days = ('Sunday', 'Monday', 'Tuesday', 'Wednesday',
'Thursday', 'Friday', 'Saturday' );
return [
map {
{ value => $i++, label => $_ }
} @days
];
}
=item From a coderef supplied to the field definition
has_field 'flim' => ( type => 'Select', options_method => \&flim_options );
sub flim_options { }
=item From a form 'options_' method or attribute
has_field 'fruit' => ( type => 'Select' );
sub options_fruit {
return (
1 => 'apples',
2 => 'oranges',
3 => 'kiwi',
);
}
-- or --
has 'options_fruit' => ( is => 'rw', traits => ['Array'],
default => sub { [1 => 'apples', 2 => 'oranges',
3 => 'kiwi'] } );
Notice that, as a convenience, you can return a simple array (or arrayref)
for the options array in the 'options_field_name' method. The hashrefs with
'value' and 'label' keys will be constructed for you by FormHandler.
=item From the database
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 or arrayref of names of the column(s) used to sort the options
See also L, the 'lookup_options' method.
=back
=head2 Customizing options
Additional attributes can be added in the options array hashref, by using
the 'attributes' key. If you have custom rendering code, you can add any
additional key that you want, of course.
Note that you should *not* set 'checked' or 'selected' attributes in options.
That is handled by setting a field default.
An options array with an extra 'note' key:
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;
}
Setting the select element to disabled:
sub options_license
{
my $self = shift;
return unless $self->schema;
my $licenses = $self->schema->resultset('License')->search(undef,
{order_by => 'sequence'});
my @selections;
while ( my $license = $licenses->next ) {
push @selections, { value => $license->id, label => $license->label,
attributes => { disabled => ($license->active == 0) ? 1 : 0 } };
}
return @selections;
}
You can also divide the options up into option groups. See the section on
rendering.
=head2 Reloading options
If the options come from the options_ 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
=head2 Sorting options
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. Note that this won't work with
option groups.
=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 options_method
Coderef of method to return 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---' );
=head1 value_when_empty
Usually the empty value is an empty arrayref. This attribute allows
changing that. Used by SelectCSV field.
=head2 label_column
Sets or returns the name of the method to call on the foreign class
to fetch the text to use for the select list.
Refers to the method (or column) name to use in a related
object class for the label for select lists.
Defaults to "name".
=head2 localize_labels
For the renderers: whether or not to call the localize method on the select
labels. Default is off.
=head2 active_column
Sets or returns the name of a boolean column that is used as a flag to indicate that
a row is active or not. Rows that are not active are ignored.
The default is "active".
If this column exists on the class then the list of options will included only
rows that are marked "active".
The exception is any columns that are marked inactive, but are also part of the
input data will be included with brackets around the label. This allows
updating records that might have data that is now considered inactive.
=head2 auto_widget_size
This is a way to provide a hint as to when to automatically
select the widget to display for fields with a small number of options.
For example, this can be used to decided to display a radio select for
select lists smaller than the size specified.
See L below.
=head2 sort_column
Sets or returns the column or arrayref of columns used in the foreign class
for sorting the options labels. Default is undefined.
If not defined 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. If the options list is less than or equal
to the L then will return C if L is false,
otherwise will return C.
=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.
=head2 no_option_validation
Set this flag to true if you don't want to validate the options that are submitted.
This would generally only happen if the options are generated via javascript.
=head2 error messages
Customize 'select_invalid_value' and 'select_not_multiple'. Though neither of these
messages should really be seen by users in a properly constructed select.
=head1 Rendering
The 'select' field can be rendered by the 'Select', 'RadioGroup', and 'CheckboxGroup'
widgets. 'RadioGroup' is for a single select, and 'CheckboxGroup' is for a multiple
select.
Option groups can be rendered by providing an options arrays with 'group' elements
containing options:
sub options_testop { (
{
group => 'First Group',
options => [
{ value => 1, label => 'One' },
{ value => 2, label => 'Two' },
{ value => 3, label => 'Three' },
],
},
{
group => 'Second Group',
options => [
{ value => 4, label => 'Four' },
{ value => 5, label => 'Five' },
{ value => 6, label => 'Six' },
],
},
) }
The select rendering widgets all have a 'render_option' method, which may be useful
for situations when you want to split up the rendering of a radio group or checkbox group.
=head1 Database relations
Also see L.
The single select is for a DBIC 'belongs_to' relation. The multiple select is for
a 'many_to_many' relation.
There is very limited ability to do multiple select with 'has_many' relations.
It will only work in very specific circumstances, and requires setting
the 'has_many' attribute to the name of the primary key of the related table.
This is a somewhat peculiar data structure for a relational database, and may
not be what you really want. A 'has_many' is usually represented with a Repeatable
field, and may require custom code if the form structure doesn't match the database
structure. See L.
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/SelectCSV.pm 0000644 0000770 0000770 00000003225 12221042077 023025 0 ustar gshank gshank package HTML::FormHandler::Field::SelectCSV;
# ABSTRACT: Multiple select field from CSV value
use HTML::FormHandler::Moose;
extends 'HTML::FormHandler::Field::Select';
has '+inflate_default_method' => ( default => sub { \&selectcsv_inflate_default } );
has '+deflate_value_method' => ( default => sub { \&selectcsv_deflate_value } );
has '+multiple' => ( default => 1 );
sub build_value_when_empty { undef }
sub selectcsv_inflate_default {
my ( $self, $value ) = @_;
if( defined $value ) {
my @values = split (/,/, $value);
return @values;
}
return;
}
sub selectcsv_deflate_value {
my ( $self, $value ) = @_;
if ( defined $value ) {
my $str = join( ',', sort @$value );
return $str;
}
return;
}
sub fif {
my $self = shift;
my $fif = $self->next::method;
$fif = [] if $fif eq '';
return $fif;
}
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::SelectCSV - Multiple select field from CSV value
=head1 VERSION
version 0.40050
=head1 SYNOPSIS
A multiple select field for comma-separated values in the database.
It expects database values like: '1,5,7'. The string will be inflated
into an arrayref for validation and form filling, and will be deflated
into a comma-separated string in the output value.
This field is useful for MySQL 'set' columns.
=head1 NAME
HTML::FormHandler::Field::SelectCSV
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/Submit.pm 0000644 0000770 0000770 00000002644 12221042077 022501 0 ustar gshank gshank package HTML::FormHandler::Field::Submit;
# ABSTRACT: submit field
use Moose;
extends 'HTML::FormHandler::Field::NoValue';
has '+value' => ( default => 'Save' );
has '+widget' => ( default => 'Submit' );
has '+type_attr' => ( default => 'submit' );
has '+html5_type_attr' => ( default => 'submit' );
sub do_label {0}
sub _result_from_input {
my ( $self, $result, $input, $exists ) = @_;
$self->_set_result($result);
$result->_set_input($input);
$result->_set_field_def($self);
return $result;
}
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::Submit - submit field
=head1 VERSION
version 0.40050
=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 to construct
a form with C<< $form->render >>.
Uses the 'submit' widget.
If you have multiple submit buttons, currently the only way to test
which one has been clicked is with C<< $field->input >>. The 'value'
attribute is used for the HTML input field 'value'.
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/Text.pm 0000644 0000770 0000770 00000005773 12221042077 022170 0 ustar gshank gshank package HTML::FormHandler::Field::Text;
# ABSTRACT: text field
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 '+widget' => ( default => 'Text' );
our $class_messages = {
'text_maxlength' => 'Field should not exceed [quant,_1,character]. You entered [_2]',
'text_minlength' => 'Field must be at least [quant,_1,character]. You entered [_2]',
};
sub get_class_messages {
my $self = shift;
my $messages = {
%{ $self->next::method },
%$class_messages,
};
$messages->{text_minlength} = $self->minlength_message
if $self->minlength_message;
$messages->{text_maxlength} = $self->maxlength_message
if $self->maxlength_message;
return $messages;
}
sub validate {
my $field = shift;
return unless $field->next::method;
my $value = $field->input;
# Check for max length
if ( my $maxlength = $field->maxlength ) {
return $field->add_error( $field->get_message('text_maxlength'),
$maxlength, length $value, $field->loc_label )
if length $value > $maxlength;
}
# Check for min length
if ( my $minlength = $field->minlength ) {
return $field->add_error(
$field->get_message('text_minlength'),
$minlength, length $value, $field->loc_label )
if length $value < $minlength;
}
return 1;
}
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::Text - text field
=head1 VERSION
version 0.40050
=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.
=head2 error messages
Set error messages (text_minlength, text_maxlength):
has_field 'my_text' => ( type => 'Text', messages =>
{ 'text_minlength' => 'Field is too short',
'text_maxlength' => 'Field is too long',
} );
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/TextArea.pm 0000644 0000770 0000770 00000001573 12221042077 022753 0 ustar gshank gshank package HTML::FormHandler::Field::TextArea;
# ABSTRACT: textarea input
use Moose;
extends 'HTML::FormHandler::Field::Text';
our $VERSION = '0.02';
has '+widget' => ( default => 'Textarea' );
has 'cols' => ( isa => 'Int', is => 'rw' );
has 'rows' => ( isa => 'Int', is => 'rw' );
sub html_element { 'textarea' }
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::TextArea - textarea input
=head1 VERSION
version 0.40050
=head1 Summary
For HTML textarea. Uses 'textarea' widget. Set cols/row/minlength/maxlength.
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/TextCSV.pm 0000644 0000770 0000770 00000003332 12221042077 022531 0 ustar gshank gshank package HTML::FormHandler::Field::TextCSV;
# ABSTRACT: CSV Text field from multiple
use HTML::FormHandler::Moose;
extends 'HTML::FormHandler::Field::Text';
has '+deflate_method' => ( default => sub { \&textcsv_deflate } );
has '+inflate_method' => ( default => sub { \&textcsv_inflate } );
has 'multiple' => ( isa => 'Bool', is => 'rw', default => '0' );
sub build_value_when_empty { [] }
sub _inner_validate_field {
my $self = shift;
my $value = $self->value;
return unless $value;
if ( ref $value ne 'ARRAY' ) {
$value = [$value];
$self->_set_value($value);
}
}
sub textcsv_deflate {
my ( $self, $value ) = @_;
if( defined $value && length $value ) {
my $value = ref $value eq 'ARRAY' ? $value : [$value];
my $new_value = join(',', @$value);
return $new_value;
}
return $value;
}
sub textcsv_inflate {
my ( $self, $value ) = @_;
if ( defined $value && length $value ) {
my @values = split(/,/, $value);
return \@values;
}
return $value;
}
__PACKAGE__->meta->make_immutable;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::TextCSV - CSV Text field from multiple
=head1 VERSION
version 0.40050
=head1 SYNOPSIS
A text field that takes multiple values from a database and converts
them to comma-separated values. This is intended for javascript fields
that require that, such as 'select2'.
=head1 NAME
HTML::FormHandler::Field::TextCSV
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/Upload.pm 0000644 0000770 0000770 00000007014 12221042077 022456 0 ustar gshank gshank package HTML::FormHandler::Field::Upload;
# ABSTRACT: file upload field
use Moose;
use Moose::Util::TypeConstraints;
extends 'HTML::FormHandler::Field';
our $VERSION = '0.02';
has '+widget' => ( default => 'Upload', );
has min_size => ( is => 'rw', isa => 'Maybe[Int]', default => 1 );
has max_size => ( is => 'rw', isa => 'Maybe[Int]', default => 1048576 );
has '+type_attr' => ( default => 'file' );
our $class_messages = {
'upload_file_not_found' => 'File not found for upload field',
'upload_file_empty' => 'File uploaded is empty',
'upload_file_too_small' => 'File is too small (< [_1] bytes)',
'upload_file_too_big' => 'File is too big (> [_1] bytes)',
};
sub get_class_messages {
my $self = shift;
return {
%{ $self->next::method },
%$class_messages,
}
}
sub validate {
my $self = shift;
my $upload = $self->value;
my $size = 0;
if( blessed $upload && $upload->can('size') ) {
$size = $upload->size;
}
elsif( is_real_fh( $upload ) ) {
$size = -s $upload;
}
else {
return $self->add_error($self->get_message('upload_file_not_found'));
}
return $self->add_error($self->get_message('upload_file_empty'))
unless $size > 0;
if( defined $self->min_size && $size < $self->min_size ) {
$self->add_error( $self->get_message('upload_file_too_small'), $self->min_size );
}
if( defined $self->max_size && $size > $self->max_size ) {
$self->add_error( $self->get_message('upload_file_too_big'), $self->max_size );
}
return;
}
# stolen from Plack::Util::is_real_fh
sub is_real_fh {
my $fh = shift;
my $reftype = Scalar::Util::reftype($fh) or return;
if( $reftype eq 'IO'
or $reftype eq 'GLOB' && *{$fh}{IO} ){
my $m_fileno = $fh->fileno;
return unless defined $m_fileno;
return unless $m_fileno >= 0;
my $f_fileno = fileno($fh);
return unless defined $f_fileno;
return unless $f_fileno >= 0;
return 1;
}
else {
return;
}
}
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::Upload - file upload field
=head1 VERSION
version 0.40050
=head1 DESCRIPTION
This field is designed to be used with a blessed object with a 'size' method,
such as L, or a filehandle.
Validates that the file is not empty and is within the 'min_size'
and 'max_size' limits (limits are in bytes).
A form containing this field must have the enctype set.
package My::Form::Upload;
use HTML::FormHandler::Moose;
extends 'HTML::FormHandler';
has '+enctype' => ( default => 'multipart/form-data');
has_field 'file' => ( type => 'Upload', max_size => '2000000' );
has_field 'submit' => ( type => 'Submit', value => 'Upload' );
In your controller:
my $form = My::Form::Upload->new;
my @params = ( file => $c->req->upload('file') )
if $c->req->method eq 'POST';
$form->process( params => { @params } );
return unless ( $form->validated );
You can set the min_size and max_size limits to undef if you don't want them to be validated.
=head1 DEPENDENCIES
=head2 widget
Widget type is 'upload'
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/Weekday.pm 0000644 0000770 0000770 00000001707 12221042077 022626 0 ustar gshank gshank package HTML::FormHandler::Field::Weekday;
# ABSTRACT: select list day of week strings
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 ];
}
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::Weekday - select list day of week strings
=head1 VERSION
version 0.40050
=head1 DESCRIPTION
Creates an option list for the days of the week.
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field/Year.pm 0000644 0000770 0000770 00000001724 12221042077 022134 0 ustar gshank gshank package HTML::FormHandler::Field::Year;
# ABSTRACT: year selection list
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;
}
);
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field::Year - year selection list
=head1 VERSION
version 0.40050
=head1 DESCRIPTION
Provides a list of years starting five years back and extending 10 years into
the future.
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Field.pm 0000644 0000770 0000770 00000140151 12221042077 021232 0 ustar gshank gshank package HTML::FormHandler::Field;
# ABSTRACT: base class for fields
use HTML::FormHandler::Moose;
use HTML::FormHandler::Field::Result;
use Try::Tiny;
use Moose::Util::TypeConstraints;
use HTML::FormHandler::Merge ('merge');
use HTML::FormHandler::Render::Util('cc_widget', 'ucc_widget');
use Sub::Name;
with 'HTML::FormHandler::Traits';
with 'HTML::FormHandler::Validate';
with 'HTML::FormHandler::Widget::ApplyRole';
with 'HTML::FormHandler::TraitFor::Types';
our $VERSION = '0.02';
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', weak_ref => 1 );
sub has_fields { }
has 'input_without_param' => (
is => 'rw',
predicate => 'has_input_without_param'
);
has 'not_nullable' => ( is => 'rw', isa => 'Bool' );
has 'no_value_if_empty' => ( is => 'rw', isa => 'Bool' );
has 'validate_when_empty' => ( is => 'rw', isa => 'Bool' );
has 'init_value' => ( is => 'rw', clearer => 'clear_init_value', predicate => 'has_init_value' );
has 'default' => ( is => 'rw' );
has 'default_over_obj' => ( is => 'rw', builder => 'build_default_over_obj' );
sub build_default_over_obj { }
has 'result' => (
isa => 'HTML::FormHandler::Field::Result',
is => 'ro',
weak_ref => 1,
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', 'add_warning', 'all_warnings', 'num_warnings',
'has_warnings', 'warnings', 'missing',
],
);
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;
}
# these should normally only be called for field tests
sub reset_result {
my $self = shift;
$self->clear_result;
$self->build_result;
}
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
$self->_set_result($result);
}
sub input {
my $self = shift;
# allow testing fields individually by creating result if no form
return undef unless $self->has_result || !$self->form;
my $result = $self->result;
return $result->_set_input(@_) if @_;
return $result->input;
}
sub value {
my $self = shift;
# allow testing fields individually by creating result if no form
return undef unless $self->has_result || !$self->form;
my $result = $self->result;
return undef unless $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 '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 ) {
if( $self->_can_deflate ) {
return $self->_apply_deflation($lresult->value);
}
else {
return $lresult->value;
}
}
elsif ( defined $self->value ) {
# this is because checkboxes and submit buttons have their own 'value'
# needs to be fixed in some better way
return $self->value;
}
return '';
}
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 'is_contains' => ( is => 'rw', isa => 'Bool' );
has 'temp' => ( is => 'rw' );
sub has_flag {
my ( $self, $flag_name ) = @_;
return unless $self->can($flag_name);
return $self->$flag_name;
}
has 'label' => (
isa => 'Maybe[Str]',
is => 'rw',
lazy => 1,
builder => 'build_label',
);
has 'do_label' => ( isa => 'Bool', is => 'rw', default => 1 );
has 'build_label_method' => ( is => 'rw', isa => 'CodeRef',
traits => ['Code'], handles => { 'build_label' => 'execute_method' },
default => sub { \&default_build_label },
);
sub default_build_label {
my $self = shift;
my $label = $self->name;
$label =~ s/_/ /g;
$label = ucfirst($label);
return $label;
}
sub loc_label {
my $self = shift;
return $self->_localize($self->label);
}
has 'wrap_label_method' => (
traits => ['Code'],
is => 'ro',
isa => 'CodeRef',
predicate => 'does_wrap_label',
handles => { 'wrap_label' => 'execute_method' },
);
has 'title' => ( isa => 'Str', is => 'rw' );
has 'style' => ( isa => 'Str', is => 'rw' );
# deprecated; remove in six months.
has 'css_class' => ( isa => 'Str', is => 'rw', trigger => \&_css_class_set );
sub _css_class_set {
my ( $self, $value ) = @_;
$self->add_wrapper_class($value);
}
# deprecated; remove in six months;
has 'input_class' => ( isa => 'Str', is => 'rw', trigger => \&_input_class_set );
sub _input_class_set {
my ( $self, $value ) = @_;
$self->add_element_class($value);
}
has 'form' => (
isa => 'HTML::FormHandler',
is => 'rw',
weak_ref => 1,
predicate => 'has_form',
);
sub is_form { 0 }
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 'do_wrapper' => ( is => 'rw', default => 1 );
sub wrapper { shift->widget_wrapper || '' }
sub uwrapper { ucc_widget( shift->widget_wrapper || '' ) || 'simple' }
sub twrapper { shift->uwrapper . ".tt" }
sub uwidget { ucc_widget( shift->widget || '' ) || 'simple' }
sub twidget { shift->uwidget . ".tt" }
# for use of wrapper classes
has 'wrapper_tags' => (
isa => 'HashRef',
traits => ['Hash'],
is => 'rw',
builder => 'build_wrapper_tags',
handles => {
has_wrapper_tags => 'count'
}
);
sub build_wrapper_tags { {} }
has 'tags' => (
traits => ['Hash'],
isa => 'HashRef',
is => 'rw',
builder => 'build_tags',
handles => {
_get_tag => 'get',
set_tag => 'set',
has_tag => 'exists',
tag_exists => 'exists',
delete_tag => 'delete',
},
);
sub build_tags {{}}
sub merge_tags {
my ( $self, $new ) = @_;
my $old = $self->tags;
$self->tags( merge($new, $old) );
}
sub get_tag {
my ( $self, $name ) = @_;
return '' unless $self->tag_exists($name);
my $tag = $self->_get_tag($name);
return $self->$tag if ref $tag eq 'CODE';
return $tag unless $tag =~ /^%/;
( my $block_name = $tag ) =~ s/^%//;
return $self->form->block($block_name)->render
if ( $self->form && $self->form->block_exists($block_name) );
return '';
}
has 'widget_name_space' => (
isa => 'HFH::ArrayRefStr',
is => 'rw',
traits => ['Array'],
default => sub {[]},
coerce => 1,
handles => {
push_widget_name_space => 'push',
},
);
sub add_widget_name_space {
my ( $self, @ns ) = @_;
@ns = @{$ns[0]}if( scalar @ns && ref $ns[0] eq 'ARRAY' );
$self->push_widget_name_space(@ns);
}
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', predicate => 'has__active' );
sub is_active {
my $self = shift;
return ! $self->is_inactive;
}
sub is_inactive {
my $self = shift;
return (($self->inactive && !$self->_active) || (!$self->inactive && $self->has__active && $self->_active == 0 ) );
}
has 'id' => ( isa => 'Str', is => 'rw', lazy => 1, builder => 'build_id' );
has 'build_id_method' => ( is => 'rw', isa => 'CodeRef', traits => ['Code'],
default => sub { sub { shift->html_name } },
handles => { build_id => 'execute_method' },
);
# html attributes
has 'password' => ( isa => 'Bool', is => 'rw' );
has 'disabled' => ( isa => 'Bool', is => 'rw' );
has 'readonly' => ( isa => 'Bool', is => 'rw' );
has 'tabindex' => ( is => 'rw', isa => 'Int' );
sub html_element { 'input' }
has 'type_attr' => ( is => 'rw', isa => 'Str', default => 'text' );
has 'html5_type_attr' => ( isa => 'Str', is => 'ro', default => 'text' );
sub input_type {
my $self = shift;
return $self->html5_type_attr if ( $self->form && $self->form->has_flag('is_html5') );
return $self->type_attr;
}
# temporary methods for compatibility after name change
sub html_attr { shift->element_attr(@_) }
sub has_html_attr { shift->has_element_attr(@_) }
sub get_html_attr { shift->get_element_attr(@_) }
sub set_html_attr { shift->set_element_attr(@_) }
{
# create the attributes and methods for
# element_attr, build_element_attr, element_class,
# label_attr, build_label_attr, label_class,
# wrapper_attr, build_wrapper_atrr, wrapper_class
no strict 'refs';
foreach my $attr ('wrapper', 'element', 'label' ) {
# trigger to move 'class' set via _attr to the class slot
my $add_meth = "add_${attr}_class";
my $trigger_sub = sub {
my ( $self, $value ) = @_;
if( my $class = delete $self->{"${attr}_attr"}->{class} ) {
$self->$add_meth($class);
}
};
has "${attr}_attr" => ( is => 'rw', traits => ['Hash'],
builder => "build_${attr}_attr",
handles => {
"has_${attr}_attr" => 'count',
"get_${attr}_attr" => 'get',
"set_${attr}_attr" => 'set',
"delete_${attr}_attr" => 'delete',
"exists_${attr}_attr" => 'exists',
},
trigger => $trigger_sub,
);
# create builders fo _attrs
my $attr_builder = __PACKAGE__ . "::build_${attr}_attr";
*$attr_builder = subname $attr_builder, sub {{}};
# create the 'class' slots
has "${attr}_class" => ( is => 'rw', isa => 'HFH::ArrayRefStr',
traits => ['Array'],
coerce => 1,
builder => "build_${attr}_class",
handles => {
"has_${attr}_class" => 'count',
"_add_${attr}_class" => 'push',
},
);
# create builders for classes
my $class_builder = __PACKAGE__ . "::build_${attr}_class";
*$class_builder = subname $class_builder, sub {[]};
# create wrapper for add_to_ to accept arrayref
my $add_to_class = __PACKAGE__ . "::add_${attr}_class";
my $_add_meth = __PACKAGE__ . "::_add_${attr}_class";
*$add_to_class = subname $add_to_class, sub { shift->$_add_meth((ref $_[0] eq 'ARRAY' ? @{$_[0]} : @_)); }
}
}
# we're assuming that the only attribute we want in an element wrapper is a class
has 'element_wrapper_class' => (
is => 'rw', isa => 'HFH::ArrayRefStr',
traits => ['Array'],
coerce => 1,
builder => "build_element_wrapper_class",
handles => {
has_element_wrapper_class => 'count',
_add_element_wrapper_class => 'push',
},
);
sub add_element_wrapper_class { shift->_add_element_wrapper_class((ref $_[0] eq 'ARRAY' ? @{$_[0]} : @_)); }
sub build_element_wrapper_class { [] }
sub element_wrapper_attributes {
my ( $self, $result ) = @_;
$result ||= $self->result;
# local copy of label_attr
my $attr = {};
my $class = [@{$self->element_wrapper_class}];
$attr->{class} = $class if @$class;
# call form hook
my $mod_attr = $self->form->html_attributes($self, 'element_wrapper', $attr, $result) if $self->form;
return ref($mod_attr) eq 'HASH' ? $mod_attr : $attr;
}
sub attributes { shift->element_attributes(@_) }
sub element_attributes {
my ( $self, $result ) = @_;
$result ||= $self->result;
my $attr = {};
# handle html5 attributes
if ($self->form && $self->form->has_flag('is_html5')) {
$attr->{required} = 'required' if $self->required;
$attr->{min} = $self->range_start if defined $self->range_start;
$attr->{max} = $self->range_end if defined $self->range_end;
}
# pull in deprecated attributes for backward compatibility
for my $dep_attr ( 'readonly', 'disabled' ) {
$attr->{$dep_attr} = $dep_attr if $self->$dep_attr;
}
for my $dep_attr ( 'style', 'title', 'tabindex' ) {
$attr->{$dep_attr} = $self->$dep_attr if defined $self->$dep_attr;
}
$attr = {%$attr, %{$self->element_attr}};
my $class = [@{$self->element_class}];
$self->add_standard_element_classes($result, $class);
$attr->{class} = $class if @$class;
# call form hook
my $mod_attr = $self->form->html_attributes($self, 'element', $attr, $result) if $self->form;
return ref($mod_attr) eq 'HASH' ? $mod_attr : $attr;
}
sub add_standard_element_classes {
my ( $self, $result, $class ) = @_;
push @$class, 'error' if $result->has_errors;
push @$class, 'warning' if $result->has_warnings;
push @$class, 'disabled' if $self->disabled;
}
sub label_attributes {
my ( $self, $result ) = @_;
$result ||= $self->result;
# local copy of label_attr
my $attr = {%{$self->label_attr}};
my $class = [@{$self->label_class}];
$attr->{class} = $class if @$class;
# call form hook
my $mod_attr = $self->form->html_attributes($self, 'label', $attr, $result) if $self->form;
return ref($mod_attr) eq 'HASH' ? $mod_attr : $attr;
}
sub wrapper_attributes {
my ( $self, $result ) = @_;
$result ||= $self->result;
# copy wrapper
my $attr = {%{$self->wrapper_attr}};
my $class = [@{$self->wrapper_class}];
# add 'error' to class
$self->add_standard_wrapper_classes($result, $class);
$attr->{class} = $class if @$class;
# add id if compound field and id doesn't exist unless 'no_wrapper_id' tag
$attr->{id} = $self->id
if ( $self->has_flag('is_compound') && not exists $attr->{id} && ! $self->get_tag('no_wrapper_id') );
# call form hook
my $mod_attr = $self->form->html_attributes($self, 'wrapper', $attr, $result) if $self->form;
return ref($mod_attr) eq 'HASH' ? $mod_attr : $attr;
}
sub add_standard_wrapper_classes {
my ( $self, $result, $class ) = @_;
push @$class, 'error' if ( $result->has_error_results || $result->has_errors );
push @$class, 'warning' if $result->has_warnings;
}
sub wrapper_tag {
my $self = shift;
return $self->get_tag('wrapper_tag') || 'div';
}
#=====================
# these may be temporary
sub field_filename {
my $self = shift;
return 'checkbox_tag.tt' if $self->input_type eq 'checkbox';
return 'input_tag.tt';
}
sub label_tag {
my $self = shift;
return $self->get_tag('label_tag') || 'label';
}
#===================
has 'writeonly' => ( isa => 'Bool', is => 'rw' );
has 'noupdate' => ( isa => 'Bool', is => 'rw' );
#==============
sub convert_full_name {
my $full_name = shift;
$full_name =~ s/\.\d+\./_/g;
$full_name =~ s/\./_/g;
return $full_name;
}
has 'validate_method' => (
traits => ['Code'],
is => 'ro',
isa => 'CodeRef',
lazy => 1,
builder => 'build_validate_method',
handles => { '_validate' => 'execute_method' },
);
has 'set_validate' => ( isa => 'Str', is => 'ro',);
sub build_validate_method {
my $self = shift;
my $set_validate = $self->set_validate;
$set_validate ||= "validate_" . convert_full_name($self->full_name);
return sub { my $self = shift; $self->form->$set_validate($self); }
if ( $self->form && $self->form->can($set_validate) );
return sub { };
}
has 'default_method' => (
traits => ['Code'],
is => 'ro',
isa => 'CodeRef',
writer => '_set_default_method',
predicate => 'has_default_method',
handles => { '_default' => 'execute_method' },
);
has 'set_default' => ( isa => 'Str', is => 'ro', writer => '_set_default');
# this is not a "true" builder, because sometimes 'default_method' is not set
sub build_default_method {
my $self = shift;
my $set_default = $self->set_default;
$set_default ||= "default_" . convert_full_name($self->full_name);
if ( $self->form && $self->form->can($set_default) ) {
$self->_set_default_method(
sub { my $self = shift; return $self->form->$set_default($self, $self->form->item); }
);
}
}
sub get_default_value {
my $self = shift;
if ( $self->has_default_method ) {
return $self->_default;
}
elsif ( defined $self->default ) {
return $self->default;
}
return;
}
{
# create inflation/deflation methods
foreach my $type ( 'inflate_default', 'deflate_value', 'inflate', 'deflate' ) {
has "${type}_method" => ( is => 'ro', traits => ['Code'],
isa => 'CodeRef',
writer => "_set_${type}_method",
predicate => "has_${type}_method",
handles => {
$type => 'execute_method',
},
);
}
}
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',
lazy => 1,
builder => 'build_render_filter',
handles => { html_filter => 'execute' },
);
sub build_render_filter {
my $self = shift;
if( $self->form && $self->form->can('render_filter') ) {
my $coderef = $self->form->can('render_filter');
return $coderef;
}
else {
return \&default_render_filter;
}
}
sub default_render_filter {
my $string = shift;
return '' if (!defined $string);
$string =~ s/&/&/g;
$string =~ s//>/g;
$string =~ s/"/"/g;
return $string;
}
has 'input_param' => ( is => 'rw', isa => 'Str' );
has 'language_handle' => (
isa => duck_type( [ qw(maketext) ] ),
is => 'rw',
reader => 'get_language_handle',
writer => 'set_language_handle',
predicate => 'has_language_handle'
);
sub language_handle {
my ( $self, $value ) = @_;
if( $value ) {
$self->set_language_handle($value);
return;
}
return $self->get_language_handle if( $self->has_language_handle );
# if language handle isn't set use form language handle if possible
return $self->form->language_handle if ( $self->has_form );
# no form, no language handle. This should only happen when
# testing fields.
my $lh;
if ( $ENV{LANGUAGE_HANDLE} ) {
if ( blessed $ENV{LANGUAGE_HANDLE} ) {
$lh = $ENV{LANGUAGE_HANDLE};
}
else {
$lh = HTML::FormHandler::I18N->get_handle( $ENV{LANGUAGE_HANDLE} );
}
}
else {
require HTML::FormHandler::I18N;
$lh = HTML::FormHandler::I18N->get_handle;
}
$self->set_language_handle($lh);
return $lh;
}
has 'localize_meth' => (
traits => ['Code'],
is => 'ro',
isa => 'CodeRef',
lazy => 1,
builder => 'build_localize_meth',
handles => { '_localize' => 'execute_method' },
);
sub build_localize_meth {
my $self = shift;
if( $self->form && $self->form->can('localize_meth') ) {
my $coderef = $self->form->can('localize_meth');
return $coderef;
}
else {
return \&default_localize;
}
}
sub default_localize {
my ($self, @message) = @_;
my $message = $self->language_handle->maketext(@message);
return $message;
}
has 'messages' => ( is => 'rw',
isa => 'HashRef',
traits => ['Hash'],
default => sub {{}},
handles => {
'_get_field_message' => 'get',
'_has_field_message' => 'exists',
'set_message' => 'set',
},
);
our $class_messages = {
'field_invalid' => 'field is invalid',
'range_too_low' => 'Value must be greater than or equal to [_1]',
'range_too_high' => 'Value must be less than or equal to [_1]',
'range_incorrect' => 'Value must be between [_1] and [_2]',
'wrong_value' => 'Wrong value',
'no_match' => '[_1] does not match',
'not_allowed' => '[_1] not allowed',
'error_occurred' => 'error occurred',
'required' => '[_1] field is required',
'unique' => 'Duplicate value for [_1]',
};
sub get_class_messages {
my $self = shift;
my $messages = { %$class_messages };
$messages->{required} = $self->required_message
if $self->required_message;
$messages->{unique} = $self->unique_message
if $self->unique_message;
return $messages;
}
sub get_message {
my ( $self, $msg ) = @_;
# first look in messages set on individual field
return $self->_get_field_message($msg)
if $self->_has_field_message($msg);
# then look at form messages
return $self->form->_get_form_message($msg)
if $self->has_form && $self->form->_has_form_message($msg);
# then look for messages up through inherited field classes
return $self->get_class_messages->{$msg};
}
sub all_messages {
my $self = shift;
my $form_messages = $self->has_form ? $self->form->messages : {};
my $field_messages = $self->messages || {};
my $lclass_messages = $self->my_class_messages || {};
return {%{$lclass_messages}, %{$form_messages}, %{$field_messages}};
}
sub BUILDARGS {
my $class = shift;
# for backwards compatibility; these will be removed eventually
my @new;
push @new, ('element_attr', {@_}->{html_attr} )
if( exists {@_}->{html_attr} );
push @new, ('do_label', !{@_}->{no_render_label} )
if( exists {@_}->{no_render_label} );
return $class->SUPER::BUILDARGS(@_, @new);
}
sub BUILD {
my ( $self, $params ) = @_;
# temporary, for compatibility. move widget_tags to tags
$self->merge_tags($self->wrapper_tags) if $self->has_wrapper_tags;
# run default method builder
$self->build_default_method;
# build validate_method; needs to happen before validation
# in order to have the "real" repeatable field names, not the instances
$self->validate_method;
# merge form widget_name_space
$self->add_widget_name_space( $self->form->widget_name_space ) if $self->form;
# handle apply actions
$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 initialize field results if there is no initial object and no params
sub _result_from_fields {
my ( $self, $result ) = @_;
if ( $self->disabled && $self->has_init_value ) {
$result->_set_value($self->init_value);
}
elsif ( my @values = $self->get_default_value ) {
if ( $self->has_inflate_default_method ) {
@values = $self->inflate_default(@values);
}
my $value = @values > 1 ? \@values : shift @values;
$self->init_value($value) if defined $value;
$result->_set_value($value) if defined $value;
}
$self->_set_result($result);
$result->_set_field_def($self);
return $result;
}
sub _result_from_input {
my ( $self, $result, $input, $exists ) = @_;
if ($exists) {
$result->_set_input($input);
}
elsif ( $self->disabled ) {
# This maybe should come from _result_from_object, but there's
# not a reliable way to get there from here. Field can handle...
return $self->_result_from_fields( $result );
}
elsif ( $self->has_input_without_param ) {
$result->_set_input( $self->input_without_param );
}
elsif ( $self->form && $self->form->use_fields_for_input_without_param ) {
return $self->_result_from_fields( $result );
}
$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_name;
# field should always have a parent unless it's a standalone field test
if ( $field->parent ) {
$parent_name = $field->parent->full_name;
}
return $name unless defined $parent_name && length $parent_name;
return $parent_name . '.' . $name;
}
sub full_accessor {
my $field = shift;
my $parent = $field->parent;
if( $field->is_contains ) {
return '' unless $parent;
return $parent->full_accessor;
}
my $accessor = $field->accessor;
my $parent_accessor;
if ( $parent ) {
$parent_accessor = $parent->full_accessor;
}
return $accessor unless defined $parent_accessor && length $parent_accessor;
return $parent_accessor . '.' . $accessor;
}
sub add_error {
my ( $self, @message ) = @_;
unless ( defined $message[0] ) {
@message = ( $class_messages->{field_invalid});
}
@message = @{$message[0]} if ref $message[0] eq 'ARRAY';
my $out;
try {
$out = $self->_localize(@message);
}
catch {
die "Error occurred localizing error message for " . $self->label . ". Check brackets. $_";
};
return $self->push_errors($out);;
}
sub push_errors {
my $self = shift;
$self->_push_errors(@_);
if ( $self->parent ) {
$self->parent->propagate_error($self->result);
}
return;
}
sub _apply_deflation {
my ( $self, $value ) = @_;
if ( $self->has_deflation ) {
$value = $self->deflation->($value);
}
elsif ( $self->has_deflate_method ) {
$value = $self->deflate($value);
}
return $value;
}
sub _can_deflate {
my $self = shift;
return $self->has_deflation || $self->has_deflate_method;
}
# 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 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->widget ) {
warn "in apply_rendering_widgets " . $self->widget . " Field\n";
$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;
}
sub peek {
my ( $self, $indent ) = @_;
$indent ||= '';
my $string = $indent . 'field: "' . $self->name . '" type: ' . $self->type . "\n";
if( $self->has_flag('has_contains') ) {
$string .= $indent . "contains: \n";
my $lindent = $indent . ' ';
foreach my $field ( $self->contains->sorted_fields ) {
$string .= $field->peek( $lindent );
}
}
if( $self->has_fields ) {
$string .= $indent . 'subfields of "' . $self->name . '": ' . $self->num_fields . "\n";
my $lindent = $indent . ' ';
foreach my $field ( $self->sorted_fields ) {
$string .= $field->peek( $lindent );
}
}
return $string;
}
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 1 if blessed($x); # true if blessed, otherwise false
return 1 if ref( $x );
return;
}
sub apply_traits {
my ($class, @traits) = @_;
$class->meta->make_mutable;
Moose::Util::apply_all_roles($class->meta, @traits);
$class->meta->make_immutable;
}
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Field - base class for fields
=head1 VERSION
version 0.40050
=head1 SYNOPSIS
Instances of Field subclasses are generally built by L
from 'has_field' declarations or the field_list, but they can also be constructed
using new for test purposes (since there's no standard way to add a field to a form
after construction).
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 from the 'field_name_space' (or directly, when prefixed with '+').
If the type is not specified, it defaults to Text.
See L for a list of the fields and brief
descriptions of their structure.
=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
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, is_inactive, is_active
Set the 'inactive' attribute to 1 if this field is inactive. The 'inactive' attribute
that isn't set or is set to 0 will make a field 'active'.
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/inactivated on 'process' by the form's 'active'/'inactive' attributes.
You can use the is_inactive and is_active methods to check whether this particular
field is active.
if( $form->field('foo')->is_active ) { ... }
=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 inflations/deflations and transforms. Used to construct the
C<< $form->values >> hash. Validation and constraints act on 'value'.
See also L.
=item fif
Values used to fill in the form. Read only. Use a deflation to get
from 'value' to 'fif' if an inflator was used. Use 'fif_from_value'
attribute if you want to use the field 'value' to fill in the form.
[% 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. Set by default for Checkbox,
and Select, since an unchecked checkbox or unselected pulldown
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. Error message will be localized
using '_localize' method.
See also L.
return $field->add_error( 'bad data' ) if $bad;
=item error_fields
Compound fields will have an array of errors from the subfields.
=item localize_meth
Set the method used to localize.
=back
=head2 Attributes for creating HTML
The 'element_attr' hashref attribute can be used to set
arbitrary HTML attributes on a field's input tag.
has_field 'foo' => ( element_attr => { readonly => 1, my_attr => 'abc' } );
Note that the 'id' and 'type' attributes are not set using element_attr. Use
the field's 'id' attribute (or 'build_id_method') to set the id.
The 'label_attr' hashref is for label attributes, and the 'wrapper_attr'
is for attributes on the wrapping element (a 'div' for the standard 'simple'
wrapper).
A 'javascript' key in one of the '_attr' hashes will be inserted into the
element as-is.
The following are used in rendering HTML, but are handled specially.
label - Text label for this field. Defaults to ucfirst field name.
build_label_method - coderef for constructing the label
wrap_label_method - coderef for constructing a wrapped label
id - Useful for javascript (default is html_name. to prefix with
form name, use 'html_prefix' in your form)
build_id_method - coderef for constructing the id
render_filter - Coderef for filtering fields before rendering. By default
changes >, <, &, " to the html entities
disabled - Boolean to set field disabled
The order attribute may be used to set the order in which fields are rendered.
order - Used for sorting errors and fields. Built automatically,
but may also be explicitly set
The following are discouraged. Use 'element_attr', 'label_attr', and 'wrapper_attr'
instead.
css_class - instead use wrapper_class => [ '...' ]
input_class - instead use element_class => [ '...' ]
title - instead use element_attr => { title => '...' }
style - instead use element_attr => { style => '...' }
tabindex - instead use element_attr => { tabindex => 1 }
readonly - instead use element_attr => { readonly => 'readonly' }
Rendering of the various HTML attributes is done by calling the 'process_attrs'
function (from HTML::FormHandler::Render::Util) and passing in a method that
adds in error classes, provides backward compatibility with the deprecated
attributes, etc.
attribute hashref class attribute wrapping method
================= ================= ================
element_attr element_class element_attributes
label_attr label_class label_attributes
wrapper_attr wrapper_class wrapper_attributes
element_wrapper_class element_wrapper_attributes
('element_wrapper' is for an inner div around the input element, not
including the label. Used for Bootstrap3 rendering, but also available
in the Simple wrapper.)
The slots for the class attributes are arrayrefs; they will coerce a
string into an arrayref.
In addition, these 'wrapping methods' call a hook method in the form class,
'html_attributes', which you can use to customize and localize the various
attributes. (Field types: 'element', 'wrapper', 'label')
sub html_attributes {
my ( $self, $field, $type, $attr ) = @_;
$attr->{class} = 'label' if $type eq 'label';
return $attr;
}
The 'process_attrs' function will also handle an array of strings, such as for the
'class' attribute.
=head2 tags
A hashref containing flags and strings for use in the rendering code.
The value of a tag can be a string, a coderef (accessed as a method on the
field) or a block specified with a percent followed by the blockname
('%blockname').
Retrieve a tag with 'get_tag'. It returns a '' if the tag doesn't exist.
This attribute used to be named 'widget_tags', which is deprecated.
=head2 html5_type_attr [string]
This string is used when rendering an input element as the value for the type attribute.
It is used when the form has the is_html5 flag on.
=head2 widget
The 'widget' attribute is used in rendering, so if you are
not using FormHandler's rendering facility, you don't need this
attribute. It is used in generating HTML, in templates and the
rendering roles. 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, create a
widget role, such as MyApp::Form::Widget::Field::MyWidget. Provide
the name space in the 'widget_name_space' attribute, and set
the 'widget' of your field to the package name after the
Field/Form/Wrapper:
has_field 'my_field' => ( widget => 'MyWidget' );
If you are using a template based rendering system you will want
to create a widget template.
(see L)
Widget types for some of the provided field classes:
Widget : Field classes
-----------------------:---------------------------------
Text : Text, Integer
Checkbox : Checkbox, Boolean
RadioGroup : Select, Multiple, IntRange (etc)
Select : Select, Multiple, IntRange (etc)
CheckboxGroup : Multiple select
TextArea : TextArea
Compound : Compound, Repeatable, DateTime
Password : Password
Hidden : Hidden
Submit : Submit
Reset : Reset
NoRender :
Upload : Upload
Widget roles are automatically applied to field classes
unless they already have a 'render' method, and if the
'no_widgets' flag in the form is not set.
You can create your own widget roles and specify the namespace
in 'widget_name_space'. In the form:
has '+widget_name_space' => ( default => sub { ['MyApp::Widget'] } );
If you want to use a fully specified role name for a widget, you
can prefix it with a '+':
widget => '+MyApp::Widget::SomeWidget'
For more about widgets, see L.
=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 Defaults
See also the documentation on L.
=over
=item default_method, set_default
Supply a coderef (which will be a method on the field) with 'default_method'
or the name of a form method with 'set_default' (which will be a method on
the form). If not specified and a form method with a name of
C<< default_ >> exists, it will be used.
=item default
Provide an initial value just like the 'set_default' method, except in the field
declaration:
has_field 'bax' => ( default => 'Default bax' );
FormHandler has flipped back and forth a couple of times about whether a default
specified in the has_field definition should override values provided in an
initial item or init_object. Sometimes people want one behavior, and sometimes
the other. Now 'default' does *not* override.
If you pass in a model object with C<< item => $row >> or an initial object
with C<< init_object => {....} >> the values in that object will be used instead
of values provided in the field definition with 'default' or 'default_fieldname'.
If you want defaults that override or supplement the item/init_object, you can use the form
flags 'use_defaults_over_obj', 'use_init_obj_over_item', and
'use_init_obj_when_no_accessor_in_item'.
You could also put your defaults into your row or init_object instead.
=item default_over_obj
This is deprecated; look into using 'use_defaults_over_obj' or 'use_init_obj_over_item'
flags instead. They allow using the standard 'default' attribute.
Allows setting defaults which will override values provided with an item/init_object.
(And only those. Will not be used for defaults without an item/init_object.)
has_field 'quux' => ( default_over_obj => 'default quux' );
At this time there is no equivalent of 'set_default', but the type of the attribute
is not defined so you can provide default values in a variety of other ways,
including providing a trait which does 'build_default_over_obj'. For examples,
see tests in the distribution.
=back
=head1 Constraints and Validations
See also L.
=head2 Constraints set in attributes
=over
=item required
Flag indicating whether this field must have a value
=item unique
For DB field - check for uniqueness. Action is performed by
the DB model.
=item messages
messages => { required => '...', unique => '...' }
Set messages created by FormHandler by setting in the 'messages'
hashref. Some field subclasses have additional settable messages.
required: Error message text added to errors if required field is not present.
The default is "Field is required".
=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,
}
=item not_nullable
Fields that contain 'empty' values such as '' are changed to undef in the validation process.
If this flag is set, the value is not changed to undef. If your database column requires
an empty string instead of a null value (such as a NOT NULL column), set this attribute.
has_field 'description' => (
type => 'TextArea',
not_nullable => 1,
);
This attribute is also used when you want an empty array to stay an empty array and not
be set to undef.
It's also used when you have a compound field and you want the 'value' returned
to contain subfields with undef, instead of the whole field to be undef.
=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) ... } }
],
);
See more documentation in L.
=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 Inflation/deflation
There are a number of methods to provide finely tuned inflation and deflation:
=over 4
=item inflate_method
Inflate to a data format desired for validation.
=item deflate_method
Deflate to a string format for presenting in HTML.
=item inflate_default_method
Modify the 'default' provided by an 'item' or 'init_object'.
=item deflate_value_method
Modify the value returned by C<< $form->value >>.
=item deflation
Another way of providing a deflation method.
=item transform
Another way of providing an inflation method.
=back
Normally if you have a deflation, you will need a matching inflation.
There are two different flavors of inflation/deflation: one for inflating values
to a format needed for validation and deflating for output, the other for
inflating the initial provided values (usually from a database row) and deflating
them for the 'values' returned.
See L.
=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 ( ... );
}
=head2 validate_method, set_validate
Supply a coderef (which will be a method on the field) with 'validate_method'
or the name of a form method with 'set_validate' (which will be a method on
the form). If not specified and a form method with a name of
C<< validate_ >> exists, it will be used.
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 'my_foo' => ( validate_method => \&my_foo_validation );
sub my_foo_validation { ... }
has_field 'title' => ( isa => 'Str', set_validate => 'check_title' );
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Fields.pm 0000644 0000770 0000770 00000016667 12221042077 021433 0 ustar gshank gshank package HTML::FormHandler::Fields;
# ABSTRACT: internal role for form and compound fields
use Moose::Role;
use HTML::FormHandler::TraitFor::Types;
has 'fields' => (
traits => ['Array'],
isa => 'ArrayRef[HTML::FormHandler::Field]',
is => 'rw',
default => sub { [] },
auto_deref => 1,
handles => {
all_fields => 'elements',
clear_fields => 'clear',
add_field => 'push',
push_field => 'push',
num_fields => 'count',
has_fields => 'count',
set_field_at => 'set',
_pop_field => 'pop',
}
);
# This is for updates applied via roles or compound field classes; allows doing
# both updates on the process call and updates from class applied roles
has 'update_subfields' => ( is => 'rw', isa => 'HashRef', builder => 'build_update_subfields',
traits => ['Hash'], handles => { clear_update_subfields => 'clear',
has_update_subfields => 'count' } );
sub build_update_subfields {{}}
# used to transfer tags to fields from form and compound fields
has 'widget_tags' => (
isa => 'HashRef',
traits => ['Hash'],
is => 'rw',
default => sub {{}},
handles => {
has_widget_tags => 'count'
}
);
# 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 }
has 'field_name_space' => (
isa => 'HFH::ArrayRefStr',
is => 'rw',
traits => ['Array'],
lazy => 1,
default => '',
coerce => 1,
handles => {
add_field_name_space => 'push',
},
);
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 subfield {
my ( $self, $name ) = @_;
return $self->field($name, undef, $self);
}
sub field {
my ( $self, $name, $die, $f ) = @_;
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( $self->form && $self == $self->form &&
exists $self->index->{$name} ) {
return $self->index->{$name};
}
if ( $name =~ /\./ ) {
my @names = split /\./, $name;
$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 { $_->is_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->is_inactive || $field->disabled || !$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->is_inactive || !$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->is_inactive || $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 propagate_error {
my ( $self, $result ) = @_;
# References to fields with errors are propagated up the tree.
# All fields with errors should end up being in the form's
# error_results. Once.
my ($found) = grep { $_ == $result } $self->result->all_error_results;
unless ( $found ) {
$self->result->add_error_result($result);
if ( $self->parent ) {
$self->parent->propagate_error( $result );
}
}
}
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');
my $message = $field->has_errors ? join( ' | ', $field->all_errors) : 'validated';
warn "HFH: ", $field->name, ": $message\n";
}
}
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Fields - internal role for form and compound fields
=head1 VERSION
version 0.40050
=head1 SYNOPSIS
A role to implement field attributes, accessors, etc. To be applied
to L and L.
=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 object with the full_name passed. Will return undef
if the field is not found, or will die if passed a second parameter.
=head2 field_index
Convenience function for use with 'set_field_at'. Pass in 'name' of field
(not full_name)
=head2 sorted_fields
Calls fields and returns them in sorted order by their "order"
value. Non-sorted fields are retrieved with 'fields'.
=head2 clear methods
clear_data
clear_fields
clear_error_fields
=head2 Dump information
dump - turn verbose flag on to get this output
dump_validated - shorter version
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Foo.pm 0000644 0000770 0000770 00000003564 12221042077 020740 0 ustar gshank gshank package HTML::FormHandler::Foo;
# ABSTRACT: Experiment in loading form from config file
use Moose;
extends 'HTML::FormHandler';
with 'HTML::FormHandler::Render::WithTT';
use Config::Any;
has 'form_error_message' => ( isa => 'Str', is => 'rw' );
has 'javascript_src' => ( isa => 'Str', is => 'rw' );
has 'javascript' => ( isa => 'Str', is => 'rw' );
sub before_build {
my $self = shift;
$self->add_tt_include_path('share/templates/foo');
$self->process_config_file;
$self->process_config;
}
sub build_tt_template { 'form.tt' }
has 'config_file' => ( isa => 'Str', is => 'rw' );
has 'config' => ( isa => 'HashRef', is => 'rw' );
sub submitted_and_valid { shift->validated }
sub process_config_file {
my $self = shift;
return unless $self->config_file;
unless ( -e $self->config_file ) {
die "form config file " . $self->config_file . " . does not exist";
}
my $config = Config::Any->load_files({
files => [$self->config_file],
use_ext => 1,
driver_args => { General => { -UTF8 => 1 }, },
});
$config = $config->[0]->{$self->config_file};
$self->config($config);
}
sub process_config {
my $self = shift;
my $config = $self->config;
while ( my ( $key, $value ) = each %{$config} ) {
confess "invalid attribute '$key' in form config"
unless $self->can($key);
$self->$key($value);
}
}
__PACKAGE__->meta->make_immutable;
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::Foo - Experiment in loading form from config file
=head1 VERSION
version 0.40050
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/I18N/ 0000755 0000770 0000770 00000000000 12221042077 020326 5 ustar gshank gshank HTML-FormHandler-0.40050/lib/HTML/FormHandler/I18N/bg_bg.pm 0000644 0000770 0000770 00000017231 12221042077 021730 0 ustar gshank gshank package HTML::FormHandler::I18N::bg_bg;
# ABSTRACT: Bulgarian message file
use strict;
use warnings;
use utf8;
use base 'HTML::FormHandler::I18N';
# translator: Dimitar Petrov
# Auto define lexicon
our %Lexicon = (
'_AUTO' => 1,
# H::F::Field
'field is invalid' => 'Полето не е валидно',
'Wrong value' => 'Грешна стойност',
'[_1] does not match' => '[_1] не съвпада',
'[_1] not allowed' => '[_1] не разрешено',
'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] е задължително',
'error occurred' => 'възникна грешка',
# 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 адрес',
'Must not 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' => 'Полето трябва да съдържа една дума',
'Must not be empty' => 'Не трябва да бъде празно',
'Must be between 8 and 255 chars, and contain a non-alpha char' => 'Трябва да бъде между 8 и 255 символа и да съдържа поне един не-буквен символ',
# H::F::Field::Date
'Date is too early' => 'Датата е прекалено рано',
'Date is too late' => 'Датата е прекалено късно',
# H::F::Field::DateTime
'Not a valid DateTime' => 'Невалидна дата/време',
# H::F::Field::Duration
'Invalid value for [_1]: [_2]' => 'Невалидна стойност за [_1]: [_2]',
# 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' => 'Моля въведете парола',
'Password must not match [_1]' => 'Паролата не съвпада с [_1]',
# H::F::Field::PasswordConf
'Please enter a password confirmation' => 'Моля, въведете парола за потвърждение',
'The password confirmation does not match the password' => 'Въведената парола за потвърждение не съвпада с паролата',
# H::F::Field::PosInteger
'Value must be a positive integer' => 'Стойността трябва да бъде положително цяло число',
# H::F::Field::Select
'This field does not take multiple values' => 'Това поле не приема няколко стойности',
'\'[_1]\' is not a valid value' => '\'[_1]\' не е валидна стойност',
# H::F::Field::Text
'Field should not exceed [quant,_1,character]. You entered [_2]' => 'Стойността не трябва да надминава [_1]. Въвели сте: [_2]',
'Field must be at least [quant,_1,character]. You entered [_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] байта)',
'File not found for upload field' => 'Не е намерен файл файл за качване',
# H::F::Model
'Value must be unique in the database' => 'Стойността трябва да е уникална в базата от данни',
# Other
'Your datetime does not match your pattern.' => 'Въведената дата/време не съвпада с вашия шаблон.',
);
1;
=pod
=head1 NAME
HTML::FormHandler::I18N::bg_bg - Bulgarian message file
=head1 VERSION
version 0.40050
=head1 NAME
HTML::FormHandler::I18N::bg_bg - Bulgarian message file
=head1 VERSION
version 0.40010
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2012 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
__END__
HTML-FormHandler-0.40050/lib/HTML/FormHandler/I18N/de_de.pm 0000644 0000770 0000770 00000011503 12221042077 021724 0 ustar gshank gshank package HTML::FormHandler::I18N::de_de;
# ABSTRACT: German message translations
use strict;
use warnings;
use base 'HTML::FormHandler::I18N';
use utf8;
# Auto define lexicon
our %Lexicon = (
'_AUTO' => 1,
# H::F::Field
'field is invalid' => 'Feld ist ungültig',
'Wrong value' => 'Ungültiger Wert',
'[_1] does not match' => '[_1] ist kein gültiger Wert',
'[_1] not allowed' => '[_1] ist nicht erlaubt',
'[_1] field is required' => 'Feld ist erforderlich',
'error occurred' => 'Fehler aufgetreten',
'Value must be between [_1] and [_2]' => 'Wert muss zwischen [_1] und [_2] liegen',
'Value must be greater than or equal to [_1]' => 'Wert muss größer oder gleich [_1] sein',
'Value must be less than or equal to [_1]' => 'Wert muss kleiner oder gleich [_1] sein',
# 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 non-empty single line of no more than 255 chars' => 'Muss eine nicht leere Zeile (max. 255 Zeichen) sein',
'Must be made up of letters, digits, and underscores' => 'Darf nur Buchstaben, Ziffern oder "_" enthalten',
'Not a valid IP address' => 'IP Adresse ungültig',
'Must not be all digits' => 'Darf nicht nur Ziffern enthalten',
'Not a valid state' => 'Kein gültiger Bundesstaat',
'Field contains non-printable characters' => 'Feld enthält nicht druckbare Zeichen',
'Must be between 4 and 255 chars' => '4 bis 255 Zeichen erforderlich',
'Zip is not valid' => 'PLZ ungültig',
'Must be a single line of no more than 255 chars' => 'Muss eine einzelne Zeile (max. 255 Zeichen) sein',
'Email is not valid' => 'E-Mail ist nicht gültig',
'Must not contain spaces' => 'Darf keine Leerzeichen enthalten',
'Field must contain a single word' => 'Feld muss ein einzelnes Wort enthalten',
'Must not be empty' => 'Feld darf nicht leer bleiben',
'Must be between 8 and 255 chars, and contain a non-alpha char' => 'Wert muss 8 bis 255 Zeichen und ein nicht alpha-num Zeichen enthalten',
# H::F::Field::Date
'Date is too early' => 'Datum ist zu früh',
'Date is too late' => 'Datum ist zu spät',
# H::F::Field::DateTime
'Not a valid DateTime' => 'Ungültige Datums-/Zeitangabe',
# H::F::Field::Duration
'Invalid value for [_1]: [_2]' => 'Ungültiger Wert für [_1]: [_2]',
# 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',
'Password must not match [_1]' => 'Passwort darf nicht mit \'[_1]\' übereinstimmen',
# H::F::Field::PasswordConf
'Please enter a password confirmation' => 'Bitte das Passwort bestätigen',
'The password confirmation does not match the password' => 'Passwort Bestätigung stimmt nicht überein',
# H::F::Field::PosInteger
'Value must be a positive integer' => 'Muss eine positive ganze Zahl sein',
# H::F::Field::Select
'This field does not take multiple values' => 'Mehrfachauswahl nicht erlaubt',
'\'[_1]\' is not a valid value' => '\'[_1]\' ist kein gültiger Wert',
# H::F::Field::Text
'Field should not exceed [quant,_1,character]. You entered [_2]' => 'Bitte auf [_1] Zeichen beschränken. Sie haben [_2] eingegeben',
'Field must be at least [quant,_1,character]. You entered [_2]' => 'Eingabe muss mindestens [_1] Zeichen lang sein. Sie haben nur [_2] eingegeben',
# H::F::Field::Upload
'File uploaded is empty' => 'Hochgeladene Datei ist leer',
'File is too small (< [_1] bytes)' => 'Datei ist zu klein (< [_1] bytes)',
'File is too big (> [_1] bytes)' => 'Datei ist zu groß (> [_1] bytes)',
'File not found for upload field' => 'Datei für upload Feld nicht gefunden',
# H::F::Model
'Value must be unique in the database' => 'Wert existiert bereits in der Datenbank',
);
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::I18N::de_de - German message translations
=head1 VERSION
version 0.40050
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/I18N/en_us.pm 0000644 0000770 0000770 00000001137 12221042077 021777 0 ustar gshank gshank package HTML::FormHandler::I18N::en_us;
# ABSTRACT: base message file
use strict;
use warnings;
use base 'HTML::FormHandler::I18N';
# Auto define lexicon
our %Lexicon = (
'_AUTO' => 1,
);
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::I18N::en_us - base message file
=head1 VERSION
version 0.40050
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/I18N/hu_hu.pm 0000644 0000770 0000770 00000012331 12221042077 021774 0 ustar gshank gshank package HTML::FormHandler::I18N::hu_hu;
# ABSTRACT: Hungarian message file
use strict;
use warnings;
use utf8;
use base 'HTML::FormHandler::I18N';
# translator: Csaba Hetényi
# notify before release: cub@cpan.org
# Auto define lexicon
our %Lexicon = (
'_AUTO' => 1,
# H:: F:: Field
'field is invalid' => 'A mező érvénytelen',
'Wrong value' => 'Rossz érték',
# '[_1] does not match' => '...',
# '[_1] not allowed' => '...',
'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',
# 'error occurred' => '...',
# 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ő',
'Must 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',
# 'Must not be empty' => '...',
# 'Must be between 8 and 255 chars, and contain a non-alpha char' => '...',
# 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::Duration
# 'Invalid value for [_1]: [_2]' => '.....',
# 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',
# 'Password must not match [_1]' => '....',
# H::F::Field::PasswordConf
'Please enter a password confirmation' => 'Jelszó megerősítése',
# 'The password confirmation does not match the password' => '...',
# 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',
# '\'[_1]\' is not a valid value' => '...',
# H::F::Field::Text
'Field should not exceed [quant,_1,character]. You entered [_2]' => 'A maximális hossz: [_1] karakter. A tiéd pedig: [_2]',
'Field must be at least [quant,_1,character]. You entered [_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)',
# 'File not found for upload field' => '...',
# H:: F:: Model
'Value must be unique in the database' => 'Az érték egyedi kell legyen az adatbázisban',
# Other
'Your datetime does not match your pattern.' => 'A datetime érték nem illeszkedik a mintára.',
);
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::I18N::hu_hu - Hungarian message file
=head1 VERSION
version 0.40050
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/I18N/it_it.pm 0000644 0000770 0000770 00000012766 12221042077 022010 0 ustar gshank gshank package HTML::FormHandler::I18N::it_it;
# ABSTRACT: Italian message translations - traduzione italiana dei messaggi
use strict;
use warnings;
use base 'HTML::FormHandler::I18N';
use utf8;
our $VERSION = '0.01';
# Auto define lexicon
our %Lexicon = (
'_AUTO' => 1,
# H::F
'There were errors in your form'=> q(Alcuni dati sono sbagliati),
# H::F::Field
'field is invalid' => 'Campo non valido',
'Wrong value' => 'Valore errato',
'[_1] does not match' => '[_1] non combacia',
'[_1] not allowed' => '[_1] non permesso',
'[_1] field is required' => 'Il campo [_1] è obbligatorio',
'error occurred' => q(C'è un errore),
'Value must be between [_1] and [_2]' => 'Il valore deve essere compreso tra [_1] e [_2]',
'Value must be greater than or equal to [_1]' => 'Il valore deve essere maggiore o eguale a [_1]',
'Value must be less than or equal to [_1]' => 'Il valore deve essere minore o eguale a [_1]',
# H::F::Types
'Must be a positive number' => 'Deve essere un numero positivo',
'Must be a positive integer' => 'Deve essere un numero intero positivo',
'Must be a negative number' => 'Deve essere un numero negativo',
'Must be a negative integer' => 'Deve essere un numero intero negativo',
'Must be a single digit' => 'Deve essere di una singola cifra',
'Must be a non-empty single line of no more than 255 chars' => 'Deve essere un testo di una riga, non vuoto e con un massimo di 255 caratteri',
'Must be made up of letters, digits, and underscores' => 'Può essere composto da lettere, cifre e "_"',
'Not a valid IP address' => q(L'indirizzo IP non è valido),
'Must not be all digits' => 'Non devono essere solo cifre',
'Not a valid state' => 'Non è uno stato valido',
'Field contains non-printable characters' => 'Il campo contiene caratteri non stampabili',
'Must be between 4 and 255 chars' => 'Deve essere tra 4 e 255 caratteri',
'Zip is not valid' => 'il CAP non è valido',
'Must be a single line of no more than 255 chars' => 'Deve essere una sola riga di testo con un massimo di 255 caratteri',
'Email is not valid' => 'Non è un indirizzo E-mail',
'Must not contain spaces' => 'Non deve contenere spazi',
'Field must contain a single word' => 'Il campo deve contenere una sola parola',
'Must not be empty' => 'Non può essere vuoto',
'Must be between 8 and 255 chars, and contain a non-alpha char' => 'Deve essere tra 8 e 255 caratteri, e contenere non solo lettere',
# H::F::Field::Date
'Date is too early' => 'La data è troppo remota',
'Date is too late' => 'La data è troppo avanti',
# H::F::Field::DateTime
'Not a valid DateTime' => 'Non è un DateTime valido',
# H::F::Field::Duration
'Invalid value for [_1]: [_2]' => 'Durata non valida per [_1]: [_2]',
# H::F::Field::Email
'Email should be of the format [_1]' => 'E-mail deve essere nel formato [_1]',
# H::F::Field::Integer
'Value must be an integer' => 'Deve essere un numero intero',
# H::F::Field::Money
'Value cannot be converted to money' => 'Il valore non può essere converito in moneta',
'Value must be a real number' => 'Deve essere un numero reale',
# H::F::Field::Password
'Please enter a password in this field' => 'Inserisci la password in questo campo',
'Password must not match [_1]' => 'La password non deve coincidere con [_1]',
# H::F::Field::PasswordConf
'Please enter a password confirmation' => 'Ripeti la password quale verifica',
'The password confirmation does not match the password' => 'La password di verifica non coincide',
# H::F::Field::PosInteger
'Value must be a positive integer' => 'Deve essere un intero positivo',
# H::F::Field::Select
'This field does not take multiple values' => 'Questo campo non accetta più di un valore',
'\'[_1]\' is not a valid value' => '\'[_1]\' non è un valore valido',
# H::F::Field::Text
'Field should not exceed [quant,_1,character]. You entered [_2]' => 'Il campo non deve eccedere [quant,_1,carattere,caratteri]. Tu ne hai inseriti [_2]',
'Field must be at least [quant,_1,character]. You entered [_2]' => 'Il campo deve essere di almeno [quant,_1,carattere,caratteri]. Tu ne hai inseriti [_2]',
# H::F::Field::Upload
'File uploaded is empty' => 'Il file inserito è vuoto',
'File is too small (< [_1] bytes)' => 'Il file è troppo piccolo (< [_1] bytes)',
'File is too big (> [_1] bytes)' => 'Il file è troppo grande (> [_1] bytes)',
'File not found for upload field' => q(Il file nel campo di upload non esiste),
# H::F::Model
'Value must be unique in the database' => 'Il valore deve essere unico nella base dati',
);
1;
=pod
=head1 NAME
HTML::FormHandler::I18N::it_it - Italian message translations - traduzione italiana dei messaggi
=head1 VERSION
version 0.40050
=head1 NAME
HTML::FormHandler::I18N::it_it - Italian message translations
=head1 VERSION
version 0.40025
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
__END__
HTML-FormHandler-0.40050/lib/HTML/FormHandler/I18N/ja_jp.pm 0000644 0000770 0000770 00000013035 12221042077 021751 0 ustar gshank gshank package HTML::FormHandler::I18N::ja_jp;
# ABSTRACT: Japanese message file
use strict;
use warnings;
use utf8;
use base 'HTML::FormHandler::I18N';
# translator: Tomohiro Hosaka
# もっと良い訳に直してください！！
# Auto define lexicon
our %Lexicon = (
'_AUTO' => 1,
# H::F::Field
'field is invalid' => 'フィールドが無効です。',
'Wrong value' => '不正な値です。',
'[_1] does not match' => '[_1]は一致しません。',
'[_1] not allowed' => '[_1]は許可されません。',
'[_1] field is required' => '[_1]を入力してください。',
'error occurred' => 'エラーが起こりました。',
'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]以下にしてください。',
# 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 non-empty single line of no more than 255 chars' => '空でない255字以下の文字列にしてください。',
'Must be made up of letters, digits, and underscores' => '数字とハイフンとアンダースコアで構成してください。',
'Not a valid IP address' => 'IPアドレスとして正しくありません。',
'Must not be all digits' => '全て数字にすることはできません。',
'Not a valid state' => '州として正しくありません。',
'Field contains non-printable characters' => '表示できない文字を含んでいます。',
'Must be between 4 and 255 chars' => '4字以上255字以下にしてください。',
'Zip is not valid' => 'ZIP codeが正しくありません。',
'Must be a single line of no more than 255 chars' => '255字以下の文字列にしてください。改行を含めることはできません。',
'Email is not valid' => 'メールアドレスが正しくありません。',
'Must not contain spaces' => 'スペースを含めることはできません。',
'Field must contain a single word' => '単語を含めてください。',
'Must not be empty' => '空にすることはできません。',
'Must be between 8 and 255 chars, and contain a non-alpha char' => '8字以上255字以下の文字列で、アルファベット以外の文字を含めてください。',
# H::F::Field::Date
'Date is too early' => '日付が早すぎます。',
'Date is too late' => '日付が遅すぎます。',
# H::F::Field::DateTime
'Not a valid DateTime' => '日時が正しくありません。',
# H::F::Field::Duration
'Invalid value for [_1]: [_2]' => '無効な値です。[_1]([_2])',
# 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' => '実数にしてください。l',
# H::F::Field::Password
'Please enter a password in this field' => 'パスワードを入力してください。',
'Password must not match [_1]' => 'パスワードが「[_1]」と一致しています。',
# H::F::Field::PasswordConf
'Please enter a password confirmation' => 'パスワードの確認を入力してください。',
'The password confirmation does not match the password' => 'パスワードの確認が入力されたパスワードと一致しません。',
# H::F::Field::PosInteger
'Value must be a positive integer' => '正の整数にしてください。',
# H::F::Field::Select
'This field does not take multiple values' => '複数選択することはできません。',
'\'[_1]\' is not a valid value' => '「[_1]」は正しくありません。',
# H::F::Field::Text
'Field should not exceed [quant,_1,character]. You entered [_2]' => '[_1]字以下にしてください。[_2]字入力されています。',
'Field must be at least [quant,_1,character]. You entered [_2]' => '[_1]字以上にしてください。[_2]字入力されています。',
# H::F::Field::Upload
'File uploaded is empty' => 'アップロードされたファイルは空でした。',
'File is too small (< [_1] bytes)' => 'ファイルが小さすぎます。(< [_1] bytes)',
'File is too big (> [_1] bytes)' => 'ファイルが大きすぎます。 (> [_1] bytes)',
'File not found for upload field' => 'ファイルが見付かりません。',
# H::F::Model
'Value must be unique in the database' => 'データベース内でユニークな値にしてください。',
);
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::I18N::ja_jp - Japanese message file
=head1 VERSION
version 0.40050
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/I18N/pt_br.pm 0000644 0000770 0000770 00000014233 12221042077 021775 0 ustar gshank gshank package HTML::FormHandler::I18N::pt_br;
# ABSTRACT: Brazilian Portuguese message file
use strict;
use warnings;
use utf8;
use base 'HTML::FormHandler::I18N';
# translator: Daniel Nicoletti
# notify before release: dantti12@gmail.com
# Auto define lexicon
our %Lexicon = (
'_AUTO' => 1,
# H:: F:: Field
'field is invalid' => 'campo esta inválido',
'Wrong value' => 'Valor errado',
'[_1] does not match' => '[_1] não coincide',
'[_1] not allowed' => '[_1] não permitido',
'Value must be between [_1] and [_2]' => 'Valor deve estar entre [_1] e [_2]',
'Value must be greater than or equal to [_1]' => 'Valor deve ser maior ou igual a [_1]',
'Value must be less than or equal to [_1]' => 'Valor deve ser menor ou igual a [_1]',
'[_1] field is required' => '[_1] é obrigatório',
'error occurred' => 'ocorreu um erro',
# H:: F:: Types
'Must be a positive number' => 'Deve ser um número positivo',
'Must be a positive integer' => 'Deve ser um número inteiro positivo',
'Must be a negative number' => 'Deve ser um número negativo',
'Must be a negative integer' => 'Deve ser um número inteiro negativo',
'Must be a single digit' => 'Deve ser um único digito',
'Must be a single line of no more than 255 chars' => 'Deve ser uma única linha com não mais do que 255 caracteres',
'Must be a non-empty single line of no more than 255 chars' => 'Deve ser uma única linha não nula com não mais do que 255 caracteres',
'Must be between 4 and 255 chars' => 'Deve ser entre 4 e 255 caracteres',
'Not a valid state' => 'Não é um estado válido',
'Email is not valid' => 'Email inválido',
'Zip is not valid' => 'CEP inválido',
'Not a valid IP address' => 'Endereço IP inválido',
'Must not contain spaces' => 'Não deve conter espaços',
'Must be made up of letters, digits, and underscores' => 'Deve conter letras, digitos e underscores',
'Must not be all digits' => 'Não pode ter todos os digitos',
'Field contains non-printable characters' => 'Campo contém caracteres inválidos',
'Field must contain a single word' => 'Campo deve conter uma única palavra',
'Must not be empty' => 'Não pode estar vazio',
'Must be between 8 and 255 chars, and contain a non-alpha char' => 'Deve ser entre 8 e 255 caracteres, e conter um caractere não alfa numérico',
# H::F::Field::Date
'Date is too early' => 'A data é muito cedo',
'Date is too late' => 'A data é muito tarde',
# H::F::Field::DateTime
'Not a valid DateTime' => 'Data e hora inválidos',
# H::F::Field::Duration
'Invalid value for [_1]: [_2]' => 'Valor inválido para [_1]: [_2]',
# H::F::Field::Email
'Email should be of the format [_1]' => 'Email deve estar no formato [_1]',
# H::F::Field::Integer
'Value must be an integer' => 'Valor deve ser um inteiro',
# H::F::Field::Money
'Value cannot be converted to money' => 'Valor não pode ser convertido a dinheiro',
'Value must be a real number' => 'Valor deve ser um número real',
# H::F::Field::Password
'Please enter a password in this field' => 'Por favor coloque uma senha neste campo',
'Password must not match [_1]' => 'Senha não pode coincidir com [_1]',
# H::F::Field::PasswordConf
'Please enter a password confirmation' => 'Por favor confirme a senha',
'The password confirmation does not match the password' => 'A confirmação da senha não coincide',
# H::F::Field::PosInteger
'Value must be a positive integer' => 'Valor deve ser um inteiro positivo',
# H::F::Field::Select
'This field does not take multiple values' => 'Este campo não recebe valores múltiplos',
'\'[_1]\' is not a valid value' => '\'[_1]\' é um valor inválido',
# H::F::Field::Text
'Field should not exceed [quant,_1,character]. You entered [_2]' => 'Campo não deve exceder [_1]. Você colocou: [_2]',
'Field must be at least [quant,_1,character]. You entered [_2]' => 'Campo deve ser ao menos [_1]. Você colocou: [_2]',
# H:: F:: Field:: Upload
'File uploaded is empty' => 'Arquivo enviado está vazio',
'File is too small (< [_1] bytes)' => 'Arquivo é muito pequeno (menor que [_1] bytes)',
'File is too big (> [_1] bytes)' => 'Arquivo é muito grande (maior que [_1] bytes)',
'File not found for upload field' => 'Arquivo não encontrado no campo de envio',
# H:: F:: Model
'Value must be unique in the database' => 'Valor deve ser único no banco de dados',
# Other
'Your datetime does not match your pattern.' => 'A sua data/hora náo coincide com o padrão.',
);
1;
=pod
=head1 NAME
HTML::FormHandler::I18N::pt_br - Brazilian Portuguese message file
=head1 VERSION
version 0.40050
=head1 NAME
HTML::FormHandler::I18N::pt_br - Brazilian Portuguese message file
=head1 VERSION
version 0.40017
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2012 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
__END__
HTML-FormHandler-0.40050/lib/HTML/FormHandler/I18N/ru_ru.pm 0000644 0000770 0000770 00000016205 12221042077 022024 0 ustar gshank gshank package HTML::FormHandler::I18N::ru_ru;
# ABSTRACT: Russian message file
use strict;
use warnings;
use utf8;
use base 'HTML::FormHandler::I18N';
# translator: Oleg Kostyuk
# notify before release: cub@cpan.org
# Auto define lexicon
our %Lexicon = (
'_AUTO' => 1,
# H::F::Field
'field is invalid' => 'Поле неверно',
'Wrong value' => 'Неверное значение',
'[_1] does not match' => 'не совпадает с [_1]',
'[_1] not allowed' => '[_1] не разрешено',
'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] является обязательным',
'error occurred' => 'произошла ошибка',
# 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 адрес не корректен',
'Must not 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' => 'Поле должно содержать одно слово',
'Must not be empty' => 'Должно быть не пустым',
'Must be between 8 and 255 chars, and contain a non-alpha char' => 'Должно быть от 8 до 255 символов, и содержать не-буквенный символ',
# H::F::Field::Date
'Date is too early' => 'Слишком ранняя дата',
'Date is too late' => 'Слишком поздняя дата',
# H::F::Field::DateTime
'Not a valid DateTime' => 'Неверная дата/время',
# H::F::Field::Duration
'Invalid value for [_1]: [_2]' => 'Неверное значение для [_1]: [_2]',
# 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' => 'Пожалуйста, введите пароль',
'Password must not match [_1]' => 'Пароль должен не совпадать с [_1]',
# H::F::Field::PasswordConf
'Please enter a password confirmation' => 'Пожалуйста, введите подтверждение пароля',
'The password confirmation does not match the password' => 'Подтверждение пароля не совпадает с паролем',
# H::F::Field::PosInteger
'Value must be a positive integer' => 'Значение должно быть положительным целым числом',
# H::F::Field::Select
'This field does not take multiple values' => 'Это поле не принимает несколько значений',
'\'[_1]\' is not a valid value' => '\'[_1]\' не корректное значение',
# H::F::Field::Text
'Field should not exceed [quant,_1,character]. You entered [_2]' => 'Символов должно быть не более [_1]. Вы ввели: [_2]',
'Field must be at least [quant,_1,character]. You entered [_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] байт)',
'File not found for upload field' => 'Файл для загрузки не найден',
# H::F::Model
'Value must be unique in the database' => 'Значение должно быть уникальным для базы данных',
# Other
'Your datetime does not match your pattern.' => 'Введённые дата/время не совпадают с вашим шаблоном.',
);
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::I18N::ru_ru - Russian message file
=head1 VERSION
version 0.40050
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/I18N/sv_se.pm 0000644 0000770 0000770 00000011374 12221042077 022011 0 ustar gshank gshank package HTML::FormHandler::I18N::sv_se;
# ABSTRACT: Swedish message translations
use strict;
use warnings;
use base 'HTML::FormHandler::I18N';
use utf8;
# Auto define lexicon
our %Lexicon = (
'_AUTO' => 1,
# H::F::Field
'field is invalid' => 'Fältet är ogiltigt.',
'Wrong value' => 'Ogiltigt värde.',
'[_1] does not match' => '[_1] matchar inte.',
'[_1] not allowed' => '[_1] är inte tillåtet.',
'[_1] field is required' => 'Fältet får inte vara tomt.',
'error occurred' => 'Ett fel har uppstått.',
'Value must be between [_1] and [_2]' => 'Värdet ska ligga mellan [_1] och [_2].',
'Value must be greater than or equal to [_1]' => 'Värdet ska vara minst [_1].',
'Value must be less than or equal to [_1]' => 'Värdet får vara högst [_1].',
# H::F::Types
'Must be a positive number' => 'Ska vara ett positivt tal.',
'Must be a positive integer' => 'Ska vara ett positivt heltal.',
'Must be a negative number' => 'Ska vara ett negativt tal.',
'Must be a negative integer' => 'Ska vara ett negativt heltal.',
'Must be a single digit' => 'Ska vara ett ensiffrigt tal.',
'Must be a non-empty single line of no more than 255 chars' => 'Ska vara en enda rad med minst ett och högst 255 tecken.',
'Must be made up of letters, digits, and underscores' => 'Får bara innehålla bokstäver, siffror och understreck.',
'Not a valid IP address' => 'Ogiltig IP-adress.',
'Must not be all digits' => 'Får inte vara enbart siffror.',
'Not a valid state' => 'Ogiltig delstat.',
'Field contains non-printable characters' => 'Fältet innehåller tecken som inte går att skriva ut.',
'Must be between 4 and 255 chars' => 'Ska vara mellan 4 och 255 tecken.',
'Zip is not valid' => 'Ogiltigt postnummer.',
'Must be a single line of no more than 255 chars' => 'Ska vara en enda rad med högst 255 tecken.',
'Email is not valid' => 'Ogiltig e-postadress.',
'Must not contain spaces' => 'Får inte innehålla mellanslag.',
'Field must contain a single word' => 'Ska vara ett enda ord.',
'Must not be empty' => 'Ska inte vara tom.',
'Must be between 8 and 255 chars, and contain a non-alpha char' => 'Ska vara mellan 8 och 255 tecken, och innehålla ett tecken som inte är en bokstav.',
# H::F::Field::Date
'Date is too early' => 'Datumet är för tidigt.',
'Date is too late' => 'Datumet är för sent.',
# H::F::Field::DateTime
'Not a valid DateTime' => 'Ogiltig datum- eller tidsangivelse.',
# H::F::Field::Duration
'Invalid value for [_1]: [_2]' => 'Ogiltigt värde för [_1]: [_2].',
# H::F::Field::Email
'Email should be of the format [_1]' => 'E-postadressen måste ha formatet [_1].',
# H::F::Field::Integer
'Value must be an integer' => 'Ska vara ett heltal.',
# H::F::Field::Money
'Value cannot be converted to money' => 'Kan inte läsas som en summa pengar.',
'Value must be a real number' => 'Ska vara ett decimaltal.',
# H::F::Field::Password
'Please enter a password in this field' => 'Skriv ett lösenord i detta fält.',
'Password must not match [_1]' => 'Lösenordet stämmer inte med [_1].',
# H::F::Field::PasswordConf
'Please enter a password confirmation' => 'Skriv lösenordet en gång till.',
'The password confirmation does not match the password' => 'Lösenorden stämmer inte överens.',
# H::F::Field::PosInteger
'Value must be a positive integer' => 'Ska vara ett positivt heltal.',
# H::F::Field::Select
'This field does not take multiple values' => 'Välj inte mer än ett värde här.',
'\'[_1]\' is not a valid value' => '\'[_1]\' är inte ett giltigt värde.',
# H::F::Field::Text
'Field should not exceed [quant,_1,character]. You entered [_2]' => 'Ska inte vara längre än [_1] tecken. Du har skrivit [_2].',
'Field must be at least [quant,_1,character]. You entered [_2]' => 'Ska vara minst [_1] tecken. Du har skrivit [_2].',
# H::F::Field::Upload
'File uploaded is empty' => 'Fick ingen fil.',
'File is too small (< [_1] bytes)' => 'Filen är för liten. (Mindre än [_1] bytes).',
'File is too big (> [_1] bytes)' => 'Filen är för stor (Större än [_1] bytes).',
'File not found for upload field' => 'Filen hittades inte.',
# H::F::Model
'Value must be unique in the database' => 'Värdet finns redan registrerat.',
);
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::I18N::sv_se - Swedish message translations
=head1 VERSION
version 0.40050
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/I18N/tr_tr.pm 0000644 0000770 0000770 00000015751 12221042077 022027 0 ustar gshank gshank package HTML::FormHandler::I18N::tr_tr;
# ABSTRACT: Turkish message file
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
'field is invalid' => 'Geçersiz değer',
'Wrong value' => 'Hatalı değer',
'[_1] does not match' => '[_1] formatı uymuyor',
'[_1] not allowed' => '[_1] izinli değil',
'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ı',
'[_1] field is required' => '[_1] alanı boş bırakılamaz',
'error occurred' => 'Hata oluştu',
# 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',
'Must not 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ı',
'Must not be empty' => 'Boş olmamalı',
'Must be between 8 and 255 chars, and contain a non-alpha char' => 'Harf olmayan karakter içermeli ve 8-255 karakter arasında olmalı',
# 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::Duration
'Invalid value for [_1]: [_2]' => '[_1] için geçersiz değer: [_2]',
# H::F::Field::Email
'Email should be of the format [_1]' => 'E-Posta [_1] formatında olmalı',
# H::F::Field::FloatNumber
'Must be a number. May contain numbers, +, - and decimal separator \'[_1]\'', => 'Bir sayı olmalı. Rakamlar, +, -, ve ondalık ayırıcı \'[_1]\' içerebilir',
'Total size of number must be less than or equal to [_1], but is [_2]', => 'Maksimum [_1] rakam içerebilir ama [_2] rakam içeriyor',
'May have a maximum of [quant,_1,digit] after the decimal point, but has [_2]', => 'Ayraçtan sonra maksimum [_1] rakam içerebilir ama [_2] rakam içeriyor',
# 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',
'Password must not match [_1]' => 'Şifre [_1] ile aynı olmamalı',
# H::F::Field::PasswordConf
'Please enter a password confirmation' => 'Lütfen şifre onayı girin',
'The password confirmation does not match the password' => 'Şifre onayı ile şifre aynı değil',
# 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',
'\'[_1]\' is not a valid value' => '\'[_1]\' geçerli bir değer değil',
# H::F::Field::Text
'Field should not exceed [quant,_1,character]. You entered [_2]' => 'Girilen verinin uzunluğu en fazla [_1] olabilir. Gönderilen: [_2]',
'Field must be at least [quant,_1,character]. You entered [_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)',
'File not found for upload field' => 'Dosya bulunamadı',
# H::F::Model
'Value must be unique in the database' => 'Daha önceden kullanımda',
# Other
'Your datetime does not match your pattern.' => 'Tarih formatı hatalı.',
);
1;
=pod
=head1 NAME
HTML::FormHandler::I18N::tr_tr - Turkish message file
=head1 VERSION
version 0.40050
=head1 NAME
HTML::FormHandler::I18N::tr_tr - Turkish message file
=head1 VERSION
version 0.35005
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
__END__
HTML-FormHandler-0.40050/lib/HTML/FormHandler/I18N/ua_ua.pm 0000644 0000770 0000770 00000015711 12221042077 021763 0 ustar gshank gshank package HTML::FormHandler::I18N::ua_ua;
# ABSTRACT: Ukrainian message file
use strict;
use warnings;
use utf8;
use base 'HTML::FormHandler::I18N';
# translator: Oleg Kostyuk
# notify before release: cub@cpan.org
# Auto define lexicon
our %Lexicon = (
'_AUTO' => 1,
# H:: F:: Field
'field is invalid' => 'Поле невірне',
'Wrong value' => 'Неправильне значення',
'[_1] does not match' => 'не співпадає з [_1]',
'[_1] not allowed' => '[_1] не дозволяється',
'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}язковим',
'error occurred' => 'трапилась помилка',
# 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 адреса не коректна',
'Must not 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' => 'Поле має містити одне слово',
'Must not be empty' => 'Має бути не пустим',
'Must be between 8 and 255 chars, and contain a non-alpha char' => 'Має бути від 8 до 255 символів, та мати не-буквений символ',
# H::F::Field::Date
'Date is too early' => 'Дата занадто рання',
'Date is too late' => 'Дата занадто піздня',
# H::F::Field::DateTime
'Not a valid DateTime' => 'Невірна дата/час',
# H::F::Field::Duration
'Invalid value for [_1]: [_2]' => 'Невірне значення для [_1]: [_2]',
# 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' => 'Будь ласка, введіть пароль',
'Password must not match [_1]' => 'Пароль має не співпадати з [_1]',
# H::F::Field::PasswordConf
'Please enter a password confirmation' => 'Будь ласка, введіть підтвердження паролю',
'The password confirmation does not match the password' => 'Підтверження паролю не співпадає з паролем',
# H::F::Field::PosInteger
'Value must be a positive integer' => 'Значення має бути позитивним цілим числом',
# H::F::Field::Select
'This field does not take multiple values' => 'Це поле не приймає кілька значень',
'\'[_1]\' is not a valid value' => '\'[_1]\' не є вірним значенням',
# H::F::Field::Text
'Field should not exceed [quant,_1,character]. You entered [_2]' => 'Символів має бути не більше [_1]. Ви ввели: [_2]',
'Field must be at least [quant,_1,character]. You entered [_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] байт)',
'File not found for upload field' => 'Файл для загрузки не знайдено',
# H:: F:: Model
'Value must be unique in the database' => 'Значення має бути унікальним для бази даних',
# Other
'Your datetime does not match your pattern.' => 'Введені дата/час не співпадають з вашим шаблоном.',
);
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::I18N::ua_ua - Ukrainian message file
=head1 VERSION
version 0.40050
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/I18N.pm 0000644 0000770 0000770 00000001645 12221042077 020672 0 ustar gshank gshank package HTML::FormHandler::I18N;
# ABSTRACT: internationalization
use strict;
use warnings;
use base ('Locale::Maketext');
use Try::Tiny;
sub maketext {
my ( $lh, @message ) = @_;
return '' unless scalar @message;
return '' unless defined $message[0];
my $out;
try {
$out = $lh->SUPER::maketext(@message);
}
catch {
die "Unable to do maketext on: " . $message[0] .
"\nIf the message contains brackets you may need to escape them with a tilde.";
};
return $out;
}
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::I18N - internationalization
=head1 VERSION
version 0.40050
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/InitResult.pm 0000644 0000770 0000770 00000015423 12221042077 022314 0 ustar gshank gshank package HTML::FormHandler::InitResult;
# ABSTRACT: internal code
use Moose::Role;
# _init is for building fields when
# there is no initial object and no params
# formerly _init
sub _result_from_fields {
my ( $self, $self_result ) = @_;
# defaults for compounds, etc.
if ( my @values = $self->get_default_value ) {
my $value = @values > 1 ? \@values : shift @values;
if( ref $value eq 'HASH' || blessed $value ) {
return $self->_result_from_object( $self_result, $value );
}
$self->init_value($value) if defined $value;
$self_result->_set_value($value) if defined $value;
}
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
);
$result = $field->_result_from_fields($result);
$my_value->{ $field->name } = $result->value if $result->has_value;
$self_result->add_result($result) if $result;
}
# setting value here to handle disabled compound fields, where we want to
# preserve the 'value' because the fields aren't submitted...except for the
# form. Not sure it's the best idea to skip for form, but it maintains previous behavior
$self_result->_set_value($my_value) if ( keys %$my_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;
my $init_obj = $self->form->init_object;
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) ) ) {
my $found = 0;
if ($field->form->use_init_obj_when_no_accessor_in_item) {
# if we're using an item, look for accessor not found in item
# in the init_object
my @names = split( /\./, $field->full_name );
my $init_obj_value = $self->find_sub_item( $init_obj, \@names );
if ( defined $init_obj_value ) {
$found = 1;
$result = $field->_result_from_object( $result, $init_obj_value );
}
}
$result = $field->_result_from_fields($result) unless $found;
}
else {
my $value = $self->_get_value( $field, $item ) unless $field->writeonly;
$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;
}
# this is used for reloading repeatables form the database if they've changed and
# for finding field values in the init_object when we have an item and the
# 'use_init_obj_when_no_accessor_in_item' flag is set
sub find_sub_item {
my ( $self, $item, $field_name_array ) = @_;
my $this_fname = shift @$field_name_array;;
my $field = $self->field($this_fname);
my $new_item = $self->_get_value( $field, $item );
if ( scalar @$field_name_array ) {
$new_item = $field->find_sub_item( $new_item, $field_name_array );
}
return $new_item;
}
sub _get_value {
my ( $self, $field, $item ) = @_;
my $accessor = $field->accessor;
my @values;
if( defined $field->default_over_obj ) {
@values = $field->default_over_obj;
}
elsif( $field->form && $field->form->use_defaults_over_obj && ( @values = $field->get_default_value ) ) {
}
elsif ( blessed($item) && $item->can($accessor) ) {
# this must be an array, so that DBIx::Class relations are arrays not resultsets
@values = $item->$accessor;
# for non-DBIC blessed object where access returns arrayref
if ( scalar @values == 1 && ref $values[0] eq 'ARRAY' && $field->has_flag('multiple') ) {
@values = @{$values[0]};
}
}
elsif ( exists $item->{$accessor} ) {
my $v = $item->{$accessor};
if($field->has_flag('multiple') && ref($v) eq 'ARRAY'){
@values = @$v;
} else {
@values = $v;
}
}
elsif ( @values = $field->get_default_value ) {
}
else {
return;
}
if( $field->has_inflate_default_method ) {
@values = $field->inflate_default(@values);
}
my $value;
if( $field->has_flag('multiple')) {
$value = scalar @values == 1 && ! defined $values[0] ? [] : \@values;
}
else {
$value = @values > 1 ? \@values : shift @values;
}
return $value;
}
use namespace::autoclean;
1;
__END__
=pod
=head1 NAME
HTML::FormHandler::InitResult - internal code
=head1 VERSION
version 0.40050
=head1 SYNOPSIS
Internal role for initializing the result objects.
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Manual/ 0000755 0000770 0000770 00000000000 12221042077 021064 5 ustar gshank gshank HTML-FormHandler-0.40050/lib/HTML/FormHandler/Manual/Catalyst.pod 0000644 0000770 0000770 00000014354 12221042077 023363 0 ustar gshank gshank package HTML::FormHandler::Manual::Catalyst;
# ABSTRACT: using HFH forms in Catalyst
__END__
=pod
=head1 NAME
HTML::FormHandler::Manual::Catalyst - using HFH forms in Catalyst
=head1 VERSION
version 0.40050
=head1 SYNOPSIS
L
This part of the FormHandler Manual describes the use of the L
package in Catalyst controllers.
See the other FormHandler documentation at L, or
the base class at L.
=head1 DESCRIPTION
Although L can be used in any Perl web application, module, or
script, one of its most common uses is in L applications.
Using a form takes only a few lines of code, so it's not necessary to have
a L 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' }
use BookDB::Form::Borrower;
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,
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( item_id => $id );
=head2 Putting a form in a Moose attribute
You can also put your form in a Moose attribute in the controller.
package MyApp::Controller::Book;
use Moose;
BEGIN { extends 'Catalyst::Controller'; }
use MyApp::Form::Book;
has 'edit_form' => ( isa => 'MyApp::Form::Book', is => 'rw',
lazy => 1, default => sub { MyApp::Form::Book->new } );
Then you can process the form in your actions with
C<< $self->edit_form->process( params => $c->req->body_parameters ); >> or
C<< my $result = $self->edit_form->run( params => $c->req->body_parameters ); >>.
=head2 Using HTML::FillInForm
If you want to use L to fill in values instead of
doing it in directly in a template using either the field or the form 'fif'
methods, you can use L 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 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" );
}
}
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
HTML-FormHandler-0.40050/lib/HTML/FormHandler/Manual/Cookbook.pod 0000644 0000770 0000770 00000065631 12221042077 023351 0 ustar gshank gshank package HTML::FormHandler::Manual::Cookbook;
# ABSTRACT: FormHandler use recipes
__END__
=pod
=head1 NAME
HTML::FormHandler::Manual::Cookbook - FormHandler use recipes
=head1 VERSION
version 0.40050
=head1 SYNOPSIS
L
Collection of use recipes for L
=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 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;
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;
Set to 'active' or 'inactive' on the 'process' call:
$form->process( params => $params, active => ['foo', 'bar'] );
...
$form->process( params => $params, inactive => ['bar'] );
If you need to check some other state to determine whether or not a field should
be active, you can do that using a Moose method modifier on 'set_active':
before 'set_active' => sub {
my $self = shift;
$self->active(['foo', bar']) if ( );
};
Fields set to active/inactive on the 'process' call are 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 in your form.
Use 'traits' on the individual fields to apply a role to field instances.
Use the form attribute 'field_traits' to apply a role to all field instances in
the form.
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 => [...] } ]);
To apply the role to a field base class, use 'apply_traits' on that class:
HTML::FormHandler::Field->apply_traits( 'Some::Test' );
HTML::FormHandler::Field::Text->apply_traits( 'Another::Trait' );
=head2 Select lists
If you want to set the default value of a select field to 0, you can just
use 'default' on the field:
has_field 'license' => ( default => 0 );
If there is logic involved, you can use a 'default_' method:
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, you can set 'empty_select' in your field if you
are using FormHandler rendering:
has_field 'subject_class' => ( type => 'Select',
empty_select => '--- Choose Subject Class ---' );
Or you can do in a template:
[% f = form.field('subject_class') %]
You can create a custom 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.
package MyApp::Form::Base;
use Moose;
extends 'HTML::FormHandler::Model::DBIC';
has 'title' => ( isa => 'Str', is => 'rw' );
has 'nav_bar' => ( isa => 'Str', is => 'rw' );
has_block 'reg_header' => ( tag => 'fieldset', label => 'Registration form',
content => 'We take your membership seriously...' );
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: