migrate FormBuilder to Moose. Start tests
This commit is contained in:
parent
814bde6b93
commit
7ee8fec611
8 changed files with 1073 additions and 0 deletions
199
lib/WebGUI/FormBuilder.pm
Normal file
199
lib/WebGUI/FormBuilder.pm
Normal file
|
|
@ -0,0 +1,199 @@
|
|||
package WebGUI::FormBuilder;
|
||||
|
||||
use strict;
|
||||
use Moose;
|
||||
use MooseX::Storage;
|
||||
|
||||
has 'action' => ( is => 'rw' );
|
||||
has 'enctype' => ( is => 'rw', default => 'multipart/form-data' );
|
||||
has 'method' => ( is => 'rw', default => 'POST' );
|
||||
has 'name' => ( is => 'rw' );
|
||||
has 'session' => (
|
||||
is => 'ro',
|
||||
isa => 'WebGUI::Session',
|
||||
required => 1,
|
||||
weak_ref => 1,
|
||||
traits => [ 'DoNotSerialize' ],
|
||||
);
|
||||
|
||||
with Storage( format => 'JSON' );
|
||||
with 'WebGUI::FormBuilder::Role::HasFields';
|
||||
with 'WebGUI::FormBuilder::Role::HasFieldsets';
|
||||
with 'WebGUI::FormBuilder::Role::HasTabs';
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 new ( session, properties )
|
||||
|
||||
Create a new FormBuilder object. C<properties> is a list of name => value pairs
|
||||
|
||||
=over 4
|
||||
|
||||
=item name
|
||||
|
||||
The name of the form. Optional, but recommended.
|
||||
|
||||
=item action
|
||||
|
||||
The URL to submit the form to.
|
||||
|
||||
=item method
|
||||
|
||||
The HTTP method to submit the form with. Defaults to POST.
|
||||
|
||||
=item enctype
|
||||
|
||||
The encoding type to use for the form. Defaults to "multipart/form-data". The
|
||||
other possible value is "application/x-www-form-urlencoded".
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
||||
sub new {
|
||||
my ( $class, $session, %properties ) = @_;
|
||||
$properties{ session } = $session;
|
||||
return $class->SUPER::new( %properties );
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 action ( [ newAction ] )
|
||||
|
||||
Get or set the action property / HTML attribute.
|
||||
|
||||
=cut
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 clone ( )
|
||||
|
||||
Create a clone of this Form
|
||||
|
||||
=cut
|
||||
|
||||
sub clone {
|
||||
my ( $self ) = @_;
|
||||
return (ref $self)->newFromHashRef( $self->toHashRef );
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 enctype ( [ newEnctype ] )
|
||||
|
||||
Get or set the enctype property / HTML attribute.
|
||||
|
||||
=cut
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 method ( [ newMethod ] )
|
||||
|
||||
Get or set the method property / HTML attribute.
|
||||
|
||||
=cut
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 name ( [ newName ] )
|
||||
|
||||
Get or set the name property / HTML attribute.
|
||||
|
||||
=cut
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 session ( )
|
||||
|
||||
Get the WebGUI::Session attached to this object
|
||||
|
||||
=cut
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 toHtml ( )
|
||||
|
||||
Return the HTML for the form
|
||||
|
||||
=cut
|
||||
|
||||
sub toHtml {
|
||||
my ( $self ) = @_;
|
||||
|
||||
my @attrs = qw{ action method name enctype };
|
||||
my $attrs = join " ", map { qq{$_="} . $self->get($_) . qq{"} } @attrs;
|
||||
|
||||
my $html = sprintf '<form %s>', $attrs;
|
||||
$html .= $self->maybe::next::method;
|
||||
$html .= '</form>';
|
||||
|
||||
return $html;
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 toTemplateVars ( prefix, [var] )
|
||||
|
||||
Get the template variables for the form's controls with the given prefix.
|
||||
C<var> is an optional hashref to add the variables to.
|
||||
|
||||
=cut
|
||||
|
||||
sub toTemplateVars {
|
||||
my ( $self, $prefix, $var ) = @_;
|
||||
$prefix ||= "form";
|
||||
$var ||= {};
|
||||
|
||||
# TODO
|
||||
# $prefix_header
|
||||
# $prefix_footer
|
||||
# $prefix_field_loop
|
||||
# name -- for comparisons
|
||||
# field
|
||||
# label -- includes hoverhelp
|
||||
# label_nohover
|
||||
# pretext
|
||||
# subtext
|
||||
# hoverhelp -- The text. For use with label_nohover
|
||||
# $prefix_field_$fieldName
|
||||
# $prefix_label_$fieldName
|
||||
# $prefix_fieldset_loop
|
||||
# name
|
||||
# legend
|
||||
# label -- same as legend
|
||||
# $prefix_field_loop
|
||||
# ...
|
||||
# $prefix_fieldset_loop
|
||||
# ...
|
||||
# $prefix_tab_loop
|
||||
# ...
|
||||
# $prefix_fieldset_$fieldsetName
|
||||
# ...
|
||||
# $prefix_tab_loop
|
||||
# name
|
||||
# label
|
||||
# $prefix_field_loop
|
||||
# ...
|
||||
# $prefix_fieldset_loop
|
||||
# ...
|
||||
# $prefix_tab_loop
|
||||
# ...
|
||||
# $prefix_tab_$tabName
|
||||
# ...
|
||||
return $var;
|
||||
}
|
||||
|
||||
=head1 TEMPLATES
|
||||
|
||||
=head2 Default View
|
||||
|
||||
This is a Template Toolkit template that will recreate the default toHtml() view
|
||||
of a form.
|
||||
|
||||
# TODO
|
||||
|
||||
=cut
|
||||
|
||||
1;
|
||||
124
lib/WebGUI/FormBuilder/Fieldset.pm
Normal file
124
lib/WebGUI/FormBuilder/Fieldset.pm
Normal file
|
|
@ -0,0 +1,124 @@
|
|||
package WebGUI::FormBuilder::Fieldset;
|
||||
|
||||
use strict;
|
||||
use Moose;
|
||||
use MooseX::Storage;
|
||||
|
||||
has 'name' => (
|
||||
is => 'ro',
|
||||
isa => 'Str',
|
||||
required => 1,
|
||||
);
|
||||
|
||||
has 'label' => (
|
||||
is => 'rw',
|
||||
isa => 'Str',
|
||||
);
|
||||
|
||||
has 'session' => (
|
||||
is => 'ro',
|
||||
isa => 'WebGUI::Session',
|
||||
required => 1,
|
||||
weak_ref => 1,
|
||||
traits => [ 'DoNotSerialize' ],
|
||||
);
|
||||
|
||||
with Storage( format => 'JSON' );
|
||||
with 'WebGUI::FormBuilder::Role::HasFields';
|
||||
with 'WebGUI::FormBuilder::Role::HasFieldsets';
|
||||
with 'WebGUI::FormBuilder::Role::HasTabs';
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=cut
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 new ( session, properties )
|
||||
|
||||
Create a new Fieldset object. C<session> is a WebGUI Session. C<properties> is
|
||||
a list of name => value pairs.
|
||||
|
||||
|
||||
=over 4
|
||||
|
||||
=item name
|
||||
|
||||
Required. The name of the fieldset. Cannot be changed after initially set,
|
||||
otherwise the parent <form> may not work correctly.
|
||||
|
||||
=item label
|
||||
|
||||
Optional. A label to show the user.
|
||||
|
||||
=item legend
|
||||
|
||||
Optional. A synonym for C<label>.
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
||||
sub new {
|
||||
my ( $class, $session, %properties ) = @_;
|
||||
$properties{ session } = $session;
|
||||
$properties{ label } ||= delete $properties{ legend };
|
||||
return $class->SUPER::new( %properties );
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 label ( newLabel )
|
||||
|
||||
A label to show the user
|
||||
|
||||
=cut
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 legend ( newLegend )
|
||||
|
||||
A synonym for label.
|
||||
|
||||
=cut
|
||||
|
||||
sub legend {
|
||||
my ( $self, @args ) = @_;
|
||||
return $self->label( @args );
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 name ( )
|
||||
|
||||
The name of the fieldset. Read-only.
|
||||
|
||||
=cut
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 session ( )
|
||||
|
||||
Get the WebGUI::Session attached to this object
|
||||
|
||||
=cut
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 toHtml ( )
|
||||
|
||||
Returns the HTML to render the fieldset.
|
||||
|
||||
=cut
|
||||
|
||||
sub toHtml {
|
||||
my ( $self ) = @_;
|
||||
|
||||
my $html = '<fieldset><legend>' . $self->legend . '</legend>';
|
||||
$html .= $self->maybe::next::method;
|
||||
$html .= '</fieldset>';
|
||||
|
||||
return $html;
|
||||
}
|
||||
|
||||
1;
|
||||
122
lib/WebGUI/FormBuilder/Role/HasFields.pm
Normal file
122
lib/WebGUI/FormBuilder/Role/HasFields.pm
Normal file
|
|
@ -0,0 +1,122 @@
|
|||
package WebGUI::FormBuilder::Role::HasFields;
|
||||
|
||||
use strict;
|
||||
use Moose::Role;
|
||||
|
||||
requires 'session', 'pack', 'unpack';
|
||||
|
||||
has 'fields' => (
|
||||
is => 'rw',
|
||||
isa => 'ArrayRef[WebGUI::Form::Control]',
|
||||
default => sub { [] },
|
||||
);
|
||||
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 addField ( WebGUI::Form::Control )
|
||||
|
||||
Add a field. Any WebGUI::Form::Control object.
|
||||
|
||||
=head2 addField ( type, properties )
|
||||
|
||||
Add a field. C<type> is a class name, optionally without 'WebGUI::Form::'.
|
||||
C<properties> is a list of name => value pairs.
|
||||
|
||||
Returns the field object
|
||||
|
||||
=over 4
|
||||
|
||||
=item name
|
||||
|
||||
Required. The name of the field in the form.
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
||||
sub addField {
|
||||
my ( $self, $type, @properties ) = @_;
|
||||
my $field;
|
||||
|
||||
if ( blessed( $type ) ) {
|
||||
$field = $type;
|
||||
}
|
||||
else {
|
||||
# Is $type a class name?
|
||||
eval { WebGUI::Pluggable::load( $type ) };
|
||||
if ( $@ ) {
|
||||
eval { WebGUI::Pluggable::load( "WebGUI::Form::$type" ) };
|
||||
if ( $@ ) {
|
||||
$self->session->error("Could not load field type '$type'. Try loading it manually." );
|
||||
confess "Could not load field type '$type'. Try loading it manually.";
|
||||
}
|
||||
$type = "WebGUI::Form::$type";
|
||||
}
|
||||
$field = $type->new( $self->session, { @properties } );
|
||||
}
|
||||
|
||||
push @{$self->fields}, $field;
|
||||
$self->{_fieldsByName}{ $field->get('name') } = $field; # TODO: Must allow multiple fields per name
|
||||
return $field;
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 getField ( name )
|
||||
|
||||
Get a field by name. Returns the field object.
|
||||
|
||||
=cut
|
||||
|
||||
sub getField {
|
||||
my ( $self, $name ) = @_;
|
||||
return $self->{_fieldsByName}{$name};
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 getFieldsRecursive ( )
|
||||
|
||||
Get all the fields in this section, including fieldsets and tabs.
|
||||
|
||||
=cut
|
||||
|
||||
sub getFieldsRecursive {
|
||||
my ( $self ) = @_;
|
||||
|
||||
my $fields = [ @{$self->fields} ]; # New arrayref, but same field objects
|
||||
|
||||
if ( $self->DOES('WebGUI::FormBuilder::Role::HasFieldsets') ) {
|
||||
# Add $self->{_fieldsets} fields
|
||||
}
|
||||
if ( $self->DOES('WebGUI::FormBuilder::Role::HasTabs') ) {
|
||||
# Add $self->{_tabs} fields
|
||||
}
|
||||
|
||||
return $fields;
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 toHtml ( )
|
||||
|
||||
Render the fields in this part of the form.
|
||||
|
||||
=cut
|
||||
|
||||
sub toHtml {
|
||||
my ( $self ) = @_;
|
||||
|
||||
# This will always be the first one called, so no maybe::next::method
|
||||
my $html = '';
|
||||
for my $field ( @{$self->fields} ) {
|
||||
$html .= $field->toHtmlWithWrapper;
|
||||
}
|
||||
|
||||
return $html;
|
||||
}
|
||||
|
||||
1;
|
||||
146
lib/WebGUI/FormBuilder/Role/HasFieldsets.pm
Normal file
146
lib/WebGUI/FormBuilder/Role/HasFieldsets.pm
Normal file
|
|
@ -0,0 +1,146 @@
|
|||
package WebGUI::FormBuilder::Role::HasFieldsets;
|
||||
|
||||
use strict;
|
||||
use Moose::Role;
|
||||
|
||||
has 'fieldsets' => (
|
||||
is => 'rw',
|
||||
isa => 'ArrayRef[WebGUI::FormBuilder::Fieldset]',
|
||||
default => sub { [] },
|
||||
);
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=cut
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 addFieldset( properties )
|
||||
|
||||
Add a fieldset. C<properties> is a list of name => value pairs. Returns the
|
||||
new WebGUI::FormBuilder::Fieldset object.
|
||||
|
||||
=over 4
|
||||
|
||||
=item name
|
||||
|
||||
Required. The name of the fieldset.
|
||||
|
||||
=item legend
|
||||
|
||||
The label for the fieldset.
|
||||
|
||||
=back
|
||||
|
||||
=head2 addFieldset( object, overrideProperties )
|
||||
|
||||
Add a fieldset. C<object> is any object that implements the C<WebGUI::FormBuilder::Role::HasFields>
|
||||
class. Any fieldsets or tabs in the C<object> will also be added. C<overrideProperties> is a list
|
||||
of name => value pairs to override properties in the C<object> (such as name and label).
|
||||
|
||||
=cut
|
||||
|
||||
sub addFieldset {
|
||||
if ( blessed( $_[1] ) ) {
|
||||
my ( $self, $object, %properties ) = @_;
|
||||
$properties{ name } ||= $object->can('name') ? $object->name : "";
|
||||
$properties{ label } ||= $object->can('label') ? $object->label : "";
|
||||
my $fieldset = WebGUI::FormBuilder::Fieldset->new( $self->session, %properties );
|
||||
push @{$self->fieldsets}, $fieldset;
|
||||
if ( $object->DOES('WebGUI::FormBuilder::Role::HasTabs') ) {
|
||||
for my $objectTab ( @{$object->tabs} ) {
|
||||
$fieldset->addTab( $objectTab );
|
||||
}
|
||||
}
|
||||
if ( $object->DOES('WebGUI::FormBuilder::Role::HasFieldsets') ) {
|
||||
for my $objectFieldset ( @{$object->fieldsets} ) {
|
||||
$fieldset->addFieldset( $objectFieldset );
|
||||
}
|
||||
}
|
||||
if ( $object->DOES('WebGUI::FormBuilder::Role::HasFields') ) {
|
||||
for my $objectField ( @{$object->fields} ) {
|
||||
$fieldset->addField( $objectField );
|
||||
}
|
||||
}
|
||||
return $fieldset;
|
||||
}
|
||||
else {
|
||||
my ( $self, @properties ) = @_;
|
||||
my $fieldset = WebGUI::FormBuilder::Fieldset->new( $self->session, @properties );
|
||||
push @{$self->fieldsets}, $fieldset;
|
||||
$self->{_fieldsetsByName}{ $fieldset->name } = $fieldset;
|
||||
return $fieldset;
|
||||
}
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 addFromHashRef( hashRef )
|
||||
|
||||
Add the fieldsets from the given serialized hashRef. See C<toHashRef> for more
|
||||
information.
|
||||
|
||||
=cut
|
||||
|
||||
sub addFromHashRef {
|
||||
my ( $self, $hashref ) = @_;
|
||||
|
||||
for my $fieldset ( @{$hashref->{fieldsets}} ) {
|
||||
my $fs = WebGUI::FormBuilder::Fieldset->newFromHashref( $self->session, $fieldset );
|
||||
$self->addFieldset( $fs );
|
||||
}
|
||||
|
||||
$self->maybe::next::method;
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 deleteFieldset ( name )
|
||||
|
||||
Delete a fieldset by name. Returns the fieldset deleted.
|
||||
|
||||
=cut
|
||||
|
||||
sub deleteFieldset {
|
||||
my ( $self, $name ) = @_;
|
||||
my $fieldset = delete $self->{_fieldsetsByName}{$name};
|
||||
for ( my $i = 0; $i < scalar @{$self->fieldsets}; $i++ ) {
|
||||
my $testFieldset = $self->fieldsets->[$i];
|
||||
if ( $testFieldset->name eq $name ) {
|
||||
splice @{$self->fieldsets}, $i, 1;
|
||||
}
|
||||
}
|
||||
return $fieldset;
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 getFieldset ( name )
|
||||
|
||||
Get a fieldset object by name
|
||||
|
||||
=cut
|
||||
|
||||
sub getFieldset {
|
||||
my ( $self, $name ) = @_;
|
||||
return $self->{_fieldsetsByName}{$name};
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 toHtml ( )
|
||||
|
||||
Render the fieldsets in this part of the form
|
||||
|
||||
=cut
|
||||
|
||||
sub toHtml {
|
||||
my ( $self ) = @_;
|
||||
my $html = $self->maybe::next::method;
|
||||
for my $fieldset ( @{$self->fieldsets} ) {
|
||||
$html .= $fieldset->toHtml;
|
||||
}
|
||||
return $html;
|
||||
}
|
||||
|
||||
1;
|
||||
128
lib/WebGUI/FormBuilder/Role/HasTabs.pm
Normal file
128
lib/WebGUI/FormBuilder/Role/HasTabs.pm
Normal file
|
|
@ -0,0 +1,128 @@
|
|||
package WebGUI::FormBuilder::Role::HasTabs;
|
||||
|
||||
use strict;
|
||||
use Moose::Role;
|
||||
|
||||
requires 'session', 'pack', 'unpack';
|
||||
|
||||
has 'tabs' => (
|
||||
is => 'rw',
|
||||
isa => 'ArrayRef[WebGUI::FormBuilder::Tab]',
|
||||
default => sub { [] },
|
||||
);
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=cut
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 addTab ( properties )
|
||||
|
||||
Add a tab. C<properties> is a list of name => value pairs to be passed to
|
||||
L<WebGUI::FormBuilder::Tab>.
|
||||
|
||||
=head2 addTab ( object, propertiesOverrides )
|
||||
|
||||
Add a tab. C<object> is any object that implements L<WebGUI::FormBuilder::Role::HasFields>.
|
||||
Any sub-tabs or fieldsets will also be included.
|
||||
|
||||
=cut
|
||||
|
||||
sub addTab {
|
||||
if ( blessed( $_[1] ) ) {
|
||||
my ( $self, $object, %properties ) = @_;
|
||||
$properties{ name } ||= $object->can('name') ? $object->name : "";
|
||||
$properties{ label } ||= $object->can('label') ? $object->label : "";
|
||||
my $tab = WebGUI::FormBuilder::Tab->new( $self->session, %properties );
|
||||
push @{ $self->tabs }, $tab;
|
||||
if ( $object->DOES('WebGUI::FormBuilder::Role::HasTabs') ) {
|
||||
for my $objectTab ( @{$object->tabs} ) {
|
||||
$tab->addTab( $objectTab );
|
||||
}
|
||||
}
|
||||
if ( $object->DOES('WebGUI::FormBuilder::Role::HasFieldsets') ) {
|
||||
for my $objectFieldset ( @{$object->fieldsets} ) {
|
||||
$tab->addFieldset( $objectFieldset );
|
||||
}
|
||||
}
|
||||
if ( $object->DOES('WebGUI::FormBuilder::Role::HasFields') ) {
|
||||
for my $objectField ( @{$object->fields} ) {
|
||||
$tab->addField( $objectField );
|
||||
}
|
||||
}
|
||||
return $tab;
|
||||
}
|
||||
else {
|
||||
my ( $self, @properties ) = @_;
|
||||
my $tab = WebGUI::FormBuilder::Tab->new( $self->session, @properties );
|
||||
push @{$self->tabs}, $tab;
|
||||
$self->{_tabsByName}{$tab->name} = $tab;
|
||||
return $tab;
|
||||
}
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 deleteTab ( name )
|
||||
|
||||
Delete a tab by name. Returns the tab deleted.
|
||||
|
||||
=cut
|
||||
|
||||
sub deleteTab {
|
||||
my ( $self, $name ) = @_;
|
||||
my $tab = delete $self->{_tabsByName}{$name};
|
||||
for ( my $i = 0; $i < scalar @{$self->tabs}; $i++ ) {
|
||||
my $testTab = $self->tabs->[$i];
|
||||
if ( $testTab->name eq $name ) {
|
||||
splice @{$self->tabs}, $i, 1;
|
||||
}
|
||||
}
|
||||
return $tab;
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 getTab ( name )
|
||||
|
||||
Get a tab object by name
|
||||
|
||||
=cut
|
||||
|
||||
sub getTab {
|
||||
my ( $self, $name ) = @_;
|
||||
return $self->{_tabsByName}{$name};
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 getTabs ( )
|
||||
|
||||
Get all tab objects. Returns the arrayref of tabs.
|
||||
|
||||
=cut
|
||||
|
||||
sub getTabs {
|
||||
my ( $self ) = @_;
|
||||
return $self->tabs;
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 toHtml ( )
|
||||
|
||||
Render the tabs in this part of the form
|
||||
|
||||
=cut
|
||||
|
||||
sub toHtml {
|
||||
my ( $self ) = @_;
|
||||
my $html = $self->maybe::next::method;
|
||||
for my $tab ( @{$self->tabs} ) {
|
||||
$html .= $tab->toHtml;
|
||||
}
|
||||
return $html;
|
||||
}
|
||||
|
||||
1;
|
||||
107
lib/WebGUI/FormBuilder/Tab.pm
Normal file
107
lib/WebGUI/FormBuilder/Tab.pm
Normal file
|
|
@ -0,0 +1,107 @@
|
|||
package WebGUI::FormBuilder::Tab;
|
||||
|
||||
use strict;
|
||||
use Moose;
|
||||
use MooseX::Storage;
|
||||
|
||||
has 'label' => (
|
||||
is => 'rw',
|
||||
isa => 'Str',
|
||||
);
|
||||
|
||||
has 'name' => (
|
||||
is => 'ro',
|
||||
isa => 'Str',
|
||||
required => 1,
|
||||
);
|
||||
|
||||
has 'session' => (
|
||||
is => 'ro',
|
||||
isa => 'WebGUI::Session',
|
||||
required => 1,
|
||||
weak_ref => 1,
|
||||
traits => [ 'DoNotSerialize' ],
|
||||
);
|
||||
|
||||
with Storage( format => 'JSON' );
|
||||
with 'WebGUI::FormBuilder::Role::HasFields';
|
||||
with 'WebGUI::FormBuilder::Role::HasFieldsets';
|
||||
with 'WebGUI::FormBuilder::Role::HasTabs';
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=cut
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 new ( session, properties )
|
||||
|
||||
Create a new Tab object. C<session> is a WebGUI Session. C<properties> is a
|
||||
list of name => value pairs.
|
||||
|
||||
=over 4
|
||||
|
||||
=item name
|
||||
|
||||
Required. A name for the tab.
|
||||
|
||||
=item label
|
||||
|
||||
Optional. A label for the tab.
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
||||
sub new {
|
||||
my ( $class, $session, %properties ) = @_;
|
||||
$properties{ session } = $session;
|
||||
return $class->SUPER::new( %properties );
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 label ( newLabel )
|
||||
|
||||
A label to show the user
|
||||
|
||||
=cut
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 name ( )
|
||||
|
||||
The name of the fieldset.
|
||||
|
||||
=cut
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 session ( )
|
||||
|
||||
Get the WebGUI::Session attached to this object
|
||||
|
||||
=cut
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 toHtml ( )
|
||||
|
||||
Render this Tab.
|
||||
|
||||
=cut
|
||||
|
||||
sub toHtml {
|
||||
my ( $self ) = @_;
|
||||
|
||||
# Whatever YUI Tabs wants
|
||||
my $html = '<div class="yui-tab">'
|
||||
. '<div class="yui-tab-label">' . $self->label . '</div>'
|
||||
;
|
||||
$html .= $self->maybe::next::method;
|
||||
$html .= '</div>';
|
||||
|
||||
return $html;
|
||||
}
|
||||
|
||||
1;
|
||||
192
t/FormBuilder.t
Normal file
192
t/FormBuilder.t
Normal file
|
|
@ -0,0 +1,192 @@
|
|||
# vim:syntax=perl
|
||||
#-------------------------------------------------------------------
|
||||
# WebGUI is Copyright 2001-2009 Plain Black Corporation.
|
||||
#-------------------------------------------------------------------
|
||||
# Please read the legal notices (docs/legal.txt) and the license
|
||||
# (docs/license.txt) that came with this distribution before using
|
||||
# this software.
|
||||
#------------------------------------------------------------------
|
||||
# http://www.plainblack.com info@plainblack.com
|
||||
#------------------------------------------------------------------
|
||||
|
||||
# Write a little about what this script tests.
|
||||
#
|
||||
#
|
||||
|
||||
use FindBin;
|
||||
use strict;
|
||||
use lib "$FindBin::Bin/lib";
|
||||
use Test::More;
|
||||
use Test::Deep;
|
||||
use WebGUI::Test; # Must use this before any other WebGUI modules
|
||||
use WebGUI::Session;
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
# Init
|
||||
my $session = WebGUI::Test->session;
|
||||
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
# Tests
|
||||
|
||||
plan tests => 53; # Increment this number for each test you create
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
# Constructor and properties
|
||||
use_ok( 'WebGUI::FormBuilder' );
|
||||
use WebGUI::FormBuilder::Tab;
|
||||
use WebGUI::FormBuilder::Fieldset;
|
||||
|
||||
my $fb = WebGUI::FormBuilder->new( $session );
|
||||
isa_ok( $fb, 'WebGUI::FormBuilder' );
|
||||
is( $fb->method, 'POST', 'method default' );
|
||||
ok( !$fb->action, 'action default' );
|
||||
is( $fb->enctype, 'multipart/form-data', 'enctype default' );
|
||||
ok( !$fb->name, 'name default' );
|
||||
|
||||
$fb = WebGUI::FormBuilder->new( $session,
|
||||
action => '/myurl',
|
||||
enctype => 'application/x-www-form-urlencoded',
|
||||
name => 'search',
|
||||
method => 'get',
|
||||
);
|
||||
isa_ok( $fb, 'WebGUI::FormBuilder' );
|
||||
is( $fb->method, 'get' );
|
||||
is( $fb->action, '/myurl' );
|
||||
is( $fb->enctype, 'application/x-www-form-urlencoded' );
|
||||
is( $fb->name, 'search' );
|
||||
|
||||
# Test mutators
|
||||
is( $fb->method("POST"), "POST" );
|
||||
is( $fb->method, "POST" );
|
||||
is( $fb->action('/otherurl'), '/otherurl' );
|
||||
is( $fb->action, '/otherurl' );
|
||||
is( $fb->enctype('multipart/form-data'), 'multipart/form-data' );
|
||||
is( $fb->enctype, 'multipart/form-data' );
|
||||
is( $fb->name('myname'), 'myname' );
|
||||
is( $fb->name, 'myname' );
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
# Adding objects
|
||||
# -- This tests the HasTabs, HasFieldsets, and HasFields roles
|
||||
|
||||
# addTab with properties
|
||||
my $tab = $fb->addTab( name => "mytab", label => "My Tab" );
|
||||
isa_ok( $tab, 'WebGUI::FormBuilder::Tab' );
|
||||
is( $fb->getTab('mytab'), $tab, 'getTab returns exact object' );
|
||||
is( $fb->tabs, $fb->tabs, 'tabs always returns same arrayref' );
|
||||
cmp_deeply(
|
||||
$fb->tabs,
|
||||
[ $tab ],
|
||||
'tabs',
|
||||
);
|
||||
|
||||
# addTab with objects
|
||||
my $field = $tab->addField(
|
||||
'WebGUI::Form::Text' => (
|
||||
name => 'search',
|
||||
value => "Search Now",
|
||||
)
|
||||
);
|
||||
my $fset = $tab->addFieldset(
|
||||
name => 'advanced',
|
||||
label => 'Advanced Search',
|
||||
);
|
||||
my $subtab = $tab->addTab(
|
||||
name => 'more',
|
||||
label => 'More',
|
||||
);
|
||||
|
||||
my $newTab = $fb->addTab( $tab, name => 'newname' );
|
||||
isa_ok( $newTab, 'WebGUI::FormBuilder::Tab' );
|
||||
isnt( $newTab, $tab, 'addTab creates a new object from the properties' );
|
||||
is( $newTab->name, 'newname', 'addTab allows property overrides' );
|
||||
is( $newTab->label, 'My Tab', 'label was not overridden' );
|
||||
ok( $newTab->fields->[0], 'field exists' );
|
||||
is( $newTab->fields->[0]->get('name'), 'search', 'field has same name' );
|
||||
ok( $newTab->fieldsets->[0], 'fieldset exists' );
|
||||
is( $newTab->fieldsets->[0]->name, 'advanced', 'fieldset has same name' );
|
||||
ok( $newTab->tabs->[0], 'subtab exists' );
|
||||
is( $newTab->tabs->[0]->name, 'more', 'subtab has same name' );
|
||||
|
||||
|
||||
# addFieldset with properties
|
||||
$fb = WebGUI::FormBuilder->new( $session );
|
||||
$fset = $fb->addFieldset(
|
||||
name => 'advanced',
|
||||
label => 'Advanced Search',
|
||||
);
|
||||
is( $fb->getFieldset('advanced'), $fset, 'getFieldset returns exact object' );
|
||||
is( $fb->fieldsets, $fb->fieldsets, 'fieldsets always returns same arrayref' );
|
||||
cmp_deeply(
|
||||
$fb->fieldsets,
|
||||
[ $fset ],
|
||||
'fieldsets',
|
||||
);
|
||||
|
||||
# addFieldset with objects
|
||||
my $field = $fset->addField(
|
||||
'WebGUI::Form::Text' => (
|
||||
name => 'search',
|
||||
value => "Search Now",
|
||||
)
|
||||
);
|
||||
my $subfset = $fset->addFieldset(
|
||||
name => 'advanced',
|
||||
label => 'Advanced Search',
|
||||
);
|
||||
my $tab = $fset->addTab(
|
||||
name => 'more',
|
||||
label => 'More',
|
||||
);
|
||||
|
||||
my $newFset = $fb->addFieldset( $fset, name => 'newname' );
|
||||
isa_ok( $newFset, 'WebGUI::FormBuilder::Fieldset' );
|
||||
isnt( $newFset, $fset, 'addFieldset creates a new object from the properties' );
|
||||
is( $newFset->name, 'newname', 'addFieldset allows property overrides' );
|
||||
is( $newFset->label, 'Advanced Search', 'label was not overridden' );
|
||||
ok( $newFset->fields->[0], 'field exists' );
|
||||
is( $newFset->fields->[0]->get('name'), 'search', 'field has same name' );
|
||||
ok( $newFset->fieldsets->[0], 'subfieldset exists' );
|
||||
is( $newFset->fieldsets->[0]->name, 'advanced', 'subfieldset has same name' );
|
||||
ok( $newFset->tabs->[0], 'tab exists' );
|
||||
is( $newFset->tabs->[0]->name, 'more', 'tab has same name' );
|
||||
|
||||
# addField with properties
|
||||
$fb = WebGUI::FormBuilder->new( $session );
|
||||
my $field = $fb->addField(
|
||||
'Text' => (
|
||||
name => 'search',
|
||||
value => 'Search Now',
|
||||
)
|
||||
);
|
||||
|
||||
isa_ok( $field, 'WebGUI::Form::Text' );
|
||||
is( $fb->getField('search'), $field, 'getField returns exact object' );
|
||||
is( $fb->fields, $fb->fields, 'fields always returns same arrayref' );
|
||||
cmp_deeply(
|
||||
$fb->fields,
|
||||
[ $field ],
|
||||
'fields',
|
||||
);
|
||||
|
||||
# addField with object
|
||||
my $field2 = $fb->addField(
|
||||
WebGUI::Form::Text->new( $session, {
|
||||
name => 'type',
|
||||
label => "Asset Type",
|
||||
} )
|
||||
);
|
||||
isa_ok( $field2, 'WebGUI::Form::Text' );
|
||||
is( $fb->getField('type'), $field2, 'getField returns exact object' );
|
||||
cmp_deeply(
|
||||
$fb->fields,
|
||||
[ $field, $field2 ],
|
||||
'fields 2',
|
||||
);
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
# Serialize and deserialize
|
||||
|
||||
|
||||
#vim:ft=perl
|
||||
55
t/FormBuilder/Tab.t
Normal file
55
t/FormBuilder/Tab.t
Normal file
|
|
@ -0,0 +1,55 @@
|
|||
# vim:syntax=perl
|
||||
#-------------------------------------------------------------------
|
||||
# WebGUI is Copyright 2001-2009 Plain Black Corporation.
|
||||
#-------------------------------------------------------------------
|
||||
# Please read the legal notices (docs/legal.txt) and the license
|
||||
# (docs/license.txt) that came with this distribution before using
|
||||
# this software.
|
||||
#------------------------------------------------------------------
|
||||
# http://www.plainblack.com info@plainblack.com
|
||||
#------------------------------------------------------------------
|
||||
|
||||
# Test the tab object
|
||||
#
|
||||
#
|
||||
|
||||
use FindBin;
|
||||
use strict;
|
||||
use lib "$FindBin::Bin/../lib";
|
||||
use Test::More;
|
||||
use WebGUI::Test; # Must use this before any other WebGUI modules
|
||||
use WebGUI::Session;
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
# Init
|
||||
my $session = WebGUI::Test->session;
|
||||
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
# Tests
|
||||
|
||||
plan tests => 9; # Increment this number for each test you create
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
# Creation, accessors and mutators
|
||||
use_ok( 'WebGUI::FormBuilder::Tab' );
|
||||
my $tab = WebGUI::FormBuilder::Tab->new( $session );
|
||||
isa_ok( $tab, 'WebGUI::FormBuilder::Tab' );
|
||||
|
||||
ok( !$tab->name, 'no default' );
|
||||
ok( !$tab->label, 'no default' );
|
||||
is( $tab->session, $session );
|
||||
|
||||
$tab = WebGUI::FormBuilder::Tab->new( $session, name => "myname", label => 'My Label' );
|
||||
is( $tab->name, 'myname' );
|
||||
is( $tab->label, 'My Label' );
|
||||
is( $tab->label('New Label'), 'New Label' );
|
||||
is( $tab->label, 'New Label' );
|
||||
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
# Cleanup
|
||||
END {
|
||||
|
||||
}
|
||||
#vim:ft=perl
|
||||
Loading…
Add table
Add a link
Reference in a new issue