Merge branch 'fb' into 8

lib/WebGUI/FormBuilder.pm

@@ -0,0 +1,278 @@
+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';
+
+use WebGUI::FormBuilder::Tab;
+use WebGUI::FormBuilder::Tabset;
+use WebGUI::FormBuilder::Fieldset;
+
+=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 {
+    # TODO
+}
+
+#----------------------------------------------------------------------------
+
+=head2 enctype ( [ newEnctype ] )
+
+Get or set the enctype property / HTML attribute.
+
+=cut
+
+#----------------------------------------------------------------------------
+
+=head2 getFooter ( )
+
+Get the footer for this form.
+
+=cut
+
+sub getFooter {
+    my ( $self ) = @_;
+
+    my $html    = '</form>';
+
+    return $html;
+}
+
+#----------------------------------------------------------------------------
+
+=head2 getHeader ( )
+
+Get the header for this form. 
+
+=cut
+
+sub getHeader {
+    my ( $self ) = @_;
+
+    my @attrs   = qw{ action method name enctype };
+    my $attrs   = join " ", map { qq{$_="} . $self->$_ . qq{"} } grep { $self->$_ } @attrs;
+
+    my $html    = sprintf '<form %s>', $attrs;
+    
+    return $html;
+}
+
+#----------------------------------------------------------------------------
+
+=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 $html = $self->getHeader;
+    # Add individual objects
+    $html   .= join "", map { $_->toHtml } @{$self->objects};
+    $html   .= $self->getFooter;
+
+    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 ||= {};
+
+    # $prefix_header
+    $var->{ "${prefix}_header" } = $self->getHeader;
+    # $prefix_footer
+    $var->{ "${prefix}_footer" } = $self->getFooter;
+    # $prefix_fieldloop
+    #   name    -- for comparisons
+    #   field
+    #   label   -- includes hoverhelp
+    #   label_nohover
+    #   pretext
+    #   subtext
+    #   hoverhelp   -- The text. For use with label_nohover
+    # $prefix_field_$fieldName
+    if ( @{$self->fields} ) {
+        my $fieldLoop = [];
+        $var->{ "${prefix}_fieldloop" } = $fieldLoop;
+        for my $field ( @{$self->fields} ) {
+            my $name  = $field->get('name');
+            my $props = {
+                name            => $name,
+                field           => $field->toHtml,
+                label           => $field->getLabel,
+                label_nohover   => $field->get('label'),
+                pretext         => $field->get('pretext'),
+                subtext         => $field->get('subtext'),
+                hoverhelp       => $field->get('hoverhelp'),
+            };
+            for my $key ( keys %{$props} ) {
+                $var->{ "${prefix}_field_${name}_${key}" } = $props->{$key};
+            }
+            push @{$fieldLoop}, $props;
+        }
+    }
+    # $prefix_fieldsetloop
+    #   name
+    #   legend
+    #   label       -- same as legend
+    #   fieldloop
+    #       ...
+    #   fieldsetloop
+    #       ...
+    #   tabloop
+    #       ...
+    # $prefix_fieldset_$fieldsetName
+    if ( @{$self->fieldsets} ) {
+        my $fieldsetLoop = [];
+        $var->{ "${prefix}_fieldsetLoop" } = $fieldsetLoop;
+        for my $fieldset ( @{$self->fieldsets} ) {
+            my $name    = $fieldset->name;
+            my $props   = $fieldset->toTemplateVars;
+            for my $key ( keys %{$props} ) {
+                $var->{ "${prefix}_fieldset_${name}_${key}" } = $props->{key};
+            }
+            push @{$fieldsetLoop}, $props;
+        }
+    }
+    # $prefix_tabloop
+    #   name
+    #   label
+    #   fieldloop
+    #       ...
+    #   fieldsetloop
+    #       ...
+    #   tabloop
+    #       ...
+    # $prefix_tab_$tabName
+    if ( @{$self->tabs} ) {
+        my $tabLoop = [];
+        $var->{ "${prefix}_tabLoop" } = $tabLoop;
+        for my $tab ( @{$self->tabs} ) {
+            my $name    = $tab->name;
+            my $props   = $tab->toTemplateVars;
+            for my $key ( keys %{$props} ) {
+                $var->{ "${prefix}_tab_${name}_${key}" } = $props->{key};
+            }
+            push @{$tabLoop}, $props;
+        }
+    }
+
+    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,144 @@
+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 );
+}
+
+sub getFooter {
+    my ( $self ) = @_;
+    return '</fieldset>';
+}
+
+sub getHeader {
+    my ( $self ) = @_;
+    return '<fieldset><legend>' . $self->label . '</legend>';
+}
+
+#----------------------------------------------------------------------------
+
+=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 = $self->getHeader;
+    $html   .= join "", map { $_->toHtml } @{$self->objects};
+    $html   .= $self->getFooter;
+
+    return $html;
+}
+
+#----------------------------------------------------------------------------
+
+=head2 toTemplateVars ( )
+
+=cut
+
+sub toTemplateVars {
+
+}
+
+1;

lib/WebGUI/FormBuilder/Role/HasFields.pm

@@ -0,0 +1,125 @@
+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 { [] },
+);
+
+with 'WebGUI::FormBuilder::Role::HasObjects';
+
+=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::" . ucfirst( $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::" . ucfirst( $type );
+        }
+        $field = $type->new( $self->session, { @properties } );
+    }
+
+    push @{$self->fields}, $field;
+    $self->addObject( $field );
+    $self->{_fieldsByName}{ $field->get('name') } = $field; # TODO: Must allow multiple fields per name
+    return $field;
+}
+
+#----------------------------------------------------------------------------
+
+=head2 deleteField ( name )
+
+Delete a field by name. Returns the field deleted.
+
+=cut
+
+sub deleteField {
+    my ( $self, $name ) = @_;
+    my $field    = delete $self->{_fieldsByName}{$name};
+    for ( my $i = 0; $i < scalar @{$self->fields}; $i++ ) {
+        my $testField    = $self->fields->[$i];
+        if ( $testField->get('name') eq $name ) {
+            splice @{$self->fields}, $i, 1;
+        }
+    }
+    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;
+}
+
+
+1;

lib/WebGUI/FormBuilder/Role/HasFieldsets.pm

@@ -0,0 +1,128 @@
+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 {
+    my ( $fieldset, $self );
+    if ( blessed( $_[1] ) ) {
+        ( $self, my $object, my %properties ) = @_;
+        $properties{ name   } ||= $object->can('name')      ? $object->name     : "";
+        $properties{ label  } ||= $object->can('label')     ? $object->label    : "";
+        $fieldset = WebGUI::FormBuilder::Fieldset->new( $self->session, %properties );
+        if ( $object->DOES('WebGUI::FormBuilder::Role::HasTabs') ) {
+            for my $objectTabset ( @{$object->tabsets} ) {
+                for my $objectTab ( @{$objectTabset->tabs} ) {
+                    $fieldset->addTab( $objectTab, tabset => $objectTabset->name );
+                }
+            }
+        }
+        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 );
+            }
+        }
+    }
+    else {
+        ( $self, my @properties ) = @_;
+        $fieldset = WebGUI::FormBuilder::Fieldset->new( $self->session, @properties );
+    }
+    push @{$self->fieldsets}, $fieldset;
+    $self->addObject( $fieldset );
+    $self->{_fieldsetsByName}{ $fieldset->name } = $fieldset;
+    return $fieldset;
+}
+
+#----------------------------------------------------------------------------
+
+=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
+
+override 'toHtml' => sub {
+    my ( $self ) = @_;
+    my $html    = super();
+    for my $fieldset ( @{$self->fieldsets} ) {
+        $html .= $fieldset->toHtml;
+    }
+    return $html;
+};
+
+1;

lib/WebGUI/FormBuilder/Role/HasObjects.pm

@@ -0,0 +1,23 @@
+package WebGUI::FormBuilder::Role::HasObjects;
+
+use Moose::Role;
+
+has 'objects' => (
+    is => 'rw',
+    isa => 'ArrayRef[Object]',
+    default => sub { [] },
+);
+
+# Objects combines "fields", "fieldsets", and "tabsets"
+
+sub addObject {
+    my ( $self, $object ) = @_;
+    push @{$self->objects}, $object;
+    return $object;
+}
+
+# Handle re-ordering of objects
+
+
+1;
+

lib/WebGUI/FormBuilder/Role/HasTabs.pm

@@ -0,0 +1,142 @@
+package WebGUI::FormBuilder::Role::HasTabs;
+
+use strict;
+use Moose::Role;
+
+with 'WebGUI::FormBuilder::Role::HasObjects';
+requires 'session', 'pack', 'unpack';
+
+has 'tabsets' => (
+    is      => 'rw',
+    isa     => 'ArrayRef[WebGUI::FormBuilder::Tabset]',
+    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 {
+    my ($tab, $self, %properties);
+    if ( blessed( $_[1] ) ) {
+        ( $self, my $object, %properties ) = @_;
+        $properties{ name   } ||= $object->can('name')      ? $object->name     : "";
+        $properties{ label  } ||= $object->can('label')     ? $object->label    : "";
+        $tab = WebGUI::FormBuilder::Tab->new( $self->session, %properties );
+        if ( $object->DOES('WebGUI::FormBuilder::Role::HasTabs') ) {
+            for my $objectTabset ( @{$object->tabsets} ) {
+                for my $objectTab ( @{$objectTabset->tabs} ) {
+                    $tab->addTab( $objectTab, tabset => $objectTabset->name );
+                }
+            }
+        }
+        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 );
+            }
+        }
+    }
+    else {
+        ( $self, %properties ) = @_;
+        $tab = WebGUI::FormBuilder::Tab->new( $self->session, %properties );
+    }
+    my $tabsetName  = delete $properties{ tabset } || "default";
+    my $tabset      = $self->getTabset( $tabsetName )
+                    || $self->addTabset( name => $tabsetName )
+                    ;
+    $tabset->addTab( $tab );
+    $self->{_tabsByName}{$tab->name} = $tab;
+    return $tab;
+}
+
+#----------------------------------------------------------------------------
+
+=head2 addTabset ( properties )
+
+Add a tabset. A tabset holds a bunch of tabs. Returns the WebGUI::FormBuilder::Tabset
+object.
+
+=cut
+
+sub addTabset {
+    my ( $self, %properties ) = @_;
+    if ( $self->{_tabsetsByName}{$properties{name}} ) {
+        confess "Cannot add another tabset of the same name: $properties{name}\n";
+    }
+    my $tabset  = WebGUI::FormBuilder::Tabset->new( $self->session, %properties );
+    $self->{_tabsetsByName}{$tabset->name} = $tabset;
+    push @{$self->tabsets}, $tabset;
+    $self->addObject( $tabset );
+    return $tabset;
+}
+
+#----------------------------------------------------------------------------
+
+=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 $tabset ( @{ $self->tabsets } ) {
+        for ( my $i = 0; $i < scalar @{$tabset->tabs}; $i++ ) {
+            my $testTab    = $tabset->tabs->[$i];
+            if ( $testTab->name eq $name ) {
+                splice @{$tabset->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 getTabset ( name )
+
+Get a tabset object by name
+
+=cut
+
+sub getTabset {
+    my ( $self, $name ) = @_;
+    return $self->{_tabsetsByName}{$name};
+}
+
+1;

lib/WebGUI/FormBuilder/Tab.pm

@@ -0,0 +1,100 @@
+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 the objects in this tab
+
+=cut
+
+sub toHtml {
+    my ( $self ) = @_;
+    my $html    = join "", map { $_->toHtml } @{$self->objects};
+    return $html;
+}
+
+1;

lib/WebGUI/FormBuilder/Tabset.pm

@@ -0,0 +1,93 @@
+package WebGUI::FormBuilder::Tabset;
+
+use Moose;
+use MooseX::Storage;
+use WebGUI::FormBuilder::Tab;
+
+has 'name' => (
+    is => 'ro',
+    isa => 'Str',
+    required => 1,
+);
+
+has 'tabs' => (
+    is => 'rw',
+    isa => 'ArrayRef[WebGUI::FormBuilder::Tab]',
+    default => sub { [] },
+);
+
+has 'session' => ( 
+    is => 'ro', 
+    isa => 'WebGUI::Session', 
+    required => 1, 
+    weak_ref => 1,
+    traits => [ 'DoNotSerialize' ],
+);
+
+with Storage( format => 'JSON' );
+with 'WebGUI::FormBuilder::Role::HasObjects';
+
+#----------------------------------------------------------------------------
+
+=head2 new ( session, properties )
+
+Create a new Tabset object. C<properties> is a list of name => value pairs
+
+=over 4
+
+=item name
+
+The name of the tabset. Required.
+
+=back
+
+=cut
+
+sub new {
+    my ( $class, $session, %properties ) = @_;
+    $properties{ session    } = $session;
+    return $class->SUPER::new( %properties );
+}
+
+#----------------------------------------------------------------------------
+
+sub addTab {
+    my ( $self, $tab ) = @_;
+    push @{$self->tabs}, $tab;
+    $self->addObject( $tab );
+    return $tab;
+}
+
+#----------------------------------------------------------------------------
+
+sub toHtml {
+    my ( $self ) = @_;
+    my $html    = sprintf( '<div id="%s" class="yui-navset">', $self->name )
+                . '<ul class="yui-nav">'
+                ;
+    
+    for ( my $i = 0; $i < @{$self->tabs}; $i++ ) {
+        my $tab = $self->tabs->[$i];
+        $html   .= sprintf '<li><a href="#tab%i"><em>%s</em></a></li>', $i, $tab->label;
+    }
+
+    $html       .= '</ul>'
+                . '<div class="yui-content">'
+                ;
+
+    for ( my $i = 0; $i < @{$self->tabs}; $i++ ) {
+        my $tab = $self->tabs->[$i];
+        $html   .= sprintf '<div id="tab%i">%s</div>', $i, $tab->toHtml;
+    }
+
+    $html       .= '</div>'
+                . '</div>'
+                . q{<script type="text/javascript">}
+                . sprintf( q{var tabView = new YAHOO.widget.TabView('%s');}, $self->name )
+                . q{</script>}
+                ;
+
+    return $html;
+}
+
+1;

t/FormBuilder.t

@@ -0,0 +1,252 @@
+# 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 => 69;        # Increment this number for each test you create
+
+#----------------------------------------------------------------------------
+# Constructor and properties
+use_ok( 'WebGUI::FormBuilder' );
+
+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->tabsets, $fb->tabsets, 'tabsets always returns same arrayref' );
+cmp_deeply(
+    $fb->tabsets,
+    [ $fb->getTabset( "default" ) ],
+    'tabsets',
+);
+cmp_deeply( 
+    $fb->tabsets->[0]->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->tabsets->[0], 'subtabset exists' );
+is( $newTab->tabsets->[0]->name, 'default', 'subtabset has correct name' );
+ok( $newTab->tabsets->[0]->tabs->[0], 'subtab exists' );
+is( $newTab->tabsets->[0]->tabs->[0]->name, 'more', 'subtab has correct name' );
+
+cmp_deeply( 
+    $fb->tabsets->[0]->tabs,
+    [ $tab, $newTab ],
+    'added tab',
+);
+is( $fb->getTab('newname'), $newTab, 'new tab can be gotten' );
+
+# deleteTab
+my $deletedTab = $fb->deleteTab( 'newname' );
+is( $deletedTab, $newTab, 'deleteTab returns object' );
+cmp_deeply(
+    $fb->tabsets->[0]->tabs,
+    [ $tab ],
+    'deleted tab',
+);
+ok( !$fb->getTab('newname'), 'deleted tab cannot be gotten' );
+
+# 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->tabsets->[0]->tabs->[0], 'tab exists' );
+is( $newFset->tabsets->[0]->tabs->[0]->name, 'more', 'tab has same name' );
+cmp_deeply( 
+    $fb->fieldsets,
+    [ $fset, $newFset],
+    'added fieldset',
+);
+is( $fb->getFieldset('newname'), $newFset, 'new fieldset can be gotten' );
+
+# deletefieldset
+my $deletedFieldset = $fb->deleteFieldset( 'newname' );
+is( $deletedFieldset, $newFset, 'deletefieldset returns object' );
+cmp_deeply(
+    $fb->fieldsets,
+    [ $fset ],
+    'deleted fieldset',
+);
+ok( !$fb->getFieldset('newname'), 'deleted fieldset cannot be gotten' );
+
+# 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',
+);
+
+# deleteField
+my $field3 = $fb->deleteField( 'type' );
+is( $field3, $field2, 'deleteField returns same field' );
+ok( !$fb->getField('type'), 'field is deleted' );
+cmp_deeply(
+    $fb->fields,
+    [ $field ],
+    'field is deleted from fields',
+);
+
+
+#----------------------------------------------------------------------------
+# Serialize and deserialize
+
+my $fb      = WebGUI::FormBuilder->new( $session );
+my $fset    = $fb->addFieldset( name => 'search', label => 'Search' );
+$fset->addField( 'text', name => 'keywords', label => 'Keywords' );
+my $tab     = $fb->addTab( name => 'advanced', label => 'Advanced Search' );
+$tab->addField( 'text', name => 'type', label => 'Type' );
+$fb->addField( 'submit', name => 'submit', label => 'Submit' );
+
+
+#----------------------------------------------------------------------------
+# toHtml
+
+print $fb->toHtml;
+
+#vim:ft=perl

t/FormBuilder/Tab.t

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