├── weaver.ini ├── .gitignore ├── MANIFEST.SKIP ├── xt └── author │ ├── critic.t │ └── kwalitee.t ├── .perltidyrc ├── t ├── 02-simple.t ├── 00-load.t ├── 25-noload.t ├── 11-reset.t ├── 16-file.t ├── 21-image.t ├── 23-password.t ├── 17-text.t ├── 18-textarea.t ├── 15-submit.t ├── 20-hidden.t ├── 29-partial-fill.t ├── lib │ └── TestApp │ │ └── Form │ │ └── Field │ │ ├── Custom.pm │ │ ├── Email.pm │ │ └── Password.pm ├── 24-radio.t ├── 12-checkbox.t ├── 19-button.t ├── 22-multiselect.t ├── 13-select.t ├── 08-notempty.t ├── 05-confirm.t ├── 09-regex.t ├── 06-maxlength.t ├── 07-minlength.t ├── 30-radiogroup.t ├── 10-combinatorics.t ├── 04-form-custom-lazy.t ├── 14-list.t ├── 26-clone.t ├── 28-compose.t ├── 03-form-register.t └── 27-partial_clone.t ├── lib ├── Spark │ ├── Couplet.pm │ ├── Form │ │ ├── Source.pm │ │ ├── Printer.pm │ │ ├── Field │ │ │ └── Role │ │ │ │ ├── Validateable.pm │ │ │ │ ├── Printable │ │ │ │ ├── HTML.pm │ │ │ │ └── XHTML.pm │ │ │ │ └── Printable.pm │ │ ├── Printer │ │ │ ├── HTML.pm │ │ │ └── XHTML.pm │ │ ├── Types.pm │ │ ├── FAQ.pm │ │ └── Field.pm │ ├── Types.pm │ └── Form.pm └── SparkX │ └── Form │ ├── BasicValidators.pm │ ├── BasicPrinters.pm │ ├── BasicFields.pm │ ├── Field │ ├── Validator │ │ ├── NotEmpty.pm │ │ ├── Regex.pm │ │ ├── MinLength.pm │ │ ├── MaxLength.pm │ │ └── Confirm.pm │ ├── File.pm │ ├── Reset.pm │ ├── Password.pm │ ├── Hidden.pm │ ├── Submit.pm │ ├── Text.pm │ ├── Textarea.pm │ ├── Checkbox.pm │ ├── Button.pm │ ├── Image.pm │ ├── Radio.pm │ ├── MultiSelect.pm │ ├── Select.pm │ └── RadioGroup.pm │ └── Printer │ └── List.pm ├── Changes ├── TODO ├── perlcriticrc └── dist.ini /weaver.ini: -------------------------------------------------------------------------------- 1 | [@Default] -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | blib 3 | _build 4 | .build 5 | *.gz 6 | META.yml 7 | Build 8 | Makefile.PL 9 | *.bak -------------------------------------------------------------------------------- /MANIFEST.SKIP: -------------------------------------------------------------------------------- 1 | ^_build 2 | ^Build$ 3 | ^blib 4 | ~$ 5 | \.bak$ 6 | ^MANIFEST\.SKIP$ 7 | ^.git 8 | .gz$ 9 | -------------------------------------------------------------------------------- /xt/author/critic.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::Perl::Critic( -profile => 'perlcriticrc' ); 5 | all_critic_ok(); 6 | -------------------------------------------------------------------------------- /.perltidyrc: -------------------------------------------------------------------------------- 1 | -i 4 2 | -l 130 3 | -pt 2 4 | -sbt 2 5 | -bt 2 6 | -bbt 0 7 | -nolc 8 | -nolq 9 | -noll 10 | -nola 11 | -fnl 12 | -ce 13 | -scp 14 | -kis 15 | #-nwrs , 16 | 17 | 18 | -------------------------------------------------------------------------------- /t/02-simple.t: -------------------------------------------------------------------------------- 1 | use Test::More tests => 1; 2 | 3 | use Spark::Form; 4 | 5 | #Create a form 6 | my $form = Spark::Form->new; 7 | 8 | isa_ok($form->field_couplet,'Data::Couplet','Correct type for field_couplet accessor'); -------------------------------------------------------------------------------- /t/00-load.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | 3 | use Test::More; 4 | use Test::UseAllModules; 5 | use Test::NoWarnings; 6 | 7 | plan tests => Test::UseAllModules::_get_module_list() + 1; 8 | 9 | diag("Testing Spark::Form $Spark::Form::VERSION, Perl $], $^X"); 10 | 11 | all_uses_ok(); 12 | 13 | -------------------------------------------------------------------------------- /lib/Spark/Couplet.pm: -------------------------------------------------------------------------------- 1 | package Spark::Couplet; 2 | 3 | use Data::Couplet::Extension -with => [qw(KeyCount BasicReorder)]; 4 | __PACKAGE__->meta->make_immutable; 5 | 1; 6 | __END__ 7 | 8 | =head1 NAME 9 | 10 | Spark::Couplet - A Spark-specific subclass of Data::Couplet 11 | 12 | =cut 13 | -------------------------------------------------------------------------------- /lib/Spark/Form/Source.pm: -------------------------------------------------------------------------------- 1 | package Spark::Form::Source; 2 | 3 | # ABSTRACT: Base class for population plugins 4 | 5 | use Moose::Role; 6 | 7 | requires 'populate'; 8 | 9 | 1; 10 | __END__ 11 | 12 | =head1 SEE ALSO 13 | 14 | L - What you were probably after 15 | 16 | =cut 17 | -------------------------------------------------------------------------------- /t/25-noload.t: -------------------------------------------------------------------------------- 1 | use Test::More tests => 1; 2 | use Spark::Form; 3 | 4 | #Local lib 5 | use lib 't/lib'; 6 | 7 | #Create a form, mixing in the printer. This ensures it correctly loads the module. 8 | eval { 9 | my $form = Spark::Form->new( printer => 'SparkX::Form::Printer::List' ); 10 | }; 11 | is($@,'',"$@ is empty"); -------------------------------------------------------------------------------- /xt/author/kwalitee.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | 6 | BEGIN { 7 | eval { require Test::Kwalitee; 1 } 8 | or plan skip_all => "You need Test::Kwalitee installed to run this test. Its only an authortest though, so thats ok"; 9 | } 10 | use Test::Kwalitee tests => [qw( -use_strict )]; 11 | -------------------------------------------------------------------------------- /t/11-reset.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | 3 | use Test::More tests => 1; 4 | use lib 't/lib'; 5 | use Spark::Form; 6 | use SparkX::Form::Field::Reset; 7 | 8 | my $form = Spark::Form->new; 9 | my $b = SparkX::Form::Field::Reset->new(name => 'test', form => $form); 10 | 11 | is($b->to_xhtml,'','Test xhtml representation'); 12 | -------------------------------------------------------------------------------- /t/16-file.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | 3 | use Test::More tests => 1; 4 | use lib 't/lib'; 5 | use Spark::Form; 6 | use SparkX::Form::Field::File; 7 | 8 | my $form = Spark::Form->new; 9 | my $b = SparkX::Form::Field::File->new(name => 'test', form => $form); 10 | 11 | is($b->to_xhtml,'','Test xhtml representation'); 12 | -------------------------------------------------------------------------------- /t/21-image.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | 3 | use Test::More tests => 1; 4 | use lib 't/lib'; 5 | use Spark::Form; 6 | use SparkX::Form::Field::Image; 7 | 8 | my $form = Spark::Form->new; 9 | my $b = SparkX::Form::Field::Image->new(name => 'test', form => $form); 10 | 11 | is($b->to_xhtml,'','Test xhtml representation'); 12 | -------------------------------------------------------------------------------- /lib/Spark/Form/Printer.pm: -------------------------------------------------------------------------------- 1 | package Spark::Form::Printer; 2 | 3 | # ABSTRACT: interface for form printers for C 4 | use Moose::Role; 5 | 6 | 1; 7 | __END__ 8 | 9 | =head1 SEE ALSO 10 | 11 | L - the forms module that started it all 12 | L - set of pre-canned printers for your forms 13 | 14 | =cut 15 | -------------------------------------------------------------------------------- /t/23-password.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | 3 | use Test::More tests => 1; 4 | use lib 't/lib'; 5 | use Spark::Form; 6 | use SparkX::Form::Field::Password; 7 | 8 | my $form = Spark::Form->new; 9 | my $b = SparkX::Form::Field::Password->new(name => 'test', form => $form); 10 | 11 | is($b->to_xhtml,'','Test xhtml representation'); 12 | -------------------------------------------------------------------------------- /lib/SparkX/Form/BasicValidators.pm: -------------------------------------------------------------------------------- 1 | package SparkX::Form::BasicValidators; 2 | 3 | # ABSTRACT: A selection of validators to make writing custom fields easier. 4 | 5 | use warnings; 6 | use strict; 7 | 8 | 1; 9 | __END__ 10 | 11 | =head1 SEE ALSO 12 | 13 | L - The forms module that started it all 14 | L - Walk-through 15 | 16 | =cut 17 | -------------------------------------------------------------------------------- /t/17-text.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | 3 | use Test::More tests => 1; 4 | use lib 't/lib'; 5 | use Spark::Form; 6 | use SparkX::Form::Field::Text; 7 | 8 | my $form = Spark::Form->new; 9 | my $b = SparkX::Form::Field::Text->new(name => 'test', value => 'test', form => $form); 10 | 11 | is($b->to_xhtml,'','Test xhtml representation'); 12 | -------------------------------------------------------------------------------- /t/18-textarea.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | 3 | use Test::More tests => 1; 4 | use lib 't/lib'; 5 | use Spark::Form; 6 | use SparkX::Form::Field::Textarea; 7 | 8 | my $form = Spark::Form->new; 9 | my $b = SparkX::Form::Field::Textarea->new(name => 'test', form => $form, value=>'test'); 10 | 11 | is($b->to_xhtml,'','Test xhtml representation'); 12 | -------------------------------------------------------------------------------- /t/15-submit.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | 3 | use Test::More tests => 1; 4 | use lib 't/lib'; 5 | use Spark::Form; 6 | use SparkX::Form::Field::Submit; 7 | 8 | my $form = Spark::Form->new; 9 | my $b = SparkX::Form::Field::Submit->new(name => 'test', value => 'test', form => $form); 10 | 11 | is($b->to_xhtml,'','Test xhtml representation'); 12 | -------------------------------------------------------------------------------- /t/20-hidden.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | 3 | use Test::More tests => 1; 4 | use lib 't/lib'; 5 | use Spark::Form; 6 | use SparkX::Form::Field::Hidden; 7 | 8 | my $form = Spark::Form->new; 9 | my $b = SparkX::Form::Field::Hidden->new(name => 'test', value => 'test', form => $form); 10 | 11 | is($b->to_xhtml,'','Test xhtml representation'); 12 | -------------------------------------------------------------------------------- /lib/Spark/Form/Field/Role/Validateable.pm: -------------------------------------------------------------------------------- 1 | package Spark::Form::Field::Role::Validateable; 2 | 3 | # ABSTRACT: Fields that can be validated 4 | 5 | use Moose::Role; 6 | use Carp (); 7 | 8 | Carp::cluck('Spark::Form::Field::Role::Validateable is a no-op. Please remove it from your code'); 9 | 10 | 1; 11 | __END__ 12 | 13 | =head1 SYNOPSIS 14 | 15 | To be phased out. Deprecated. Gone. 16 | 17 | =cut 18 | -------------------------------------------------------------------------------- /lib/SparkX/Form/BasicPrinters.pm: -------------------------------------------------------------------------------- 1 | package SparkX::Form::BasicPrinters; 2 | 3 | # ABSTRACT: A selection of basic form printers for printing a C. 4 | 5 | 1; 6 | __END__ 7 | 8 | =head1 SEE ALSO 9 | 10 | L - The forms module that started it all 11 | L - The interface that printers must fulfil 12 | L - A printer that prints a HTML list 13 | 14 | =cut 15 | -------------------------------------------------------------------------------- /lib/Spark/Form/Printer/HTML.pm: -------------------------------------------------------------------------------- 1 | package Spark::Form::Printer::HTML; 2 | 3 | # ABSTRACT: the interface a HTML-printing form printer needs to implement 4 | use Moose::Role; 5 | with 'Spark::Form::Printer'; 6 | 7 | requires 'to_html'; 8 | 9 | 1; 10 | __END__ 11 | 12 | =head1 SEE ALSO 13 | 14 | L - The forms module that started it all 15 | L - Set of pre-canned form printers 16 | 17 | =cut 18 | -------------------------------------------------------------------------------- /lib/Spark/Form/Printer/XHTML.pm: -------------------------------------------------------------------------------- 1 | package Spark::Form::Printer::XHTML; 2 | 3 | # ABSTRACT: the interface an XHTML-printing form printer needs to implement 4 | 5 | use Moose::Role; 6 | with 'Spark::Form::Printer'; 7 | 8 | requires 'to_xhtml'; 9 | 10 | 1; 11 | __END__ 12 | 13 | =head1 SEE ALSO 14 | 15 | L - The forms module that started it all 16 | L - Set of pre-canned form printers 17 | 18 | =cut 19 | -------------------------------------------------------------------------------- /lib/Spark/Form/Types.pm: -------------------------------------------------------------------------------- 1 | package Spark::Types; 2 | 3 | use MooseX::Types 4 | -declare => [ qw( 5 | SCouplet 6 | SForm 7 | SField 8 | SFieldValidator 9 | )]; 10 | 11 | class_type SCouplet, { class => 'Spark::Couplet' }; 12 | class_type SForm, { class => 'Spark::Form' }; 13 | class_type SField, { class => 'Spark::Form::Field' }; 14 | class_type SFieldValidator, { class => 'Spark::Form::Field::Validator' }; 15 | 16 | 1; 17 | __END__ 18 | -------------------------------------------------------------------------------- /t/29-partial-fill.t: -------------------------------------------------------------------------------- 1 | use Test::More tests => 1; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use lib 't/lib'; 7 | use Spark::Form; 8 | use SparkX::Form::Field::Checkbox; 9 | 10 | my $form = Spark::Form->new; 11 | my $c = SparkX::Form::Field::Checkbox->new(name => 'test1', form => $form); 12 | my $c2 = SparkX::Form::Field::Checkbox->new(name => 'test2', form => $form, value => 1); 13 | 14 | $form->data({test => 'yes'}); 15 | $form->validate; 16 | ok($form->valid,"Form is valid"); -------------------------------------------------------------------------------- /t/lib/TestApp/Form/Field/Custom.pm: -------------------------------------------------------------------------------- 1 | package TestApp::Form::Field::Custom; 2 | 3 | use Moose; 4 | extends 'Spark::Form::Field'; 5 | 6 | has 'min_length' => ( 7 | isa => 'Int', 8 | is => 'rw', 9 | required => 0, 10 | default => 6, 11 | ); 12 | 13 | sub _validate { 14 | my ($self) = @_; 15 | if ($self->min_length > length $self->value) { 16 | $self->error('Customs must be at least ' . $self->min_length . ' characters long.'); 17 | } 18 | } 19 | 20 | 1; 21 | -------------------------------------------------------------------------------- /t/24-radio.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | 3 | use Test::More tests => 1; 4 | use lib 't/lib'; 5 | use Spark::Form; 6 | use SparkX::Form::Field::Radio; 7 | 8 | my $form = Spark::Form->new; 9 | my $b = SparkX::Form::Field::Radio->new( 10 | name => 'test', form => $form, 11 | value => 'test-2', options => ['test-1','test-2','test-3'], 12 | ); 13 | 14 | is($b->to_xhtml,' ','Test xhtml representation'); 15 | -------------------------------------------------------------------------------- /t/12-checkbox.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | 3 | use Test::More tests => 2; 4 | use lib 't/lib'; 5 | use Spark::Form; 6 | use SparkX::Form::Field::Checkbox; 7 | 8 | my $form = Spark::Form->new; 9 | my $c = SparkX::Form::Field::Checkbox->new(name => 'test', form => $form); 10 | my $c2 = SparkX::Form::Field::Checkbox->new(name => 'test', form => $form, value => 1); 11 | is($c->to_xhtml,'','Test xhtml representation'); 12 | is($c2->to_xhtml,'','Test xhtml representation'); 13 | -------------------------------------------------------------------------------- /t/19-button.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | 3 | use Test::More tests => 2; 4 | use lib 't/lib'; 5 | use Spark::Form; 6 | use SparkX::Form::Field::Button; 7 | 8 | my $form = Spark::Form->new; 9 | my $b = SparkX::Form::Field::Button->new(name => 'test', form => $form); 10 | my $b2 = SparkX::Form::Field::Button->new( 11 | name => 'test', form => $form, 12 | content=>'' 13 | ); 14 | is($b->to_xhtml,'','Test xhtml representation'); 15 | is($b2->to_xhtml,'','Test xhtml representation'); 16 | -------------------------------------------------------------------------------- /t/22-multiselect.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | 3 | use Test::More tests => 1; 4 | use lib 't/lib'; 5 | use Spark::Form; 6 | use SparkX::Form::Field::MultiSelect; 7 | 8 | my $form = Spark::Form->new; 9 | my $b = SparkX::Form::Field::MultiSelect->new( 10 | name => 'test', form => $form, 11 | value => ['1','3'], 12 | options => ['1','2','3','4'], 13 | ); 14 | 15 | is($b->to_xhtml,'','Test xhtml representation'); 16 | -------------------------------------------------------------------------------- /t/13-select.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | 3 | use Test::More tests => 1; 4 | use lib 't/lib'; 5 | use Spark::Form; 6 | use SparkX::Form::Field::Select; 7 | 8 | my $form = Spark::Form->new; 9 | my $b = SparkX::Form::Field::Select->new( 10 | name => 'test', form => $form, 11 | options => [ 12 | 'Option 1' => 'o1', 13 | 'Option 2' => 'o2', 14 | 'Option 3' => 'o3', 15 | ], 16 | value => 'test-2', 17 | ); 18 | 19 | is($b->to_xhtml,'','Test xhtml representation'); 20 | -------------------------------------------------------------------------------- /lib/Spark/Types.pm: -------------------------------------------------------------------------------- 1 | package Spark::Types; 2 | 3 | use MooseX::Types 4 | -declare => [ qw( 5 | SCouplet 6 | SForm 7 | SField 8 | SFieldValidator 9 | )]; 10 | 11 | use MooseX::Types::Moose qw(ArrayRef); 12 | 13 | use Spark::Couplet; 14 | 15 | class_type SCouplet, { class => 'Spark::Couplet' }; 16 | coerce SCouplet, 17 | from ArrayRef, 18 | via { Spark::Couplet->new(@$_) }; 19 | 20 | class_type SForm, { class => 'Spark::Form' }; 21 | class_type SField, { class => 'Spark::Form::Field' }; 22 | class_type SFieldValidator, { class => 'Spark::Form::Field::Validator' }; 23 | 24 | 1; 25 | __END__ 26 | -------------------------------------------------------------------------------- /t/08-notempty.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | 3 | use Spark::Form; 4 | use Test::More tests => 3; 5 | use lib 't/lib'; 6 | 7 | use Spark::Form::Field; 8 | use SparkX::Form::Field::Validator::NotEmpty; 9 | 10 | my $f = Spark::Form->new(); 11 | 12 | my $test = Spark::Form::Field->new(form => $f, name => 'test'); 13 | SparkX::Form::Field::Validator::NotEmpty->meta->apply($test); 14 | 15 | $f->add($test); 16 | $f->data({}); 17 | $f->validate; 18 | is(scalar $f->errors,1,"One error, unset"); 19 | $f->data({test => ''}); 20 | $f->validate; 21 | is(scalar $f->errors,1,"One error, empty"); 22 | $f->data({test => 'foo'}); 23 | $f->validate; 24 | is(scalar $f->errors,0,"No error"); 25 | -------------------------------------------------------------------------------- /Changes: -------------------------------------------------------------------------------- 1 | Revision history for {{$dist->name}} 2 | 3 | {{$NEXT}} 4 | Merged in SparkX::Form::BasicFields 5 | Merged in SparkX::Form::BasicPrinters 6 | Merged in SparkX::Form::BasicValidators 7 | Replaced fields_[ah] with 'fields' accessor and get{,_at} methods 8 | Migrated build system to Dist::Zilla, so version numbers work now. 9 | 10 | 0.02 2009-07-21 11 | Added testing deps. 12 | Auto-requires printer modules for you (and fixes related bug) 13 | 14 | 0.1 2009-05-31 15 | First version, released on an unsuspecting world. 16 | Module currently deals purely with validation from user input. 17 | -------------------------------------------------------------------------------- /t/lib/TestApp/Form/Field/Email.pm: -------------------------------------------------------------------------------- 1 | package TestApp::Form::Field::Email; 2 | 3 | use Moose; 4 | extends 'Spark::Form::Field'; 5 | 6 | sub _validate { 7 | my ($self) = @_; 8 | 9 | # This regexp is intentionally crap. It's a test. don't use this in real code 10 | my $valid = $self->value =~ /^[a-z.0-9_-]+@[a-z.0-9_-]+\.(com|org|net|museum|co\.[a-z]{2})$/; 11 | $self->error("That does not look like an email!") unless $valid; 12 | } 13 | 14 | sub to_html { 15 | q{} 16 | } 17 | 18 | sub to_xhtml { 19 | q{} 20 | } 21 | 22 | 1; 23 | -------------------------------------------------------------------------------- /t/05-confirm.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | 3 | use Spark::Form; 4 | use Test::More tests => 2; 5 | use lib 't/lib'; 6 | 7 | use Spark::Form::Field; 8 | use SparkX::Form::Field::Validator::Confirm; 9 | 10 | my $f = Spark::Form->new(); 11 | 12 | my $t1 = Spark::Form::Field->new(form => $f, name => 't1'); 13 | my $t2 = Spark::Form::Field->new(form => $f, name => 't2'); 14 | SparkX::Form::Field::Validator::Confirm->meta->apply($t1); 15 | $t1->confirm('t2'); 16 | 17 | $f->add($t1)->add($t2); 18 | $f->data({t1 => 'foo', t2 => 'bar'}); 19 | $f->validate; 20 | is(scalar $f->errors,1,"One error"); 21 | $f->data({t1 => 'foo', t2 => 'foo'}); 22 | $f->validate; 23 | is(scalar @{$f->errors},0,"No errors"); 24 | -------------------------------------------------------------------------------- /t/09-regex.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | 3 | use Spark::Form; 4 | use Test::More tests => 3; 5 | use lib 't/lib'; 6 | 7 | use Spark::Form::Field; 8 | use SparkX::Form::Field::Validator::Regex; 9 | 10 | my $f = Spark::Form->new(); 11 | 12 | my $test = Spark::Form::Field->new(name => 'test', form => $f); 13 | SparkX::Form::Field::Validator::Regex->meta->apply($test); 14 | $test->regex(qr/^[A-Z][0-9]$/); 15 | 16 | $f->add($test); 17 | $f->data({}); 18 | $f->validate; 19 | is(scalar $f->errors,1,"One error, unset"); 20 | $f->data({test => 'AB'}); 21 | $f->validate; 22 | is(scalar $f->errors,1,"One error, no match"); 23 | $f->data({test => 'A1'}); 24 | $f->validate; 25 | is(scalar $f->errors,0,"No error, match"); 26 | -------------------------------------------------------------------------------- /t/06-maxlength.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | 3 | use Spark::Form; 4 | use Test::More tests => 3; 5 | use lib 't/lib'; 6 | 7 | use Spark::Form::Field; 8 | use SparkX::Form::Field::Validator::MaxLength; 9 | 10 | my $f = Spark::Form->new(); 11 | 12 | my $test = Spark::Form::Field->new(form => $f, name => 'test'); 13 | SparkX::Form::Field::Validator::MaxLength->meta->apply($test); 14 | $test->max_length(3); 15 | 16 | $f->add($test); 17 | $f->data({test => 'qu'}); 18 | $f->validate; 19 | is(scalar $f->errors,0,"No errors"); 20 | $f->data({test => 'quu'}); 21 | $f->validate; 22 | is(scalar $f->errors,0,"No errors, borderline"); 23 | $f->data({test => 'quux'}); 24 | $f->validate; 25 | is(scalar $f->errors,1,"One error, borderline"); 26 | -------------------------------------------------------------------------------- /t/07-minlength.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | 3 | use Spark::Form; 4 | use Test::More tests => 3; 5 | use lib 't/lib'; 6 | 7 | use Spark::Form::Field; 8 | use SparkX::Form::Field::Validator::MinLength; 9 | 10 | my $f = Spark::Form->new(); 11 | 12 | my $test = Spark::Form::Field->new(form => $f, name => 'test'); 13 | SparkX::Form::Field::Validator::MinLength->meta->apply($test); 14 | $test->min_length(3); 15 | 16 | $f->add($test); 17 | $f->data({test => 'qu'}); 18 | $f->validate; 19 | is(scalar $f->errors,1,"One error, borderline"); 20 | $f->data({test => 'quu'}); 21 | $f->validate; 22 | is(scalar $f->errors,0,"No errors, borderline"); 23 | $f->data({test => 'quux'}); 24 | $f->validate; 25 | is(scalar $f->errors,0,"One error"); 26 | -------------------------------------------------------------------------------- /TODO: -------------------------------------------------------------------------------- 1 | AIMS 2 | 3 | To be simply the best forms handling module on CPAN. To cope with the oddest situations 4 | 5 | COMING SOON 6 | 7 | 1. Tests. Tons of new functionality has been added, especially as regards cloning. We need more tests in the following areas: 8 | - Cloning (including logic for partial cloning) 9 | - Composition 10 | - Removing items 11 | 12 | IDEAS 13 | 14 | We need ideas for the following: 15 | 16 | 1. TT integration. 17 | 2. Autogeneration from DBIx::Class , particularly in how to cleanly apply constraints on top of generated forms. 18 | 3. Inter-field validation 19 | 4. Conditional validation 20 | 21 | Minors: 22 | 1. ::Reset ought not to have a value 23 | 2. Debatable whether ::{File,Image} ought to have a value (not echoed, not validated but read) -------------------------------------------------------------------------------- /t/lib/TestApp/Form/Field/Password.pm: -------------------------------------------------------------------------------- 1 | package TestApp::Form::Field::Password; 2 | 3 | use Moose; 4 | extends 'Spark::Form::Field'; 5 | 6 | has confirm => ( 7 | isa => 'Maybe[Str]', 8 | is => 'ro', 9 | ); 10 | 11 | sub _validate { 12 | my ($self) = @_; 13 | 14 | if (length($self->value || '') < 6) { 15 | $self->error('Password must be at least 6 characters long'); 16 | } 17 | if ($self->confirm) { 18 | my $other = $self->form->get($self->confirm); 19 | if ($other->value ne $self->value) { 20 | $self->error('passwords must match'); 21 | } 22 | } 23 | } 24 | 25 | sub to_html { 26 | q{}; 27 | } 28 | 29 | sub to_xhtml { 30 | q{}; 31 | } 32 | 33 | 1; 34 | -------------------------------------------------------------------------------- /t/30-radiogroup.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | 3 | use Test::More tests => 1; 4 | use lib 't/lib'; 5 | use Spark::Form; 6 | use SparkX::Form::Field::RadioGroup; 7 | 8 | my $form = Spark::Form->new; 9 | my $b = SparkX::Form::Field::RadioGroup->new( 10 | name => 'test', form => $form, 11 | options => [ 12 | 'Radio Button 1', => 'r1', 13 | 'Radio Button 2', => 'r2', 14 | 'Radio Button 3', => 'r3', 15 | ], 16 | value => 'test-2', 17 | ); 18 | 19 | is($b->to_xhtml, 20 | ' 21 | 22 | 23 | 24 | 25 | ','Test xhtml representation'); 26 | -------------------------------------------------------------------------------- /lib/Spark/Form/Field/Role/Printable/HTML.pm: -------------------------------------------------------------------------------- 1 | package Spark::Form::Field::Role::Printable::HTML; 2 | 3 | # ABSTRACT: a HTML4-printable form field role 4 | 5 | use Moose::Role; 6 | with 'Spark::Form::Field::Role::Printable'; 7 | 8 | requires 'to_html'; 9 | 10 | 1; 11 | __END__ 12 | 13 | =head1 SYNOPSIS 14 | 15 | package MyApp::Form::Field::CustomText; 16 | use Moose; 17 | extends 'Spark::Form::Field'; 18 | with 'Spark::Form::Field::Role::Printable::HTML'; 19 | use HTML::Tiny; 20 | 21 | sub to_html { 22 | my ($self) = @_; 23 | my $html = HTML::Tiny->new( mode => 'html' ); 24 | $html->input({type => 'text', value => $self->value}); 25 | } 26 | 27 | =head1 METHODS 28 | 29 | =head2 to_html :: Undef => Str 30 | 31 | This function should return a HTML string representing your control 32 | 33 | =head1 SEE ALSO 34 | 35 | L 36 | 37 | =cut 38 | -------------------------------------------------------------------------------- /lib/SparkX/Form/BasicFields.pm: -------------------------------------------------------------------------------- 1 | package SparkX::Form::BasicFields; 2 | 3 | # ABSTRACT: A collection of basic fields for Spark::Form 4 | 5 | 1; 6 | __END__ 7 | 8 | =head1 DESCRIPTION 9 | 10 | L is a way to define your own forms with validation and auto-printing. See that module for more information. 11 | 12 | This file is just explanatory. SEE ALSO for more interesting files. 13 | 14 | =head1 SEE ALSO 15 | 16 | L - The forms handling system itself 17 | L - If you want to have validation of these fields 18 | L - A text field 19 | L - A checkbox field 20 | L - A radio button set 21 | L - A select button set 22 | L - A textarea field 23 | 24 | =head1 ACKNOWLEDGEMENTS 25 | 26 | =cut 27 | -------------------------------------------------------------------------------- /lib/Spark/Form/Field/Role/Printable/XHTML.pm: -------------------------------------------------------------------------------- 1 | package Spark::Form::Field::Role::Printable::XHTML; 2 | 3 | # ABSTRACT: a XHTML1-printable form field role 4 | 5 | use Moose::Role; 6 | with 'Spark::Form::Field::Role::Printable'; 7 | 8 | requires 'to_xhtml'; 9 | 10 | 1; 11 | __END__ 12 | 13 | =head1 SYNOPSIS 14 | 15 | package MyApp::Form::Field::CustomText; 16 | use Moose; 17 | extends 'Spark::Form::Field'; 18 | with 'Spark::Form::Field::Role::Printable::XHTML'; 19 | use HTML::Tiny; 20 | 21 | sub to_xhtml { 22 | my ($self) = @_; 23 | my $html = HTML::Tiny->new( mode => 'xml' ); 24 | $html->input({type => 'text', value => $self->value}); 25 | } 26 | 27 | =head1 METHODS 28 | 29 | =head2 to_xhtml :: Undef => Str 30 | 31 | This function should return a XHTML string representing your control 32 | 33 | =head1 SEE ALSO 34 | 35 | L 36 | 37 | =cut 38 | -------------------------------------------------------------------------------- /lib/SparkX/Form/Field/Validator/NotEmpty.pm: -------------------------------------------------------------------------------- 1 | package SparkX::Form::Field::Validator::NotEmpty; 2 | 3 | # ABSTRACT: Validates a field has some value 4 | 5 | use Moose::Role; 6 | 7 | has errmsg_empty => ( 8 | isa => 'Str', 9 | is => 'rw', 10 | required => 0, 11 | default => sub { 12 | my $self = shift; 13 | return $self->human_name . 14 | ' must be provided.' 15 | }, 16 | ); 17 | 18 | sub _not_empty { 19 | my ($self) = @_; 20 | 21 | unless ($self->value) { 22 | $self->error($self->errmsg_empty); 23 | } 24 | return $self; 25 | } 26 | 27 | after '_validate' => sub { return shift->_not_empty }; 28 | 29 | 1; 30 | __END__ 31 | 32 | =head1 DESCRIPTION 33 | 34 | A not empty enforcement mix-in. Adds one field plus action. 35 | Makes sure that C is not empty. 36 | 37 | =head1 ACCESSORS 38 | 39 | =head2 errmsg_empty => Str 40 | 41 | Error message to be shown to the user if C is empty. 42 | 43 | =cut 44 | -------------------------------------------------------------------------------- /perlcriticrc: -------------------------------------------------------------------------------- 1 | severity = 1 2 | 3 | exclude = RequireTidyCode RequirePodSections ProhibitPostfixControls RequireRcsKeywords RequireExplicitPackage ProhibitUnlessBlocks ProhibitBuiltinHomonyms RequireCleanNamespace RequireUseStrict RequireUseWarnings Variables::ProhibitPunctuationVars RegularExpressions::RequireDotMatchAnything RegularExpressions::RequireExtendedFormatting RegularExpressions::RequireLineBoundaryMatching RequirePodAtEnd 4 | 5 | include = Moose::ProhibitMultipleWiths Moose::ProhibitNewMethod Moose::RequireMakeImmutable CodeLayout::ProhibitTrailingWhitespace 6 | 7 | color = 1 8 | verbose = 9 9 | 10 | [BuiltinFunctions::ProhibitStringyEval] 11 | allow_includes = 1 12 | 13 | [CodeLayout::ProhibitTrailingWhitespace] 14 | 15 | [Documentation::PodSpelling] 16 | stop_words = CPAN Str TODO rw HashRef ArrayRef HTML XHTML Bool API CGI basename plugins MyApp plugin Laver Django YAML Jifty validators Superclass superclass accessors pre checkbox textarea Printability RegexRef Undef 17 | 18 | [NamingConventions::ProhibitAmbiguousNames] 19 | forbid = abstract bases close contract last left no record right second 20 | -------------------------------------------------------------------------------- /lib/Spark/Form/Field/Role/Printable.pm: -------------------------------------------------------------------------------- 1 | package Spark::Form::Field::Role::Printable; 2 | 3 | # ABSTRACT: Printability for form fields 4 | 5 | use Moose::Role; 6 | 7 | has label => ( 8 | isa => 'Str', 9 | is => 'rw', 10 | required => 0, 11 | ); 12 | 13 | 1; 14 | __END__ 15 | 16 | =head1 DESCRIPTION 17 | 18 | A fairly free-form module, this is mostly used for checking that it's printable at all. 19 | You probably want one of the roles under this hierarchy, but not just this one. 20 | 21 | =head1 SYNOPSIS 22 | 23 | package MyApp::Field::CustomText; 24 | use Moose; 25 | extends 'Spark::Form::Field'; 26 | with 'Spark::Form::Field::Role::Printable'; 27 | 28 | sub to_string { 29 | my $self = shift; 30 | sprintf("%s: %s",$self->label, $self->value); 31 | } 32 | 33 | =head1 VARS 34 | 35 | =head2 label :: Str [Optional] 36 | 37 | A label that will be printed next to said field in the printed out version 38 | 39 | =head1 SEE ALSO 40 | 41 | L - Role for being printable under HTML4 42 | L - Role for being printable under XHTML1 43 | 44 | =cut 45 | -------------------------------------------------------------------------------- /lib/SparkX/Form/Field/File.pm: -------------------------------------------------------------------------------- 1 | package SparkX::Form::Field::File; 2 | 3 | # ABSTRACT: A File upload field for SparkX::Form 4 | 5 | use Moose; 6 | use HTML::Tiny; 7 | 8 | extends 'Spark::Form::Field'; 9 | with 'Spark::Form::Field::Role::Printable::HTML', 10 | 'Spark::Form::Field::Role::Printable::XHTML'; 11 | 12 | has '+value' => ( 13 | isa => 'Str', 14 | ); 15 | 16 | sub to_html { 17 | return shift->_render(HTML::Tiny->new(mode => 'html')); 18 | } 19 | 20 | sub to_xhtml { 21 | return shift->_render(HTML::Tiny->new(mode => 'xml')); 22 | } 23 | 24 | sub _render { 25 | my ($self, $html) = @_; 26 | 27 | return $html->input({type => 'file', name => $self->name}); 28 | } 29 | __PACKAGE__->meta->make_immutable; 30 | 1; 31 | __END__ 32 | 33 | =head1 METHODS 34 | 35 | =head2 to_html() => Str 36 | 37 | Renders the field to HTML 38 | 39 | =head2 to_xhtml() => Str 40 | 41 | Renders the field to XHTML 42 | 43 | =head2 validate() => Bool 44 | 45 | Validates the field. Before composition with validators, always returns 1. 46 | 47 | =head1 SEE ALSO 48 | 49 | L - The forms module this is to be used with 50 | L - A collection of fields for use with C 51 | 52 | =cut 53 | -------------------------------------------------------------------------------- /lib/SparkX/Form/Field/Reset.pm: -------------------------------------------------------------------------------- 1 | package SparkX::Form::Field::Reset; 2 | 3 | # ABSTRACT: A reset button for SparkX::Form 4 | 5 | use Moose; 6 | use HTML::Tiny; 7 | 8 | extends 'Spark::Form::Field'; 9 | with 'Spark::Form::Field::Role::Printable::HTML', 10 | 'Spark::Form::Field::Role::Printable::XHTML'; 11 | 12 | has '+value' => ( 13 | isa => 'Str', 14 | ); 15 | 16 | sub to_html { 17 | return shift->_render(HTML::Tiny->new(mode => 'html')); 18 | } 19 | 20 | sub to_xhtml { 21 | return shift->_render(HTML::Tiny->new(mode => 'xml')); 22 | } 23 | 24 | sub _render { 25 | my ($self, $html) = @_; 26 | 27 | return $html->input({type => 'reset', name => $self->name}); 28 | } 29 | __PACKAGE__->meta->make_immutable; 30 | 1; 31 | __END__ 32 | 33 | =head1 METHODS 34 | 35 | =head2 to_html() => Str 36 | 37 | Renders the field to HTML 38 | 39 | =head2 to_xhtml() => Str 40 | 41 | Renders the field to XHTML 42 | 43 | =head2 validate() => Bool 44 | 45 | Validates the field. Before composition with validators, always returns 1. 46 | 47 | =head1 SEE ALSO 48 | 49 | L - The forms module this is to be used with 50 | L - A collection of fields for use with C 51 | 52 | =cut 53 | -------------------------------------------------------------------------------- /lib/SparkX/Form/Field/Password.pm: -------------------------------------------------------------------------------- 1 | package SparkX::Form::Field::Password; 2 | 3 | # ABSTRACT: A Password field for SparkX::Form 4 | 5 | use Moose; 6 | use HTML::Tiny; 7 | 8 | extends 'Spark::Form::Field'; 9 | with 'Spark::Form::Field::Role::Printable::HTML', 10 | 'Spark::Form::Field::Role::Printable::XHTML'; 11 | 12 | has '+value' => ( 13 | isa => 'Str', 14 | ); 15 | 16 | sub to_html { 17 | return shift->_render(HTML::Tiny->new(mode => 'html')); 18 | } 19 | 20 | sub to_xhtml { 21 | return shift->_render(HTML::Tiny->new(mode => 'xml')); 22 | } 23 | 24 | sub _render { 25 | my ($self, $html) = @_; 26 | 27 | return $html->input({type => 'password', name => $self->name}); 28 | } 29 | 30 | __PACKAGE__->meta->make_immutable; 31 | 1; 32 | __END__ 33 | 34 | =head1 METHODS 35 | 36 | =head2 to_html() => Str 37 | 38 | Renders the field to HTML 39 | 40 | =head2 to_xhtml() => Str 41 | 42 | Renders the field to XHTML 43 | 44 | =head2 validate() => Bool 45 | 46 | Validates the field. Before composition with validators, always returns 1. 47 | 48 | =head1 SEE ALSO 49 | 50 | L - The forms module this is to be used with 51 | L - A collection of fields for use with C 52 | 53 | =cut 54 | -------------------------------------------------------------------------------- /lib/SparkX/Form/Field/Hidden.pm: -------------------------------------------------------------------------------- 1 | package SparkX::Form::Field::Hidden; 2 | 3 | # ABSTRACT: A hidden field for SparkX::Form 4 | 5 | use Moose; 6 | use HTML::Tiny; 7 | 8 | extends 'Spark::Form::Field'; 9 | with 'Spark::Form::Field::Role::Printable::HTML', 10 | 'Spark::Form::Field::Role::Printable::XHTML'; 11 | 12 | has '+value' => ( 13 | isa => 'Str', 14 | ); 15 | 16 | sub to_html { 17 | return shift->_render(HTML::Tiny->new(mode => 'html')); 18 | } 19 | 20 | sub to_xhtml { 21 | return shift->_render(HTML::Tiny->new(mode => 'xml')); 22 | } 23 | 24 | sub _render { 25 | my ($self, $html) = @_; 26 | 27 | return $html->input({type => 'hidden', value => $self->value, name => $self->name}); 28 | } 29 | __PACKAGE__->meta->make_immutable; 30 | 1; 31 | __END__ 32 | 33 | =head1 METHODS 34 | 35 | =head2 to_html() => Str 36 | 37 | Renders the field to HTML 38 | 39 | =head2 to_xhtml() => Str 40 | 41 | Renders the field to XHTML 42 | 43 | =head2 validate() => Bool 44 | 45 | Validates the field. Before composition with validators, always returns 1. 46 | 47 | =head1 SEE ALSO 48 | 49 | L - The forms module this is to be used with 50 | L - A collection of fields for use with C 51 | 52 | =cut 53 | -------------------------------------------------------------------------------- /lib/SparkX/Form/Field/Submit.pm: -------------------------------------------------------------------------------- 1 | package SparkX::Form::Field::Submit; 2 | 3 | # ABSTRACT: A Submit field for SparkX::Form 4 | 5 | use Moose; 6 | use HTML::Tiny; 7 | 8 | extends 'Spark::Form::Field'; 9 | with 'Spark::Form::Field::Role::Printable::HTML', 10 | 'Spark::Form::Field::Role::Printable::XHTML'; 11 | 12 | has '+value' => ( 13 | isa => 'Str', 14 | ); 15 | 16 | sub to_html { 17 | return shift->_render(HTML::Tiny->new(mode => 'html')); 18 | } 19 | 20 | sub to_xhtml { 21 | return shift->_render(HTML::Tiny->new(mode => 'xml')); 22 | } 23 | 24 | sub _render { 25 | my ($self, $html) = @_; 26 | 27 | return $html->input({type => 'submit', value => $self->value, name => $self->name}); 28 | } 29 | __PACKAGE__->meta->make_immutable; 30 | 1; 31 | __END__ 32 | 33 | =head1 METHODS 34 | 35 | =head2 to_html() => Str 36 | 37 | Renders the field to HTML 38 | 39 | =head2 to_xhtml() => Str 40 | 41 | Renders the field to XHTML 42 | 43 | =head2 validate() => Bool 44 | 45 | Validates the field. Before composition with validators, always returns 1. 46 | 47 | =head1 SEE ALSO 48 | 49 | L - The forms module this is to be used with 50 | L - A collection of fields for use with C 51 | 52 | =cut 53 | -------------------------------------------------------------------------------- /lib/SparkX/Form/Field/Text.pm: -------------------------------------------------------------------------------- 1 | package SparkX::Form::Field::Text; 2 | 3 | # ABSTRACT: A Text field for SparkX::Form 4 | 5 | use Moose; 6 | use HTML::Tiny; 7 | 8 | extends 'Spark::Form::Field'; 9 | with 'Spark::Form::Field::Role::Printable::HTML', 10 | 'Spark::Form::Field::Role::Printable::XHTML'; 11 | 12 | has '+value' => ( 13 | isa => 'Str', 14 | ); 15 | 16 | sub to_html { 17 | return shift->_render(HTML::Tiny->new(mode => 'html')); 18 | } 19 | 20 | sub to_xhtml { 21 | return shift->_render(HTML::Tiny->new(mode => 'xml')); 22 | } 23 | 24 | sub _render { 25 | my ($self, $html) = @_; 26 | 27 | return $html->input({type => 'text', value => $self->value, name => $self->name}); 28 | } 29 | 30 | __PACKAGE__->meta->make_immutable; 31 | 32 | 1; 33 | __END__ 34 | 35 | =head1 METHODS 36 | 37 | =head2 to_html() => Str 38 | 39 | Renders the field to HTML 40 | 41 | =head2 to_xhtml() => Str 42 | 43 | Renders the field to XHTML 44 | 45 | =head2 validate() => Bool 46 | 47 | Validates the field. Before composition with validators, always returns 1. 48 | 49 | =head1 SEE ALSO 50 | 51 | L - The forms module this is to be used with 52 | L - A collection of fields for use with C 53 | 54 | =cut 55 | -------------------------------------------------------------------------------- /t/10-combinatorics.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | 3 | use Spark::Form; 4 | use Test::More tests => 4; 5 | use lib 't/lib'; 6 | 7 | use Spark::Form::Field; 8 | use SparkX::Form::Field::Validator::Regex; 9 | use SparkX::Form::Field::Validator::MinLength; 10 | use SparkX::Form::Field::Validator::MaxLength; 11 | use SparkX::Form::Field::Validator::Confirm; 12 | 13 | my $f = Spark::Form->new(); 14 | 15 | my $test = Spark::Form::Field->new( 16 | form => $f, 17 | name => 'test' 18 | ); 19 | 20 | SparkX::Form::Field::Validator::Regex->meta->apply($test); 21 | SparkX::Form::Field::Validator::MinLength->meta->apply($test); 22 | SparkX::Form::Field::Validator::MaxLength->meta->apply($test); 23 | SparkX::Form::Field::Validator::Confirm->meta->apply($test); 24 | $test->regex(qr/^[A-Z]+[0-9]$/); 25 | $test->min_length(6); 26 | $test->max_length(6); 27 | $test->confirm('test'); 28 | 29 | $f->add($test); 30 | $f->data({test => ''}); 31 | $f->validate; 32 | is(scalar $f->errors,2,"Two errors, unset"); 33 | $f->data({test => 'ABCDE'}); 34 | $f->validate; 35 | is(scalar $f->errors,2,"Two errors"); 36 | $f->data({test => 'ABCDEFG'}); 37 | $f->validate; 38 | is(scalar $f->errors,2,"Two errors,"); 39 | $f->data({test => 'ABCDE1'}); 40 | $f->validate; 41 | is(scalar $f->errors,0,"No errors"); 42 | -------------------------------------------------------------------------------- /lib/SparkX/Form/Field/Textarea.pm: -------------------------------------------------------------------------------- 1 | package SparkX::Form::Field::Textarea; 2 | 3 | # ABSTRACT: A Textarea field for SparkX::Form 4 | 5 | use Moose; 6 | use HTML::Tiny; 7 | 8 | extends 'Spark::Form::Field'; 9 | with 'Spark::Form::Field::Role::Printable::HTML', 10 | 'Spark::Form::Field::Role::Printable::XHTML'; 11 | 12 | has '+value' => ( 13 | isa => 'Str', 14 | default => q{}, 15 | ); 16 | 17 | sub to_html { 18 | return shift->_render(HTML::Tiny->new(mode => 'html')); 19 | } 20 | 21 | sub to_xhtml { 22 | return shift->_render(HTML::Tiny->new(mode => 'xml')); 23 | } 24 | 25 | sub _render { 26 | my ($self, $html) = @_; 27 | 28 | return $html->textarea({name => $self->name}, $self->value); 29 | } 30 | __PACKAGE__->meta->make_immutable; 31 | 1; 32 | __END__ 33 | 34 | =head1 METHODS 35 | 36 | =head2 to_html() => Str 37 | 38 | Renders the field to HTML 39 | 40 | =head2 to_xhtml() => Str 41 | 42 | Renders the field to XHTML 43 | 44 | =head2 validate() => Bool 45 | 46 | Validates the field. Before composition with validators, always returns 1. 47 | 48 | =head1 SEE ALSO 49 | 50 | L - The forms module this is to be used with 51 | L - A collection of fields for use with C 52 | 53 | =cut 54 | -------------------------------------------------------------------------------- /lib/SparkX/Form/Printer/List.pm: -------------------------------------------------------------------------------- 1 | package SparkX::Form::Printer::List; 2 | 3 | # ABSTRACT: A list-printer for SparkX::Form. Spouts out form elements in a (X)HTML list. 4 | 5 | use Moose::Role; 6 | with 'Spark::Form::Printer'; 7 | 8 | use HTML::Tiny; 9 | 10 | sub to_xhtml { 11 | my ($self, @args) = @_; 12 | return $self->_render('to_xhtml', HTML::Tiny->new(mode => 'xml'), @args); 13 | } 14 | 15 | sub to_html { 16 | my ($self, @args) = @_; 17 | return $self->_render('to_html', HTML::Tiny->new(mode => 'html'), @args); 18 | } 19 | 20 | sub _render { 21 | my ($self, $func, $html, @params) = @_; 22 | return $html->ul( 23 | join q{ }, $self->_get_lis($func, $html) 24 | ); 25 | } 26 | 27 | sub _get_lis { 28 | my ($self, $func, $html) = @_; 29 | return map { 30 | $html->li($html->label($_->human_name)) => $html->li($_->$func) 31 | } $self->fields; 32 | } 33 | 34 | 1; 35 | __END__ 36 | 37 | =head1 EXPORT 38 | 39 | A list of functions that can be exported. You can delete this section 40 | if you don't export anything, such as for a purely object-oriented module. 41 | 42 | =head1 FUNCTIONS 43 | 44 | =head2 to_html 45 | 46 | Prints the form to HTML 47 | 48 | =head2 to_xhtml 49 | 50 | Prints the form to XHTML 51 | 52 | =head1 ACKNOWLEDGEMENTS 53 | 54 | =cut 55 | -------------------------------------------------------------------------------- /lib/SparkX/Form/Field/Validator/Regex.pm: -------------------------------------------------------------------------------- 1 | package SparkX::Form::Field::Validator::Regex; 2 | 3 | # ABSTRACT: Validates a field matches a regular expression 4 | 5 | use Moose::Role; 6 | 7 | has regex => ( 8 | isa => 'Maybe[RegexpRef]', 9 | is => 'rw', 10 | required => 0, 11 | default => undef, 12 | ); 13 | 14 | has errmsg_regex => ( 15 | isa => 'Str', 16 | is => 'rw', 17 | required => 0, 18 | lazy => 1, 19 | default => sub { 20 | my $self = shift; 21 | $self->human_name . ' failed the regex.' 22 | }, 23 | ); 24 | 25 | sub _regex { 26 | my ($self) = @_; 27 | 28 | return unless $self->regex; 29 | 30 | if ($self->value !~ $self->regex) { 31 | $self->error($self->errmsg_regex); 32 | } 33 | return $self; 34 | } 35 | 36 | after '_validate' => sub { return shift->_regex }; 37 | 38 | 1; 39 | __END__ 40 | 41 | =head1 DESCRIPTION 42 | 43 | A regular expression validation mix-in. Adds two fields plus action. 44 | Makes sure that C matches the expression. 45 | 46 | =head1 ACCESSORS 47 | 48 | =head2 C => Str 49 | 50 | RegexRef to match. 51 | Required, no default. 52 | 53 | =head2 errmsg_regex => Str 54 | 55 | Allows you to provide a custom error message for when the match fails. 56 | Required, no default. 57 | 58 | =cut 59 | -------------------------------------------------------------------------------- /lib/SparkX/Form/Field/Checkbox.pm: -------------------------------------------------------------------------------- 1 | package SparkX::Form::Field::Checkbox; 2 | 3 | # ABSTRACT: A Checkbox field for SparkX::Form 4 | 5 | use Moose; 6 | use HTML::Tiny; 7 | 8 | extends 'Spark::Form::Field'; 9 | with 'Spark::Form::Field::Role::Printable::HTML', 10 | 'Spark::Form::Field::Role::Printable::XHTML'; 11 | 12 | has '+value' => ( 13 | isa => 'Str', 14 | ); 15 | 16 | sub to_html { 17 | return shift->_render(HTML::Tiny->new(mode => 'html')); 18 | } 19 | 20 | sub to_xhtml { 21 | return shift->_render(HTML::Tiny->new(mode => 'xml')); 22 | } 23 | 24 | sub _render { 25 | my ($self, $html) = @_; 26 | 27 | return $html->input({ 28 | type => 'checkbox', 29 | value => 1, 30 | ($self->value ? (checked => 'checked') : ()), 31 | name => $self->name 32 | }); 33 | } 34 | __PACKAGE__->meta->make_immutable; 35 | 1; 36 | __END__ 37 | 38 | =head1 METHODS 39 | 40 | =head2 to_html() => Str 41 | 42 | Renders the field to HTML 43 | 44 | =head2 to_xhtml() => Str 45 | 46 | Renders the field to XHTML 47 | 48 | =head2 validate() => Bool 49 | 50 | Validates the field. Before composition with validators, always returns 1. 51 | 52 | =head1 SEE ALSO 53 | 54 | L - The forms module this is to be used with 55 | L - A collection of fields for use with C 56 | 57 | =cut 58 | -------------------------------------------------------------------------------- /dist.ini: -------------------------------------------------------------------------------- 1 | name = Spark-Form 2 | author = James Laver L 3 | license = Perl_5 4 | copyright_holder = James Laver C<< >> 5 | main_module = lib/Spark/Form.pm 6 | [PruneCruft] 7 | 8 | [MetaResources] 9 | homepage = http://jjl.github.com/Spark-Form 10 | bugtracker.web = http://rt.cpan.org/NoAuth/Bugs.html?Dist=Spark-Form 11 | bugtracker.mailto = bug-spark-form@rt.cpan.org 12 | repository.web = http://github.com/jjl/Spark-Form 13 | repository.url = git://github.com/jjl/Spark-Form 14 | repository.type = git 15 | 16 | [GatherDir] 17 | 18 | [License] 19 | 20 | [PkgVersion] 21 | [PodWeaver] 22 | [PodVersion] 23 | 24 | [MetaProvides::Package] 25 | 26 | [MetaJSON] 27 | [MetaYAML] 28 | [MetaConfig] 29 | 30 | [MakeMaker] 31 | [MakeMaker::Runner] 32 | 33 | [ReadmeFromPod] 34 | 35 | [ManifestSkip] 36 | [Manifest] 37 | 38 | [CompileTests] 39 | [MetaTests] 40 | [PodCoverageTests] 41 | [PodSyntaxTests] 42 | [ExtraTests] 43 | 44 | [TestRelease] 45 | [NextRelease] 46 | [UploadToCPAN] 47 | [ConfirmRelease] 48 | [AutoVersion] 49 | major=1 50 | 51 | [AutoPrereqs] 52 | [Prereqs] 53 | Module::Pluggable = 0 54 | Moose = 0.89 55 | HTML::Tiny = 0 56 | MooseX::AttributeHelpers = 0.21 57 | List::MoreUtils = 0 58 | List::Util = 0 59 | Data::Couplet = 0.02004422 60 | 61 | ;[TestReq] 62 | Test::More = 0 63 | -------------------------------------------------------------------------------- /lib/SparkX/Form/Field/Button.pm: -------------------------------------------------------------------------------- 1 | package SparkX::Form::Field::Button; 2 | 3 | # ABSTRACT: A Button for SparkX::Form 4 | 5 | use Moose; 6 | use HTML::Tiny; 7 | 8 | extends 'Spark::Form::Field'; 9 | with 'Spark::Form::Field::Role::Printable::HTML', 10 | 'Spark::Form::Field::Role::Printable::XHTML'; 11 | 12 | has '+value' => ( 13 | isa => 'Str', 14 | ); 15 | 16 | has 'content' => ( 17 | isa => 'Str', 18 | is => 'rw', 19 | required => 0, 20 | default => q(), 21 | ); 22 | 23 | sub to_html { 24 | return shift->_render(HTML::Tiny->new(mode => 'html')); 25 | } 26 | 27 | sub to_xhtml { 28 | return shift->_render(HTML::Tiny->new(mode => 'xml')); 29 | } 30 | 31 | sub _render { 32 | my ($self, $html) = @_; 33 | 34 | return $html->button({value => $self->value, name => $self->name}, $self->content); 35 | } 36 | 37 | __PACKAGE__->meta->make_immutable; 38 | 39 | 1; 40 | __END__ 41 | 42 | =head1 METHODS 43 | 44 | =head2 to_html() => Str 45 | 46 | Renders the field to HTML 47 | 48 | =head2 to_xhtml() => Str 49 | 50 | Renders the field to XHTML 51 | 52 | =head2 validate() => Bool 53 | 54 | Validates the field. Before composition with validators, always returns 1. 55 | 56 | =head1 SEE ALSO 57 | 58 | L - The forms module this is to be used with 59 | L - A collection of fields for use with C 60 | 61 | =cut 62 | -------------------------------------------------------------------------------- /t/04-form-custom-lazy.t: -------------------------------------------------------------------------------- 1 | # Test custom fields 2 | use Test::More tests => 9; 3 | 4 | use lib 't/lib'; 5 | use Spark::Form; 6 | 7 | #Create a form 8 | my $form = Spark::Form->new(plugin_ns => 'TestApp::Form::Field'); 9 | 10 | #First off, verify there are no fields in an empty form 11 | is_deeply([$form->fields], [], "Fields are not yet populated"); 12 | 13 | #Add two custom fields 14 | $form->add('custom', 'gt6', min_length => 6); 15 | cmp_ok(scalar $form->fields, '==', 1, "Custom field 1 added"); 16 | $form->add('custom', 'gt2', min_length => 2); 17 | cmp_ok(scalar $form->fields, '==', 2, "Custom field 2 added"); 18 | 19 | #DATASET 1 - two fail 20 | my %data = ( 21 | gt6 => '1', 22 | gt2 => '1', 23 | ); 24 | $form->data(\%data); 25 | $form->validate; 26 | cmp_ok($form->valid, '==', 0, "Dataset 1 is invalid"); 27 | cmp_ok(scalar $form->errors, '==', 2, "Dataset 1 has 2 errors"); 28 | 29 | #DATASET 2 - one fail 30 | %data = ( 31 | gt6 => '12', 32 | gt2 => '12', 33 | ); 34 | $form->data(\%data); 35 | $form->validate; 36 | cmp_ok($form->valid, '==', 0, "Dataset 2 is invalid"); 37 | cmp_ok(scalar $form->errors, '==', 1, "Dataset 2 has 1 error"); 38 | 39 | #DATASET 3 - No errors 40 | %data = ( 41 | gt6 => '123456', 42 | gt2 => '12', 43 | ); 44 | $form->data(\%data); 45 | $form->validate; 46 | cmp_ok($form->valid, '==', 1, "Dataset 3 is valid"); 47 | is_deeply([$form->errors], [], "Dataset 3 has no errors"); 48 | -------------------------------------------------------------------------------- /t/14-list.t: -------------------------------------------------------------------------------- 1 | use Test::More tests => 4; 2 | use Spark::Form; 3 | 4 | #Local lib 5 | use lib 't/lib'; 6 | use SparkX::Form::Field::Text; 7 | use SparkX::Form::Field::Password; 8 | use SparkX::Form::Printer::List; 9 | 10 | #Create a form, mixing in the printer 11 | my $form = Spark::Form->new( printer => 'SparkX::Form::Printer::List' ); 12 | 13 | #Code cunningly copied and pasted from t/03-register.t 14 | my $email = SparkX::Form::Field::Text->new(name => 'email', form => $form); 15 | my $pass1 = SparkX::Form::Field::Password->new(name => 'password', form => $form); 16 | my $pass2 = SparkX::Form::Field::Password->new(name => 'confirm_password', confirm=>'password', form => $form); 17 | 18 | #Add the fields 19 | $form->add($email)->add($pass1)->add($pass2); 20 | 21 | #Can? 22 | ok(UNIVERSAL::can($form,'to_xhtml'),"can to_xhtml"); 23 | ok(UNIVERSAL::can($form,'to_html'),"can to_html"); 24 | 25 | my $xhtml = '
'; 26 | my $html = '
'; 27 | 28 | #To string 29 | is($form->to_xhtml, $xhtml, "XHTML representation"); 30 | is($form->to_html, $html, "HTML representation"); 31 | 32 | -------------------------------------------------------------------------------- /lib/SparkX/Form/Field/Validator/MinLength.pm: -------------------------------------------------------------------------------- 1 | package SparkX::Form::Field::Validator::MinLength; 2 | 3 | # ABSTRACT: Validates a field is at least a given size 4 | 5 | use Moose::Role; 6 | 7 | has min_length => ( 8 | isa => 'Maybe[Int]', 9 | is => 'rw', 10 | required => 0, 11 | default => 0, 12 | ); 13 | 14 | has errmsg_too_short => ( 15 | isa => 'Str', 16 | is => 'rw', 17 | required => 0, 18 | lazy => 1, 19 | default => sub { 20 | my $self = shift; 21 | return $self->human_name . 22 | ' must be at least ' . 23 | $self->min_length . 24 | ' characters long'; 25 | }, 26 | ); 27 | 28 | sub _min_length { 29 | my ($self) = @_; 30 | 31 | return unless $self->min_length; 32 | 33 | if (length $self->value < $self->min_length) { 34 | $self->error($self->errmsg_too_short); 35 | } 36 | return $self; 37 | } 38 | 39 | after '_validate' => sub { return shift->_min_length }; 40 | 41 | 1; 42 | __END__ 43 | 44 | =head1 DESCRIPTION 45 | 46 | A minimum length enforcement mix-in. Adds two fields plus action. 47 | Makes sure that C is at least C characters long. 48 | 49 | =head1 ACCESSORS 50 | 51 | =head2 min_length => Int 52 | 53 | The minimum length you desire. Required. In a subclass, you can: 54 | 55 | has '+min_length' => (required => 0,default => sub { $HOW_LONG }); 56 | 57 | if you want to have it optional with a default 58 | 59 | =head2 errmsg_too_short => Str 60 | 61 | Error message to be shown if C is too short. 62 | 63 | =cut 64 | -------------------------------------------------------------------------------- /lib/SparkX/Form/Field/Validator/MaxLength.pm: -------------------------------------------------------------------------------- 1 | package SparkX::Form::Field::Validator::MaxLength; 2 | 3 | # ABSTRACT: Validates a variable does not exceed a given size 4 | 5 | use Moose::Role; 6 | 7 | has max_length => ( 8 | isa => 'Maybe[Int]', 9 | is => 'rw', 10 | required => 0, 11 | default => 0, 12 | ); 13 | 14 | has errmsg_too_long => ( 15 | isa => 'Str', 16 | is => 'rw', 17 | required => 0, 18 | lazy => 1, 19 | default => sub { 20 | my $self = shift; 21 | return $self->human_name . 22 | ' must be no more than ' . 23 | $self->max_length . 24 | ' characters long'; 25 | }, 26 | ); 27 | 28 | sub _max_length { 29 | my ($self) = @_; 30 | 31 | return unless $self->max_length; 32 | 33 | if (length $self->value > $self->max_length) { 34 | $self->error($self->errmsg_too_long); 35 | } 36 | return $self; 37 | } 38 | 39 | after '_validate' => sub { return shift->_max_length }; 40 | 41 | 1; 42 | __END__ 43 | 44 | =head1 DESCRIPTION 45 | 46 | A maximum length enforcement mix-in. Adds two fields plus action. 47 | Makes sure that C is at most C characters long. 48 | 49 | =head1 ACCESSORS 50 | 51 | =head2 max_length => Int 52 | 53 | The maximum length you desire. Required. In a subclass, you can: 54 | 55 | has '+max_length' => (required => 0,default => sub { $HOW_LONG }); 56 | 57 | if you want to have it optional with a default 58 | 59 | =head2 errmsg_too_long => Str 60 | 61 | Error message to be shown if C is too long. 62 | 63 | =cut 64 | -------------------------------------------------------------------------------- /t/26-clone.t: -------------------------------------------------------------------------------- 1 | use Test::More tests => 5; 2 | 3 | use Spark::Form; 4 | use Data::Dumper 'Dumper'; 5 | 6 | #Local lib 7 | use lib 't/lib'; 8 | use TestApp::Form::Field::Email; 9 | use TestApp::Form::Field::Password; 10 | 11 | #Create a form 12 | my $form = Spark::Form->new; 13 | 14 | my $email = TestApp::Form::Field::Email->new(name => 'email', form => $form); 15 | my $pass1 = TestApp::Form::Field::Password->new(name => 'password', form => $form); 16 | my $pass2 = TestApp::Form::Field::Password->new(name => 'confirm_password', confirm => 'password', form => $form); 17 | 18 | #Add an email 19 | $form->add($email); 20 | #Add a password 21 | $form->add($pass1); 22 | #And a confirm password 23 | $form->add($pass2, confirm => 'password'); 24 | cmp_ok(scalar $form->fields, '==', 3, "3 fields added"); 25 | 26 | my $other_form = $form->clone_all(); 27 | 28 | 29 | #Validate 30 | $form->data({email => 'blah', password => 'password', confirm_password => 'foo'}); 31 | $form->validate; 32 | is(scalar $form->errors, 3, 'Three errors on original form'); 33 | 34 | $other_form->data({email => 'blah', password => 'password', confirm_password => 'foo'}); 35 | $other_form->validate; 36 | is(scalar $other_form->errors, 3, 'Three errors on cloned form'); 37 | 38 | #Revalidate 39 | $other_form->data({email => 'blah@blah.com', password => 'password', confirm_password => 'password'}); 40 | $other_form->validate; 41 | is(scalar $other_form->errors, 0, 'No error on cloned form'); 42 | 43 | #Check it hasn't tampered with the existing form 44 | $form->validate; 45 | is(scalar $form->errors, 3, 'Three errors on original form still'); 46 | -------------------------------------------------------------------------------- /lib/Spark/Form/FAQ.pm: -------------------------------------------------------------------------------- 1 | package Spark::Form::FAQ; 2 | 3 | # ABSTRACT: Frequently Asked Questions about Spark::Form 4 | 5 | 1; 6 | __END__ 7 | 8 | =head1 Frequently Asked Questions 9 | 10 | =head2 Why another forms module? 11 | 12 | None of the others met my needs. This is CPAN, people reinvent wheels 13 | properly so you don't have to. 14 | 15 | Essentially the only real viable alternative I've come across is HTML::FormFu 16 | and I wanted a Pure-Perl solution, no YAML. 17 | 18 | =head2 Why Spark::Form? 19 | 20 | Why not? 21 | 22 | =over 4 23 | 24 | =item Simple to use 25 | 26 | Designed to be really simple, while still being flexible. 27 | 28 | =item Framework independent 29 | 30 | It doesn't rely on Catalyst, Jifty, CGI::Application etc. Plug it into anything. 31 | 32 | =item Simple Plugin Architecture 33 | 34 | It's B simple to write a new field plugin. So simple and quick, you'll 35 | want to define all your fields as plugins so they can be re-used. 36 | 37 | =item Promotes re-use 38 | 39 | Define fields once and re-use them to compose different forms that will all 40 | enforce the same validation. 41 | 42 | =item Pure Perl (and pretty at that) 43 | 44 | No YAML files, no other language to learn. Just simple Perl. 45 | 46 | =item Quality code 47 | 48 | Easy to read and built with L and L. 49 | 50 | =back 51 | 52 | =head2 Why do you depend on Moose? 53 | 54 | It made writing this module a lot quicker and the code a lot cleaner. And it 55 | will make maintenance a lot easier. 56 | 57 | =head2 Will there be a non-Moose version? 58 | 59 | No. Feel free to create and maintain a fork. 60 | 61 | =cut 62 | -------------------------------------------------------------------------------- /lib/SparkX/Form/Field/Image.pm: -------------------------------------------------------------------------------- 1 | package SparkX::Form::Field::Image; 2 | 3 | # ABSTRACT: An image field for SparkX::Form 4 | 5 | use Moose; 6 | use HTML::Tiny; 7 | 8 | extends 'Spark::Form::Field'; 9 | with 'Spark::Form::Field::Role::Printable::HTML', 10 | 'Spark::Form::Field::Role::Printable::XHTML'; 11 | 12 | has '+value' => ( 13 | isa => 'Str', 14 | ); 15 | 16 | ## no critic (ProhibitMagicNumbers) 17 | has 'names' => ( 18 | lazy => 1, 19 | (Moose->VERSION >= 0.84) ? (is => 'bare') : (), 20 | default => sub { 21 | my $self = shift; 22 | 23 | return [$self->name . '.x', $self->name . '.y']; 24 | }, 25 | ); 26 | ## use critic 27 | 28 | sub to_html { 29 | return shift->_render(HTML::Tiny->new(mode => 'html')); 30 | } 31 | 32 | sub to_xhtml { 33 | return shift->_render(HTML::Tiny->new(mode => 'xml')); 34 | } 35 | 36 | sub _render { 37 | my ($self, $html) = @_; 38 | 39 | return $html->input({type => 'image', name => $self->name}); 40 | } 41 | __PACKAGE__->meta->make_immutable; 42 | 43 | 1; 44 | __END__ 45 | 46 | =head1 DESCRIPTION 47 | 48 | Note that this does not support server-side image map functionality but will be treated as a submit. Patches welcome that don't break this (99% of the time desired) behaviour. 49 | 50 | =head1 METHODS 51 | 52 | =head2 to_html() => Str 53 | 54 | Renders the field to HTML 55 | 56 | =head2 to_xhtml() => Str 57 | 58 | Renders the field to XHTML 59 | 60 | =head2 validate() => Bool 61 | 62 | Validates the field. Before composition with validators, always returns 1. 63 | 64 | =head1 SEE ALSO 65 | 66 | L - The forms module this is to be used with 67 | L - A collection of fields for use with C 68 | 69 | =cut 70 | -------------------------------------------------------------------------------- /lib/SparkX/Form/Field/Radio.pm: -------------------------------------------------------------------------------- 1 | package SparkX::Form::Field::Radio; 2 | 3 | # ABSTRACT: A set of radio buttons for SparkX::Form 4 | 5 | use Moose; 6 | use HTML::Tiny; 7 | 8 | extends 'Spark::Form::Field'; 9 | with 'Spark::Form::Field::Role::Printable::HTML', 10 | 'Spark::Form::Field::Role::Printable::XHTML'; 11 | 12 | has '+value' => ( 13 | isa => 'Str', 14 | ); 15 | 16 | has options => ( 17 | isa => 'ArrayRef', 18 | is => 'rw', 19 | required => 0, 20 | lazy => 1, 21 | default => sub { return shift->value }, 22 | ); 23 | 24 | sub to_html { 25 | return shift->_render(HTML::Tiny->new(mode => 'html')); 26 | } 27 | 28 | sub to_xhtml { 29 | return shift->_render(HTML::Tiny->new(mode => 'xml')); 30 | } 31 | 32 | sub _render_element { 33 | my ($self, $html, $option) = @_; 34 | return $html->input({ 35 | type => 'radio', 36 | value => $option, 37 | ($self->value eq $option ? (checked => 'checked') : ()), 38 | name => $self->name, 39 | }); 40 | 41 | } 42 | 43 | sub _render { 44 | my ($self, $html) = @_; 45 | return join q{ }, map { $self->_render_element($html, $_) } @{$self->options}; 46 | } 47 | __PACKAGE__->meta->make_immutable; 48 | 1; 49 | __END__ 50 | 51 | =head1 METHODS 52 | 53 | =head2 to_html() => Str 54 | 55 | Renders the field(s) to HTML 56 | 57 | =head2 to_xhtml() => Str 58 | 59 | Renders the field(s) to XHTML 60 | 61 | =head2 validate() => Bool 62 | 63 | Validates the field. Before composition with validators, always returns 1. 64 | 65 | =head1 SEE ALSO 66 | 67 | L - The forms module this is to be used with 68 | L - A collection of fields for use with C 69 | 70 | =cut 71 | -------------------------------------------------------------------------------- /lib/SparkX/Form/Field/Validator/Confirm.pm: -------------------------------------------------------------------------------- 1 | package SparkX::Form::Field::Validator::Confirm; 2 | 3 | # ABSTRACT: Validates whether or not the user confirmed some choice. 4 | 5 | use Moose::Role; 6 | 7 | has confirm => ( 8 | isa => 'Maybe[Str]', 9 | is => 'rw', 10 | required => 0, 11 | lazy => 1, 12 | default => undef, 13 | ); 14 | 15 | has errmsg_confirm => ( 16 | isa => 'Str', 17 | is => 'rw', 18 | required => 0, 19 | lazy => 1, 20 | default => sub { 21 | my $self = shift; 22 | return $self->human_name . 23 | ' must match ' . 24 | $self->_confirm_human_name 25 | }, 26 | ); 27 | 28 | sub _confirm_field { 29 | my ($self) = @_; 30 | 31 | return $self->form->get($self->confirm); 32 | } 33 | 34 | sub _confirm_human_name { 35 | my ($self) = @_; 36 | 37 | return $self->_confirm_field->human_name; 38 | } 39 | 40 | sub _confirm { 41 | my ($self) = @_; 42 | 43 | return unless $self->confirm; 44 | 45 | if ($self->value ne $self->_confirm_field->value) { 46 | $self->error($self->errmsg_confirm); 47 | } 48 | return $self; 49 | } 50 | 51 | after '_validate' => sub { return shift->_confirm }; 52 | 53 | 54 | 1; 55 | __END__ 56 | 57 | =head1 DESCRIPTION 58 | 59 | A confirmation comparison mix-in. Adds two fields plus action. 60 | Makes sure that the selected C field matches this one. 61 | 62 | =head1 ACCESSORS 63 | 64 | =head2 confirm => Str 65 | 66 | Name of the field whose value must match. 67 | Required, no default. 68 | 69 | =head2 errmsg_confirm => Str 70 | 71 | Allows you to provide a custom error message for when the fields do not match. 72 | Optional, Default = $human_name must match $confirm_human_name 73 | 74 | =cut 75 | -------------------------------------------------------------------------------- /lib/SparkX/Form/Field/MultiSelect.pm: -------------------------------------------------------------------------------- 1 | package SparkX::Form::Field::MultiSelect; 2 | 3 | # ABSTRACT: A multiple select drop-down field for SparkX::Form 4 | 5 | use Moose; 6 | use HTML::Tiny; 7 | use List::Util 'first'; 8 | 9 | extends 'Spark::Form::Field'; 10 | with 'Spark::Form::Field::Role::Printable::HTML', 11 | 'Spark::Form::Field::Role::Printable::XHTML'; 12 | 13 | has '+value' => ( 14 | isa => 'ArrayRef[Str]', 15 | ); 16 | 17 | has options => ( 18 | isa => 'ArrayRef', 19 | is => 'rw', 20 | required => 0, 21 | lazy => 1, 22 | default => sub { return shift->value }, 23 | ); 24 | 25 | sub to_html { 26 | return shift->_render(HTML::Tiny->new(mode => 'html')); 27 | } 28 | 29 | sub to_xhtml { 30 | return shift->_render(HTML::Tiny->new(mode => 'xml')); 31 | } 32 | 33 | sub _is_selected { 34 | my ($self, $value) = @_; 35 | 36 | return first { $value eq $_ } @{$self->value}; 37 | } 38 | 39 | sub _render_option { 40 | my ($self, $html, $option) = @_; 41 | return $html->option({ 42 | value => $option, 43 | ($self->_is_selected($option) ? (selected => 'selected') : ()), 44 | }); 45 | } 46 | 47 | sub _render { 48 | my ($self, $html) = @_; 49 | my @options = map { $self->_render_option($html, $_) } @{$self->options}; 50 | 51 | return $html->select( 52 | {name => $self->name, multiple => 'multiple'}, join q{ }, @options 53 | ); 54 | } 55 | __PACKAGE__->meta->make_immutable; 56 | 1; 57 | __END__ 58 | 59 | =head1 METHODS 60 | 61 | =head2 to_html() => Str 62 | 63 | Renders the field to HTML 64 | 65 | =head2 to_xhtml() => Str 66 | 67 | Renders the field to XHTML 68 | 69 | =head2 validate() => Bool 70 | 71 | Validates the field. Before composition with validators, always returns 1. 72 | 73 | =head1 SEE ALSO 74 | 75 | L - The forms module this is to be used with 76 | L - A collection of fields for use with C 77 | 78 | =cut 79 | -------------------------------------------------------------------------------- /lib/SparkX/Form/Field/Select.pm: -------------------------------------------------------------------------------- 1 | package SparkX::Form::Field::Select; 2 | 3 | # ABSTRACT: A select drop-down field for SparkX::Form 4 | 5 | use Moose; 6 | use HTML::Tiny; 7 | use Spark::Types qw(SCouplet); 8 | 9 | extends 'Spark::Form::Field'; 10 | with 'Spark::Form::Field::Role::Printable::HTML', 11 | 'Spark::Form::Field::Role::Printable::XHTML'; 12 | 13 | has '+value' => ( 14 | isa => 'Str', 15 | ); 16 | 17 | has options => ( 18 | isa => SCouplet, 19 | is => 'rw', 20 | coerce => 1, 21 | required => 0, 22 | lazy => 1, 23 | default => sub { return shift->value }, 24 | handles => { 25 | options_kv => 'key_values_paired', 26 | }, 27 | ); 28 | 29 | sub to_html { 30 | return shift->_render(HTML::Tiny->new(mode => 'html')); 31 | } 32 | 33 | sub to_xhtml { 34 | return shift->_render(HTML::Tiny->new(mode => 'xml')); 35 | } 36 | 37 | sub _render_element { 38 | my ($self, $html, $text, $value) = @_; 39 | return $html->option({ 40 | value => $value, 41 | (($self->value eq $value) ? (selected => 'selected') : ()), 42 | }, $text); 43 | } 44 | 45 | sub _render { 46 | my ($self, $html) = @_; 47 | my @options = map { 48 | $self->_render_element( 49 | $html, # HTML::Tiny, 50 | @{$_}, # Text, Value 51 | ) 52 | } $self->options_kv; 53 | return $html->select( 54 | {name => $self->name}, join q{ }, @options 55 | ); 56 | } 57 | __PACKAGE__->meta->make_immutable; 58 | 1; 59 | __END__ 60 | 61 | =head1 METHODS 62 | 63 | =head2 to_html() => Str 64 | 65 | Renders the field to HTML 66 | 67 | =head2 to_xhtml() => Str 68 | 69 | Renders the field to XHTML 70 | 71 | =head2 validate() => Bool 72 | 73 | Validates the field. Before composition with validators, always returns 1. 74 | 75 | =head1 SEE ALSO 76 | 77 | L - The forms module this is to be used with 78 | L - A collection of fields for use with C 79 | 80 | =cut 81 | -------------------------------------------------------------------------------- /t/28-compose.t: -------------------------------------------------------------------------------- 1 | # Something looking a bit more real-world 2 | use Test::More; 3 | plan tests => 12; 4 | 5 | use Spark::Form; 6 | 7 | #Local lib 8 | use lib 't/lib'; 9 | use TestApp::Form::Field::Email; 10 | use TestApp::Form::Field::Password; 11 | 12 | #Create a form 13 | my $form = Spark::Form->new; 14 | my $form2 = Spark::Form->new; 15 | my $email = TestApp::Form::Field::Email->new(name => 'email', form => $form); 16 | my $pass1 = TestApp::Form::Field::Password->new(name => 'password', form => $form2); 17 | my $pass2 = TestApp::Form::Field::Password->new(name => 'confirm_password', confirm => 'password', form => $form2); 18 | 19 | #Add an email 20 | $form->add($email); 21 | cmp_ok(scalar $form->fields, '==', 1, "Email field added"); 22 | 23 | #Add a password 24 | $form2->add($pass1); 25 | cmp_ok(scalar $form2->fields, '==', 1, "Password field added"); 26 | #And a confirm password 27 | $form2->add($pass2, confirm => 'password'); 28 | cmp_ok(scalar $form2->fields, '==', 2, "Password confirm field added"); 29 | 30 | #Clone and check field count 31 | $form3 = $form->compose($form2); 32 | 33 | #Check field counts 34 | cmp_ok(scalar $form->fields, '==', 1, "First form still has one field"); 35 | cmp_ok(scalar $form2->fields, '==', 2, "Second form still has two fields"); 36 | cmp_ok(scalar $form3->fields, '==', 3, "Check new field count"); 37 | 38 | #Validate form 1 39 | $form->data({email => 'blah'}); 40 | $form->validate; 41 | is(scalar $form->errors, 1, 'One error'); 42 | 43 | #Validate form 2 44 | $form2->data({password => 'password', confirm_password => 'foo'}); 45 | $form2->validate; 46 | is(scalar $form2->errors, 2, 'Two errors'); 47 | 48 | #Validate form 3 49 | $form3->data({email => 'blah', password => 'password', confirm_password => 'foo'}); 50 | $form3->validate; 51 | is(scalar $form3->errors, 3, 'Three error'); 52 | #Revalidate 53 | $form3->data({email => 'blah@blah.com', password => 'password', confirm_password => 'password'}); 54 | $form3->validate; 55 | is(scalar $form3->errors, 0, 'No errors'); 56 | #Revalidate first two forms 57 | $form->validate; 58 | is(scalar $form->errors, 1, 'Still one error'); 59 | $form2->validate; 60 | is(scalar $form2->errors, 2, 'Still two errors'); 61 | -------------------------------------------------------------------------------- /lib/SparkX/Form/Field/RadioGroup.pm: -------------------------------------------------------------------------------- 1 | package SparkX::Form::Field::RadioGroup; 2 | 3 | # ABSTRACT: A Radio group field for SparkX::Form 4 | 5 | use Moose; 6 | use HTML::Tiny; 7 | use Spark::Types qw(SCouplet); 8 | extends 'Spark::Form::Field'; 9 | with 'Spark::Form::Field::Role::Printable::HTML', 10 | 'Spark::Form::Field::Role::Printable::XHTML'; 11 | 12 | has '+value' => ( 13 | isa => 'Str', 14 | ); 15 | 16 | has options => ( 17 | isa => SCouplet, 18 | is => 'rw', 19 | coerce => 1, 20 | required => 0, 21 | lazy => 1, 22 | default => sub { return shift->value }, 23 | handles => { 24 | options_kv => 'key_values_paired', 25 | }, 26 | ); 27 | 28 | sub to_html { 29 | return shift->_render(HTML::Tiny->new(mode => 'html')); 30 | } 31 | 32 | sub to_xhtml { 33 | return shift->_render(HTML::Tiny->new(mode => 'xml')); 34 | } 35 | 36 | sub _render_element { 37 | my ($self, $html, $name, $value, $count) = @_; 38 | my $id = join('-' => ($self->name, $count)); 39 | my $label = $html->label({for => $id}, $name); 40 | my $input = $html->input({ 41 | type => 'radio', 42 | value => $value, 43 | id => $id, 44 | }); 45 | return join("\n" => ($label, $input)); 46 | } 47 | 48 | sub _render { 49 | my ($self, $html) = @_; 50 | my $count; # We use this to generate unique IDs for the labels 51 | my @options = map { 52 | $self->_render_element( 53 | $html, # HTML::Tiny 54 | @{$_}, # Key, Value strings 55 | ++$count, # Uniquifier 56 | ); 57 | } $self->options_kv; 58 | return join "\n",@options; 59 | } 60 | __PACKAGE__->meta->make_immutable; 61 | 1; 62 | __END__ 63 | 64 | =head1 ATTRIBUTES 65 | 66 | =head2 options => L 67 | 68 | Text => value pairs. Coerces from ArrayRef with regular list inside 69 | 70 | =head1 METHODS 71 | 72 | =head2 to_html() => Str 73 | 74 | Renders the field to HTML 75 | 76 | =head2 to_xhtml() => Str 77 | 78 | Renders the field to XHTML 79 | 80 | =head2 validate() => Bool 81 | 82 | Validates the field. Before composition with validators, always returns 1. 83 | 84 | =head1 SEE ALSO 85 | 86 | L - The forms module this is to be used with 87 | L - A collection of fields for use with C 88 | 89 | =cut 90 | -------------------------------------------------------------------------------- /t/03-form-register.t: -------------------------------------------------------------------------------- 1 | # Something looking a bit more real-world 2 | use Test::More; 3 | plan tests => 15; 4 | 5 | use Spark::Form; 6 | use Data::Dumper 'Dumper'; 7 | 8 | #Local lib 9 | use lib 't/lib'; 10 | use TestApp::Form::Field::Email; 11 | use TestApp::Form::Field::Password; 12 | 13 | #Create a form 14 | my $form = Spark::Form->new; 15 | 16 | my $email = TestApp::Form::Field::Email->new(name => 'email', form => $form); 17 | my $pass1 = TestApp::Form::Field::Password->new(name => 'password', form => $form); 18 | my $pass2 = TestApp::Form::Field::Password->new(name => 'confirm_password', confirm => 'password', form => $form); 19 | 20 | #First off, verify there are no fields in an empty form 21 | is_deeply([$form->fields], [], "Fields are not yet populated"); 22 | 23 | #Add an email 24 | $form->add($email); 25 | cmp_ok(scalar $form->fields, '==', 1, "Email field added"); 26 | 27 | #Validate 28 | $form->data({email => 'blah'}); 29 | $form->validate; 30 | 31 | is(scalar $form->errors, 1, 'One error'); 32 | 33 | #Revalidate 34 | $form->data({email => 'blah@blah.com'}); 35 | $form->validate; 36 | is(scalar $form->errors, 0, 'No error'); 37 | 38 | #Add a password 39 | $form->add($pass1); 40 | cmp_ok(scalar $form->fields, '==', 2, "Password field added"); 41 | 42 | #Validate 43 | $form->data({email => 'blah', password => 'foo'}); 44 | $form->validate; 45 | is(scalar $form->errors, 2, 'Two errors'); 46 | 47 | #Revalidate 48 | $form->data({email => 'blah@blah.com', password => 'password'}); 49 | $form->validate; 50 | is(scalar $form->errors, 0, 'No error'); 51 | 52 | #And a confirm password 53 | $form->add($pass2, confirm => 'password'); 54 | cmp_ok(scalar $form->fields, '==', 3, "Password confirm field added"); 55 | 56 | #Validate 57 | $form->data({email => 'blah', password => 'password', confirm_password => 'foo'}); 58 | $form->validate; 59 | is(scalar $form->errors, 3, 'Three errors'); 60 | 61 | #Revalidate 62 | $form->data({email => 'blah@blah.com', password => 'password', confirm_password => 'password'}); 63 | $form->validate; 64 | is(scalar $form->errors, 0, 'No error'); 65 | 66 | is($form->valid, 1, "Form is valid"); 67 | 68 | #Remove a field 69 | $form->remove('email'); 70 | cmp_ok(scalar $form->fields,'==',2,"Removed a field"); 71 | is_deeply([sort $form->keys],['confirm_password','password'],"Correct field removed"); 72 | is($form->get_at(0),$pass1,"Keys were renumbered appropriately 1"); 73 | is($form->get_at(1),$pass2,"Keys were renumbered appropriately 2"); 74 | -------------------------------------------------------------------------------- /t/27-partial_clone.t: -------------------------------------------------------------------------------- 1 | use Test::More; 2 | plan tests => 9; 3 | 4 | use Spark::Form; 5 | 6 | #Local lib 7 | use lib 't/lib'; 8 | use TestApp::Form::Field::Email; 9 | use TestApp::Form::Field::Password; 10 | 11 | #Create a form 12 | my $form = Spark::Form->new; 13 | 14 | my $email = TestApp::Form::Field::Email->new(name => 'email', form => $form); 15 | my $pass1 = TestApp::Form::Field::Password->new(name => 'password', form => $form); 16 | my $pass2 = TestApp::Form::Field::Password->new(name => 'confirm_password', confirm => 'password', form => $form); 17 | my $email2 = TestApp::Form::Field::Email->new(name => 'email2', form => $form); 18 | 19 | #Add fields and count them 20 | $form->add($email) 21 | ->add($pass1) 22 | ->add($pass2, confirm => 'password') 23 | ->add($email2); 24 | cmp_ok(scalar $form->fields, '==', 4, "Fields all added"); 25 | 26 | #Validate 27 | $form->data({email => 'blah', password => 'password', confirm_password => 'foo', email2 => 'feh'}); 28 | $form->validate; 29 | is(scalar $form->errors, 4, 'Four errors'); 30 | 31 | #Revalidate 32 | $form->data({email => 'blah@blah.com', password => 'password', confirm_password => 'password', email2 => 'blah@blah.com'}); 33 | $form->validate; 34 | is(scalar $form->errors, 0, 'No error'); 35 | 36 | my $form2 = $form->clone_except_names('email'); 37 | is_deeply([sort $form2->keys],[qw(confirm_password email2 password)],"Email field removed in clone"); 38 | 39 | my $form3 = $form->clone_only_names(qw(email email2)); 40 | is_deeply([sort $form3->keys],[qw(email email2)],"Two password fields removed in clone") || diag explain [[ $form3->keys], [$form->keys] ]; 41 | 42 | 43 | my $form4 = $form->clone_except_ids(1,2); 44 | is_deeply([sort $form4->keys],[qw(email email2)],"Two email fields remain alone in clone"); 45 | 46 | my $form5 = $form->clone_only_ids(1,2); 47 | is_deeply([sort $form5->keys],[qw(confirm_password password)],"Two password fields remain alone in clone") || diag explain [[ $form5->keys ], [$form->keys ]]; 48 | 49 | my $form6 = $form->clone_if(sub { 50 | $_[1] !~ /_/ 51 | }); 52 | is_deeply([sort $form6->keys],[qw(email email2 password)],"Two password fields remain alone in clone") || 53 | diag explain [[ $form6->keys ], [ $form->keys] ]; 54 | 55 | 56 | 57 | my $form7 = $form->clone_unless(sub { 58 | $_[1] =~ /2$/ 59 | }); 60 | is_deeply([sort $form7->keys],[qw(confirm_password email password)],"Two password fields remain alone in clone"); 61 | 62 | 63 | #clone_if 64 | 65 | #clone_unless 66 | -------------------------------------------------------------------------------- /lib/Spark/Form/Field.pm: -------------------------------------------------------------------------------- 1 | package Spark::Form::Field; 2 | 3 | # ABSTRACT: Superclass for all Form Fields 4 | 5 | use Moose; 6 | use MooseX::LazyRequire; 7 | 8 | with qw(MooseX::Clone); 9 | 10 | has name => ( 11 | isa => 'Str', 12 | is => 'ro', 13 | required => 1, 14 | ); 15 | 16 | has form => ( 17 | isa => 'Spark::Form', 18 | is => 'rw', 19 | lazy_required => 1, 20 | weak_ref => 1, #De-circular-ref 21 | traits => [qw(NoClone)], #Argh, what will it be set to? 22 | ); 23 | 24 | has value => ( 25 | is => 'rw', 26 | required => 0, 27 | ); 28 | 29 | has valid => ( 30 | isa => 'Bool', 31 | is => 'rw', 32 | required => 0, 33 | default => 0, 34 | ); 35 | 36 | has _errors => ( 37 | traits => ['Array'], 38 | isa => 'ArrayRef[Str]', 39 | is => 'ro', 40 | required => 0, 41 | default => sub { [] }, 42 | handles => { 43 | '_add_error' => 'push', 44 | 'errors' => 'elements', 45 | '_clear_errors' => 'clear', 46 | }, 47 | ); 48 | 49 | sub error { 50 | my ($self, $error) = @_; 51 | 52 | $self->valid(0); 53 | $self->_add_error($error); 54 | 55 | return $self; 56 | } 57 | 58 | sub human_name { 59 | my ($self) = @_; 60 | 61 | if ($self->can('label')) { 62 | return $self->label if $self->label; 63 | } 64 | if ($self->can('name')) { 65 | return $self->name if $self->name; 66 | } 67 | return q(); 68 | } 69 | 70 | sub validate { 71 | my ($self) = @_; 72 | $self->_clear_errors; 73 | $self->valid(1); 74 | 75 | #Set a default of the empty string, suppresses a warning 76 | $self->value($self->value || q()); 77 | $self->_validate; 78 | # This for moose roles interaction 79 | return $self->valid; 80 | } 81 | 82 | sub _validate { return 1 } 83 | 84 | __PACKAGE__->meta->make_immutable; 85 | 1; 86 | __END__ 87 | 88 | =head1 DESCRIPTION 89 | 90 | Field superclass. Must subclass this to be considered a field. 91 | 92 | =head1 SYNOPSIS 93 | 94 | package My::Field; 95 | use Moose; 96 | require Spark::Form::Field; 97 | extends 'Spark::Form::Field'; 98 | with 'Spark::Form::Field::Role::Validateable'; 99 | with 'Spark::Form::Field::Role::Printable::XHTML'; 100 | 101 | sub _validate { 102 | my $self = shift; 103 | 104 | #validate existence of data 105 | if ($self->value) { 106 | #If we're valid, we should say so 107 | $self->valid(1); 108 | } else { 109 | #error will call $self->valid(0) and also set an error. 110 | $self->error('no value') 111 | } 112 | 113 | #And we should return boolean validity 114 | $self->valid 115 | } 116 | 117 | sub to_xhtml { 118 | #Rather poorly construct an XHTML tag 119 | ''; 120 | } 121 | 122 | Note that you might want to look into HTML::Tiny. 123 | Or better still, L. 124 | 125 | There are a bunch of pre-built fields you can actually use in 126 | L. 127 | 128 | =head1 ACCESSORS 129 | 130 | =head2 name => Str 131 | 132 | Name of the field in the data source. Will be slurped on demand. 133 | Required at validation time, not at construction time. 134 | 135 | =head2 form => Spark::Form 136 | 137 | Reference to the form it is a member of. 138 | 139 | =head2 value => Any 140 | 141 | Value in the field. 142 | 143 | =head2 valid => Bool 144 | 145 | Treat as read-only. Whether the field is valid. 146 | 147 | =head2 errors => ArrayRef 148 | 149 | Treat as read-only. The list of errors generated in validation. 150 | 151 | =head1 METHODS 152 | 153 | =head2 human_name 154 | 155 | Returns the label if present, else the field name. 156 | 157 | =head2 validate 158 | 159 | Returns true always. Subclass and fill in C<_validate> to do proper validation. See the synopsis. 160 | 161 | =head2 error (Str) 162 | 163 | Adds an error to the current field's list. 164 | 165 | =head1 SEE ALSO 166 | 167 | L - Fields that can be printed 168 | L - Set of validators to use creating fields 169 | L - Ready to use fields 170 | =cut 171 | -------------------------------------------------------------------------------- /lib/Spark/Form.pm: -------------------------------------------------------------------------------- 1 | package Spark::Form; 2 | 3 | # ABSTRACT: A simple yet powerful forms validation system that promotes reuse. 4 | 5 | use Moose; 6 | use List::MoreUtils 'all'; 7 | use Spark::Couplet (); 8 | use Carp (); 9 | use Scalar::Util qw( blessed ); 10 | 11 | with qw(MooseX::Clone); 12 | 13 | has _fields => ( 14 | isa => 'Spark::Couplet', 15 | is => 'ro', 16 | required => 0, 17 | default => sub { Spark::Couplet->new }, 18 | traits => [qw(Clone)], 19 | ); 20 | 21 | has plugin_ns => ( 22 | isa => 'Str', 23 | is => 'ro', 24 | required => 0, 25 | ); 26 | 27 | has _errors => ( 28 | traits => ['Array'], 29 | isa => 'ArrayRef', 30 | is => 'ro', 31 | required => 0, 32 | default => sub { [] }, 33 | handles => { 34 | '_add_error' => 'push', 35 | 'errors' => 'elements', 36 | '_clear_errors' => 'clear', 37 | }, 38 | ); 39 | 40 | has valid => ( 41 | isa => 'Bool', 42 | is => 'rw', 43 | required => 0, 44 | default => 0, 45 | ); 46 | 47 | has '_printer' => ( 48 | isa => 'Maybe[Str]', 49 | required => 0, 50 | is => 'ro', 51 | init_arg => 'printer', 52 | ); 53 | 54 | sub BUILD { 55 | my ($self) = @_; 56 | my @search_path = ( 57 | 58 | #This will load anything from SparkX::Form::Field 59 | 'SparkX::Form::Field', 60 | ); 61 | if ($self->plugin_ns) { 62 | unshift @search_path, ($self->plugin_ns); 63 | } 64 | 65 | require Module::Pluggable; 66 | eval { 67 | Module::Pluggable->import( 68 | search_path => \@search_path, 69 | sub_name => 'field_mods', 70 | required => 1, 71 | ); 72 | } or Carp::croak("Spark::Form: Could not instantiate Module::Pluggable, $@"); 73 | 74 | if (defined $self->_printer) { 75 | 76 | my $printer = $self->_printer; 77 | 78 | eval { 79 | 80 | #Load the module, else short circuit. 81 | #There were strange antics with qq{} and this is tidier than the alternative 82 | eval "require $printer; 1" or Carp::croak("Require of $printer failed, $@"); 83 | 84 | #Apply the role (failure will short circuit). Return 1 so the 'or' won't trigger 85 | $self->_printer->meta->apply($self); 86 | 87 | 1 88 | } or Carp::croak("Could not apply printer $printer, $@"); 89 | } 90 | return; 91 | } 92 | 93 | sub _error { 94 | my ($self, $error) = @_; 95 | 96 | $self->valid(0); 97 | $self->_add_error($error); 98 | 99 | return $self; 100 | } 101 | 102 | sub field_couplet { 103 | my ($self) = @_; 104 | return $self->_fields; 105 | } 106 | 107 | sub add { 108 | my ($self, $item, @args) = @_; 109 | 110 | #Dispatch to the appropriate handler sub 111 | 112 | #1. Regular String. Should have a name and any optional args 113 | unless (ref $item) { 114 | Carp::croak('->add expects [Scalar, List where { items > 0 }] or [Ref].') unless (scalar @args); 115 | $self->_add_by_type($item, @args); 116 | return $self; 117 | } 118 | 119 | #2. Array - loop. This will spectacularly fall over if you are using string-based creation as there's no way to pass multiple names yet 120 | if (ref $item eq 'ARRAY') { 121 | $self->add($_, @args) for @{$item}; 122 | return $self; 123 | } 124 | 125 | #3. Custom field. Just takes any optional args 126 | if ($self->_valid_custom_field($item)) { 127 | $self->_add_custom_field($item, @args); 128 | return $self; 129 | } 130 | 131 | #Unknown thing 132 | Carp::croak(q(Spark::Form: Don\'t know what to do with a ) . ref $item . q(/) . (blessed $item|| q())); 133 | } 134 | 135 | sub get { 136 | my ($self, $key) = @_; 137 | return $self->_fields->value($key); 138 | } 139 | 140 | sub get_at { 141 | my ($self, $index) = @_; 142 | return $self->_fields->value_at($index); 143 | } 144 | 145 | sub keys { 146 | my ($self) = @_; 147 | return $self->_fields->keys(); 148 | } 149 | 150 | sub fields { 151 | my ($self) = @_; 152 | return $self->_fields->values; 153 | } 154 | 155 | sub remove { 156 | my ($self, @keys) = @_; 157 | $self->_fields->unset_key(@keys); 158 | 159 | return $self; 160 | } 161 | 162 | sub remove_at { 163 | my ($self, @indices) = @_; 164 | $self->_fields->unset_at(@indices); 165 | 166 | return $self; 167 | } 168 | 169 | sub validate { 170 | my ($self) = @_; 171 | 172 | #Clear out 173 | $self->valid(1); 174 | $self->_clear_errors(); 175 | foreach my $field ($self->fields) { 176 | $field->validate; 177 | unless ($field->valid) { 178 | $self->_error($_) foreach $field->errors; 179 | } 180 | } 181 | return $self->valid; 182 | } 183 | 184 | sub data { 185 | my ($self, $fields) = @_; 186 | while (my ($k, $v) = each %{$fields}) { 187 | if ($self->_fields->value($k)) { 188 | $self->_fields->value($k)->value($v); 189 | } 190 | } 191 | 192 | return $self; 193 | } 194 | 195 | sub _valid_custom_field { 196 | my ($self, $thing) = @_; 197 | return eval { 198 | $thing->isa('Spark::Form::Field') 199 | } or 0; 200 | } 201 | 202 | sub _add_custom_field { 203 | my ($self, $item, %opts) = @_; 204 | 205 | #And add it. 206 | $self->_add($item, $item->name, %opts); 207 | 208 | return $self; 209 | } 210 | 211 | sub _add_by_type { 212 | my ($self, $type, $name, %opts) = @_; 213 | 214 | #Default name is type itself 215 | $name ||= $type; 216 | 217 | #Create and add it 218 | $self->_add($self->_create_type($type, $name, %opts), $name); 219 | 220 | return $self; 221 | } 222 | 223 | sub _add { 224 | my ($self, $field, $name) = @_; 225 | 226 | Carp::carp("Field name $name exists in form.") if $self->_fields->value($name); 227 | 228 | #Add it onto the ArrayRef 229 | $self->_fields->set($name, $field); 230 | 231 | return 1; 232 | } 233 | 234 | sub _mangle_modname { 235 | my ($self, $mod) = @_; 236 | 237 | #Strip one or the other. This is the cleanest way. 238 | #It also doesn't matter that class may be null 239 | my @namespaces = ( 240 | 'SparkX::Form::Field', 241 | 'Spark::Form::Field', 242 | ); 243 | 244 | push @namespaces, $self->plugin_ns if $self->plugin_ns; 245 | 246 | foreach my $ns (@namespaces) { 247 | last if $mod =~ s/^${ns}:://; 248 | } 249 | 250 | #Regulate. 251 | $mod =~ s/::/-/g; 252 | $mod = lc $mod; 253 | 254 | return $mod; 255 | } 256 | 257 | sub _find_matching_mod { 258 | my ($self, $wanted) = @_; 259 | 260 | #Just try and find something that, when mangled, eq $wanted 261 | foreach my $mod ($self->field_mods) { 262 | return $mod if $self->_mangle_modname($mod) eq $wanted; 263 | } 264 | 265 | #Cannot find 266 | return 0; 267 | } 268 | 269 | sub _create_type { 270 | my ($self, $type, $name, %opts) = @_; 271 | my $mod = $self->_find_matching_mod($type) or Carp::croak("Could not find field mod: $type"); 272 | eval qq{ use $mod; 1 } or Carp::croak("Could not load $mod, $@"); 273 | 274 | return $mod->new(name => $name, form => $self, %opts); 275 | } 276 | 277 | sub clone_all { 278 | my ($self) = @_; 279 | my $new = $self->clone; 280 | $_->form($self) foreach $new->fields; 281 | 282 | return $new; 283 | } 284 | 285 | sub clone_except_names { 286 | my ($self, @fields) = @_; 287 | my $new = $self->clone_all; 288 | $new->remove($_) foreach @fields; 289 | 290 | return $new; 291 | } 292 | 293 | # 294 | # ->_except( \@superset , \@things_to_get_rid_of ) 295 | # 296 | 297 | sub _except { 298 | my ($self, $input_list, $exclusion_list) = @_; 299 | my %d; 300 | @d{@{$exclusion_list}} = (); 301 | 302 | return grep { 303 | !exists $d{$_} 304 | } @{$input_list}; 305 | } 306 | 307 | sub clone_only_names { 308 | my ($self, @fields) = @_; 309 | my @all = $self->keys; 310 | my @excepted = $self->_except(\@all, \@fields); 311 | return $self->clone_except_names(@excepted); 312 | } 313 | 314 | sub clone_except_ids { 315 | my ($self, @ids) = @_; 316 | my $new = $self->clone_all; 317 | $new->remove_at(@ids); 318 | 319 | return $new; 320 | } 321 | 322 | sub clone_only_ids { 323 | my ($self, @ids) = @_; 324 | my @all = 0 .. $self->_fields->last_index; 325 | 326 | return $self->clone_except_ids($self->_except(\@all, \@ids)); 327 | } 328 | 329 | sub clone_if { 330 | my ($self, $sub) = @_; 331 | my (@all) = ($self->_fields->key_values_paired); 332 | my $i = 0 - 1; 333 | 334 | # Filter out items that match 335 | # coderef->( $current_index, $key, $value ); 336 | @all = grep { 337 | $i++; 338 | !$sub->($i, @{$_}); 339 | } @all; 340 | 341 | return $self->clone_except_names(map { $_->[0] } @all); 342 | } 343 | 344 | sub clone_unless { 345 | my ($self, $sub) = @_; 346 | my (@all) = $self->_fields->key_values_paired; 347 | my $i = 0 - 1; 348 | 349 | # Filter out items that match 350 | # coderef->( $current_index, $key, $value ); 351 | 352 | @all = grep { 353 | $i++; 354 | $sub->($i, @{$_}); 355 | } @all; 356 | return $self->clone_except_names(map { $_->[0] } @all); 357 | } 358 | 359 | sub compose { 360 | my ($self, $other) = @_; 361 | my $new = $self->clone_all; 362 | my $other_new = $other->clone_all; 363 | foreach my $key ($other_new->keys) { 364 | 365 | $new->add($other_new->get($key)); 366 | } 367 | return $new; 368 | } 369 | 370 | __PACKAGE__->meta->make_immutable; 371 | 372 | 1; 373 | 374 | __END__ 375 | 376 | =head1 SYNOPSIS 377 | 378 | use Spark::Form; 379 | use CGI; #Because it makes for a quick and oversimplistic example 380 | use Third::Party::Field; 381 | $form = Spark::Form->new(plugin_ns => 'MyApp::Field'); 382 | # Add a couple of inbuilt modules 383 | $form->add('email','email',confirm_field => 'email-confirm') 384 | ->add('email','email-confirm') 385 | ->add('password','password',regex => qr/^\S{6,}$/), 386 | #This one will be autoloaded from MyApp::Field::Username 387 | ->add('username','username') 388 | # And this shows how you can use a third party field of any class name 389 | ->add(Third::Party::Field->new(name => 'blah')); 390 | #Pass in a HashRef of params to populate the virtual form with data 391 | $form->data(CGI->new->params); 392 | #And do the actual validation 393 | if ($form->validate) { 394 | print "You are now registered"; 395 | } else { 396 | print join "\n", $form->errors; 397 | } 398 | 399 | and over in MyApp/Field/Username.pm... 400 | 401 | package MyApp::Form::Field::Username; 402 | use base Spark::Form::Field; 403 | 404 | sub _validate { 405 | 406 | my ($self,$v) = @_; 407 | 408 | if (length $v < 6 or length $v > 12) { 409 | $self->error("Usernames must be 6-12 characters long"); 410 | } elsif ($v =~ /[^a-zA-Z0-9_-]/) { 411 | $self->error("Usernames may contain only a-z,A-Z,0-9, _ and -"); 412 | } else { 413 | $self->error(undef); 414 | } 415 | $self->valid(!!$self->error()); 416 | } 417 | 418 | =head1 INSTABILITY 419 | 420 | Periodically the API may break. I'll try to make sure it's obvious so it doesn't silently malfunction. 421 | 422 | By 0.5, we shouldn't have to do this. 423 | 424 | =head1 DEPENDENCIES 425 | 426 | Moose. I've dropped using Any::Moose. If you need the performance increase, perhaps it's time to start thinking about shifting off CGI. 427 | 428 | =head1 METHODS 429 | 430 | =head2 import (%options) 431 | 432 | Allows you to set some options for the forms class. 433 | 434 | =over 4 435 | 436 | =item class => String 437 | 438 | Optional, gives the basename for searching for form plugins. 439 | 440 | Given 'MyApp', it will try to load form plugins from MyApp::Form::Field::* 441 | 442 | =item source => String 443 | 444 | Optional, names a plugin to try and extract form data from. 445 | 446 | If unspecified, you will need to call $form->data(\%data); 447 | 448 | =back 449 | 450 | =head2 add ($thing,@rest) 451 | 452 | If $thing is a string, attempts to instantiate a plugin of that type and add it 453 | to the form. Requires the second argument to be a string name for the field to identify it in the form. Rest will become %kwargs 454 | If it is an ArrayRef, it loops over the contents (Useful for custom fields, will probably result in bugs for string field names).@rest will be passed in each iteration. 455 | If it looks sufficiently like a field (implements Spark::Form::Field), 456 | then it will add it to the list of fields. @rest will just become %kwargs 457 | 458 | Uses 'field name' to locate it from the data passed in. 459 | 460 | This is a B, it returns the form itself. 461 | 462 | =head2 validate 463 | 464 | Validates the form. Sets C and then also returns the value. 465 | 466 | =head2 data 467 | 468 | Allows you to pass in a HashRef of data to populate the fields with before validation. Useful if you don't use a plugin to automatically populate the data. 469 | 470 | This is a B, it returns the form itself. 471 | 472 | =head2 fields () => Fields 473 | 474 | Returns a list of Fields in the form in their current order 475 | 476 | =head2 BUILD 477 | 478 | Moose constructor. Test::Pod::Coverage made me do it. 479 | Adds C to the search path for field modules. 480 | 481 | =head2 get (Str) 482 | 483 | Returns the form field of that name 484 | 485 | =head2 get_at (Int) 486 | 487 | Returns the form field at that index (counting from 0) 488 | 489 | =head2 keys () :: Array 490 | 491 | Returns the field names 492 | 493 | =head2 field_couplet () :: Data::Couplet 494 | 495 | Returns the Data::Couplet used to store the fields. Try not to use this too much. 496 | 497 | =head2 remove (Array[Str]) :: Spark::Form 498 | 499 | Removes the field(s) bearing the given name(s) from the form object. Silently no-ops any that do not exist. 500 | 501 | =head2 remove_at (Array[Int]) :: Spark::Form 502 | 503 | Removes the field at the given ID(s) from the form object. Silently no-ops any that do not exist. 504 | 505 | WARNING: Things will get re-ordered when you do this. If you have a form with 506 | IDs 0..3 and you remove (1, 3), then (0, 2) will remain but they will now be 507 | (0, 1) as L will move them to keep a consistent array. 508 | 509 | =head2 clone_all () :: Spark::Form 510 | 511 | Returns a new copy of the form with freshly instantiated fields. 512 | 513 | =head2 clone_except_names (Array[Str]) :: Spark::Form 514 | 515 | Clones, removing the fields with the specified names. 516 | 517 | =head2 clone_only_names (Array[Str]) :: Spark::Form 518 | 519 | Clones, removing the fields without the specified names. 520 | 521 | =head2 clone_except_ids (Array[Int]) :: Spark::Form 522 | 523 | Clones, removing the fields with the specified IDs. 524 | 525 | =head2 clone_only_ids (Array[Int]) :: Spark::Form 526 | 527 | Clones, removing the fields without the specified IDs. 528 | 529 | =head2 clone_if (SubRef[(Int, Str, Any) -> Bool]) :: Spark::Form 530 | 531 | Clones, removing items for which the sub returns false. Sub is passed (Id, Key, Value). 532 | 533 | =head2 clone_unless (SubRef[(Int, Str, Any) -> Bool]) :: Spark::Form 534 | 535 | Clones, removing items for which the sub returns true. Sub is passed (Id, Key, Value). 536 | 537 | =head2 compose (Spark::Form) :: Spark::Form 538 | 539 | Clones the current form object and copies fields from the supplied other form to the end of that form. 540 | Where names clash, items on the current form take priority. 541 | 542 | =head1 Docs? 543 | 544 | L 545 | 546 | =head2 Source? 547 | 548 | L 549 | 550 | =head1 THANKS 551 | 552 | Thanks to the Django Project, whose forms module gave some inspiration. 553 | 554 | =head1 SEE ALSO 555 | 556 | The FAQ: L 557 | L used to hold the fields (see C) 558 | 559 | =cut 560 | --------------------------------------------------------------------------------