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->{attributes}->{$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->{elements}->{$element})); } sub print_element { my ($self, $element) = @_; if (defined($self->{elements}->{$element})) { print "{elements}->{$element}->{type}\"" if (!defined($self->{base}->{$self->{elements}->{$element}->{type}})); print "<$self->{elements}->{$element}->{type}" if (defined($self->{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 "
\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{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->{properties}->{$name})); } sub delete_attribute { my $self = shift; my $element = shift; my %del_attributes = @_; $self->{elements}->{$element}->delete_attribute(%del_attributes) if (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 $element) { 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 after 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", "