Beefy Boxes and Bandwidth Generously Provided by pair Networks DiBona
Just another Perl shrine
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
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

In reply to CGI::Buildform by jryan

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others chanting in the Monastery: (5)
    As of 2014-04-20 03:40 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      April first is:







      Results (485 votes), past polls