Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
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
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 exploiting the Monastery: (3)
As of 2014-07-13 13:14 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    When choosing user names for websites, I prefer to use:








    Results (249 votes), past polls