From: Kirrily R. <sk...@us...> - 2001-09-24 20:10:54
|
Update of /cvsroot/formmagick/formmagick/lib/CGI/FormMagick In directory usw-pr-cvs1:/tmp/cvs-serv12811/lib/CGI/FormMagick Added Files: Events.pm Setup.pm Log Message: Extracted events and setup routines out to sub-modules. Passing tests, but I'm not sure that it's actually all right, as I *know* the tests don't cover anything. If anyone wants to write some more tests, this is your chance. --- NEW FILE --- #!/usr/bin/perl -w # # FormMagick (c) 2000-2001 Kirrily Robert <sk...@cp...> # This software is distributed under the same licenses as Perl; see # the file COPYING for details. # # $Id: Events.pm,v 1.1 2001/09/24 20:10:47 skud Exp $ # package CGI::FormMagick; use strict; use Carp; =pod =head1 NAME CGI::FormMagick::Events -- pre/post form/page event handlers =head1 SYNOPSIS use CGI::FormMagick; =head1 DESCRIPTION =head2 form_pre_event($self) performs the PRE-EVENT (if any) for the form. Usually used to do setup for the application. this is the routine where we call some routine that will give us default data for the form, or otherwise do things that need doing before the form is submitted. =cut sub form_pre_event { my ($self) = @_; # find out what the form pre_event action is. my $pre_form_routine = $self->{clean_xml}->{'PRE-EVENT'} || return; if ($pre_form_routine) { my $cp = $self->{calling_package}; my $voodoo = "\&$cp\:\:$pre_form_routine(\$self->{cgi})"; # if the pre_form_routine is defined in the calling file, # it'll run. Otherwise, we'll give some simple display of the # variables that were submitted. unless (eval $voodoo) { debug($self, "<p>There was no pre-form routine.</p>\n") } } } =pod =head2 form_post_event($self) performs validation and runs the POST-EVENT (if any) otherwise just prints out the data that the user input Note: we need to validate EVERY ONE of the form inputs to make sure malicious attacks don't happen. See also "SECURITY CONSIDERATIONS" in the perldoc for how to get around this :-/ =cut sub form_post_event { my ($self) = @_; $self->debug("This is the form post event"); $self->validate_all(); $self->debug("finished validating for form post event"); if ($self->errors()) { $self->debug("Looks like we've got some errors"); #print "<h2>", localise("Validation errors"), "</h2>\n"; #print "<p>", localise("These validation errors are probably evidence of an attempt to circumvent the data validation on this application. Please start over again."), "</p>"; $self->list_error_messages(); } else { $self->debug("Validation successful."); # find out what the form post_event action is. my $post_form_routine = $self->{clean_xml}->{'POST-EVENT'}; unless ($self->do_external_routine($post_form_routine)) { print "<p>", localise("The following data was submitted"), "</p>\n"; print "<ul>\n"; my @params = $self->{cgi}->param; foreach my $param (@params) { my $value = $self->{cgi}->param($param); print "<li>$param: $value\n"; } print "</ul>\n"; } } } =pod =head2 page_pre_event($self) =cut sub page_pre_event { my ($self) = @_; $self->debug("This is the page pre-event."); if (my $pre_page_routine = $self->page->{'PRE-EVENT'}) { $self->debug("The pre-routine is $pre_page_routine"); $self->do_external_routine($pre_page_routine); } } =pod =head2 page_post_event($self) =cut sub page_post_event { my ($self) = @_; $self->debug("This is the page post-event."); if (my $post_page_routine = $self->page->{'POST-EVENT'}) { $self->debug("The post-routine is $post_page_routine"); $self->do_external_routine($post_page_routine); } } return "FALSE"; # true value =pod =head1 SEE ALSO CGI::FormMagick =cut --- NEW FILE --- #!/usr/bin/perl -w # # FormMagick (c) 2000-2001 Kirrily Robert <sk...@cp...> # This software is distributed under the same licenses as Perl; see # the file COPYING for details. # # $Id: Setup.pm,v 1.1 2001/09/24 20:10:47 skud Exp $ # package CGI::FormMagick; use strict; use Carp; use File::Basename; =pod =head1 NAME CGI::FormMagick::Setup - setup/initialisation routines for FormMagick =head1 SYNOPSIS use CGI::FormMagick; =head1 DESCRIPTION =head2 default_xml_filename() default source filename to the same as the perl script, with .xml extension =begin testing BEGIN: { use vars qw( $fm ); use lib "./lib"; use CGI::FormMagick; } my $xml = qq( <FORM TITLE="FormMagick demo application" POST-EVENT="submit_order"> <PAGE NAME="Personal" TITLE="Personal details" POST-EVENT="lookup_group_info"> <FIELD ID="firstname" LABEL="first name" TYPE="TEXT" VALIDATION="nonblank"/> <FIELD ID="lastname" LABEL="last name" TYPE="TEXT" VALIDATION="nonblank"/> </PAGE> </FORM> ); ok($fm = CGI::FormMagick->new(TYPE => 'STRING', SOURCE => $xml), "create fm object"); =end testing =cut sub default_xml_filename { my($scriptname, $scriptdir, $extension) = File::Basename::fileparse($0, '\.[^\.]+'); return $scriptname . '.xml'; } =pod =head2 parse_xml() Parses the source XML and returns the results as a Perl data structure. =for testing TODO: { local $TODO = "writeme"; fail(); } =cut sub parse_xml { my ($self) = @_; my $p = new XML::Parser (Style => 'Tree'); my $xml; if ($self->{inputtype} eq "FILE") { $xml = $p->parsefile($self->{source} || default_xml_filename()); } elsif ($self->{inputtype} eq "STRING") { $xml = $p->parse($self->{source}); } else { croak 'Invalid source type specified (should be "FILE" or "STRING")'; } return $xml; } =head2 clean_xml() Cleans up the output of parse_xml() and returns it as a nicer, more usable data structure, like this: { 'FORM' => { 'POST-EVENT' => 'submit_order', 'TITLE' => 'FormMagick demo application' }, 'PAGES' => [ { 'POST-EVENT' => 'lookup_group_info', 'FIELDS' => [ { 'TYPE' => 'TEXT', 'ID' => 'firstname', 'VALIDATION' => 'nonblank', 'LABEL' => 'first name' }, { 'TYPE' => 'TEXT', 'ID' => 'lastname', 'VALIDATION' => 'nonblank', 'LABEL' => 'last name' } ], 'NAME' => 'Personal', 'TITLE' => 'Personal details' } ] }; =for testing is(ref($fm->{clean_xml}), "HASH", "clean_xml gives us a hash"); is($fm->{clean_xml}->{TITLE}, "FormMagick demo application", "Picked up form title"); is(ref($fm->{clean_xml}->{PAGES}), "ARRAY", "clean_xml gives us an array of pages"); is(ref($fm->{clean_xml}->{PAGES}->[0]), "HASH", "each page is a hashref"); is($fm->{clean_xml}->{PAGES}->[0]->{NAME}, "Personal", "Picked up first page's name"); is(ref($fm->{clean_xml}->{PAGES}->[0]->{FIELDS}), "ARRAY", "Page's fields are an array"); =cut sub clean_xml { my $self = shift; my @pages; my $dirty_form = $self->{xml}->[1]; for (my $i = 4; $i < scalar(@$dirty_form); $i += 4) { my $page = $dirty_form->[$i][0]; my @fields; for (my $j = 4; $j < scalar(@{$dirty_form->[$i]}); $j += 4) { my $field = $dirty_form->[$i]->[$j]->[0]; push @fields, $field; } $page->{FIELDS} = \@fields; push @pages, $page; } my $clean = { %{$dirty_form->[0]}, PAGES => \@pages, }; return $clean; } =pod =head2 initialise_sessiondir($self) Figures out where the session tokens should be kept. =for testing ok( CGI::FormMagick::initialise_sessiondir("abc"), "Initialise sessiondir with name"); ok( CGI::FormMagick::initialise_sessiondir(), "Initialise sessiondir with undef"); =cut sub initialise_sessiondir { my ($sessiondir) = @_; # use the user-defined session handling directory (or default to # session-tokens) to store session tokens if ($sessiondir) { return $sessiondir; } else { require File::Basename; my($scriptname, $scriptdir, $extension) = File::Basename::fileparse($0, '\.[^\.]+'); return "$scriptdir/session-tokens"; } } return "FALSE"; # true value ;) =pod =head1 SEE ALSO CGI::FormMagick =cut |