HTML-Widget-1.11/0000755000076400007640000000000010571575434013606 5ustar cafrankscafranksHTML-Widget-1.11/Makefile.PL0000644000076400007640000000077110571575043015561 0ustar cafrankscafranksuse inc::Module::Install; name 'HTML-Widget'; all_from 'lib/HTML/Widget.pm'; requires 'perl' => '5.8.1'; requires 'HTML::Element' => '3.22'; requires 'Class::Accessor::Fast'; requires 'Class::Accessor::Chained::Fast'; requires 'Class::Data::Accessor'; requires 'HTML::Scrubber'; requires 'Storable'; requires 'Module::Pluggable::Fast'; requires 'Email::Valid'; requires 'Date::Calc'; requires 'Scalar::Util'; build_requires 'Test::NoWarnings'; no_index directory => 't/lib'; auto_install; &WriteAll; HTML-Widget-1.11/README0000644000076400007640000000006510571572143014461 0ustar cafrankscafranksHTML::Widget - HTML Widget And Validation Framework! HTML-Widget-1.11/META.yml0000644000076400007640000000104510571575337015061 0ustar cafrankscafranksabstract: HTML Widget And Validation Framework author: Sebastian Riedel, C build_requires: Test::NoWarnings: 0 distribution_type: module generated_by: Module::Install version 0.64 license: perl name: HTML-Widget no_index: directory: - t/lib - inc - t requires: Class::Accessor::Chained::Fast: 0 Class::Accessor::Fast: 0 Class::Data::Accessor: 0 Date::Calc: 0 Email::Valid: 0 HTML::Element: 3.22 HTML::Scrubber: 0 Module::Pluggable::Fast: 0 Scalar::Util: 0 Storable: 0 perl: 5.8.1 version: 1.11 HTML-Widget-1.11/t/0000755000076400007640000000000010571575434014051 5ustar cafrankscafranksHTML-Widget-1.11/t/filter_custom_namespace.pm0000644000076400007640000000063310571572142021275 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 1; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo' ); $w->filter( '+HTMLWidget::CustomFilter', 'foo' ); # With mocked basic query { my $query = HTMLWidget::TestLib->mock_query( {foo => 'Foo'} ); my $f = $w->process($query); is( $f->param('foo', 'foo', 'foo value' ); } HTML-Widget-1.11/t/result_add_error.t0000644000076400007640000000260210571572142017566 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 5; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo' )->value('foo'); # Without query { my $f = $w->process; is( "$f", <
EOF } # With mocked basic query { my $query = HTMLWidget::TestLib->mock_query( { foo => 'yada' } ); my $result = $w->process($query); is( "$result", <
EOF $result->add_error( { name => 'foo', message => 'bad foo', } ); ok( $result->has_errors('foo') ); ok( !$result->valid('foo') ); is( "$result", <
bad foo
EOF } HTML-Widget-1.11/t/constraint_email.t0000644000076400007640000000226010571572142017562 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 8; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo' ); $w->constraint( 'Email', 'foo' ); # Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => 'sri@oook.de' } ); my $f = $w->process($query); is( $f->param('foo'), 'sri@oook.de', 'foo value' ); ok( !$f->errors, 'no errors' ); } # Invalid { my $query = HTMLWidget::TestLib->mock_query( { foo => 'invalid' } ); my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errors' ); } # Multiple Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => [ 'sri@oook.de', 'sri@oook.de' ], } ); my $f = $w->process($query); is( $f->valid('foo'), 1, "Valid" ); my @results = $f->param('foo'); is( $results[0], 'sri@oook.de', "Multiple valid values" ); is( $results[1], 'sri@oook.de', "Multiple valid values" ); ok( !$f->errors, 'no errors' ); } # Multiple Invalid { my $query = HTMLWidget::TestLib->mock_query( { foo => [ 'yada', 'bar' ], } ); my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errors' ); } HTML-Widget-1.11/t/07custom_render.t0000644000076400007640000002370610571572142017257 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 46; use HTML::Widget; use lib qw(t/lib); use HTMLWidget::TestLib; my $w = HTML::Widget->new->method('post')->action('/foo/bar'); $w->element( 'Textfield', 'age' )->label('Age')->size(3); $w->element( 'Textfield', 'name' )->label('Name')->size(60); $w->element( 'Submit', 'ok' )->value('OK'); $w->constraint( 'Integer', 'age' )->message('No integer.'); $w->constraint( 'Length', 'age' )->min(1)->max(3)->message('Wrong length.'); $w->constraint( 'Range', 'age' )->min(22)->max(24)->message('Wrong range.'); $w->constraint( 'Regex', 'age' )->regex(qr/\D+/) ->message('Contains digit characters.'); $w->constraint( 'Not_Integer', 'name' ); $w->constraint( 'All', 'age', 'name' )->message('Missing value.'); { my ($e) = $w->get_elements( name => 'age' ); ok( $e, 'Found element with name of "age"' ); isa_ok( $e, 'HTML::Widget::Element' ); ok( $e->container_class, 'Can read container class for individual object' ); is( $e->container_class, 'HTML::Widget::Container', 'Default container class is right' ); HTML::Widget::Element->container_class('Class1'); is( $e->container_class, 'Class1', 'Object instance inherits super container class value' ); HTML::Widget::Element::Textfield->container_class('Class2'); is( $e->container_class, 'Class2', 'Object instance inherits container class value' ); $e->container_class('Class3'); is( $e->container_class, 'Class3', 'Object instance container class value' ); $e->container_class(undef); HTML::Widget::Element::Textfield->container_class(''); isa_ok( $e->containerize($w), 'HTML::Widget::Container', 'Container isa Container when class set to empty string' ); # Reset test classes back, and use TestContainer for all elements delete $e->{container_class}; HTML::Widget::Element->container_class('TestContainer'); HTML::Widget::Element::Textfield->container_class('TestContainer'); } # Without query { my $f = $w->result; is( $f->as_xml, <


EOF } # With mocked basic query { my $query = HTMLWidget::TestLib->mock_query( { age => 23, name => 'sri', ok => 'OK', } ); my $f = $w->process($query); isa_ok( $f, 'HTML::Widget::Result', 'Result is HTML::Widget::Result object' ); my @e = $f->has_errors; ok( $f->valid('name'), 'Field name is valid' ); is( $e[0], 'age', 'Field age has errors' ); is( $f->valid('name'), 1, 'Field name is valid' ); is( !$f->valid('age'), 1, 'Field age is not valid' ); is( !$f->valid('foo'), 1, 'Field foo is not valid' ); is( !$f->has_errors('name'), 1, 'Field name has no errors' ); is( $f->has_errors('age'), 1, 'Field foo has errors' ); is( $f->has_error('foo'), 0, 'Field foo has no errors' ); is( $f->param('name'), 'sri', 'Param name is accessible' ); is( $f->param('age'), undef, 'Param age is not accessible' ); is( $f->param('foo'), undef, 'Param foo is not defined' ); is( $f->params->{name}, 'sri', 'Param name is defined' ); is( $f->params->{age}, undef, 'Param age is not defined' ); is( $f->parameters->{foo}, undef, 'Param foo is not defined' ); $f->add_valid( 'bar', 'dude' ); is( $f->params->{bar}, 'dude', 'Bar is dude' ); is( $f->param('bar'), 'dude', 'Bar is dude' ); is( $f->valid('bar'), 1, 'Bar is valid' ); my $c = $f->element('ok'); is( $c->label, undef, 'Label is empty' ); $c = $f->element('age'); isa_ok( $c, 'HTML::Widget::Container', 'Element is a (base) container object' ); isa_ok( $c, 'TestContainer', 'Element is also an overridden container object' ); isa_ok( $c->element, 'HTML::Element', 'Element is a HTML::Element object' ); isa_ok( $c->error, 'HTML::Element', 'Error is a HTML::Element object' ); isa_ok( $c->label, 'HTML::Element', 'Label is a HTML::Element object' ); is( $c->javascript, '', 'JavaScript is empty' ); is( $c->element_xml, <Age
EOF is( $c->error_xml, <Contains digit characters. EOF is( $c->javascript_xml, < EOF is( $c->as_xml, <Age
Contains digit characters. EOF my @errors = $f->errors; is( $errors[0]->name, 'age', 'Expected error' ); is( $errors[0], 'Contains digit characters.', 'Field contains digit characters' ); is( "$f", <

Contains digit characters.
EOF } # Embed { my $w2 = HTML::Widget->new('foo')->action('/foo'); my $w3 = HTML::Widget->new('bar'); $w3->element( 'Textfield', 'baz' ); $w2->embed($w); $w2->embed($w3); my $f = $w2->process; is( $f->as_xml, <


EOF } # Merge { my $w2 = HTML::Widget->new('foo')->action('/foo'); my $w3 = HTML::Widget->new('bar'); $w3->element( 'Textfield', 'baz' ); $w2->merge($w); $w2->merge($w3); my $f = $w2->process; is( $f->as_xml, <


EOF } # Test $w->element_container_class { my $w2 = HTML::Widget->new('foo')->action('/foo'); $w2->merge($w); HTML::Widget::Element->container_class(undef); HTML::Widget::Element::Textfield->container_class(undef); my $f = $w2->process; is( $f->as_xml, <element_container_class' );
EOF $w2->element_container_class('TestContainer'); $f = $w2->process; is( $f->as_xml, <element_container_class changes output for that widget' );


EOF $f = $w->name('foo')->action('/foo')->process; is( $f->as_xml, <element_container_class doesnt change output for $w->process' );
EOF } HTML-Widget-1.11/t/filter_trimedges.t0000644000076400007640000000105510571572142017560 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 2; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo' ); $w->element( 'Textfield', 'bar' ); $w->filter( 'TrimEdges', 'foo' ); # With mocked basic query { my $query = HTMLWidget::TestLib->mock_query( { foo => ' foo bar baz ', bar => ' 2 3 ', } ); my $f = $w->process($query); is( $f->param('foo'), 'foo bar baz', 'foo value', ); is( $f->param('bar'), ' 2 3 ', 'bar value' ); } HTML-Widget-1.11/t/element_radiogroup_constrain_values.t0000644000076400007640000000377410571572142023565 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 7; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'RadioGroup', 'foo' )->values( [ 0, 1, 2 ] )->constrain_values(1); $w->element( 'RadioGroup', 'bar' )->values( [ 3, 4 ] )->constrain_values(1); # With mocked basic query { my $query = HTMLWidget::TestLib->mock_query( { foo => 1, bar => 1 } ); my $f = $w->process($query); my @constraints = $w->get_constraints; cmp_ok( scalar(@constraints), '==', 2, 'Two implicit IN constraints' ); cmp_ok( scalar( @{ $constraints[0]->in } ), '==', 3, 'Three keys for constraint 0' ); cmp_ok( scalar( @{ $constraints[1]->in } ), '==', 2, 'Two keys for constraint 1' ); ok( $f->valid('foo') ); ok( !$f->valid('bar') ); ok( $f->has_errors('bar') ); is( "$f", <
Invalid Input
EOF } HTML-Widget-1.11/t/03podcoverage.t0000644000076400007640000000036010571572142016667 0ustar cafrankscafranksuse strict; use warnings; use Test::More; eval "use Test::Pod::Coverage 1.04"; plan skip_all => 'Test::Pod::Coverage 1.04 required' if $@; plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD}; all_pod_coverage_ok(); HTML-Widget-1.11/t/06bugs_name_regex_chars.t0000644000076400007640000000054710571572142020715 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 1; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo[bar]' ); { my $query = HTMLWidget::TestLib->mock_query( { 'foo[bar]' => 'bam' } ); my $f = $w->process($query); is( $f->param('foo[bar]'), 'bam', 'foo[bar] valid' ); } HTML-Widget-1.11/t/06bugs_constraint_range_zero_min.t0000644000076400007640000000115110571572142022655 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 4; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo' ); $w->constraint( 'Range', 'foo' )->min(0)->max(4); # Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => 0 } ); my $f = $w->process($query); ok( $f->valid('foo'), 'foo valid' ); ok( !$f->errors, 'no errors' ); } # Invalid { my $query = HTMLWidget::TestLib->mock_query( { foo => -1 } ); my $f = $w->process($query); ok( !$f->valid('foo'), 'foo not valid' ); ok( $f->errors, 'errors' ); } HTML-Widget-1.11/t/06bugs_in_value_empty.t0000644000076400007640000000104410571572142020434 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 3; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo' ); $w->constraint( 'In', 'foo' )->in('bar'); { my $query = HTMLWidget::TestLib->mock_query( { foo => '' } ); my $f = $w->process($query); ok( $f->valid('foo'), 'foo is valid' ); ok( !$f->has_errors, 'no errors' ); } { my $query = HTMLWidget::TestLib->mock_query( {} ); my $f = $w->process($query); ok( !$f->has_errors, 'no errors' ); } HTML-Widget-1.11/t/constraint_datetime.t0000644000076400007640000000321010571572142020263 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 13; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Textfield', 'year' ); $w->element( 'Textfield', 'month' ); $w->element( 'Textfield', 'day' ); $w->element( 'Textfield', 'hour' ); $w->element( 'Textfield', 'month' ); $w->element( 'Textfield', 'second' ); $w->constraint( 'DateTime', 'year', 'month', 'day', 'hour', 'minute', 'second' ); # Valid { my $query = HTMLWidget::TestLib->mock_query( { year => '2005', month => '12', day => '9', hour => '10', minute => '25', second => '13' } ); my $f = $w->process($query); is( $f->param('year'), 2005, 'year value' ); is( $f->param('month'), 12, 'month value' ); is( $f->param('day'), 9, 'day value' ); is( $f->param('hour'), 10, 'hour value' ); is( $f->param('minute'), 25, 'minute value' ); is( $f->param('second'), 13, 'second value' ); ok( !$f->errors, 'no errors' ); } # Invalid { my $query = HTMLWidget::TestLib->mock_query( { year => '2005', month => '11', day => '500', hour => '10', minute => '15', second => '23' } ); my $f = $w->process($query); ok( $f->errors('year'), 'year has errors' ); ok( $f->errors('month'), 'month has errors' ); ok( $f->errors('day'), 'day has errors' ); ok( $f->errors('hour'), 'hour has errors' ); ok( $f->errors('minute'), 'minute has errors' ); ok( $f->errors('second'), 'second has errors' ); } HTML-Widget-1.11/t/get_filters.t0000644000076400007640000000262610571572142016544 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 13; use HTML::Widget; my $w = HTML::Widget->new; $w->filter( 'HTMLEscape', 'foo' ); $w->filter( 'LowerCase', 'bar' ); $w->filter( 'LowerCase', 'baz' ); $w->filter( 'Whitespace', 'baz' ); { my @filters = $w->get_filters; is( scalar(@filters), 4, 'correct number of filters' ); is_deeply( $filters[0]->names, ['foo'], 'correct filter names' ); is_deeply( $filters[1]->names, ['bar'], 'correct filter names' ); is_deeply( $filters[2]->names, ['baz'], 'correct filter names' ); is_deeply( $filters[3]->names, ['baz'], 'correct filter names' ); } { my @filters = $w->get_filters( type => 'Whitespace' ); is( scalar(@filters), 1, 'correct number of filters' ); is_deeply( $filters[0]->names, ['baz'], 'correct filter names' ); isa_ok( $filters[0], 'HTML::Widget::Filter::Whitespace', 'correct filter type' ); } { my @filters = $w->get_filters( type => 'LowerCase' ); is( scalar(@filters), 2, 'correct number of filters' ); is_deeply( $filters[0]->names, ['bar'], 'correct filter names' ); is_deeply( $filters[1]->names, ['baz'], 'correct filter names' ); isa_ok( $filters[0], 'HTML::Widget::Filter::LowerCase', 'correct filter type' ); isa_ok( $filters[1], 'HTML::Widget::Filter::LowerCase', 'correct filter type' ); } HTML-Widget-1.11/t/element_upload.t0000644000076400007640000000327710571572142017235 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 3; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Upload', 'foo' )->label('Foo')->accept('text/plain') ->maxlength(1000)->size(30); $w->element( 'Upload', 'bar' ); $w->constraint( 'Integer', 'foo' ); $w->constraint( 'Integer', 'bar' ); # Without query { my $f = $w->process; ok( $w->enctype() eq 'multipart/form-data', 'enctype automatically set to multipart/form-data' ); is( "$f", <
EOF } # With mocked basic query { my $query = HTMLWidget::TestLib->mock_query( { foo => 'yada', bar => '23', } ); my $f = $w->process($query); is( "$f", <
Invalid Input
EOF } HTML-Widget-1.11/t/constraint_number.t0000644000076400007640000000341210571572142017763 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 12; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo' ); $w->constraint( 'Number', 'foo' ); # Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => 23 } ); my $f = $w->process($query); is( $f->param('foo'), 23, 'foo value' ); ok( !$f->errors, 'no errors' ); } # Invalid { my $query = HTMLWidget::TestLib->mock_query( { foo => 'yada' } ); my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errors' ); } # Multiple Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => [ 123, 321, 111 ], } ); my $f = $w->process($query); is( $f->valid('foo'), 1, "Valid" ); my @results = $f->param('foo'); is( $results[0], 123, "Multiple valid values" ); is( $results[1], 321, "Multiple valid values" ); is( $results[2], 111, "Multiple valid values" ); } # Multiple Invalid { my $query = HTMLWidget::TestLib->mock_query( { foo => [ 123, 'foo', 321 ], } ); my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errors' ); } { # undef valid my $query = HTMLWidget::TestLib->mock_query( { foo => undef } ); my $f = $w->process($query); ok( $f->valid('foo') ); } { # decimal valid my $query = HTMLWidget::TestLib->mock_query( { foo => '1.1' } ); my $f = $w->process($query); ok( $f->valid('foo') ); } { # exponential valid my $query = HTMLWidget::TestLib->mock_query( { foo => '.1e2' } ); my $f = $w->process($query); ok( $f->valid('foo') ); } { # invalid my $query = HTMLWidget::TestLib->mock_query( { foo => '10foo' } ); my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errors' ); } HTML-Widget-1.11/t/element_radio.t0000644000076400007640000000762710571572142017052 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 3; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Radio', 'foo' )->value('foo')->label('Foo'); $w->element( 'Radio', 'bar' )->value(23)->label('Bar'); $w->element( 'Radio', 'bar' )->checked('checked')->label('Bar2'); $w->element( 'Radio', 'bar' )->label('Bar3'); $w->constraint( 'Integer', 'foo' ); $w->constraint( 'Integer', 'bar' ); # Without query { my $f = $w->process; is( "$f", <
EOF } # With mocked basic query { my $query = HTMLWidget::TestLib->mock_query( { foo => 'yada', bar => '23', } ); my $f = $w->process($query); is( "$f", <
Invalid Input
EOF } # With mocked basic query and container { my $w1 = HTML::Widget->new; $w1->element( 'Radio', 'foo' )->value('foo')->label('Foo'); $w1->element( 'Radio', 'bar' )->value(23)->label('Bar'); $w1->element( 'Radio', 'bar' )->checked('checked')->label('Bar2'); $w1->element( 'Radio', 'bar' )->label('Bar3'); $w1->constraint( 'Integer', 'foo' ); $w1->constraint( 'Integer', 'bar' ); my $query = HTMLWidget::TestLib->mock_query( { foo => 'yada', bar => '23', } ); my $w2 = HTML::Widget->new('something'); $w2->embed($w1); my $f = $w2->process($query); is( "$f", <
Invalid Input
EOF } HTML-Widget-1.11/t/element_password.t0000644000076400007640000000276510571572142017614 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 2; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Password', 'foo' )->value('foo')->size(30)->maxlength(30) ->label('Foo'); $w->element( 'Password', 'bar' )->fill(1); $w->constraint( 'Integer', 'foo' ); $w->constraint( 'Integer', 'bar' ); # Without query { my $f = $w->process; is( "$f", <
EOF } # With mocked basic query { my $query = HTMLWidget::TestLib->mock_query( { foo => 'yada', bar => '23', } ); my $f = $w->process($query); is( "$f", <
Invalid Input
EOF } HTML-Widget-1.11/t/attributes.t0000644000076400007640000000253010571572142016415 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 11; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; # widget my $w = HTML::Widget->new( 'form', { class => 'myForm' } ); ok( exists $w->attributes->{class}, 'key exists' ); $w->attributes( onsubmit => 'foo' ); $w->attributes( { onclick => 'bar' } ); ok( exists $w->attributes->{onsubmit}, 'key exists' ); ok( exists $w->attributes->{onclick}, 'key exists' ); #element my $e = $w->element( 'Textfield', 'foo', { class => 'myText', disabled => 'disabled' } )->size(10); ok( $e->attributes->{disabled}, 'key exists' ); $e->attributes( onsubmit => 'foo' ); $e->attributes( { onclick => 'bar' } ); ok( exists $e->attributes->{onsubmit}, 'key exists' ); ok( exists $e->attributes->{onclick}, 'key exists' ); # delete attributes idiom %{ $w->attributes } = (); ok( !exists $w->attributes->{class}, 'key does not exist' ); %{ $e->attributes } = (); ok( !exists $e->attributes->{disabled}, 'key does not exist' ); #element inside a block my $b = $w->element('Block'); my $e2 = $b->element( 'Textfield', 'foo', { foobar => 'disabled' } )->size(10); ok( $e2->attributes->{foobar}, 'key exists' ); $e2->attributes( onsubmit => 'foo' ); $e2->attributes( { onclick => 'bar' } ); ok( exists $e2->attributes->{onsubmit}, 'key exists' ); ok( exists $e2->attributes->{onclick}, 'key exists' ); HTML-Widget-1.11/t/element_radiogroup.t0000644000076400007640000001261210571572142020115 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 6; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; my $e = $w->element( 'RadioGroup', 'bar' )->values( [ 'opt1', 'opt2', 'opt3' ] ) ->value('opt1'); # Without query { my $f = $w->process; is( "$f", <
EOF } # With mocked basic query { my $query = HTMLWidget::TestLib->mock_query( { bar => 'opt2' } ); my $f = $w->process($query); is( "$f", <
EOF } # With legend $e->legend('Select One'); { my $f = $w->process; is( "$f", <
Select One
EOF } # With label $e->legend(undef); $e->label('Choose'); { my $f = $w->process; is( "$f", <
Choose
EOF } # With comment too $e->comment('Informed'); { my $f = $w->process; is( "$f", <
ChooseInformed
EOF } # With error $w->constraint( 'In' => 'bar' )->in('octopus'); { my $query = HTMLWidget::TestLib->mock_query( { bar => 'opt2' } ); my $f = $w->process($query); is( "$f", <
ChooseInformed
Invalid Input
EOF } HTML-Widget-1.11/t/08empty_errors.t0000644000076400007640000000124210571572142017130 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 1; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->empty_errors(1); $w->element( 'Textfield', 'foo' ); $w->constraint( 'All', 'foo' ); # Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => 'yada' } ); my $f = $w->process($query); is( "$f", <
EOF } HTML-Widget-1.11/t/constraint_range.t0000644000076400007640000000265010571572142017572 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 10; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo' ); $w->constraint( 'Range', 'foo' )->min(3)->max(4); # Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => 4 } ); my $f = $w->process($query); is( $f->param('foo'), 4, 'foo value' ); ok( !$f->errors, 'no errors' ); } # Valid '' { my $query = HTMLWidget::TestLib->mock_query( { foo => '' } ); my $f = $w->process($query); ok( $f->valid('foo'), 'foo valid' ); is( $f->param('foo'), '', 'foo value' ); } # Invalid { my $query = HTMLWidget::TestLib->mock_query( { foo => 5 } ); my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errors' ); } # Invalid 'a' { my $query = HTMLWidget::TestLib->mock_query( { foo => 'a' } ); my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errors' ); } # Multiple Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => [ 4, 4 ] } ); my $f = $w->process($query); is( $f->valid('foo'), 1, "Valid" ); my @results = $f->param('foo'); is( $results[0], 4, "Multiple valid values" ); is( $results[1], 4, "Multiple valid values" ); } # Multiple Invalid { my $query = HTMLWidget::TestLib->mock_query( { foo => [ 4, 5, 4 ] } ); my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errors' ); } HTML-Widget-1.11/t/get_filter.t0000644000076400007640000000200710571572142016352 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 8; use HTML::Widget; my $w = HTML::Widget->new; $w->filter( 'HTMLEscape', 'foo' ); $w->filter( 'LowerCase', 'bar' ); $w->filter( 'LowerCase', 'baz' ); $w->filter( 'Whitespace', 'baz' ); { my @filters = $w->get_filter; is( scalar(@filters), 1, 'correct number of filters' ); is_deeply( $filters[0]->names, ['foo'], 'correct filter names' ); } { my @filters = $w->get_filter( type => 'Whitespace' ); is( scalar(@filters), 1, 'correct number of filters' ); is_deeply( $filters[0]->names, ['baz'], 'correct filter names' ); isa_ok( $filters[0], 'HTML::Widget::Filter::Whitespace', 'correct filter type' ); } { my @filters = $w->get_filter( type => 'LowerCase' ); is( scalar(@filters), 1, 'correct number of filters' ); is_deeply( $filters[0]->names, ['bar'], 'correct filter names' ); isa_ok( $filters[0], 'HTML::Widget::Filter::LowerCase', 'correct filter type' ); } HTML-Widget-1.11/t/constraint_http.t0000644000076400007640000000272710571572142017462 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 11; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo' ); $w->constraint( 'HTTP', 'foo' ); # Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => 'http://oook.de' } ); my $f = $w->process($query); is( $f->param('foo'), 'http://oook.de', 'foo value' ); ok( !$f->errors, 'no errors' ); } # Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => '' } ); my $f = $w->process($query); ok( $f->valid('foo'), 'foo valid' ); is( $f->param('foo'), '', 'foo is empty string' ); ok( !$f->errors, 'no errors' ); } # Invalid { my $query = HTMLWidget::TestLib->mock_query( { foo => 'foobar' } ); my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errors' ); } # Multiple Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => [ 'http://catalyst.perl.org', 'http://oook.de' ], } ); my $f = $w->process($query); is( $f->valid('foo'), 1, "Valid" ); my @results = $f->param('foo'); is( $results[0], 'http://catalyst.perl.org', "Multiple valid values" ); is( $results[1], 'http://oook.de', "Multiple valid values" ); ok( !$f->errors, 'no errors' ); } # Multiple Invalid { my $query = HTMLWidget::TestLib->mock_query( { foo => [ 'yada', 'foo' ], } ); my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errors' ); } HTML-Widget-1.11/t/constraint_equal.t0000644000076400007640000001042110571572142017600 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 19; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; my $elem_foo = $w->element( 'Textfield', 'foo' ); my $elem_bar = $w->element( 'Textfield', 'bar' ); my $elem_baz = $w->element( 'Textfield', 'baz' ); my $constraint = $w->constraint( 'Equal', 'foo', 'bar', 'baz' ); # Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => 'yada', bar => 'yada', baz => 'yada', } ); my $f = $w->process($query); is( $f->param('foo'), 'yada', 'foo value' ); is( $f->param('foo'), $f->param('bar'), 'foo eq bar' ); ok( !$f->errors, 'no errors' ); } # Valid (blank 1) SKIP: { skip "drunken feature", 1; my $query = HTMLWidget::TestLib->mock_query( { foo => '', bar => 'yada', } ); my $f = $w->process($query); is( "$f", <
EOF } # Valid (blank 2) SKIP: { skip "drunken feature", 1; my $query = HTMLWidget::TestLib->mock_query( { foo => 'yada', bar => '', } ); my $f = $w->process($query); is( "$f", <
EOF } # Invalid { my $query = HTMLWidget::TestLib->mock_query( { foo => 'yada', bar => 'nada', baz => 'yada', } ); my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errors' ); ok( $f->errors('bar'), 'bar has errors' ); ok( $f->errors('baz'), 'baz has errors' ); ok( !$f->param('foo'), 'param foo is undef due to error' ); ok( !$f->param('bar'), 'param bar is undef due to error' ); ok( !$f->param('baz'), 'param baz is undef due to error' ); } # Display error on first value only { $constraint->render_errors(qw/ foo /); my $query = HTMLWidget::TestLib->mock_query( { foo => 'yada', bar => 'nada', baz => 'nada', } ); my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errors' ); ok( $f->errors('bar'), 'bar has errors' ); ok( $f->errors('baz'), 'baz has errors' ); is( "$f", <
Invalid Input
EOF } # Display error on some { $constraint->render_errors(qw/ foo bar /); my $query = HTMLWidget::TestLib->mock_query( { foo => 'yada', bar => 'nada', baz => 'something completely different', } ); my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errors' ); ok( $f->errors('bar'), 'bar has errors' ); ok( $f->errors('baz'), 'baz has errors' ); is( "$f", <
Invalid InputInvalid Input
EOF } HTML-Widget-1.11/t/constraint_regex.t0000644000076400007640000000214410571572142017606 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 7; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo' ); $w->constraint( 'Regex', 'foo' )->regex(qr/^\w+$/); # Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => 'yada' } ); my $f = $w->process($query); is( $f->param('foo'), 'yada', 'foo value' ); ok( !$f->errors, 'no errors' ); } # Invalid { my $query = HTMLWidget::TestLib->mock_query( { foo => "yada \n dada" } ); my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errors' ); } # Multiple Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => [ 'bar', 'yada' ] } ); my $f = $w->process($query); is( $f->valid('foo'), 1, "Valid" ); my @results = $f->param('foo'); is( $results[0], 'bar', "Multiple valid values" ); is( $results[1], 'yada', "Multiple valid values" ); } # Multiple Invalid { my $query = HTMLWidget::TestLib->mock_query( { foo => [ 'yada', "\n" ] } ); my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errors' ); } HTML-Widget-1.11/t/constraint_bool.t0000644000076400007640000000410410571572142017425 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 15; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo' ); $w->constraint( 'Bool', 'foo' ); # Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => 1 } ); my $f = $w->process($query); is( $f->param('foo'), 1, 'foo value' ); ok( !$f->errors, 'no errors' ); } # Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => 0 } ); my $f = $w->process($query); is( $f->param('foo'), 0, 'foo value' ); ok( !$f->errors, 'no errors' ); } # undef valid { my $query = HTMLWidget::TestLib->mock_query( { foo => undef } ); my $f = $w->process($query); ok( $f->valid('foo') ); } # empty valid { my $query = HTMLWidget::TestLib->mock_query( { foo => '' } ); my $f = $w->process($query); ok( $f->valid('foo') ); is( $f->param('foo'), '', 'foo value' ); } # Invalid { my $query = HTMLWidget::TestLib->mock_query( { foo => 'yada' } ); my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errors' ); } # Multiple Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => [ 1, 0, 1 ], } ); my $f = $w->process($query); ok( $f->valid('foo'), 'Valid' ); my @results = $f->param('foo'); is_deeply( \@results, [ 1, 0, 1 ], 'Multiple valid values' ); } # Multiple Invalid { my $query = HTMLWidget::TestLib->mock_query( { foo => [ 1, 0, 2 ], } ); my $f = $w->process($query); ok( !$f->valid('foo'), 'foo not valid' ); ok( $f->errors('foo'), 'foo has errors' ); } # invalid { my $query = HTMLWidget::TestLib->mock_query( { foo => '11' } ); my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errors' ); } # invalid { my $query = HTMLWidget::TestLib->mock_query( { foo => '1.1' } ); my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errors' ); } # invalid { my $query = HTMLWidget::TestLib->mock_query( { foo => '10foo' } ); my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errros' ); } HTML-Widget-1.11/t/constraint_ascii.t0000644000076400007640000000215010571572142017561 0ustar cafrankscafranksuse strict; use warnings; use utf8; use Test::More tests => 7; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo' ); $w->constraint( 'ASCII', 'foo' ); # Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => 'yada' } ); my $f = $w->process($query); is( $f->param('foo'), 'yada', 'foo value' ); ok( !$f->errors, 'no errors' ); } # Invalid { my $query = HTMLWidget::TestLib->mock_query( { foo => '日本語' } ); my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errors' ); } # Multiple Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => [ 'bar', 'yada' ] } ); my $f = $w->process($query); is( $f->valid('foo'), 1, "Valid" ); my @results = $f->param('foo'); is( $results[0], 'bar', "Multiple valid values" ); is( $results[1], 'yada', "Multiple valid values" ); } # Multiple Invalid { my $query = HTMLWidget::TestLib->mock_query( { foo => [ 'yada', '日本語' ] } ); my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errors' ); } HTML-Widget-1.11/t/constraint_in.t0000644000076400007640000000177210571572142017110 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 7; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo' ); $w->constraint( 'In', 'foo' )->in( 'one', 'two', 'three' ); # Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => 'one' } ); my $f = $w->process($query); is( $f->param('foo'), 'one', 'foo value' ); ok( !$f->errors, 'no errors' ); } # Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => 'two' } ); my $f = $w->process($query); is( $f->param('foo'), 'two', 'foo value' ); ok( !$f->errors, 'no errors' ); } # Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => 'three' } ); my $f = $w->process($query); is( $f->param('foo'), 'three', 'foo value' ); ok( !$f->errors, 'no errors' ); } # Invalid { my $query = HTMLWidget::TestLib->mock_query( { foo => 'four' } ); my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errors' ); } HTML-Widget-1.11/t/constraint_allornone.t0000644000076400007640000000273010571572142020466 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 11; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo' ); $w->element( 'Textfield', 'bar' ); $w->constraint( 'AllOrNone', 'foo', 'bar' ); # Valid All { my $query = HTMLWidget::TestLib->mock_query( { foo => 'yada', bar => 'nada', } ); my $f = $w->process($query); is( $f->param('foo'), 'yada', 'foo value' ); is( $f->param('bar'), 'nada', 'bar value' ); ok( !$f->errors, 'no errors' ); } # Valid None { my $query = HTMLWidget::TestLib->mock_query( {} ); my $f = $w->process($query); ok( !$f->valid, 'none valid' ); ok( !$f->errors, 'no errors' ); } # Invalid { my $query = HTMLWidget::TestLib->mock_query( { foo => 'yada' } ); my $f = $w->process($query); is( $f->param('foo'), 'yada', 'foo value' ); ok( $f->errors('bar'), 'bar has errors' ); } # Empty strings - like an empty form as submitted by Firefox { my $query = HTMLWidget::TestLib->mock_query( { foo => '', bar => '' } ); my $f = $w->process($query); ok( !$f->errors('foo'), 'foo has no errors' ); ok( !$f->errors('bar'), 'bar has no errors' ); } # "0" as a query value { my $query = HTMLWidget::TestLib->mock_query( { foo => 0 } ); my $f = $w->process($query); is( $f->param('foo'), 0, 'foo value' ); ok( $f->errors('bar'), 'bar has errors' ); } HTML-Widget-1.11/t/filter_callback.t0000644000076400007640000000212410571572142017327 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 3; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo' ); $w->filter( 'Callback', 'foo' )->callback( sub { my $value = shift; $value =~ s/foo/bar/g; return $value; } ); # With mocked basic query { my $query = HTMLWidget::TestLib->mock_query( { foo => 'foobar' } ); my $f = $w->process($query); is( $f->param('foo'), 'barbar', 'foo value' ); } my $w2 = HTML::Widget->new; $w2->element( 'Textfield', 'foo' ); $w2->element( 'Textfield', 'bar' ); $w2->filter('Callback')->callback( sub { my $value = shift; $value =~ s/foo/bar/g; return $value; } ); # With mocked basic query { my $query = HTMLWidget::TestLib->mock_query( { foo => [ 'foobar', 'foobuz' ], bar => [ 'barfoo', 'barbuz' ] } ); my $f = $w2->process($query); is_deeply( [ $f->param('foo') ], [qw/ barbar barbuz/], 'foo values' ); is_deeply( [ $f->param('bar') ], [qw/ barbar barbuz/], 'bar values' ); } HTML-Widget-1.11/t/06bugs_select_zero_key_constraint.t0000644000076400007640000000073710571572142023056 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 3; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Select', 'foo' )->options( 1 => 'yes', 0 => 'no' ) ->constrain_options(1); my $f = $w->process(); my @constraints = $w->get_constraints; is( scalar(@constraints), 1, '1 implicit IN constraint' ); my $keys = $constraints[0]->in; is( $keys->[0], 1, 'constraint value' ); is( $keys->[1], 0, 'constraint value' ); HTML-Widget-1.11/t/get_errors.t0000644000076400007640000000605010571572142016403 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 6; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo' )->value('foo'); # With mocked basic query { my $result = $w->process; $result->add_error( { name => 'foo', message => 'bad foo', type => 'Custom' } ); $result->add_error( { name => 'baz', message => 'Baz error', type => 'OtherType' } ); is_deeply( [ new HTML::Widget::Error( { type => 'OtherType', name => 'baz', message => 'Baz error' } ), new HTML::Widget::Error( { type => 'Custom', name => 'foo', message => 'bad foo' } ), ], [ $result->errors ], "Errors correct with no params" ); is_deeply( [], [ $result->errors( undef, 'FakeType' ) ], "There are no FakeType errors" ); is_deeply( [ new HTML::Widget::Error( { type => 'Custom', name => 'foo', message => 'bad foo' } ) ], [ $result->errors( undef, 'Custom' ) ], "Filtered returned correct type" ); $result->add_error( { name => 'baz', message => 'Baz error 2', type => 'All', } ); is_deeply( [ new HTML::Widget::Error( { type => 'OtherType', name => 'baz', message => 'Baz error' } ), new HTML::Widget::Error( { type => 'All', name => 'baz', message => 'Baz error 2', } ), ], [ $result->errors('baz') ], "Errors correct with name provided" ); is_deeply( [ new HTML::Widget::Error( { type => 'OtherType', name => 'baz', message => 'Baz error' } ), new HTML::Widget::Error( { type => 'All', name => 'baz', message => 'Baz error 2', } ), new HTML::Widget::Error( { type => 'Custom', name => 'foo', message => 'bad foo' } ), ], [ $result->errors ], "Errors correct with no params" ); is_deeply( [ new HTML::Widget::Error( { type => 'All', name => 'baz', message => 'Baz error 2', } ), ], [ $result->errors( 'baz', 'All' ) ], "errors correct with name and type params" ); } HTML-Widget-1.11/t/constraint_singlevalue.t0000644000076400007640000000230410571572142021010 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 9; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo' ); $w->constraint( 'SingleValue', 'foo' ); # Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => 1 } ); my $f = $w->process($query); is( $f->param('foo'), 1, 'foo value' ); ok( !$f->errors, 'no errors' ); } # undef valid { my $query = HTMLWidget::TestLib->mock_query( { foo => undef } ); my $f = $w->process($query); ok( $f->valid('foo') ); } # empty valid { my $query = HTMLWidget::TestLib->mock_query( { foo => '' } ); my $f = $w->process($query); ok( $f->valid('foo') ); is( $f->param('foo'), '', 'foo value' ); } # Multiple Invalid { my $query = HTMLWidget::TestLib->mock_query( { foo => [ 1, 0 ], } ); my $f = $w->process($query); ok( !$f->valid('foo'), 'foo not valid' ); ok( $f->errors('foo'), 'foo has errors' ); } # Multiple Invalid { my $query = HTMLWidget::TestLib->mock_query( { foo => [ 'foo', 'bar' ], } ); my $f = $w->process($query); ok( !$f->valid('foo'), 'foo not valid' ); ok( $f->errors('foo'), 'foo has errors' ); } HTML-Widget-1.11/t/06bugs_constraint_range_zero_max.t0000644000076400007640000000115110571572142022657 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 4; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo' ); $w->constraint( 'Range', 'foo' )->min(-4)->max(0); # Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => 0 } ); my $f = $w->process($query); ok( $f->valid('foo'), 'foo valid' ); ok( !$f->errors, 'no errors' ); } # Invalid { my $query = HTMLWidget::TestLib->mock_query( { foo => 1 } ); my $f = $w->process($query); ok( !$f->valid('foo'), 'foo not valid' ); ok( $f->errors, 'errors' ); } HTML-Widget-1.11/t/06bugs_value_no_default.t0000644000076400007640000001106210571572142020731 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 2; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Button', 'my_button', )->value(1); $w->element( 'Checkbox', 'my_checkbox' )->value(1)->checked('checked'); $w->element( 'Checkbox', 'my_checkbox' )->value(0); $w->element( 'Hidden', 'my_hidden' )->value(1); $w->element( 'Password', 'my_password' )->value(1)->fill(1); $w->element( 'Radio', 'my_radio' )->value(1)->checked('checked'); $w->element( 'Radio', 'my_radio' )->value(0); $w->element( 'RadioGroup', 'my_radiogroup' )->values( 1, 0 )->checked(1); $w->element( 'Reset', 'my_reset' )->value(1); $w->element( 'Select', 'my_select' ) ->options( 0 => 'unsubscribed', 1 => 'subscribed' )->selected(1); $w->element( 'Submit', 'my_submit' )->value(1); $w->element( 'Textarea', 'my_textarea' )->value(1); $w->element( 'Textfield', 'my_textfield' )->value(1); { my $f = $w->process(); is( "$f", <
EOF } # make sure XML of the result object has empty values, not defaults { my $query = HTMLWidget::TestLib->mock_query( {} ); my $f = $w->process($query); is( "$f", <
EOF } HTML-Widget-1.11/t/element_button.t0000644000076400007640000000221610571572142017254 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 4; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Button', 'foo' )->value('foo'); $w->element( 'Button', 'bar' ); $w->constraint( 'Integer', 'foo' ); $w->constraint( 'Integer', 'bar' ); # Without query { my $f = $w->process; is( "$f", <
EOF } # With mocked basic query { my $query = HTMLWidget::TestLib->mock_query( { foo => 'yada', bar => '23', } ); my $f = $w->process($query); is( "$f", <
EOF ok( !$f->valid('foo') ); ok( $f->valid('bar') ); } HTML-Widget-1.11/t/09nested_embed.t0000644000076400007640000000323410571572142017020 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 3; use HTML::Widget; #
#
# #
# #
#
#
# Old style my $wo = HTML::Widget->new('foo')->action('/foo'); my $fso1 = HTML::Widget->new('main'); $fso1->element( 'Textfield', 'bar' ); my $fso2 = HTML::Widget->new('nested'); $fso2->element( 'Textfield', 'baz' ); $fso1->embed_into_first($fso2); $wo->embed($fso1); my $fo = $wo->process; is( $fo->as_xml, <
EOF # New style my $w = HTML::Widget->new('foo')->action('/foo'); my $fs1 = $w->element( 'Fieldset', 'main' ); $fs1->element( 'Textfield', 'bar' ); my $fs2 = $fs1->element( 'Fieldset', 'nested' ); $fs2->element( 'Textfield', 'baz' ); my $f = $w->process; is( $f->as_xml, <
EOF # CHECK BOTH EXAMPLES PRODUCE SAME OUTPUT is( "$fo", "$f", 'widgets are identical' ); HTML-Widget-1.11/t/filter_htmlescape.t0000644000076400007640000000141610571573024017723 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 3; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo' ); $w->filter( 'HTMLEscape', 'foo' ); # With mocked basic query { my $query = HTMLWidget::TestLib->mock_query( { foo => '

message

', bar => '23', } ); my $f = $w->process($query); is( $f->param('foo'), '<p>message</p>', 'foo value' ); is( $f->param('bar'), '23', 'bar value' ); SKIP: { skip "HTML::Element now checks for already-escaped characters - Won't fix", 1; like( "$f", qr{\Q value="&lt;p&gt;message&lt;/p&gt;" }x, 'XML output is double encoded' ); } } HTML-Widget-1.11/t/02pod.t0000644000076400007640000000033110571572142015150 0ustar cafrankscafranksuse strict; use warnings; use Test::More; eval "use Test::Pod 1.14"; plan skip_all => 'Test::Pod 1.14 required' if $@; plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD}; all_pod_files_ok(); HTML-Widget-1.11/t/06bugs_ascii_space.t0000644000076400007640000000067210571572142017665 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 3; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo' ); $w->constraint( 'ASCII', 'foo' ); my $query = HTMLWidget::TestLib->mock_query( { foo => ' ' } ); my $f = $w->process($query); ok( !$f->has_errors, 'no errors' ); ok( $f->valid('foo'), 'foo valid' ); is( $f->param('foo'), ' ', 'value is space character' ); HTML-Widget-1.11/t/06bugs_result_elements_warnings.t0000644000076400007640000000070710571572142022543 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 1 + 1; # +1 is for Test::NoWarnings use Test::NoWarnings; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; { my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo' ); my $query = HTMLWidget::TestLib->mock_query( { foo => 'yada' } ); my $result = $w->process($query); my @elements = $result->elements; ok( @elements == 1, '@elements contains 1 value' ); } HTML-Widget-1.11/t/constraint_any.t0000644000076400007640000000445110571572142017266 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 10; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo' ); $w->element( 'Textfield', 'bar' ); my $constraint = $w->constraint( 'Any', 'foo', 'bar' ); # Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => 'yada' } ); my $f = $w->process($query); is( $f->param('foo'), 'yada', 'foo value' ); ok( !$f->errors, 'no errors' ); } # Invalid { my $query = HTMLWidget::TestLib->mock_query( { baz => 23 } ); my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errors' ); ok( $f->errors('bar'), 'bar has errors' ); } # Multiple invalid, error only on one { $constraint->render_errors(qw/ foo /); my $query = HTMLWidget::TestLib->mock_query( { baz => 23 } ); my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errors' ); ok( $f->errors('bar'), 'bar has errors' ); is( "$f", <
Alternative Missing
EOF } # Multiple invalid, error on both (explicitly) { $constraint->render_errors(qw/ foo bar /); my $query = HTMLWidget::TestLib->mock_query( { baz => 23 } ); my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errors' ); ok( $f->errors('bar'), 'bar has errors' ); is( "$f", <
Alternative MissingAlternative Missing
EOF } HTML-Widget-1.11/t/06bugs_widget_name_zero.t0000644000076400007640000000021510571572142020735 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 1; use HTML::Widget; my $w = HTML::Widget->new(0); is( $w->name, 0, 'widget name 0' ); HTML-Widget-1.11/t/get_constraints.t0000644000076400007640000000314410571572142017437 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 13; use HTML::Widget; my $w = HTML::Widget->new; $w->constraint( 'Integer', 'foo' ); $w->constraint( 'Printable', 'bar' ); $w->constraint( 'All', 'baz', 'one' ); $w->constraint( 'All', 'baz', 'two' ); { my @constraints = $w->get_constraints; is( scalar(@constraints), 4, 'correct number of constraints' ); is_deeply( $constraints[0]->names, ['foo'], 'correct constraint names' ); is_deeply( $constraints[1]->names, ['bar'], 'correct constraint names' ); is_deeply( $constraints[2]->names, [qw/ baz one /], 'correct constraint names' ); is_deeply( $constraints[3]->names, [qw/ baz two /], 'correct constraint names' ); } { my @constraints = $w->get_constraints( type => 'Integer' ); is( scalar(@constraints), 1, 'correct number of constraints' ); is_deeply( $constraints[0]->names, ['foo'], 'correct constraint names' ); isa_ok( $constraints[0], 'HTML::Widget::Constraint::Integer', 'correct constraint type' ); } { my @constraints = $w->get_constraints( type => 'All' ); is( scalar(@constraints), 2, 'correct number of constraints' ); is_deeply( $constraints[0]->names, [qw/ baz one /], 'correct constraint names' ); is_deeply( $constraints[1]->names, [qw/ baz two /], 'correct constraint names' ); isa_ok( $constraints[0], 'HTML::Widget::Constraint::All', 'correct constraint type' ); isa_ok( $constraints[1], 'HTML::Widget::Constraint::All', 'correct constraint type' ); } HTML-Widget-1.11/t/element_custom_namespace.t0000644000076400007640000000240310571572142021265 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 2; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( '+HTMLWidget::CustomElement', 'foo' )->value('foo')->size(30) ->label('Foo'); $w->constraint( 'Integer', 'foo' ); # Without query { my $f = $w->process; is( "$f", <
EOF } # With mocked basic query { my $query = HTMLWidget::TestLib->mock_query( { foo => 'yada', bar => '23', } ); my $f = $w->process($query); is( "$f", <
Invalid Input
EOF } HTML-Widget-1.11/t/filter_uppercase.t0000644000076400007640000000102010571572142017554 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 2; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo' ); $w->element( 'Textfield', 'bar' ); $w->filter( 'UpperCase', 'foo' ); # With mocked basic query { my $query = HTMLWidget::TestLib->mock_query( { foo => 'Foo', bar => 'Bar', } ); my $f = $w->process($query); is( $f->param('foo'), 'FOO', 'foo value' ); is( $f->param('bar'), 'Bar', 'bar value' ); } HTML-Widget-1.11/t/element_hidden.t0000644000076400007640000000213610571572142017175 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 2; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Hidden', 'foo' )->value('foo'); $w->element( 'Hidden', 'bar' ); $w->constraint( 'Integer', 'foo' ); $w->constraint( 'Integer', 'bar' ); # Without query { my $f = $w->process; is( "$f", <
EOF } # With mocked basic query { my $query = HTMLWidget::TestLib->mock_query( { foo => 'yada', bar => '23', } ); my $f = $w->process($query); is( "$f", <
EOF } HTML-Widget-1.11/t/element_reset.t0000644000076400007640000000104510571572142017062 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 1; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Reset', 'foo' )->value('foo'); $w->element( 'Reset', 'bar' ); # Without query { my $f = $w->process; is( "$f", <
EOF } HTML-Widget-1.11/t/constraint_custom_namespace.t0000644000076400007640000000174510571572142022030 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 3; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo' ); $w->constraint( '+HTMLWidget::CustomConstraint', 'foo' ); # Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => 23 } ); my $f = $w->process($query); is( $f->param('foo'), 23, 'foo value' ); ok( !$f->errors, 'no errors' ); } # Invalid { my $query = HTMLWidget::TestLib->mock_query( { foo => 'yada' } ); my $f = $w->process($query); is( "$f", <
Invalid Input
EOF } HTML-Widget-1.11/t/element_submit.t0000644000076400007640000000424510571572142017250 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 4; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Submit', 'foo' )->value('foo'); $w->element( 'Submit', 'bar' ); $w->element( 'Submit', 'foobar' )->src('http://localhost/test.jpg'); $w->element( 'Submit', 'foo1' )->src('test.jpg')->height(10); $w->element( 'Submit', 'foo2' )->src('test.jpg')->width(10); $w->element( 'Submit', 'foo3' )->src('test.jpg')->height(10)->width(20); $w->constraint( 'Integer', 'foo' ); $w->constraint( 'Integer', 'bar' ); # Without query { my $f = $w->process; is( "$f", <
EOF } # With mocked basic query { my $query = HTMLWidget::TestLib->mock_query( { foo => 'yada', bar => '23', } ); my $f = $w->process($query); is( "$f", <
EOF ok( !$f->valid('foo') ); ok( $f->valid('bar') ); } HTML-Widget-1.11/t/06bugs_callbackone_missing_param.t0000644000076400007640000000141010571572142022560 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 5; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; my ( $foo, $bar, $zoo ); $w->element( 'Textfield', 'foo' ); $w->element( 'Textfield', 'bar' ); $w->element( 'Textfield', 'zoo' ); $w->constraint( 'CallbackOnce', 'foo', 'bar', 'zoo' ) ->callback( sub { ( $foo, $bar, $zoo ) = @_; return 1; } ); # Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => '', zoo => 'nada', } ); my $f = $w->process($query); is( $foo, '', '$foo assigned correctly' ); ok( !defined $bar, '$bar undef' ); is( $zoo, 'nada', '$zoo assigned correctly' ); ok( $f->valid('foo'), 'foo valid' ); ok( $f->valid('zoo'), 'zoo valid' ); } HTML-Widget-1.11/t/10explicit_ids.t0000644000076400007640000000212510571572142017050 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 2; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new->explicit_ids(1); $w->element( 'Textfield', 'foo' ); $w->element( 'Textfield', 'bar' )->attributes->{id} = 'my_bar'; # Without query { my $f = $w->process; is( "$f", <
EOF } # With mocked basic query { my $query = HTMLWidget::TestLib->mock_query( { foo => 'yada', bar => '23', } ); # Add an id to the top-level widget too $w->attributes->{id} = 'my_form'; my $f = $w->process($query); is( "$f", <
EOF } HTML-Widget-1.11/t/06bugs_value_empty_string.t0000644000076400007640000000035410571572142021337 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 1; use HTML::Widget; my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo' )->value(''); my $f = $w->process(); like( "$f", qr/\Q value="" /x, 'empty value appears in XML' ); HTML-Widget-1.11/t/05strict.t0000644000076400007640000000246110571572142015707 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 11; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new->method('post')->action('/foo/bar')->strict(1); $w->element( 'Textfield', 'age' )->label('Age')->size(3); $w->element( 'Textfield', 'name' )->label('Name')->size(60); $w->element( 'Submit', 'ok' )->value('OK'); $w->constraint( 'Integer', 'age' )->message('No integer.'); $w->constraint( 'Maybe', 'ok' ); my $query = HTMLWidget::TestLib->mock_query( { age => 'NaN', name => 'sri', foo => 'blah', bar => 'stuff', ok => 'OK', } ); my $f = $w->process($query); ok( $f->valid('ok'), 'Field ok is valid' ); ok( !$f->valid('name'), 'Field name is valid' ); ok( !$f->valid('age'), 'Field age is not valid' ); ok( !$f->valid('foo'), 'Field foo is not valid' ); ok( !$f->valid('other'), 'Field other is not valid' ); is( $f->params->{ok}, 'OK', 'Param name is accessible' ); ok( !$f->params->{name}, 'Param name is accessible' ); # is this correct here? ok( !exists $f->params->{age}, 'Param age does not exist in params hash' ); is( $f->params->{age}, undef, 'Param age is undef' ); ok( !exists $f->params->{foo}, 'Param foo is not in params hash' ); ok( !exists $f->params->{other}, 'Param other is not in params hash' ); HTML-Widget-1.11/t/constraint_string.t0000644000076400007640000000211310571572142017776 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 7; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo' ); $w->constraint( 'String', 'foo' ); # Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => 'yada' } ); my $f = $w->process($query); is( $f->param('foo'), 'yada', 'foo value' ); ok( !$f->errors, 'no errors' ); } # Invalid { my $query = HTMLWidget::TestLib->mock_query( { foo => '!@#$%' } ); my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errors' ); } # Multiple Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => [ 'bar', 'yada' ] } ); my $f = $w->process($query); is( $f->valid('foo'), 1, "Valid" ); my @results = $f->param('foo'); is( $results[0], 'bar', "Multiple valid values" ); is( $results[1], 'yada', "Multiple valid values" ); } # Multiple Invalid { my $query = HTMLWidget::TestLib->mock_query( { foo => [ 'yada', '-' ] } ); my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errors' ); } HTML-Widget-1.11/t/element_textarea.t0000644000076400007640000000337410571572142017564 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 2; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Textarea', 'foo' )->value('foo')->cols(20)->rows(40)->wrap('off') ->label('Foo'); $w->element( 'Textarea', 'bar' )->label('Bar')->comment('Baz'); $w->constraint( 'Integer', 'foo' ); $w->constraint( 'Integer', 'bar' ); # Without query { my $f = $w->process; is( "$f", <
EOF } # With mocked basic query { my $query = HTMLWidget::TestLib->mock_query( { foo => 'yada', bar => '23', } ); my $f = $w->process($query); is( "$f", <
Invalid Input
EOF } HTML-Widget-1.11/t/constraint_callback.t0000644000076400007640000000216310571572142020231 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 7; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo' ); $w->constraint( 'Callback', 'foo' )->callback( sub { return 1 if $_[0] } ); # Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => 'yada' } ); my $f = $w->process($query); is( $f->param('foo'), 'yada', 'foo value' ); ok( !$f->errors, 'no errors' ); } # Invalid { my $query = HTMLWidget::TestLib->mock_query( { foo => '' } ); my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errors' ); } # Multiple Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => [ 'bar', 'yada' ], } ); my $f = $w->process($query); is( $f->valid('foo'), 1, "Valid" ); my @results = $f->param('foo'); is( $results[0], 'bar', "Multiple valid values" ); is( $results[1], 'yada', "Multiple valid values" ); } # Multiple Invalid { my $query = HTMLWidget::TestLib->mock_query( { foo => [ '', '' ] } ); my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errors' ); } HTML-Widget-1.11/t/filter_lowercase.t0000644000076400007640000000102010571572142017551 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 2; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo' ); $w->element( 'Textfield', 'bar' ); $w->filter( 'LowerCase', 'foo' ); # With mocked basic query { my $query = HTMLWidget::TestLib->mock_query( { foo => 'Foo', bar => 'Bar', } ); my $f = $w->process($query); is( $f->param('foo'), 'foo', 'foo value' ); is( $f->param('bar'), 'Bar', 'bar value' ); } HTML-Widget-1.11/t/submitted.t0000644000076400007640000000121210571572142016223 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 2; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Select', 'foo' )->label('Foo') ->options( foo => 'Foo', bar => 'Bar' ); $w->constraint( 'Integer', 'foo' ); $w->constraint( 'Integer', 'bar' ); # Without query { my $f = $w->process(); is( $f->submitted, 0, 'Form was not submitted' ); } # With mocked basic query { my $query = HTMLWidget::TestLib->mock_query( { foo => 'foo', bar => [ 'yada', 23 ], } ); my $f = $w->process($query); is( $f->submitted, 1, 'Form was submitted' ); } HTML-Widget-1.11/t/element_block.t0000644000076400007640000001673410571572142017045 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 28; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; my $e = $w->element( 'Block', 'foo' ); $e->element( 'Textfield', 'bar' )->value('bar')->label('Bar'); my $fs = $e->element( 'Fieldset', 'fs' )->legend('FS'); $fs->element( 'Textfield', 'baz' ); my $fs2 = $e->element( 'Fieldset', 'fs2' ); $fs2->element( 'Textfield', 'bartwo' ); $fs2->element( 'Textfield', 'baztwo' ); my $fsn = $fs2->element( 'Fieldset', 'fsnest' ); $fsn->element( 'Textfield', 'barnest' )->value('Barnest'); # Not completely sure if NullContainers should be used for real, # but test them anyway as they're the base for Block. my $nc = $e->element( 'NullContainer', 'nc' ); $nc->element( 'Textfield', 'norp' ); # Without query { my $f = $w->process; is( "$f", <
FS
EOF } # With mocked basic query - okay { my $query = HTMLWidget::TestLib->mock_query( { bar => 'yada', baz => '23', bartwo => 'ping', baztwo => '18', barnest => 'yellow', } ); my $f = $w->process($query); is( "$f", <
FS
EOF } # With mocked basic query - errors $w->constraint( 'Integer', 'bar', 'baz', 'bartwo', 'baztwo' ); { my $query = HTMLWidget::TestLib->mock_query( { bar => 'yada', baz => '23', bartwo => 'ping', baztwo => '18', norp => 'Nil', } ); my $f = $w->process($query); is( "$f", <
Invalid Input
FS
Invalid Input
EOF } # Introspection my @el = $e->get_elements(); is( scalar(@el), 4, 'foo has 4 els' ); isa_ok( $el[0], 'HTML::Widget::Element::Textfield', 'foo 1st el is textfield' ); isa_ok( $el[1], 'HTML::Widget::Element::Fieldset', 'foo 2nd el is fieldset' ); my @fsl = $el[1]->get_elements(); is( scalar(@fsl), 1, 'fs has 1' ); isa_ok( $fsl[0], 'HTML::Widget::Element::Textfield', 'fs 1st el is textfield' ); isa_ok( $e->get_element( name => 'bar' ), 'HTML::Widget::Element::Textfield', 'el bar by name' ); isa_ok( $e->get_element( type => 'Fieldset' ), 'HTML::Widget::Element::Fieldset', 'el fs by type' ); my @full_el = $e->find_elements(); is( scalar(@full_el), 11, 'find_elements' ); my @a_types = map { ref($_); } @full_el; my @e_types = map "HTML::Widget::Element::$_", qw( Block Textfield Fieldset Textfield Fieldset Textfield Textfield Fieldset Textfield NullContainer Textfield ); ok( eq_array( \@a_types, \@e_types ), 'find_elements types' ); my @a_names = map { $_->name; } @full_el; my @e_names = qw(foo bar fs baz fs2 bartwo baztwo fsnest barnest nc norp); ok( eq_array( \@a_names, \@e_names ), 'find_elements names' ); @full_el = $e->find_elements( type => 'Textfield' ); is( scalar(@full_el), 6, 'find_elements by type' ); @a_types = map { ref($_); } @full_el; @e_types = map "HTML::Widget::Element::$_", ('Textfield') x 6; ok( eq_array( \@a_types, \@e_types ), 'find_elements types' ); @a_names = map { $_->name; } @full_el; @e_names = qw(bar baz bartwo baztwo barnest norp); ok( eq_array( \@a_names, \@e_names ), 'find_elements names' ); @full_el = $e->find_elements( name => 'bartwo' ); is( scalar(@full_el), 1, 'find_elements by name' ); is( ref( $full_el[0] ), 'HTML::Widget::Element::Textfield', 'find_element type' ); is( $full_el[0]->name, 'bartwo', 'find_element name' ); # This may change: my @fs2l = $el[2]->get_elements( type => 'OrderedList' ); is( scalar(@fs2l), 0, 'fs2 has no ordered lists' ); @fs2l = $el[2]->get_elements( type => 'Textfield' ); is( scalar(@fs2l), 2, 'fs2 has 2 textfields' ); @fs2l = $el[2]->get_elements( name => 'baztwo' ); is( scalar(@fs2l), 1, 'fs2 has 1 baztwo' ); is( $fs2l[0]->name, 'baztwo', 'baztwo name ok' ); # Container introspection { my $query = HTMLWidget::TestLib->mock_query( { bar => 'yada', baz => '23', bartwo => 'ping', baztwo => '18', } ); my $f = $w->process($query); my $foop = $f->element('fs'); ok( not($foop), 'fs not a top-level element' ); $foop = $f->element('foo'); isa_ok( $foop, 'HTML::Widget::BlockContainer', 'result foo' ); $foop = $f->find_result_element('fs'); isa_ok( $foop, 'HTML::Widget::BlockContainer', 'find_result_element fs' ); my @c = $f->elements_for('fs2'); is( scalar(@c), 3, 'elements_for fs2' ); isa_ok( $c[1], 'HTML::Widget::Container' ); } # EOF HTML-Widget-1.11/t/constraint_printable.t0000644000076400007640000000267710571572142020467 0ustar cafrankscafranksuse strict; use warnings; use utf8; use Test::More tests => 13; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo' ); $w->constraint( 'Printable', 'foo' ); # Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => 'yada' } ); my $f = $w->process($query); is( $f->param('foo'), 'yada', 'foo value' ); ok( !$f->errors, 'no errors' ); } # Invalid { my $query = HTMLWidget::TestLib->mock_query( { foo => pack( 'H*', 123456 ), } ); my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errors' ); } # Multiple Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => [ 'bar', 'yada' ] } ); my $f = $w->process($query); is( $f->valid('foo'), 1, "Valid" ); my @results = $f->param('foo'); is( $results[0], 'bar', "Multiple valid values" ); is( $results[1], 'yada', "Multiple valid values" ); } # Multiple Invalid { my $query = HTMLWidget::TestLib->mock_query( { foo => [ 'yada', pack( 'H*', 123456 ) ], } ); my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errors' ); } my $c = HTML::Widget::Constraint::Printable->new; ok( $c->validate("foo"), "alpha" ); ok( $c->validate("foo bar"), "alpha, space" ); ok( $c->validate(",la; bar"), "punct" ); ok( $c->validate("יובל"), "hebrew" ); ok( !$c->validate("\x00"), "zero" ); ok( !$c->validate("\xb"), "backspace" ); HTML-Widget-1.11/t/constraint_integer.t0000644000076400007640000000341410571572142020132 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 12; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo' ); $w->constraint( 'Integer', 'foo' ); # Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => 23 } ); my $f = $w->process($query); is( $f->param('foo'), 23, 'foo value' ); ok( !$f->errors, 'no errors' ); } # Invalid { my $query = HTMLWidget::TestLib->mock_query( { foo => 'yada' } ); my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errors' ); } # Multiple Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => [ 123, 321, 111 ], } ); my $f = $w->process($query); is( $f->valid('foo'), 1, "Valid" ); my @results = $f->param('foo'); is( $results[0], 123, "Multiple valid values" ); is( $results[2], 111, "Multiple valid values" ); } # Multiple Invalid { my $query = HTMLWidget::TestLib->mock_query( { foo => [ 123, 'foo', 321 ], } ); my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errors' ); } { # undef valid my $query = HTMLWidget::TestLib->mock_query( { foo => undef } ); my $f = $w->process($query); ok( $f->valid('foo') ); } { # zero valid my $query = HTMLWidget::TestLib->mock_query( { foo => 0 } ); my $f = $w->process($query); ok( $f->valid('foo') ); is( $f->param('foo'), 0, 'foo value' ); } { # decimal invalid my $query = HTMLWidget::TestLib->mock_query( { foo => '1.1' } ); my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errors' ); } { # invalid my $query = HTMLWidget::TestLib->mock_query( { foo => '10foo' } ); my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errros' ); } HTML-Widget-1.11/t/element_textfield.t0000644000076400007640000000271110571572142017731 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 2; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo' )->value('foo')->size(30)->label('Foo'); $w->element( 'Textfield', 'bar' ); $w->constraint( 'Integer', 'foo' ); $w->constraint( 'Integer', 'bar' ); # Without query { my $f = $w->process; is( "$f", <
EOF } # With mocked basic query { my $query = HTMLWidget::TestLib->mock_query( { foo => 'yada', bar => '23', } ); my $f = $w->process($query); is( "$f", <
Invalid Input
EOF } HTML-Widget-1.11/t/06bugs_widget_get_elements.t0000644000076400007640000000066410571572142021441 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 3; use HTML::Widget; my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo' ); $w->element( 'Textfield', 'bar' ); $w->element( 'Textarea', 'bar' ); my @elems = $w->get_elements( name => 'bar', type => 'Textfield' ); is( scalar(@elems), 1, 'correct number of elements' ); is( $elems[0]->name, 'bar', 'correct name' ); like( ref($elems[0]), qr/Textfield$/, 'correct type' ); HTML-Widget-1.11/t/constraint_callbackonce.t0000644000076400007640000000506410571572142021101 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 23; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; our $counter; $w->element( 'Textfield', 'foo' ); $w->element( 'Textfield', 'bar' ); my $constraint = $w->constraint( 'CallbackOnce', 'foo', 'bar' ) ->callback( sub { $counter++; return 1 if $_[0] && $_[1] } ); # Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => 'yada', bar => 'nada', } ); local $counter = 0; my $f = $w->process($query); is( $counter, 1, 'callback only called once' ); is( $f->param('foo'), 'yada' ); is( $f->param('bar'), 'nada' ); ok( !$f->errors, 'no errors' ); } # Invalid { my $query = HTMLWidget::TestLib->mock_query( { foo => '', bar => 'nada', } ); local $counter = 0; my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errors' ); ok( $f->errors('bar'), 'bar has errors' ); is( $counter, 1, 'callback only called once' ); } # Multiple Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => [ 'bar', 'yada' ], bar => 'nada', } ); local $counter = 0; my $f = $w->process($query); ok( $f->valid('foo'), "Valid" ); ok( $f->valid('bar'), "Valid" ); my @results = $f->param('foo'); is( $results[0], 'bar', "Multiple valid values" ); is( $results[1], 'yada', "Multiple valid values" ); is( $counter, 1, 'callback only called once' ); } # Multiple Invalid { my $query = HTMLWidget::TestLib->mock_query( { foo => [ '', '' ] } ); local $counter = 0; my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errors' ); ok( $f->errors('bar'), 'bar has errors' ); is( $counter, 1 ); } # Display one error on multiple failure { $constraint->render_errors(qw/ foo /); my $query = HTMLWidget::TestLib->mock_query( { foo => [ '', '' ] } ); my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errors' ); ok( $f->errors('bar'), 'bar has errors' ); ok( !$f->valid('foo'), 'foo is not valid' ); ok( !$f->valid('bar'), 'bar is not valid' ); } # Display both errors (explicitly) on multiple failure { $constraint->render_errors(qw/ foo bar /); my $query = HTMLWidget::TestLib->mock_query( { foo => [ '', '' ] } ); my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errors' ); ok( $f->errors('bar'), 'bar has errors' ); ok( !$f->valid('foo'), 'foo is not valid' ); ok( !$f->valid('bar'), 'bar is not valid' ); } HTML-Widget-1.11/t/filter_htmlstrip.t0000644000076400007640000000112210571572142017616 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 2; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo' ); $w->element( 'Textfield', 'bar' ); $w->filter( 'HTMLStrip', 'foo' ); $w->filter( 'HTMLStrip', 'bar' ); # With mocked basic query { my $query = HTMLWidget::TestLib->mock_query( { foo => '

message

', bar => '

23

', } ); my $f = $w->process($query); is( $f->param('foo'), 'message', 'foo value' ); is( $f->param('bar'), 23, 'bar value' ); } HTML-Widget-1.11/t/get_constraint.t0000644000076400007640000000217710571572142017261 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 8; use HTML::Widget; my $w = HTML::Widget->new; $w->constraint( 'Integer', 'foo' ); $w->constraint( 'Printable', 'bar' ); $w->constraint( 'All', 'baz', 'one' ); $w->constraint( 'All', 'baz', 'two' ); { my @constraints = $w->get_constraint; is( scalar(@constraints), 1, 'correct number of constraints' ); is_deeply( $constraints[0]->names, ['foo'], 'correct constraint names' ); } { my @constraints = $w->get_constraint( type => 'Integer' ); is( scalar(@constraints), 1, 'correct number of constraints' ); is_deeply( $constraints[0]->names, ['foo'], 'correct constraint names' ); isa_ok( $constraints[0], 'HTML::Widget::Constraint::Integer', 'correct constraint type' ); } { my @constraints = $w->get_constraint( type => 'All' ); is( scalar(@constraints), 1, 'correct number of constraints' ); is_deeply( $constraints[0]->names, [qw/ baz one /], 'correct constraint names' ); isa_ok( $constraints[0], 'HTML::Widget::Constraint::All', 'correct constraint type' ); } HTML-Widget-1.11/t/06bugs_zero_xml.t0000644000076400007640000000237210571572142017260 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 6; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w1 = HTML::Widget->new; $w1->element( 'Textfield', 'foo' ); $w1->element( 'Textfield', '0' ); # Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => 'yada', 0 => 'a', } ); my $result = $w1->process($query); ok( $result->valid(0), '0 valid' ); ok( !$result->has_errors(0), '0 not error' ); like( "$result", qr/\Q id="widget_0" name="0" type="text" value="a" /, 'name 0 XML ok' ); } # Embed test { my $query = HTMLWidget::TestLib->mock_query( { foo => 'yada', 0 => 'a', } ); my $w2 = new HTML::Widget; $w1->name('embed'); $w2->embed($w1); my $result = $w2->process($query); ok( $result->valid(0), '0 valid' ); ok( !$result->has_errors(0), '0 not error' ); is( "$result", <
EOF } HTML-Widget-1.11/t/06bugs_xml_escape.t0000644000076400007640000000075310571574724017552 0ustar cafrankscafranksuse strict; use warnings; use utf8; use Test::More tests => 2; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo' ); $w->element( 'Hidden', 'bar' ); { my $query = HTMLWidget::TestLib->mock_query( { foo => 'é', bar => '" foo >', } ); my $f = $w->process($query); like( "$f", qr'value="é"', 'utf-8 character ok' ); like( "$f", qr'value="" foo >"', '' ); } HTML-Widget-1.11/t/element_span.t0000644000076400007640000000121010571572142016673 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 1; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new->tag('span')->subtag('span'); $w->element( 'Span', 'foo' )->content('foo'); $w->element( 'Span', 'bar' ); my $b = HTML::Element->new('b'); $b->push_content('bold text'); $w->element( 'Span', 'baz' )->content($b); # Without query { my $f = $w->process; is( "$f", <foobold text EOF } HTML-Widget-1.11/t/element_checkbox.t0000644000076400007640000000333510571572142017532 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 2; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Checkbox', 'foo' )->value('foo')->label('Foo'); $w->element( 'Checkbox', 'bar' )->checked('checked'); $w->element( 'Checkbox', 'bar' )->checked('checked')->value('b'); $w->constraint( 'Integer', 'foo' ); $w->constraint( 'Integer', 'bar' ); # Without query { my $f = $w->process; is( "$f", <
EOF } # With mocked basic query { my $query = HTMLWidget::TestLib->mock_query( { foo => 'yada', bar => '23', } ); my $f = $w->process($query); is( "$f", <
Invalid Input
EOF } HTML-Widget-1.11/t/constraint_date.t0000644000076400007640000000201110571572142017402 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 7; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Textfield', 'year' ); $w->element( 'Textfield', 'month' ); $w->element( 'Textfield', 'day' ); $w->constraint( 'Date', 'year', 'month', 'day' ); # Valid { my $query = HTMLWidget::TestLib->mock_query( { year => '2005', month => '12', day => '9', } ); my $f = $w->process($query); is( $f->param('year'), 2005, 'year value' ); is( $f->param('month'), 12, 'month value' ); is( $f->param('day'), 9, 'day value' ); ok( !$f->errors, 'no errors' ); } # Invalid { my $query = HTMLWidget::TestLib->mock_query( { year => '2005', month => 'foo', day => '500', } ); my $f = $w->process($query); ok( $f->errors('year'), 'year has errors' ); ok( $f->errors('month'), 'month has errors' ); ok( $f->errors('day'), 'day has errors' ); } HTML-Widget-1.11/t/06bugs_select_empty_options.t0000644000076400007640000000076710571572142021677 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 2; use HTML::Widget; my $w = HTML::Widget->new; $w->element( 'Select', 'foo' ); $w->element( 'Select', 'bar' )->options(); eval { my $f = $w->process(); is( "$f", <
EOF }; ok( !$@, 'no errors' ); HTML-Widget-1.11/t/filter_whitespace.t0000644000076400007640000000101110571572142017721 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 2; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo' ); $w->element( 'Textfield', 'bar' ); $w->filter( 'Whitespace', 'foo' ); # With mocked basic query my $query = HTMLWidget::TestLib->mock_query( { foo => ' foo bar baz ', bar => ' 2 3 ', } ); my $f = $w->process($query); is( $f->param('foo'), 'foobarbaz', 'foo value' ); is( $f->param('bar'), ' 2 3 ', 'bar value' ); HTML-Widget-1.11/t/get_elements.t0000644000076400007640000000323510571572142016705 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 17; use HTML::Widget; my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo' ); $w->element( 'Textfield', 'bar' ); $w->element( 'Textarea', 'baz' ); $w->element( 'Password', 'baz' ); { my @elements = $w->get_elements; is( scalar(@elements), 4, 'correct number of elements' ); is( $elements[0]->name, 'foo', 'correct element name' ); is( $elements[1]->name, 'bar', 'correct element name' ); is( $elements[2]->name, 'baz', 'correct element name' ); is( $elements[3]->name, 'baz', 'correct element name' ); } { my @elements = $w->get_elements( type => 'Textfield' ); is( scalar(@elements), 2, 'correct number of elements' ); is( $elements[0]->name, 'foo', 'correct element name' ); is( $elements[1]->name, 'bar', 'correct element name' ); } { my @elements = $w->get_elements( type => 'Textarea' ); is( scalar(@elements), 1, 'correct number of elements' ); is( $elements[0]->name, 'baz', 'correct element name' ); } { my @elements = $w->get_elements( name => 'bar' ); is( scalar(@elements), 1, 'correct number of elements' ); is( $elements[0]->name, 'bar', 'correct element name' ); } { my @elements = $w->get_elements( name => 'baz' ); is( scalar(@elements), 2, 'correct number of elements' ); is( $elements[0]->name, 'baz', 'correct element name' ); is( $elements[1]->name, 'baz', 'correct element name' ); isa_ok( $elements[0], 'HTML::Widget::Element::Textarea', 'correct element type' ); isa_ok( $elements[1], 'HTML::Widget::Element::Password', 'correct element type' ); } HTML-Widget-1.11/t/element_button_tag.t0000644000076400007640000000246210571572142020112 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 4; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Button', 'foo' )->value('foo')->content('foo'); $w->element( 'Button', 'bar' )->content('')->type('submit'); $w->constraint( 'Integer', 'foo' ); $w->constraint( 'Integer', 'bar' ); # Without query { my $f = $w->process; is( "$f", <
EOF } # With mocked basic query { my $query = HTMLWidget::TestLib->mock_query( { foo => 'yada', bar => '23', } ); my $f = $w->process($query); is( "$f", <
EOF ok( !$f->valid('foo') ); ok( $f->valid('bar') ); } HTML-Widget-1.11/t/06bugs_zero_value_xml.t0000644000076400007640000001275310571572142020460 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 13; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Button', 'my_button', )->value(1); $w->element( 'Checkbox', 'my_checkbox' )->value(1)->checked('checked'); $w->element( 'Checkbox', 'my_checkbox' )->value(0); $w->element( 'Hidden', 'my_hidden' )->value(1); $w->element( 'Password', 'my_password' )->value(1)->fill(1); $w->element( 'Radio', 'my_radio' )->value(1)->checked('checked'); $w->element( 'Radio', 'my_radio' )->value(0); $w->element( 'RadioGroup', 'my_radiogroup' )->values( 1, 0 )->checked(1); $w->element( 'Reset', 'my_reset' )->value(1); $w->element( 'Select', 'my_select' ) ->options( 0 => 'unsubscribed', 1 => 'subscribed' )->selected(1); $w->element( 'Submit', 'my_submit' )->value(1); $w->element( 'Textarea', 'my_textarea' )->value(1); $w->element( 'Textfield', 'my_textfield' )->value(1); { my $f = $w->process(); is( "$f", <
EOF } # make sure XML of the result object has submitted values, not defaults { my $query = HTMLWidget::TestLib->mock_query( { my_button => 0, my_checkbox => 0, my_hidden => 0, my_password => 0, my_radio => 0, my_radiogroup => 0, my_reset => 0, my_select => 0, my_submit => 0, my_textarea => 0, my_textfield => 0, } ); my $f = $w->process($query); is( $f->param('my_button'), 0 ); is( $f->param('my_checkbox'), 0 ); is( $f->param('my_hidden'), 0 ); is( $f->param('my_password'), 0 ); is( $f->param('my_radio'), 0 ); is( $f->param('my_radiogroup'), 0 ); is( $f->param('my_reset'), 0 ); is( $f->param('my_select'), 0 ); is( $f->param('my_submit'), 0 ); is( $f->param('my_textarea'), 0 ); is( $f->param('my_textfield'), 0 ); is( "$f", <
EOF } HTML-Widget-1.11/t/retain_default.t0000644000076400007640000001165310571572142017223 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 2; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Button', 'my_button', )->value(1)->retain_default(1); $w->element( 'Checkbox', 'my_checkbox' )->value(1)->checked('checked') ->retain_default(1); $w->element( 'Checkbox', 'my_checkbox' )->value(0)->retain_default(1); $w->element( 'Hidden', 'my_hidden' )->value(1)->retain_default(1); $w->element( 'Password', 'my_password' )->value(1)->fill(1)->retain_default(1); $w->element( 'Radio', 'my_radio' )->value(1)->checked('checked') ->retain_default(1); $w->element( 'Radio', 'my_radio' )->value(0)->retain_default(1); $w->element( 'RadioGroup', 'my_radiogroup' )->values( 1, 0 )->checked(1) ->retain_default(1); $w->element( 'Reset', 'my_reset' )->value(1)->retain_default(1); $w->element( 'Select', 'my_select' ) ->options( 0 => 'unsubscribed', 1 => 'subscribed' )->selected(1) ->retain_default(1); $w->element( 'Submit', 'my_submit' )->value(1)->retain_default(1); $w->element( 'Textarea', 'my_textarea' )->value(1)->retain_default(1); $w->element( 'Textfield', 'my_textfield' )->value(1)->retain_default(1); { my $f = $w->process(); is( "$f", <
EOF } # make sure XML of the result object has empty values, not defaults { my $query = HTMLWidget::TestLib->mock_query( {} ); my $f = $w->process($query); is( "$f", <
EOF } HTML-Widget-1.11/t/10no_name.t0000644000076400007640000000347410571572142016014 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 4 + 1; # extra NoWarnings test use Test::NoWarnings; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; { my $w = HTML::Widget->new; $w->element('Block'); my $f = $w->process; is( "$f", <
EOF } { my $w = HTML::Widget->new; my $e = $w->element('Block'); $e->element('Submit'); my $f = $w->process; is( "$f", <
EOF } { my $w = HTML::Widget->new; my $fs = $w->element('Fieldset'); $fs->element( 'Textfield', 'foo' ); my $f = $w->process; is( "$f", <
EOF } { my $w = HTML::Widget->new; $w->element( 'Fieldset', 'foo' ) ->legend( 'the legend of foo' ) ->element('Fieldset') ->legend( 'the legend of blank' ) ->element( 'Fieldset', 'baz' ) ->legend( 'the legend of baz' ) ->element( 'Textfield', 'bar' ); my $f = $w->process; is( "$f", <
the legend of foo
the legend of blank
the legend of baz
EOF } HTML-Widget-1.11/t/get_element.t0000644000076400007640000000236410571572142016524 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 11; use HTML::Widget; my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo' ); $w->element( 'Textfield', 'bar' ); $w->element( 'Textarea', 'baz' ); $w->element( 'Password', 'baz' ); { my @elements = $w->get_element; is( scalar(@elements), 1, 'correct number of elements' ); is( $elements[0]->name, 'foo', 'correct element name' ); } { my @elements = $w->get_element( type => 'Textfield' ); is( scalar(@elements), 1, 'correct number of elements' ); is( $elements[0]->name, 'foo', 'correct element name' ); } { my @elements = $w->get_element( type => 'Textarea' ); is( scalar(@elements), 1, 'correct number of elements' ); is( $elements[0]->name, 'baz', 'correct element name' ); } { my @elements = $w->get_element( name => 'bar' ); is( scalar(@elements), 1, 'correct number of elements' ); is( $elements[0]->name, 'bar', 'correct element name' ); } { my @elements = $w->get_element( name => 'baz' ); is( scalar(@elements), 1, 'correct number of elements' ); is( $elements[0]->name, 'baz', 'correct element name' ); isa_ok( $elements[0], 'HTML::Widget::Element::Textarea', 'correct element type' ); } HTML-Widget-1.11/t/06bugs_value_zero.t0000644000076400007640000000155010571572142017571 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 1; use HTML::Widget; my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo' )->value(0); $w->element( 'RadioGroup', 'bar' )->values( 0, 1 )->value(0); $w->constraint( 'All', 'foo', 'bar' ); my $f = $w->process(); is( "$f", <
EOF HTML-Widget-1.11/t/constraint_length.t0000644000076400007640000000254110571572142017756 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 9; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo' ); $w->constraint( 'Length', 'foo' )->min(3)->max(4); # Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => 'yada' } ); my $f = $w->process($query); is( $f->param('foo'), 'yada', 'foo value' ); ok( !$f->errors, 'no errors' ); } # Valid (blank) { my $query = HTMLWidget::TestLib->mock_query( { foo => '' } ); my $f = $w->process($query); ok( !$f->errors, 'no errors' ); } # Invalid { my $query = HTMLWidget::TestLib->mock_query( { foo => 'yadayada' } ); my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errors' ); } # Multiple Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => [ 'yad', 'yada', 'nada' ], } ); my $f = $w->process($query); is( $f->valid('foo'), 1, "Valid" ); my @results = $f->param('foo'); is( $results[0], 'yad', "Multiple valid values" ); is( $results[1], 'yada', "Multiple valid values" ); is( $results[2], 'nada', "Multiple valid values" ); } # Multiple Invalid { my $query = HTMLWidget::TestLib->mock_query( { foo => [ 'yada', 'yadayada', 'yadayada' ], } ); my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errors' ); } HTML-Widget-1.11/t/08filter_all.t0000644000076400007640000000125110571572142016513 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 3; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo' ); $w->element( 'Textfield', 'bar' ); $w->filter_all('UpperCase'); # this element shouldn't get a filter added $w->element( 'Textfield', 'baz' ); # With mocked basic query { my $query = HTMLWidget::TestLib->mock_query( { foo => 'Foo', bar => 'Bar', baz => 'yada', } ); my $f = $w->process($query); is( $f->param('foo'), 'FOO', 'foo value' ); is( $f->param('bar'), 'BAR', 'bar value' ); is( $f->param('baz'), 'yada', 'bar value' ); } HTML-Widget-1.11/t/08constraint_all.t0000644000076400007640000000421210571572142017412 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 16; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; my $fs = $w->element( 'Fieldset', 'outer' ); $fs->element( 'Textfield', 'foo' ); $fs->element( 'Textfield', 'bar' ); $w->constraint_all('Bool'); # this element shouldn't get a constraint added $fs->element( 'Textfield', 'baz' ); # Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => 1, bar => 0, baz => 'yada' } ); my $f = $w->process($query); ok( $f->valid('foo'), 'foo value' ); ok( $f->valid('bar'), 'bar value' ); ok( $f->valid('baz'), 'baz value' ); ok( !$f->errors, 'no errors' ); my @cons = $w->get_constraints; is( scalar @cons, 2, '2 constraints' ); } # Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => 0 } ); my $f = $w->process($query); ok( $f->valid('foo'), 'foo value' ); ok( !$f->errors, 'no errors' ); } # undef valid { my $query = HTMLWidget::TestLib->mock_query( { foo => undef } ); my $f = $w->process($query); ok( $f->valid('foo') ); } # empty valid { my $query = HTMLWidget::TestLib->mock_query( { foo => '' } ); my $f = $w->process($query); ok( $f->valid('foo') ); is( $f->param('foo'), '', 'foo value' ); } # Invalid { my $query = HTMLWidget::TestLib->mock_query( { foo => 'yada', bar => 1 } ); my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errors' ); } # Multiple Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => [ 1, 0, 1 ], } ); my $f = $w->process($query); ok( $f->valid('foo'), 'Valid' ); my @results = $f->param('foo'); is_deeply( \@results, [ 1, 0, 1 ], 'Multiple valid values' ); } # Multiple Invalid { my $query = HTMLWidget::TestLib->mock_query( { foo => [ 1, 0, 2 ], } ); my $f = $w->process($query); ok( !$f->valid('foo'), 'foo not valid' ); ok( $f->errors('foo'), 'foo has errors' ); } # invalid { my $query = HTMLWidget::TestLib->mock_query( { foo => '11' } ); my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errors' ); } HTML-Widget-1.11/t/constraint_time.t0000644000076400007640000000202710571572142017432 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 7; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Textfield', 'hour' ); $w->element( 'Textfield', 'minute' ); $w->element( 'Textfield', 'second' ); $w->constraint( 'Time', 'hour', 'minute', 'second' ); # Valid { my $query = HTMLWidget::TestLib->mock_query( { hour => '6', minute => '12', second => '9', } ); my $f = $w->process($query); is( $f->param('hour'), 6, 'hour value' ); is( $f->param('minute'), 12, 'minute value' ); is( $f->param('second'), 9, 'second value' ); ok( !$f->errors, 'no errors' ); } # Invalid { my $query = HTMLWidget::TestLib->mock_query( { hour => '6', minute => '400', second => '5', } ); my $f = $w->process($query); ok( $f->errors('hour'), 'hour has errors' ); ok( $f->errors('minute'), 'minute has errors' ); ok( $f->errors('second'), 'second has errors' ); } HTML-Widget-1.11/t/01use.t0000644000076400007640000000011710571572142015163 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 1; use_ok('HTML::Widget'); HTML-Widget-1.11/t/lib/0000755000076400007640000000000010571575434014617 5ustar cafrankscafranksHTML-Widget-1.11/t/lib/HTMLWidget/0000755000076400007640000000000010571575434016527 5ustar cafrankscafranksHTML-Widget-1.11/t/lib/HTMLWidget/CustomConstraint.pm0000644000076400007640000000021510571572141022372 0ustar cafrankscafrankspackage HTMLWidget::CustomConstraint; use warnings; use strict; use base 'HTML::Widget::Constraint::Regex'; sub regex { qr/^[0-9]*$/ } 1; HTML-Widget-1.11/t/lib/HTMLWidget/CustomFilter.pm0000644000076400007640000000024710571572141021500 0ustar cafrankscafrankspackage HTMLWidget::CustomFilter; use warnings; use strict; use base 'HTML::Widget::Filter'; sub filter { my ( $self, $value ) = @_; return lc $value; } 1; HTML-Widget-1.11/t/lib/HTMLWidget/TestLib.pm0000644000076400007640000000206110571572141020422 0ustar cafrankscafrankspackage HTMLWidget::TestLib; use strict; use warnings; sub mock_query { my ( $self, $query ) = @_; return HTMLWidget::MockObject->new( $query ); } #### package HTMLWidget::MockObject; use strict; use warnings; sub new { my ( $class, $query ) = @_; die "query must be a hashref" unless ref($query) eq 'HASH'; return bless $query, $class; } sub param { my ( $self, $param, $value ) = @_; if ( @_ == 1 ) { return keys %$self; } elsif ( @_ == 3 ) { $self->{$param} = $value; return $self->{$param}; } else { unless ( exists $self->{$param} ) { return wantarray ? () : undef; } if ( ref $self->{$param} eq 'ARRAY' ) { return (wantarray) ? @{ $self->{$param} } : $self->{$param}->[0]; } else { return (wantarray) ? ( $self->{$param} ) : $self->{$param}; } } } 1; HTML-Widget-1.11/t/lib/HTMLWidget/CustomElement.pm0000644000076400007640000000132610571572141021643 0ustar cafrankscafrankspackage HTMLWidget::CustomElement; use warnings; use strict; use base 'HTML::Widget::Element'; __PACKAGE__->mk_accessors(qw/comment label value/); __PACKAGE__->mk_attr_accessors(qw/size maxlength/); sub prepare { my ($self) = @_; $self->attributes->{class} = "my_tag"; } sub containerize { my ( $self, $w, $value, $errors ) = @_; $value ||= $self->value; $value = ref $value eq 'ARRAY' ? shift @$value : $value; my $l = $self->mk_label( $w, $self->label, $self->comment, $errors ); my $i = $self->mk_input( $w, { type => 'text', value => $value }, $errors ); my $e = $self->mk_error( $w, $errors ); return $self->container( { element => $i, error => $e, label => $l } ); } 1; HTML-Widget-1.11/t/lib/TestContainer.pm0000644000076400007640000000110410571572141017723 0ustar cafrankscafranks package TestContainer; use strict; use warnings; use base 'HTML::Widget::Container'; sub _build_element { my $self = shift; my $e = shift; return () unless $e; return map { $self->_build_element($_) } @{$e} if ref $e eq 'ARRAY'; my $class = $e->attr('class') || ''; $e = new HTML::Element('span', class => 'custom_fields_with_errors')->push_content($e->clone ) if $self->error && $e->tag eq 'input'; my @list; push @list, $self->label, new HTML::Element('br') if $self->label; push @list, $e if $e; return @list; } 1; HTML-Widget-1.11/t/constraint_all.t0000644000076400007640000000251510571572142017246 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 10; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo' ); $w->element( 'Textfield', 'bar' ); $w->constraint( 'All', 'foo', 'bar' ); # Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => 'yada', bar => 'nada', } ); my $f = $w->process($query); is( $f->param('foo'), 'yada', 'foo value' ); is( $f->param('bar'), 'nada', 'bar value' ); ok( !$f->errors, 'no errors' ); } # Invalid { my $query = HTMLWidget::TestLib->mock_query( { foo => 'yada', } ); my $f = $w->process($query); is( $f->param('foo'), 'yada', 'foo value' ); ok( $f->errors('bar'), 'bar has errors' ); } # Empty strings - like an empty form as submitted by Firefox - should be error { my $query = HTMLWidget::TestLib->mock_query( { foo => '', bar => '' } ); my $f = $w->process($query); ok( $f->errors('foo'), 'foo has errors' ); ok( $f->errors('bar'), 'bar has errors' ); } # "0" as a query value { my $query = HTMLWidget::TestLib->mock_query( { foo => 0 } ); my $f = $w->process($query); ok( $f->valid('foo'), 'foo valid' ); is( $f->param('foo'), 0, 'foo value' ); ok( $f->errors('bar'), 'bar has errors' ); } HTML-Widget-1.11/t/04basic.t0000644000076400007640000001615310571572142015462 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 36; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new->method('post')->action('/foo/bar'); $w->element( 'Textfield', 'age' )->label('Age')->size(3); $w->element( 'Textfield', 'name' )->label('Name')->size(60); $w->element( 'Submit', 'ok' )->value('OK'); $w->legend('Fool'); $w->constraint( 'Integer', 'age' )->message('No integer.'); $w->constraint( 'Length', 'age' )->min(1)->max(3)->message('Wrong length.'); $w->constraint( 'Range', 'age' )->min(22)->max(24)->message('Wrong range.'); $w->constraint( 'Regex', 'age' )->regex(qr/\D+/) ->message('Contains digit characters.'); $w->constraint( 'Not_Integer', 'name' ); $w->constraint( 'All', 'age', 'name' )->message('Missing value.'); # Without query { my $f = $w->result; is( $f->as_xml, <
Fool
EOF } # With mocked basic query { my $query = HTMLWidget::TestLib->mock_query( { age => 23, name => 'sri', ok => 'OK', } ); my $f = $w->process($query); isa_ok( $f, 'HTML::Widget::Result', 'Result is HTML::Widget::Result object' ); my @e = $f->has_errors; ok( $f->valid('name'), 'Field name is valid' ); is( $e[0], 'age', 'Field age has errors' ); is( $f->valid('name'), 1, 'Field name is valid' ); is( !$f->valid('age'), 1, 'Field age is not valid' ); is( !$f->valid('foo'), 1, 'Field foo is not valid' ); is( !$f->has_errors('name'), 1, 'Field name has no errors' ); is( $f->has_errors('age'), 1, 'Field foo has errors' ); is( $f->has_error('foo'), 0, 'Field foo has no errors' ); is( $f->param('name'), 'sri', 'Param name is accessible' ); is( $f->param('age'), undef, 'Param age is not accessible' ); is( $f->param('foo'), undef, 'Param foo is not defined' ); is( $f->params->{name}, 'sri', 'Param name is defined' ); is( $f->params->{age}, undef, 'Param age is not defined' ); is( $f->parameters->{foo}, undef, 'Param foo is not defined' ); $f->add_valid( 'bar', 'dude' ); is( $f->params->{bar}, 'dude', 'Bar is dude' ); is( $f->param('bar'), 'dude', 'Bar is dude' ); is( $f->valid('bar'), 1, 'Bar is valid' ); my $c = $f->element('age'); isa_ok( $c, 'HTML::Widget::Container', 'Element is a container object' ); isa_ok( $c->element, 'HTML::Element', 'Element is a HTML::Element object' ); isa_ok( $c->error, 'HTML::Element', 'Error is a HTML::Element object' ); is( $c->javascript, '', 'JavaScript is empty' ); is( $c->element_xml, <Age EOF is( $c->error_xml, <Contains digit characters. EOF is( $c->javascript_xml, < EOF is( $c->as_xml, <Age Contains digit characters. EOF my @errors = $f->errors; is( $errors[0]->name, 'age', 'Expected error' ); is( $errors[0], 'Contains digit characters.', 'Field contains digit characters' ); is( "$f", <
FoolContains digit characters.
EOF } # Embed { my $w2 = HTML::Widget->new('foo')->action('/foo'); my $w3 = HTML::Widget->new('bar'); $w3->element( 'Textfield', 'baz' ); $w2->embed($w); $w2->embed($w3); my $f = $w2->process; is( $f->as_xml, <
Fool
EOF } # Merge { my $w2 = HTML::Widget->new('foo')->action('/foo'); my $w3 = HTML::Widget->new('bar'); $w3->element( 'Textfield', 'baz' ); $w2->merge($w); $w2->merge($w3); my $f = $w2->process; is( $f->as_xml, <
EOF } # *_ref methods { my @element = $w->get_elements; my @filter = $w->get_filters; my @constraint = $w->get_constraints; is_deeply( $w->get_elements_ref, \@element, 'get_elements_ref' ); is_deeply( $w->get_filters_ref, \@filter, 'get_filters_ref' ); is_deeply( $w->get_constraints_ref, \@constraint, 'get_constraints_ref' ); my $f = $w->process; my @f_element = $f->elements; is_deeply( $f->elements_ref, \@f_element, 'elements_ref' ); } HTML-Widget-1.11/t/06bugs_result_params_multiple.t0000644000076400007640000000077610571572142022223 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 2; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w1 = HTML::Widget->new; $w1->element( 'Textfield', 'foo' ); # Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => [ 'one', 'two' ], } ); my $result = $w1->process($query); ok( $result->valid('foo'), 'foo valid' ); my $params = $result->params; is_deeply( $params, { foo => [ 'one', 'two' ] }, '$result->params is_deeply' ); } HTML-Widget-1.11/t/element_select_constrain_options.t0000644000076400007640000000313410571572142023053 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 7; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Select', 'foo' )->label('Foo') ->options( 0 => 'zero', 1 => 'one', 2 => 'two' )->constrain_options(1); $w->element( 'Select', 'bar' )->label('Bar') ->options( 3 => 'three', 4 => 'four' )->constrain_values(1); # With mocked basic query { my $query = HTMLWidget::TestLib->mock_query( { foo => 1, bar => 1 } ); my $f = $w->process($query); my @constraints = $w->get_constraints; cmp_ok( scalar(@constraints), '==', 2, 'Two implicit IN constraints' ); cmp_ok( scalar( @{ $constraints[0]->in } ), '==', 3, 'Three keys for constraint 0' ); cmp_ok( scalar( @{ $constraints[1]->in } ), '==', 2, 'Two keys for constraint 1' ); ok( $f->valid('foo') ); ok( !$f->valid('bar') ); ok( $f->has_errors('bar') ); is( "$f", <
Invalid Input
EOF } HTML-Widget-1.11/t/constraint_dependon.t0000644000076400007640000000216510571572142020273 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 8; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Textfield', 'foo' ); $w->element( 'Textfield', 'bar' ); $w->constraint( 'DependOn', 'foo', 'bar' ); # Valid { my $query = HTMLWidget::TestLib->mock_query( { foo => 'yada', bar => 'nada', } ); my $f = $w->process($query); is( $f->param('foo'), 'yada', 'foo value' ); is( $f->param('bar'), 'nada', 'bar value' ); ok( !$f->errors, 'no errors' ); } # Valid { my $query = HTMLWidget::TestLib->mock_query( { other => 'whatever' } ); my $f = $w->process($query); ok( !$f->errors, 'no errors' ); } # Valid { my $query = HTMLWidget::TestLib->mock_query( { bar => 'only' } ); my $f = $w->process($query); is( $f->param('bar'), 'only', 'bar value' ); ok( !$f->errors, 'no errors' ); } # Invalid { my $query = HTMLWidget::TestLib->mock_query( { foo => 'yada' } ); my $f = $w->process($query); is( $f->param('foo'), 'yada', 'foo value' ); ok( $f->errors('bar'), 'bar has errors' ); } HTML-Widget-1.11/t/element_select.t0000644000076400007640000000557710571572142017235 0ustar cafrankscafranksuse strict; use warnings; use Test::More tests => 6; use HTML::Widget; use lib 't/lib'; use HTMLWidget::TestLib; my $w = HTML::Widget->new; $w->element( 'Select', 'foo' )->label('Foo') ->options( foo => 'Foo', bar => 'Bar' )->selected('foo'); $w->element( 'Select', 'bar' )->options( 23 => 'Baz', yada => 'Yada' ); $w->element( 'Select', 'stool' )->options( 1 => 'one', 2 => 'two' )->size(2); $w->element( 'Select', 'pigeon' )->options( 3 => 'three', 4 => 'four' ) ->multiple(1)->selected('4'); $w->constraint( 'Integer', 'foo' ); $w->constraint( 'Integer', 'stool' ); # Without query { my $f = $w->process; is( "$f", <
EOF } # With mocked basic query { my $query = HTMLWidget::TestLib->mock_query( { foo => 'foo', bar => [ 'yada', 23 ], stool => 2, pigeon => [ 3, 4 ], } ); my $f = $w->process($query); ok( !$f->valid('foo') ); ok( !$f->valid('bar') ); ok( $f->valid('stool') ); ok( $f->valid('pigeon') ); is( "$f", <
Invalid InputMultiple Selections Not Allowed
EOF } HTML-Widget-1.11/inc/0000755000076400007640000000000010571575434014357 5ustar cafrankscafranksHTML-Widget-1.11/inc/Module/0000755000076400007640000000000010571575434015604 5ustar cafrankscafranksHTML-Widget-1.11/inc/Module/Install/0000755000076400007640000000000010571575434017212 5ustar cafrankscafranksHTML-Widget-1.11/inc/Module/Install/WriteAll.pm0000644000076400007640000000162410571575337021300 0ustar cafrankscafranks#line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.64'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub WriteAll { my $self = shift; my %args = ( meta => 1, sign => 0, inline => 0, check_nmake => 1, @_ ); $self->sign(1) if $args{sign}; $self->Meta->write if $args{meta}; $self->admin->WriteAll(%args) if $self->is_admin; if ( $0 =~ /Build.PL$/i ) { $self->Build->write; } else { $self->check_nmake if $args{check_nmake}; unless ( $self->makemaker_args->{'PL_FILES'} ) { $self->makemaker_args( PL_FILES => {} ); } if ($args{inline}) { $self->Inline->write; } else { $self->Makefile->write; } } } 1; HTML-Widget-1.11/inc/Module/Install/Include.pm0000644000076400007640000000101410571575336021130 0ustar cafrankscafranks#line 1 package Module::Install::Include; use strict; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.64'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub include { shift()->admin->include(@_); } sub include_deps { shift()->admin->include_deps(@_); } sub auto_include { shift()->admin->auto_include(@_); } sub auto_include_deps { shift()->admin->auto_include_deps(@_); } sub auto_include_dependent_dists { shift()->admin->auto_include_dependent_dists(@_); } 1; HTML-Widget-1.11/inc/Module/Install/Fetch.pm0000644000076400007640000000463010571575337020606 0ustar cafrankscafranks#line 1 package Module::Install::Fetch; use strict; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.64'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub get_file { my ($self, %args) = @_; my ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) { $args{url} = $args{ftp_url} or (warn("LWP support unavailable!\n"), return); ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; } $|++; print "Fetching '$file' from $host... "; unless (eval { require Socket; Socket::inet_aton($host) }) { warn "'$host' resolve failed!\n"; return; } return unless $scheme eq 'ftp' or $scheme eq 'http'; require Cwd; my $dir = Cwd::getcwd(); chdir $args{local_dir} or return if exists $args{local_dir}; if (eval { require LWP::Simple; 1 }) { LWP::Simple::mirror($args{url}, $file); } elsif (eval { require Net::FTP; 1 }) { eval { # use Net::FTP to get past firewall my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); $ftp->login("anonymous", 'anonymous@example.com'); $ftp->cwd($path); $ftp->binary; $ftp->get($file) or (warn("$!\n"), return); $ftp->quit; } } elsif (my $ftp = $self->can_run('ftp')) { eval { # no Net::FTP, fallback to ftp.exe require FileHandle; my $fh = FileHandle->new; local $SIG{CHLD} = 'IGNORE'; unless ($fh->open("|$ftp -n")) { warn "Couldn't open ftp: $!\n"; chdir $dir; return; } my @dialog = split(/\n/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit END_FTP foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } else { warn "No working 'ftp' program available!\n"; chdir $dir; return; } unless (-f $file) { warn "Fetching failed: $@\n"; chdir $dir; return; } return if exists $args{size} and -s $file != $args{size}; system($args{run}) if exists $args{run}; unlink($file) if $args{remove}; print(((!exists $args{check_for} or -e $args{check_for}) ? "done!" : "failed! ($!)"), "\n"); chdir $dir; return !$?; } 1; HTML-Widget-1.11/inc/Module/Install/Can.pm0000644000076400007640000000337410571575337020262 0ustar cafrankscafranks#line 1 package Module::Install::Can; use strict; use Module::Install::Base; use Config (); ### This adds a 5.005 Perl version dependency. ### This is a bug and will be fixed. use File::Spec (); use ExtUtils::MakeMaker (); use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.64'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } # check if we can load some module ### Upgrade this to not have to load the module if possible sub can_use { my ($self, $mod, $ver) = @_; $mod =~ s{::|\\}{/}g; $mod .= '.pm' unless $mod =~ /\.pm$/i; my $pkg = $mod; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{}i; local $@; eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # check if we can run some command sub can_run { my ($self, $cmd) = @_; my $_cmd = $cmd; return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { my $abs = File::Spec->catfile($dir, $_[1]); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # can we locate a (the) C compiler sub can_cc { my $self = shift; my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return $self->can_run("@chunks") || (pop(@chunks), next); } return; } # Fix Cygwin bug on maybe_command(); if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; __END__ #line 157 HTML-Widget-1.11/inc/Module/Install/Makefile.pm0000644000076400007640000001337310571575337021276 0ustar cafrankscafranks#line 1 package Module::Install::Makefile; use strict 'vars'; use Module::Install::Base; use ExtUtils::MakeMaker (); use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.64'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub Makefile { $_[0] } my %seen = (); sub prompt { shift; # Infinite loop protection my @c = caller(); if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; } # In automated testing, always use defaults if ( $ENV{AUTOMATED_TESTING} and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } sub makemaker_args { my $self = shift; my $args = ($self->{makemaker_args} ||= {}); %$args = ( %$args, @_ ) if @_; $args; } # For mm args that take multiple space-seperated args, # append an argument to the current list. sub makemaker_append { my $self = shift; my $name = shift; my $args = $self->makemaker_args; $args->{name} = defined $args->{$name} ? join( ' ', $args->{name}, @_ ) : join( ' ', @_ ); } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join(' ', grep length, $clean->{FILES}, @_), ); } sub realclean_files { my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( %$realclean, FILES => join(' ', grep length, $realclean->{FILES}, @_), ); } sub libs { my $self = shift; my $libs = ref $_[0] ? shift : [ shift ]; $self->makemaker_args( LIBS => $libs ); } sub inc { my $self = shift; $self->makemaker_args( INC => shift ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name || $self->determine_NAME($args); $args->{VERSION} = $self->version || $self->determine_VERSION($args); $args->{NAME} =~ s/-/::/g; if ( $self->tests ) { $args->{test} = { TESTS => $self->tests }; } if ($] >= 5.005) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = $self->author; } if ( eval($ExtUtils::MakeMaker::VERSION) >= 6.10 ) { $args->{NO_META} = 1; } if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 and $self->sign ) { $args->{SIGN} = 1; } unless ( $self->is_admin ) { delete $args->{SIGN}; } # merge both kinds of requires into prereq_pm my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } map { @$_ } grep $_, ($self->build_requires, $self->requires) ); # merge both kinds of requires into prereq_pm my $subdirs = ($args->{DIR} ||= []); if ($self->bundles) { foreach my $bundle (@{ $self->bundles }) { my ($file, $dir) = @$bundle; push @$subdirs, $dir if -d $dir; delete $prereq->{$file}; } } if ( my $perl_version = $self->perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; } my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args; if ($self->admin->preop) { $args{dist} = $self->admin->preop; } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { my $self = shift; my $makefile_name = shift; my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; my $postamble = "# Postamble by $top_class $top_version\n" . ($self->postamble || ''); local *MAKEFILE; open MAKEFILE, "< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; my $makefile = do { local $/; }; close MAKEFILE or die $!; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; # Module::Install will never be used to build the Core Perl # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. $makefile =~ s/("?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; open MAKEFILE, "> $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; 1; } sub preamble { my ($self, $text) = @_; $self->{preamble} = $text . $self->{preamble} if defined $text; $self->{preamble}; } sub postamble { my ($self, $text) = @_; $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} } 1; __END__ #line 334 HTML-Widget-1.11/inc/Module/Install/Base.pm0000644000076400007640000000203510571575336020423 0ustar cafrankscafranks#line 1 package Module::Install::Base; $VERSION = '0.64'; # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } ### This is the ONLY module that shouldn't have strict on # use strict; #line 41 sub new { my ($class, %args) = @_; foreach my $method ( qw(call load) ) { *{"$class\::$method"} = sub { shift()->_top->$method(@_); } unless defined &{"$class\::$method"}; } bless( \%args, $class ); } #line 61 sub AUTOLOAD { my $self = shift; local $@; my $autoload = eval { $self->_top->autoload } or return; goto &$autoload; } #line 76 sub _top { $_[0]->{_top} } #line 89 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } sub is_admin { $_[0]->admin->VERSION; } sub DESTROY {} package Module::Install::Base::FakeAdmin; my $Fake; sub new { $Fake ||= bless(\@_, $_[0]) } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 138 HTML-Widget-1.11/inc/Module/Install/Metadata.pm0000644000076400007640000001747610571575336021310 0ustar cafrankscafranks#line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.64'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } my @scalar_keys = qw{ name module_name abstract author version license distribution_type perl_version tests }; my @tuple_keys = qw{ build_requires requires recommends bundles }; sub Meta { shift } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } foreach my $key (@scalar_keys) { *$key = sub { my $self = shift; return $self->{values}{$key} if defined wantarray and !@_; $self->{values}{$key} = shift; return $self; }; } foreach my $key (@tuple_keys) { *$key = sub { my $self = shift; return $self->{values}{$key} unless @_; my @rv; while (@_) { my $module = shift or last; my $version = shift || 0; if ( $module eq 'perl' ) { $version =~ s{^(\d+)\.(\d+)\.(\d+)} {$1 + $2/1_000 + $3/1_000_000}e; $self->perl_version($version); next; } my $rv = [ $module, $version ]; push @rv, $rv; } push @{ $self->{values}{$key} }, @rv; @rv; }; } sub sign { my $self = shift; return $self->{'values'}{'sign'} if defined wantarray and !@_; $self->{'values'}{'sign'} = ( @_ ? $_[0] : 1 ); return $self; } sub dynamic_config { my $self = shift; unless ( @_ ) { warn "You MUST provide an explicit true/false value to dynamic_config, skipping\n"; return $self; } $self->{'values'}{'dynamic_config'} = $_[0] ? 1 : 0; return $self; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { my $name = $self->name or die "all_from called with no args without setting name() first"; $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; die "all_from: cannot find $file from $name" unless -e $file; } $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; # The remaining probes read from POD sections; if the file # has an accompanying .pod, use that instead my $pod = $file; if ( $pod =~ s/\.pm$/.pod/i and -e $pod ) { $file = $pod; } $self->author_from($file) unless $self->author; $self->license_from($file) unless $self->license; $self->abstract_from($file) unless $self->abstract; } sub provides { my $self = shift; my $provides = ( $self->{values}{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->name, dist_version => $self->version, license => $self->license, ); $self->provides(%{ $build->find_dist_packages || {} }); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return $self->{values}->{features} ? @{ $self->{values}->{features} } : (); } sub no_index { my $self = shift; my $type = shift; push @{ $self->{values}{no_index}{$type} }, @_ if $type; return $self->{values}{no_index}; } sub read { my $self = shift; $self->include_deps( 'YAML', 0 ); require YAML; my $data = YAML::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { my ( $self, $file ) = @_; require ExtUtils::MM_Unix; $self->version( ExtUtils::MM_Unix->parse_version($file) ); } sub abstract_from { my ( $self, $file ) = @_; require ExtUtils::MM_Unix; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } sub _slurp { my ( $self, $file ) = @_; local *FH; open FH, "< $file" or die "Cannot open $file.pod: $!"; do { local $/; }; } sub perl_version_from { my ( $self, $file ) = @_; if ( $self->_slurp($file) =~ m/ ^ use \s* v? ([\d_\.]+) \s* ; /ixms ) { my $v = $1; $v =~ s{_}{}g; $self->perl_version($1); } else { warn "Cannot determine perl version info from $file\n"; return; } } sub author_from { my ( $self, $file ) = @_; my $content = $self->_slurp($file); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; $author =~ s{E}{<}g; $author =~ s{E}{>}g; $self->author($author); } else { warn "Cannot determine author info from $file\n"; } } sub license_from { my ( $self, $file ) = @_; if ( $self->_slurp($file) =~ m/ =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b (.*?) (=head\\d.*|=cut.*|) \z /ixms ) { my $license_text = $1; my @phrases = ( 'under the same (?:terms|license) as perl itself' => 'perl', 'GNU public license' => 'gpl', 'GNU lesser public license' => 'gpl', 'BSD license' => 'bsd', 'Artistic license' => 'artistic', 'GPL' => 'gpl', 'LGPL' => 'lgpl', 'BSD' => 'bsd', 'Artistic' => 'artistic', ); while ( my ( $pattern, $license ) = splice( @phrases, 0, 2 ) ) { $pattern =~ s{\s+}{\\s+}g; if ( $license_text =~ /\b$pattern\b/i ) { $self->license($license); return 1; } } } warn "Cannot determine license info from $file\n"; return 'unknown'; } 1; HTML-Widget-1.11/inc/Module/Install/AutoInstall.pm0000644000076400007640000000227210571575336022013 0ustar cafrankscafranks#line 1 package Module::Install::AutoInstall; use strict; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.64'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub AutoInstall { $_[0] } sub run { my $self = shift; $self->auto_install_now(@_); } sub write { my $self = shift; $self->auto_install(@_); } sub auto_install { my $self = shift; return if $self->{done}++; # Flatten array of arrays into a single array my @core = map @$_, map @$_, grep ref, $self->build_requires, $self->requires; my @config = @_; # We'll need Module::AutoInstall $self->include('Module::AutoInstall'); require Module::AutoInstall; Module::AutoInstall->import( (@config ? (-config => \@config) : ()), (@core ? (-core => \@core) : ()), $self->features, ); $self->makemaker_args( Module::AutoInstall::_make_args() ); my $class = ref($self); $self->postamble( "# --- $class section:\n" . Module::AutoInstall::postamble() ); } sub auto_install_now { my $self = shift; $self->auto_install(@_); Module::AutoInstall::do_install(); } 1; HTML-Widget-1.11/inc/Module/Install/Win32.pm0000644000076400007640000000341610571575337020460 0ustar cafrankscafranks#line 1 package Module::Install::Win32; use strict; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.64'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $^O eq 'MSWin32' and $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and ! $self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); if (!$rv) { die <<'END_MESSAGE'; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE } } 1; HTML-Widget-1.11/inc/Module/Install.pm0000644000076400007640000001761110571575336017557 0ustar cafrankscafranks#line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } use 5.004; use strict 'vars'; use vars qw{$VERSION}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or # different versions of modules. # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. $VERSION = '0.64'; } # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. # If not set, the caller may NOT have loaded the bundled version, and thus # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; unless ( $INC{$file} ) { die <<"END_DIE"; Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE } # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. if ( -f $0 and (stat($0))[9] > time ) { die << "END_DIE"; Your installer $0 has a modification time in the future. This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE } use Cwd (); use File::Find (); use File::Path (); use FindBin; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; sub autoload { my $self = shift; my $who = $self->_caller; my $cwd = Cwd::cwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::cwd(); if ( my $code = $sym->{$pwd} ) { # delegate back to parent dirs goto &$code unless $cwd eq $pwd; } $$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym"; unshift @_, ($self, $1); goto &{$self->can('call')} unless uc($1) eq $1; }; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; unless ( -f $self->{file} ) { require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); $self->{admin}->init; @_ = ($class, _self => $self); goto &{"$self->{name}::import"}; } *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{"$self->{file}"}; delete $INC{"$self->{path}.pm"}; } sub preload { my ($self) = @_; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { my $admin = $self->{admin}; @exts = $admin->load_all_extensions; } my %seen; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless $obj->can($method); next if $method =~ /^_/; next if $method eq uc($method); $seen{$method}++; } } my $who = $self->_caller; foreach my $name ( sort keys %seen ) { *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $class =~ s/^\Q$args{prefix}\E:://; $args{name} ||= $class; $args{version} ||= $class->VERSION; unless ( $args{path} ) { $args{path} = $args{name}; $args{path} =~ s!::!/!g; } $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; bless( \%args, $class ); } sub call { my ($self, $method) = @_; my $obj = $self->load($method) or return; splice(@_, 0, 2, $obj); goto &{$obj->can($method)}; } sub load { my ($self, $method) = @_; $self->load_extensions( "$self->{prefix}/$self->{path}", $self ) unless $self->{extensions}; foreach my $obj (@{$self->{extensions}}) { return $obj if $obj->can($method); } my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top) = @_; unless ( grep { lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; } foreach my $rv ( $self->find_extensions($path) ) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = delete $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); } $self->{extensions} ||= []; } sub find_extensions { my ($self, $path) = @_; my @found; File::Find::find( sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; my $subpath = $1; return if lc($subpath) eq lc($self->{dispatch}); $file = "$self->{path}/$subpath.pm"; my $pkg = "$self->{name}::$subpath"; $pkg =~ s!/!::!g; # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { open PKGFILE, "<$subpath.pm" or die "find_extensions: Can't open $subpath.pm: $!"; my $in_pod = 0; while ( ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text next if /^\s*#/; # and comments if ( m/^\s*package\s+($pkg)\s*;/i ) { $pkg = $1; last; } } close PKGFILE; } push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } 1; HTML-Widget-1.11/inc/Module/AutoInstall.pm0000644000076400007640000005077210571575336020415 0ustar cafrankscafranks#line 1 package Module::AutoInstall; use strict; use Cwd (); use ExtUtils::MakeMaker (); use vars qw{$VERSION}; BEGIN { $VERSION = '1.03'; } # special map on pre-defined feature sets my %FeatureMap = ( '' => 'Core Features', # XXX: deprecated '-core' => 'Core Features', ); # various lexical flags my ( @Missing, @Existing, %DisabledTests, $UnderCPAN, $HasCPANPLUS ); my ( $Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly ); my ( $PostambleActions, $PostambleUsed ); # See if it's a testing or non-interactive session _accept_default( $ENV{AUTOMATED_TESTING} or ! -t STDIN ); _init(); sub _accept_default { $AcceptDefault = shift; } sub missing_modules { return @Missing; } sub do_install { __PACKAGE__->install( [ $Config ? ( UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) : () ], @Missing, ); } # initialize various flags, and/or perform install sub _init { foreach my $arg ( @ARGV, split( /[\s\t]+/, $ENV{PERL_AUTOINSTALL} || $ENV{PERL_EXTUTILS_AUTOINSTALL} || '' ) ) { if ( $arg =~ /^--config=(.*)$/ ) { $Config = [ split( ',', $1 ) ]; } elsif ( $arg =~ /^--installdeps=(.*)$/ ) { __PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) ); exit 0; } elsif ( $arg =~ /^--default(?:deps)?$/ ) { $AcceptDefault = 1; } elsif ( $arg =~ /^--check(?:deps)?$/ ) { $CheckOnly = 1; } elsif ( $arg =~ /^--skip(?:deps)?$/ ) { $SkipInstall = 1; } elsif ( $arg =~ /^--test(?:only)?$/ ) { $TestOnly = 1; } } } # overrides MakeMaker's prompt() to automatically accept the default choice sub _prompt { goto &ExtUtils::MakeMaker::prompt unless $AcceptDefault; my ( $prompt, $default ) = @_; my $y = ( $default =~ /^[Yy]/ ); print $prompt, ' [', ( $y ? 'Y' : 'y' ), '/', ( $y ? 'n' : 'N' ), '] '; print "$default\n"; return $default; } # the workhorse sub import { my $class = shift; my @args = @_ or return; my $core_all; print "*** $class version " . $class->VERSION . "\n"; print "*** Checking for Perl dependencies...\n"; my $cwd = Cwd::cwd(); $Config = []; my $maxlen = length( ( sort { length($b) <=> length($a) } grep { /^[^\-]/ } map { ref($_) ? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} ) : '' } map { +{@args}->{$_} } grep { /^[^\-]/ or /^-core$/i } keys %{ +{@args} } )[0] ); while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) { my ( @required, @tests, @skiptests ); my $default = 1; my $conflict = 0; if ( $feature =~ m/^-(\w+)$/ ) { my $option = lc($1); # check for a newer version of myself _update_to( $modules, @_ ) and return if $option eq 'version'; # sets CPAN configuration options $Config = $modules if $option eq 'config'; # promote every features to core status $core_all = ( $modules =~ /^all$/i ) and next if $option eq 'core'; next unless $option eq 'core'; } print "[" . ( $FeatureMap{ lc($feature) } || $feature ) . "]\n"; $modules = [ %{$modules} ] if UNIVERSAL::isa( $modules, 'HASH' ); unshift @$modules, -default => &{ shift(@$modules) } if ( ref( $modules->[0] ) eq 'CODE' ); # XXX: bugward combatability while ( my ( $mod, $arg ) = splice( @$modules, 0, 2 ) ) { if ( $mod =~ m/^-(\w+)$/ ) { my $option = lc($1); $default = $arg if ( $option eq 'default' ); $conflict = $arg if ( $option eq 'conflict' ); @tests = @{$arg} if ( $option eq 'tests' ); @skiptests = @{$arg} if ( $option eq 'skiptests' ); next; } printf( "- %-${maxlen}s ...", $mod ); if ( $arg and $arg =~ /^\D/ ) { unshift @$modules, $arg; $arg = 0; } # XXX: check for conflicts and uninstalls(!) them. if ( defined( my $cur = _version_check( _load($mod), $arg ||= 0 ) ) ) { print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n"; push @Existing, $mod => $arg; $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; } else { print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n"; push @required, $mod => $arg; } } next unless @required; my $mandatory = ( $feature eq '-core' or $core_all ); if ( !$SkipInstall and ( $CheckOnly or _prompt( qq{==> Auto-install the } . ( @required / 2 ) . ( $mandatory ? ' mandatory' : ' optional' ) . qq{ module(s) from CPAN?}, $default ? 'y' : 'n', ) =~ /^[Yy]/ ) ) { push( @Missing, @required ); $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; } elsif ( !$SkipInstall and $default and $mandatory and _prompt( qq{==> The module(s) are mandatory! Really skip?}, 'n', ) =~ /^[Nn]/ ) { push( @Missing, @required ); $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; } else { $DisabledTests{$_} = 1 for map { glob($_) } @tests; } } $UnderCPAN = _check_lock(); # check for $UnderCPAN if ( @Missing and not( $CheckOnly or $UnderCPAN ) ) { require Config; print "*** Dependencies will be installed the next time you type '$Config::Config{make}'.\n"; # make an educated guess of whether we'll need root permission. print " (You may need to do that as the 'root' user.)\n" if eval '$>'; } print "*** $class configuration finished.\n"; chdir $cwd; # import to main:: no strict 'refs'; *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main'; } # Check to see if we are currently running under CPAN.pm and/or CPANPLUS; # if we are, then we simply let it taking care of our dependencies sub _check_lock { return unless @Missing; if ($ENV{PERL5_CPANPLUS_IS_RUNNING}) { print <<'END_MESSAGE'; *** Since we're running under CPANPLUS, I'll just let it take care of the dependency's installation later. END_MESSAGE return 1; } _load_cpan(); # Find the CPAN lock-file my $lock = MM->catfile( $CPAN::Config->{cpan_home}, ".lock" ); return unless -f $lock; # Check the lock local *LOCK; return unless open(LOCK, $lock); if ( ( $^O eq 'MSWin32' ? _under_cpan() : == getppid() ) and ( $CPAN::Config->{prerequisites_policy} || '' ) ne 'ignore' ) { print <<'END_MESSAGE'; *** Since we're running under CPAN, I'll just let it take care of the dependency's installation later. END_MESSAGE return 1; } close LOCK; return; } sub install { my $class = shift; my $i; # used below to strip leading '-' from config keys my @config = ( map { s/^-// if ++$i; $_ } @{ +shift } ); my ( @modules, @installed ); while ( my ( $pkg, $ver ) = splice( @_, 0, 2 ) ) { # grep out those already installed if ( defined( _version_check( _load($pkg), $ver ) ) ) { push @installed, $pkg; } else { push @modules, $pkg, $ver; } } return @installed unless @modules; # nothing to do return @installed if _check_lock(); # defer to the CPAN shell print "*** Installing dependencies...\n"; return unless _connected_to('cpan.org'); my %args = @config; my %failed; local *FAILED; if ( $args{do_once} and open( FAILED, '.#autoinstall.failed' ) ) { while () { chomp; $failed{$_}++ } close FAILED; my @newmod; while ( my ( $k, $v ) = splice( @modules, 0, 2 ) ) { push @newmod, ( $k => $v ) unless $failed{$k}; } @modules = @newmod; } if ( _has_cpanplus() ) { _install_cpanplus( \@modules, \@config ); } else { _install_cpan( \@modules, \@config ); } print "*** $class installation finished.\n"; # see if we have successfully installed them while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { if ( defined( _version_check( _load($pkg), $ver ) ) ) { push @installed, $pkg; } elsif ( $args{do_once} and open( FAILED, '>> .#autoinstall.failed' ) ) { print FAILED "$pkg\n"; } } close FAILED if $args{do_once}; return @installed; } sub _install_cpanplus { my @modules = @{ +shift }; my @config = _cpanplus_config( @{ +shift } ); my $installed = 0; require CPANPLUS::Backend; my $cp = CPANPLUS::Backend->new; my $conf = $cp->configure_object; return unless $conf->can('conf') # 0.05x+ with "sudo" support or _can_write($conf->_get_build('base')); # 0.04x # if we're root, set UNINST=1 to avoid trouble unless user asked for it. my $makeflags = $conf->get_conf('makeflags') || ''; if ( UNIVERSAL::isa( $makeflags, 'HASH' ) ) { # 0.03+ uses a hashref here $makeflags->{UNINST} = 1 unless exists $makeflags->{UNINST}; } else { # 0.02 and below uses a scalar $makeflags = join( ' ', split( ' ', $makeflags ), 'UNINST=1' ) if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } ); } $conf->set_conf( makeflags => $makeflags ); $conf->set_conf( prereqs => 1 ); while ( my ( $key, $val ) = splice( @config, 0, 2 ) ) { $conf->set_conf( $key, $val ); } my $modtree = $cp->module_tree; while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { print "*** Installing $pkg...\n"; MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall; my $success; my $obj = $modtree->{$pkg}; if ( $obj and defined( _version_check( $obj->{version}, $ver ) ) ) { my $pathname = $pkg; $pathname =~ s/::/\\W/; foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) { delete $INC{$inc}; } my $rv = $cp->install( modules => [ $obj->{module} ] ); if ( $rv and ( $rv->{ $obj->{module} } or $rv->{ok} ) ) { print "*** $pkg successfully installed.\n"; $success = 1; } else { print "*** $pkg installation cancelled.\n"; $success = 0; } $installed += $success; } else { print << "."; *** Could not find a version $ver or above for $pkg; skipping. . } MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall; } return $installed; } sub _cpanplus_config { my @config = (); while ( @_ ) { my ($key, $value) = (shift(), shift()); if ( $key eq 'prerequisites_policy' ) { if ( $value eq 'follow' ) { $value = CPANPLUS::Internals::Constants::PREREQ_INSTALL(); } elsif ( $value eq 'ask' ) { $value = CPANPLUS::Internals::Constants::PREREQ_ASK(); } elsif ( $value eq 'ignore' ) { $value = CPANPLUS::Internals::Constants::PREREQ_IGNORE(); } else { die "*** Cannot convert option $key = '$value' to CPANPLUS version.\n"; } } else { die "*** Cannot convert option $key to CPANPLUS version.\n"; } } return @config; } sub _install_cpan { my @modules = @{ +shift }; my @config = @{ +shift }; my $installed = 0; my %args; _load_cpan(); require Config; if (CPAN->VERSION < 1.80) { # no "sudo" support, probe for writableness return unless _can_write( MM->catfile( $CPAN::Config->{cpan_home}, 'sources' ) ) and _can_write( $Config::Config{sitelib} ); } # if we're root, set UNINST=1 to avoid trouble unless user asked for it. my $makeflags = $CPAN::Config->{make_install_arg} || ''; $CPAN::Config->{make_install_arg} = join( ' ', split( ' ', $makeflags ), 'UNINST=1' ) if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } ); # don't show start-up info $CPAN::Config->{inhibit_startup_message} = 1; # set additional options while ( my ( $opt, $arg ) = splice( @config, 0, 2 ) ) { ( $args{$opt} = $arg, next ) if $opt =~ /^force$/; # pseudo-option $CPAN::Config->{$opt} = $arg; } local $CPAN::Config->{prerequisites_policy} = 'follow'; while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall; print "*** Installing $pkg...\n"; my $obj = CPAN::Shell->expand( Module => $pkg ); my $success = 0; if ( $obj and defined( _version_check( $obj->cpan_version, $ver ) ) ) { my $pathname = $pkg; $pathname =~ s/::/\\W/; foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) { delete $INC{$inc}; } my $rv = $args{force} ? CPAN::Shell->force( install => $pkg ) : CPAN::Shell->install($pkg); $rv ||= eval { $CPAN::META->instance( 'CPAN::Distribution', $obj->cpan_file, ) ->{install} if $CPAN::META; }; if ( $rv eq 'YES' ) { print "*** $pkg successfully installed.\n"; $success = 1; } else { print "*** $pkg installation failed.\n"; $success = 0; } $installed += $success; } else { print << "."; *** Could not find a version $ver or above for $pkg; skipping. . } MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall; } return $installed; } sub _has_cpanplus { return ( $HasCPANPLUS = ( $INC{'CPANPLUS/Config.pm'} or _load('CPANPLUS::Shell::Default') ) ); } # make guesses on whether we're under the CPAN installation directory sub _under_cpan { require Cwd; require File::Spec; my $cwd = File::Spec->canonpath( Cwd::cwd() ); my $cpan = File::Spec->canonpath( $CPAN::Config->{cpan_home} ); return ( index( $cwd, $cpan ) > -1 ); } sub _update_to { my $class = __PACKAGE__; my $ver = shift; return if defined( _version_check( _load($class), $ver ) ); # no need to upgrade if ( _prompt( "==> A newer version of $class ($ver) is required. Install?", 'y' ) =~ /^[Nn]/ ) { die "*** Please install $class $ver manually.\n"; } print << "."; *** Trying to fetch it from CPAN... . # install ourselves _load($class) and return $class->import(@_) if $class->install( [], $class, $ver ); print << '.'; exit 1; *** Cannot bootstrap myself. :-( Installation terminated. . } # check if we're connected to some host, using inet_aton sub _connected_to { my $site = shift; return ( ( _load('Socket') and Socket::inet_aton($site) ) or _prompt( qq( *** Your host cannot resolve the domain name '$site', which probably means the Internet connections are unavailable. ==> Should we try to install the required module(s) anyway?), 'n' ) =~ /^[Yy]/ ); } # check if a directory is writable; may create it on demand sub _can_write { my $path = shift; mkdir( $path, 0755 ) unless -e $path; return 1 if -w $path; print << "."; *** You are not allowed to write to the directory '$path'; the installation may fail due to insufficient permissions. . if ( eval '$>' and lc(`sudo -V`) =~ /version/ and _prompt( qq( ==> Should we try to re-execute the autoinstall process with 'sudo'?), ((-t STDIN) ? 'y' : 'n') ) =~ /^[Yy]/ ) { # try to bootstrap ourselves from sudo print << "."; *** Trying to re-execute the autoinstall process with 'sudo'... . my $missing = join( ',', @Missing ); my $config = join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) if $Config; return unless system( 'sudo', $^X, $0, "--config=$config", "--installdeps=$missing" ); print << "."; *** The 'sudo' command exited with error! Resuming... . } return _prompt( qq( ==> Should we try to install the required module(s) anyway?), 'n' ) =~ /^[Yy]/; } # load a module and return the version it reports sub _load { my $mod = pop; # class/instance doesn't matter my $file = $mod; $file =~ s|::|/|g; $file .= '.pm'; local $@; return eval { require $file; $mod->VERSION } || ( $@ ? undef: 0 ); } # Load CPAN.pm and it's configuration sub _load_cpan { return if $CPAN::VERSION; require CPAN; if ( $CPAN::HandleConfig::VERSION ) { # Newer versions of CPAN have a HandleConfig module CPAN::HandleConfig->load; } else { # Older versions had the load method in Config directly CPAN::Config->load; } } # compare two versions, either use Sort::Versions or plain comparison sub _version_check { my ( $cur, $min ) = @_; return unless defined $cur; $cur =~ s/\s+$//; # check for version numbers that are not in decimal format if ( ref($cur) or ref($min) or $cur =~ /v|\..*\./ or $min =~ /v|\..*\./ ) { if ( ( $version::VERSION or defined( _load('version') )) and version->can('new') ) { # use version.pm if it is installed. return ( ( version->new($cur) >= version->new($min) ) ? $cur : undef ); } elsif ( $Sort::Versions::VERSION or defined( _load('Sort::Versions') ) ) { # use Sort::Versions as the sorting algorithm for a.b.c versions return ( ( Sort::Versions::versioncmp( $cur, $min ) != -1 ) ? $cur : undef ); } warn "Cannot reliably compare non-decimal formatted versions.\n" . "Please install version.pm or Sort::Versions.\n"; } # plain comparison local $^W = 0; # shuts off 'not numeric' bugs return ( $cur >= $min ? $cur : undef ); } # nothing; this usage is deprecated. sub main::PREREQ_PM { return {}; } sub _make_args { my %args = @_; $args{PREREQ_PM} = { %{ $args{PREREQ_PM} || {} }, @Existing, @Missing } if $UnderCPAN or $TestOnly; if ( $args{EXE_FILES} and -e 'MANIFEST' ) { require ExtUtils::Manifest; my $manifest = ExtUtils::Manifest::maniread('MANIFEST'); $args{EXE_FILES} = [ grep { exists $manifest->{$_} } @{ $args{EXE_FILES} } ]; } $args{test}{TESTS} ||= 't/*.t'; $args{test}{TESTS} = join( ' ', grep { !exists( $DisabledTests{$_} ) } map { glob($_) } split( /\s+/, $args{test}{TESTS} ) ); my $missing = join( ',', @Missing ); my $config = join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) if $Config; $PostambleActions = ( $missing ? "\$(PERL) $0 --config=$config --installdeps=$missing" : "\$(NOECHO) \$(NOOP)" ); return %args; } # a wrapper to ExtUtils::MakeMaker::WriteMakefile sub Write { require Carp; Carp::croak "WriteMakefile: Need even number of args" if @_ % 2; if ($CheckOnly) { print << "."; *** Makefile not written in check-only mode. . return; } my %args = _make_args(@_); no strict 'refs'; $PostambleUsed = 0; local *MY::postamble = \&postamble unless defined &MY::postamble; ExtUtils::MakeMaker::WriteMakefile(%args); print << "." unless $PostambleUsed; *** WARNING: Makefile written with customized MY::postamble() without including contents from Module::AutoInstall::postamble() -- auto installation features disabled. Please contact the author. . return 1; } sub postamble { $PostambleUsed = 1; return << "."; config :: installdeps \t\$(NOECHO) \$(NOOP) checkdeps :: \t\$(PERL) $0 --checkdeps installdeps :: \t$PostambleActions . } 1; __END__ #line 1003 HTML-Widget-1.11/MANIFEST0000644000076400007640000001075310571575402014740 0ustar cafrankscafranksChanges examples/big.pl examples/simple.css inc/Module/AutoInstall.pm inc/Module/Install.pm inc/Module/Install/AutoInstall.pm inc/Module/Install/Base.pm inc/Module/Install/Can.pm inc/Module/Install/Fetch.pm inc/Module/Install/Include.pm inc/Module/Install/Makefile.pm inc/Module/Install/Metadata.pm inc/Module/Install/Win32.pm inc/Module/Install/WriteAll.pm lib/HTML/Widget.pm lib/HTML/Widget/Accessor.pm lib/HTML/Widget/BlockContainer.pm lib/HTML/Widget/Constraint.pm lib/HTML/Widget/Constraint/All.pm lib/HTML/Widget/Constraint/AllOrNone.pm lib/HTML/Widget/Constraint/Any.pm lib/HTML/Widget/Constraint/ASCII.pm lib/HTML/Widget/Constraint/Bool.pm lib/HTML/Widget/Constraint/Callback.pm lib/HTML/Widget/Constraint/CallbackOnce.pm lib/HTML/Widget/Constraint/Date.pm lib/HTML/Widget/Constraint/DateTime.pm lib/HTML/Widget/Constraint/DependOn.pm lib/HTML/Widget/Constraint/Email.pm lib/HTML/Widget/Constraint/Equal.pm lib/HTML/Widget/Constraint/HTTP.pm lib/HTML/Widget/Constraint/In.pm lib/HTML/Widget/Constraint/Integer.pm lib/HTML/Widget/Constraint/Length.pm lib/HTML/Widget/Constraint/Maybe.pm lib/HTML/Widget/Constraint/Number.pm lib/HTML/Widget/Constraint/Printable.pm lib/HTML/Widget/Constraint/Range.pm lib/HTML/Widget/Constraint/Regex.pm lib/HTML/Widget/Constraint/SingleValue.pm lib/HTML/Widget/Constraint/String.pm lib/HTML/Widget/Constraint/Time.pm lib/HTML/Widget/Container.pm lib/HTML/Widget/Element.pm lib/HTML/Widget/Element/Block.pm lib/HTML/Widget/Element/Button.pm lib/HTML/Widget/Element/Checkbox.pm lib/HTML/Widget/Element/Fieldset.pm lib/HTML/Widget/Element/Hidden.pm lib/HTML/Widget/Element/NullContainer.pm lib/HTML/Widget/Element/Password.pm lib/HTML/Widget/Element/Radio.pm lib/HTML/Widget/Element/RadioGroup.pm lib/HTML/Widget/Element/Reset.pm lib/HTML/Widget/Element/Select.pm lib/HTML/Widget/Element/Span.pm lib/HTML/Widget/Element/Submit.pm lib/HTML/Widget/Element/Textarea.pm lib/HTML/Widget/Element/Textfield.pm lib/HTML/Widget/Element/Upload.pm lib/HTML/Widget/Error.pm lib/HTML/Widget/Filter.pm lib/HTML/Widget/Filter/Callback.pm lib/HTML/Widget/Filter/HTMLEscape.pm lib/HTML/Widget/Filter/HTMLStrip.pm lib/HTML/Widget/Filter/LowerCase.pm lib/HTML/Widget/Filter/TrimEdges.pm lib/HTML/Widget/Filter/UpperCase.pm lib/HTML/Widget/Filter/Whitespace.pm lib/HTML/Widget/Manual/Developer.pod lib/HTML/Widget/Result.pm Makefile.PL MANIFEST This list of files META.yml README t/01use.t t/02pod.t t/03podcoverage.t t/04basic.t t/05strict.t t/06bugs_ascii_space.t t/06bugs_callbackone_missing_param.t t/06bugs_constraint_range_zero_max.t t/06bugs_constraint_range_zero_min.t t/06bugs_in_value_empty.t t/06bugs_name_regex_chars.t t/06bugs_result_elements_warnings.t t/06bugs_result_params_multiple.t t/06bugs_select_empty_options.t t/06bugs_select_zero_key_constraint.t t/06bugs_value_empty_string.t t/06bugs_value_no_default.t t/06bugs_value_zero.t t/06bugs_widget_get_elements.t t/06bugs_widget_name_zero.t t/06bugs_xml_escape.t t/06bugs_zero_value_xml.t t/06bugs_zero_xml.t t/07custom_render.t t/08constraint_all.t t/08empty_errors.t t/08filter_all.t t/09nested_embed.t t/10explicit_ids.t t/10no_name.t t/attributes.t t/constraint_all.t t/constraint_allornone.t t/constraint_any.t t/constraint_ascii.t t/constraint_bool.t t/constraint_callback.t t/constraint_callbackonce.t t/constraint_custom_namespace.t t/constraint_date.t t/constraint_datetime.t t/constraint_dependon.t t/constraint_email.t t/constraint_equal.t t/constraint_http.t t/constraint_in.t t/constraint_integer.t t/constraint_length.t t/constraint_number.t t/constraint_printable.t t/constraint_range.t t/constraint_regex.t t/constraint_singlevalue.t t/constraint_string.t t/constraint_time.t t/element_block.t t/element_button.t t/element_button_tag.t t/element_checkbox.t t/element_custom_namespace.t t/element_hidden.t t/element_password.t t/element_radio.t t/element_radiogroup.t t/element_radiogroup_constrain_values.t t/element_reset.t t/element_select.t t/element_select_constrain_options.t t/element_span.t t/element_submit.t t/element_textarea.t t/element_textfield.t t/element_upload.t t/filter_callback.t t/filter_custom_namespace.pm t/filter_htmlescape.t t/filter_htmlstrip.t t/filter_lowercase.t t/filter_trimedges.t t/filter_uppercase.t t/filter_whitespace.t t/get_constraint.t t/get_constraints.t t/get_element.t t/get_elements.t t/get_errors.t t/get_filter.t t/get_filters.t t/lib/HTMLWidget/CustomConstraint.pm t/lib/HTMLWidget/CustomElement.pm t/lib/HTMLWidget/CustomFilter.pm t/lib/HTMLWidget/TestLib.pm t/lib/TestContainer.pm t/result_add_error.t t/retain_default.t t/submitted.t HTML-Widget-1.11/examples/0000755000076400007640000000000010571575434015424 5ustar cafrankscafranksHTML-Widget-1.11/examples/big.pl0000644000076400007640000000231410571572143016514 0ustar cafrankscafranksuse HTML::Widget; use Test::MockObject; my $w1 = HTML::Widget->new('widget1')->legend('widget1'); my $w2 = HTML::Widget->new('widget2'); $w1->element( 'Checkbox', 'checkbox1' )->label('Checkbox1'); $w1->element( 'Checkbox', 'checkbox2' )->label('Checkbox3'); $w1->element( 'Checkbox', 'checkbox3' )->label('Checkbox2'); $w1->element( 'Radio', 'radio' )->label('Radio1'); $w1->element( 'Radio', 'radio' )->label('Radio2'); $w1->element( 'Radio', 'radio' )->label('Radio3'); $w1->element( 'Textarea', 'textarea' )->label('Textarea'); $w1->element( 'Textfield', 'texfield' )->label('Textfield') ->comment('(Optional)'); $w1->element( 'Upload', 'upload' )->label('Upload'); $w1->element( 'Submit', 'submit' )->value('Submit'); $w1->constraint( 'All', qw/checkbox1 checkbox2 checkbox3 radio1 radio2 radio3 textarea textfield upload submit/ )->message('Required'); my $f1 = $w1->process; print "Example1:\n"; print $f1; $w2->embed($w1); my $f2 = $w2->process; print "Example2:\n"; print $f2; my $query = Test::MockObject->new; my $data = { foo => 'bar' }; $query->mock( 'param', sub { $_[1] ? ( return $data->{ $_[1] } ) : ( keys %$data ) } ); my $f3 = $w2->process($query); print "Example3:\n"; print $f3; HTML-Widget-1.11/examples/simple.css0000644000076400007640000000226110571572143017422 0ustar cafrankscafranksbody { font-family: verdana, tahoma, sans-serif; } form { width: 50%; margin: 1em auto; } .widget_fieldset { padding: 0.5em 0; border: 1px solid #c0c0c0; background: #f0f0f0; } legend { font-weight: bold; font-style: italic; color: #333; margin: 0; padding: 0.1em 0.5em; } label, .radiogroup_fieldset { padding: 0 1em; margin: 0em; margin-top: 0.5em; display: block; } textarea { width: 100%; } input.submit { margin-left: 1em; font-weight: bold; clear: both; display: block; margin-top: 1em; } input.texfield, input.password { margin-top: 0.1em; display: block; width: 50%; } .labels_with_errors { display: block; padding-top: 5px; border-top: 1px solid red; background: #e0e0e0; } .labels_with_errors span, .labels_with_errors input { margin-top: 0; margin-bottom: 0; } .error_messages { color: red; font-style: italic; padding: 5px 1em; display: block; border-bottom: 1px solid red; background: #e0e0e0; } .label_comments { font-style: italic; color: #444; margin-left: 0.4em; } HTML-Widget-1.11/lib/0000755000076400007640000000000010571575434014354 5ustar cafrankscafranksHTML-Widget-1.11/lib/HTML/0000755000076400007640000000000010571575434015120 5ustar cafrankscafranksHTML-Widget-1.11/lib/HTML/Widget.pm0000644000076400007640000012443710571574163016712 0ustar cafrankscafrankspackage HTML::Widget; use warnings; use strict; use base 'HTML::Widget::Accessor'; use HTML::Widget::Result; use Scalar::Util 'blessed'; use Carp qw/croak/; # For PAR use Module::Pluggable::Fast search => [qw/HTML::Widget::Element HTML::Widget::Constraint HTML::Widget::Filter/], require => 1; __PACKAGE__->plugins; __PACKAGE__->mk_accessors( qw/container indicator query subcontainer uploads strict empty_errors element_container_class xhtml_strict unwrapped explicit_ids/ ); __PACKAGE__->mk_ro_accessors(qw/implicit_subcontainer/); # Custom attr_accessor for id provided later __PACKAGE__->mk_attr_accessors(qw/action enctype method/); use overload '""' => sub { return shift->attributes->{id} }, fallback => 1; *const = \&constraint; *elem = \&element; *name = \&id; *tag = \&container; *subtag = \&subcontainer; *result = \&process; *indi = \&indicator; *constrain_all = \*constraint_all; our $VERSION = '1.11'; =head1 NAME HTML::Widget - HTML Widget And Validation Framework =head1 NOTE L is no longer under active development and the current maintainers are instead pursuing an intended replacement (see the L for details). Volunteer maintainers / developers for L, please contact the L. =head1 SYNOPSIS use HTML::Widget; # Create a widget my $w = HTML::Widget->new('widget')->method('get')->action('/'); # Add a fieldset to contain the elements my $fs = $w->element( 'Fieldset', 'user' )->legend('User Details'); # Add some elements $fs->element( 'Textfield', 'age' )->label('Age')->size(3); $fs->element( 'Textfield', 'name' )->label('Name')->size(60); $fs->element( 'Submit', 'ok' )->value('OK'); # Add some constraints $w->constraint( 'Integer', 'age' )->message('No integer.'); $w->constraint( 'Not_Integer', 'name' )->message('Integer.'); $w->constraint( 'All', 'age', 'name' )->message('Missing value.'); # Add some filters $w->filter('Whitespace'); # Process my $result = $w->process; my $result = $w->process($query); # Check validation results my @valid_fields = $result->valid; my $is_valid = $result->valid('foo'); my @invalid_fields = $result->have_errors; my $is_invalid = $result->has_errors('foo');; # CGI.pm-compatible! (read-only) my $value = $result->param('foo'); my @params = $result->param; # Catalyst::Request-compatible my $value = $result->params->{foo}; my @params = keys %{ $result->params }; # Merge widgets (constraints and elements will be appended) $widget->merge($other_widget); # Embed widgets (as fieldset) $widget->embed($other_widget); # Get list of elements my @elements = $widget->get_elements; # Get list of constraints my @constraints = $widget->get_constraints; # Get list of filters my @filters = $widget->get_filters; # Complete xml result [% result %] [% result.as_xml %] # Iterate over elements
[% FOREACH element = result.elements %] [% element.field_xml %] [% element.error_xml %] [% END %]
# Iterate over validation errors [% FOREACH element = result.have_errors %]

[% element %]:

    [% FOREACH error = result.errors(element) %]
  • [% error.name %]: [% error.message %] ([% error.type %])
  • [% END %]

[% END %]

    [% FOREACH element = result.have_errors %] [% IF result.error( element, 'Integer' ) %]
  • [% element %] has to be an integer.
  • [% END %] [% END %]

[% FOREACH error = result.errors %]
  • [% error.name %]: [% error.message %] ([% error.type %])
  • [% END %] # XML output looks like this (easy to theme with css)
    Contains digit characters.
    =head1 DESCRIPTION Create easy to maintain HTML widgets! Everything is optional, use validation only or just generate forms, you can embed and merge them later. The API was designed similar to other popular modules like L and L, L is also built in (and much faster). This Module is very powerful, don't misuse it as a template system! =head1 METHODS =head2 new Arguments: $name, \%attributes Return Value: $widget Create a new HTML::Widget object. The name parameter will be used as the id of the form created by the to_xml method. The C argument is equivalent to using the L method. =cut sub new { my ( $self, $name, $attrs ) = @_; $self = bless {}, ( ref $self || $self ); $self->container('form'); $self->subcontainer('fieldset'); $self->name( defined $name ? $name : 'widget' ); if ( defined $attrs ) { croak 'attributes argument must be a hash-reference' if ref($attrs) ne 'HASH'; $self->attributes->{$_} = $attrs->{$_} for keys %$attrs; } return $self; } =head2 action Arguments: $uri Return Value: $uri Get/Set the action associated with the form. The default is no action, which causes most browsers to submit to the current URI. =head2 attributes =head2 attrs Arguments: %attributes Arguments: \%attributes Return Value: $widget Arguments: none Return Value: \%attributes Accepts either a list of key/value pairs, or a hash-ref. $w->attributes( $key => $value ); $w->attributes( { $key => $value } ); Returns the C<$widget> object, to allow method chaining. As of v1.10, passing a hash-ref no longer deletes current attributes, instead the attributes are added to the current attributes hash. This means the attributes hash-ref can no longer be emptied using C<< $w->attributes( { } ); >>. Instead, you may use C<< %{ $w->attributes } = (); >>. As a special case, if no arguments are passed, the return value is a hash-ref of attributes instead of the object reference. This provides backwards compatability to support: $w->attributes->{key} = $value; L is an alias for L. =head2 container Arguments: $tag Return Value: $tag Get/Set the tag used to contain the XML output when as_xml is called on the HTML::Widget object. Defaults to C
    . =head2 element_container_class Arguments: $class_name Return Value: $class_name Get/Set the container_class override for all elements in this widget. If set to non-zero value, process will call $element->container_class($class_name) for each element. Defaults to not set. See L. =head2 elem =head2 element Arguments: $type, $name, \%attributes Return Value: $element Add a new element to the Widget. Each element must be given at least a type. The name is used to generate an id attribute on the tag created for the element, and for form-specific elements is used as the name attribute. The returned element object can be used to set further attributes, please see the individual element classes for the methods specific to each one. The C argument is equivalent to using the L method. If the element starts with a name other than C, you can fully qualify the name by using a unary plus: $self->element( "+Fully::Qualified::Name", $name ); The type can be one of the following: =over 4 =item L my $e = $widget->element('Block'); Add a Block element, which by default will be rendered as a C
    . my $e = $widget->element('Block'); $e->type('img'); =item L my $e = $widget->element( 'Button', 'foo' ); $e->value('bar'); Add a button element. my $e = $widget->element( 'Button', 'foo' ); $e->value('bar'); $e->content('arbitrary markup'); $e->type('submit'); Add a button element which uses a C