migrate FormBuilder to Moose. Start tests

lib/WebGUI/FormBuilder.pm

@@ -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;

lib/WebGUI/FormBuilder/Fieldset.pm

@@ -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;

lib/WebGUI/FormBuilder/Role/HasFields.pm

@@ -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;

lib/WebGUI/FormBuilder/Role/HasFieldsets.pm

@@ -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;

lib/WebGUI/FormBuilder/Role/HasTabs.pm

@@ -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;

lib/WebGUI/FormBuilder/Tab.pm

@@ -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;