Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
PerlMonks  

CGI::Buildform

by jryan (Vicar)
on Aug 30, 2001 at 04:35 UTC ( #108964=sourcecode: print w/ replies, xml ) Need Help??

Category: CGI Programming
Author/Contact Info Joseph F. Ryan 580ryan@erienet.net (or ryan.311@osu.edu after 9/17/2001)
Description:

CGI::BuildForm lets the user build a form in OO style. The user can create any type of form element, and set any type of attribute to that. CGI::BuildForm also has the abilty to regenerate a form after the form has been submitted. Here's a quick sample:

# before the form is submitted my $foo = new CGI::BuildForm("meep"); $foo->set_property(action=>'/cgi-bin/meep.pl', method=>'post'); $foo->new_element("bar", "text"); $foo->new_element("meep", "textarea"); $foo->new_element("narf", "submit"); $foo->set_attribute("bar", value=>'a title here', size=>'10'); $foo->set_attribute("meep", rows=>'2', cols=>'50'); $foo->set_end("meep", "Sample text in a textarea"); print "Content-type: text/html\n\n"; $foo->print_all("\n", "<br>\n", "<br>"); # after the form is submitted my $foo = new CGI::BuildForm("meep"); $foo->rebuild_form; $foo->print_all("\n", "<br>\n", "<br>");

QUITE handy, I've already used it myself. Its especially good for spreading forms accross multiple pages. Save yourself hours of mundane typing and use this module! :)

I'd appreciate anyone reviewing, trying it out, improving it, etc.

package CGI::BuildForm::Element;

use 5.000;
use strict;
use warnings;

sub new
{
    my ($class,$name,$type,$end) = @_;
    my $self =
    {
        name => $name,
        type => $type,
        end => $end,
        attributes => {},
    };
    bless $self;
}
sub print_attribute
{
    my ($self, $delim) = @_;
    my $quotes="";
    $quotes ="\"" unless ($delim);
    $delim=" " unless ($delim);
    while ( my($key, $value) = each %{$self->{attributes}})
    {
        print "$delim$key=$quotes$value$quotes";
    }
}
sub set_attribute
{
    my $self = shift;
    my %attributes = @_;
    while ( my($key, $value) = each %attributes)
    {
        $self->{attributes}->{$key} = $value;
    }
}
sub delete_attribute
{
    my $self = shift;
    my %del_attributes = @_;
    while ( my($key, $value) = each %del_attributes)
    {
        delete($self->{attributes}->{$key}) if (defined($self->{attrib
+utes}->{$key}));
    }
}
"JAPH";


package CGI::BuildForm;

use 5.000;
use strict;
use warnings;

sub new
{
    my ($class, $name) = @_;
    my $self =
    {
        name => $name,
        properties => {},
        elements => {},
        order => [],
        last_accessed => 1,
        hidden => 1,
        base => {select=>'1', textarea=>'1', optgroup=>'1', option=>'1
+', label=>'1', legend=>'1', fieldset=>'1'},
    };
bless $self;
}
sub new_element
{
    my ($self, $name, $type, $end) = @_;
    my $newel = new CGI::BuildForm::Element($name, $type, $end);
    $self->{elements}->{$name} = $newel;
    $self->{order}->[$self->{last_accessed}] = $name; 
    $self->{last_accessed}++;
}
sub set_attribute
{
    my $self = shift;
    my $element = shift;
    my %new_attributes = @_;
    $self->{elements}->{$element}->set_attribute(%new_attributes) if (
+ defined($self->{elements}->{$element}));
}
sub set_property
{
    my $self = shift;
    my %new_attributes = @_;
    while ( my($key, $value) = each %new_attributes)
    {
        $self->{properties}->{$key} = $value;
    }
}
sub set_hidden
{
    my ($self, $hidden) = @_;
    $self->{hidden} = $hidden;
}
sub set_type
{
    my ($self, $element, $type) = @_;
    $self->{elements}->{$element}->{type} = $type if (defined($self->{
+elements}->{$element}));
}
sub set_end
{
    my ($self, $element, $end) = @_;
    $self->{elements}->{$element}->{end} = $end if (defined($self->{el
+ements}->{$element}));

}
sub print_element
{
    my ($self, $element) = @_;
    if (defined($self->{elements}->{$element}))
    {
        print "<input type=\"$self->{elements}->{$element}->{type}\"" 
+if (!defined($self->{base}->{$self->{elements}->{$element}->{type}}))
+;
        print "<$self->{elements}->{$element}->{type}" if (defined($se
+lf->{base}->{$self->{elements}->{$element}->{type}}));;
        print " name=\"$self->{elements}->{$element}->{name}\"";
        $self->{elements}->{$element}->print_attribute;
        print ">";
    }
}
sub end_element
{
    my ($self, $element) = @_;
    if (defined($self->{elements}->{$element}))
    {
        print "$self->{elements}->{$element}->{end}</$self->{elements}
+->{$element}->{type}>" if (defined($self->{base}->{$self->{elements}-
+>{$element}->{type}}));
        $self->print_hidden($element);
    }
}
sub print_form
{
    my $self = shift;
    print "<form name=\"$self->{name}\"";
    while ( my($key, $value) = each %{$self->{properties}})
    {
        print " $key=\"$value\"";
    }
    print ">\n";
    if ($self->{hidden})
    {
        print "<input type=\"hidden\" name=\"forminfofor$self->{name}\
+" value=\"";
        while ( my($key, $value) = each %{$self->{properties}})
            {
            print "$key=$value*";
        }
        print "\">\n";
    }
}
sub end_form
{
    print "</form>\n";
}
sub print_all
{
    my ($self, $start, $deliminator, $end) = @_;
    $self->print_form;
    print $start if ($start);
    foreach my $key (@{$self->{order}})
    {
        $self->print_element($key);
        $self->end_element($key);
        print $deliminator;
    }
    print $end if ($end);
    $self->end_form;
}
sub print_hidden
{
    my ($self, $element) = @_;
    if ($self->{hidden})
    {
        print "\n<input type=\"hidden\" name=\"infofor$self->{elements
+}->{$element}->{name}\" value=\"type=$self->{elements}->{$element}->{
+type}";
        $self->{elements}->{$element}->print_attribute("*");
        print "\">\n";
    }
}
sub delete_element
{
    my ($self, $name) = @_;
    delete($self->{elements}->{$name}) if (defined($self->{elements}->
+{$name}));
}
sub delete_property
{
    my ($self, $name) = @_;
    delete($self->{properties}->{$name}) if (defined($self->{propertie
+s}->{$name}));
}
sub delete_attribute
{
    my $self = shift;
    my $element = shift;
    my %del_attributes = @_;
    $self->{elements}->{$element}->delete_attribute(%del_attributes) i
+f (defined($self->{elements}->{$element}));

}
sub rebuild_form
{
    my $self = shift;
    my $q = new CGI;
    my @parameters = $q->param;
    my (@elements, @attributes);
    my $property;
    my ($x, $y);
    foreach my $item (@parameters)
    {
        if (substr($item, 0, 7) eq "infofor")
        {
            $attributes[$x] = $item;
            $x++;
        }
        elsif (substr($item, 0, 11) eq "forminfofor")
        {
            $property = $item;
        }
        else
        {
            $elements[$y] = $item;
            $y++;
        }
    }
    if ($property ne "")
    {
        my @properties = split (/\*/, $q->param($property));
        foreach my $item (@properties)
        {
            my($key, $value) = split(/=/, $item);
            $self->set_property($key=>$value);
        }
        foreach my $element (@elements)
        {
            foreach my $attribute (@attributes)
            {
                if (substr($attribute, 7, length($element)) eq $elemen
+t)
                {
                    my @items  = split (/\*/, $q->param($attribute));
                    my($key, $value) = split(/=/, $items[0]);
                    my $end="";
                    $end=$q->param($element) if ($value eq "textarea")
+;
                    $self->new_element($element, $value, $end);
                    for (my $i=1; $i<@items; $i++)
                    {    
                        my($key, $value) = split(/=/, $items[$i]);
                        $self->set_attribute($element, $key=>$value);
                    }
                }
            }
        }
    }
    else
    {
        foreach my $element (@elements)
        {
            $self->new_element($element, "hidden");
            $self->set_attribute($element, value=>$q->param($element))
+;
        }
    }
}
sub get_value
{
    my ($self, $element, $skipto) = @_;
    if (defined($self->{elements}->{$element}->{attributes}->{value}) 
+&& ($skipto != 1))
    {
        return $self->{elements}->{$element}->{attributes}->{value};
    }
    elsif (defined($self->{elements}->{$element}->{end}))
    {
        return $self->{elements}->{$element}->{end};
    }
    else
    {
        return "undefined";
    }
}
"JAPH";


=head1 NAME

CGI::BuildForm - an OO way to create HTML forms and then recall them a
+fter trasmit.

=head2 SYNOPSIS

# before the form is submitted

my $foo = new CGI::BuildForm("meep");
$foo->set_property(action=>'/cgi-bin/meep.pl', method=>'post');

$foo->new_element("bar", "text");
$foo->new_element("meep", "textarea");
$foo->new_element("narf", "submit");

$foo->set_attribute("bar", value=>'a title here', size=>'10');
$foo->set_attribute("meep", rows=>'2', cols=>'50');
$foo->set_end("meep", "Sample text in a textarea");

print "Content-type: text/html\n\n";
$foo->print_all("\n", "<br>\n", "<br>");

# after the form is submitted

my $foo = new CGI::BuildForm("meep");
$foo->rebuild_form;
$foo->print_all("\n", "<br>\n", "<br>");

=head3 DESCRIPTION

CGI::BuildForm lets the user build a form in OO style.  The user can
create any type of form element, and set any type of attribute to that
+.
CGI::BuildForm also has the abilty to regenerate a form after the form
has been submitted.

=head4 ATTRIBUTES

=item new_element(element_name, element_type, end_data)
    new_element creates a new element that is a member of the form obj
+ect
    with the name element_name.
    It can be called with as many as 3 arguments:
    element_name: the new element's name
    element_type: the new element's type (optional)
    end_data: the text that will appear between the element start and 
+end
    tags.  primarily used with textareas. (optional)
=item set_attribute(element_name, hash)
    set_attribute adds the attributes that are in hash to the form ele
+ment
    named element_name.  Both arguments are required.  Hash can be of 
+any
    length.
=item set_property(hash)
    set_property adds the items in hash to the form's properties.
=item set_type(element_name, element_type)
    set_type sets the element named element_name's type to element_typ
+e
=item set_end(element_name, end_data)
    set_type sets the element named element_name's end (the data to pu
+t
    between element start and end tags) to end_data
=item set_hidden(on/off)
    sets whether form element attributes are to be sent along with for
+m
    data.  send 1 to turn it on (default), 0 to turn it off.
=item print_element(element_name)
    prints element named element name in html form
=item end_element(element_name)
    prints the closing tag for the element, if there is any.
=item print_form
    prints the form header
=item end_form
    prints the form footer
=item print_all(start, delimiter, end)
    prints the entire form.  useful for debugging and
    also useful for the lazy programmer. 3 arguments:
    start: printed before the form begins (optional)
    delimiter: printed after every element (optional)
    end: printed at... the beginning? no, the end! (optional)
=item delete_element(element_name)
    deletes element named element_name from the form
=item delete_attribute(element_name, hash)
    deletes from element named element_name the attributes listed
    in hash.  call like this:
    $foo->delete_attribute(bar, value=>'');
=item delete_property(hash)
    deletes properties listed in hash from the form
=item rebuild_form
    can use information sent by the form to create a new form
    object based on the old information.  set_hiddens must be 
    turned on to capture all element attributes.  if hiddens are
    turned off (or the form was created without CGI::Buildform),
    a form object will still be created, except attributes must
    entered manually.  this can be useful when spliting up a form
    onto multiple pages, as the default type is hidden (aka 
    <input type="hidden">), and the value will be able to be 
    gathered no matter what.
=item get_value($element, $skip)
    attempts to get the value of the element.  If the element has
    a value attribute, it returns that.  If it doesnt, it then checks
    to see if it has an end property (such as the text in a textarea).
    if it doesnt have that, it returns "undefined".  If the optional 
    argument skip is used, and its value is equal to 1, get_value will
    look directly for the end property.

=head5 AUTHOR

Joseph F. Ryan 580ryan@erienet.net (or ryan.311@osu.edu after 9/17/200
+1)

=cut

Comment on CGI::Buildform
Download Code
Replies are listed 'Best First'.
Re: CGI::Buildform
by Brovnik (Hermit) on Aug 30, 2001 at 14:36 UTC
    One brief comment - Always use the 2 argument form of bless,
    bless($self,$class);
    so that the class can be subclassed. You may need to check the $class, depending on how it is called, so
    my $proto = shift; my $class = ref($proto) || $proto; # stuff to create self bless($self,$class);
    is good practice. bless returns the item as well, so you could write your new() method as
    sub new { my ($proto,$name,$type,$end) = @_; my $class = ref($proto) || $proto; return bless { name => $name, type => $type, end => $end, attributes => {}, }, $class; }

    --
    Brovnik

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://108964]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (6)
As of 2015-08-01 01:35 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (285 votes), past polls