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;