# this is the application class
#
# this example shows how to make use of the context
# and how passing your personalized xml dom around.
#
# actually this is allready a full featured example, although it does
# nothing useful :>
#
# while programming with this package you should avoid printing to the
# clientside, because this is the job of the serialization function.
# for q'n'd scripter this will be the biggest change of
# paradigma. from the viewpoint of XML/ XSLT this follows exactly the
# paradigma of separating function, content and presentation.
#
# once you get used not using the print function from inside a script,
# you will realize the resulting code will be much easier to maintain.
package example2;
use vars qw( @ISA @HANLDER );
use CGI::XMLApplication;
use XML::LibXML;
@ISA = qw(CGI::XMLApplication);
# if you implement internal error events ashure, you place them at the
# very end of the eventlist, so if someone places a parameter with the
# same name into a form, the script can still find the correct event
# (which is usually the submit button a client pushed).
#
# what are internal events good for? i found it's comfortable to have
# special events, for special problems. this could be that a database
# server is not reachable or a client session has expiered. These are
# no real events, clients cause by clicking around, but in my logic,
# this should be handled in special events. So i delete all existing
# events (done implicit by sendEvent) and send the error event by
# myself.
sub registerEvents { qw( submit _internal_error_ ); } # the handler list
# the requestDOM function is called by the serialize function. it has
# to return a XML::LibXML::Document object. If no DOM is
# returned,sreialize will create an empty DOM, so stylesheets can be
# processed, even if the script does not create a DOM structure
#
# pay attention that you can use any name to store your own DOM
# in the context hash.
sub requestDOM { my ( undef, $ctxt ) = @_; return $ctxt->{-XML}; }
# one can implement any complexity of stylesheet selection wanted, but
# i recommend to keep this function as simple as possible.
sub selectStylesheet {
my ( $self, $ctxt ) = @_;
return $self->getStylesheetPath() . qw( ex2_form.xsl ex2_finish.xsl )[ $ctxt->{-stylesheet} ];
}
# the following subroutine will make CGI::XMLApplication to pass the returned
# hash to the stylesheetprocessor
sub getXSLTParameter {
my ( $self, $ctxt ) = @_;
return ( test=>$ctxt->{-test}||-1 );
}
# the init event should do all required initializing, that is common
# to all events implemeted, as well system problems should be catched
# here as well
sub event_init {
my ( $self , $ctxt ) = @_;
# initialize the context
my $dom = XML::LibXML::Document->new();
my $root= $dom->createElement( 'yourfavouritetagname' );
$dom->setDocumentElement( $root );
$ctxt->{-XML} = $dom;
$ctxt->{-ROOT}= $root;
$ctxt->{-stylesheet} = 0; # on default we'll display the form
# do some testing
# in more complex scripts such tests would be confusing here ...
# the use of error handling inside event_init is more for general
# problems.
if ( $self->param('email')=~/\@.*\@/ || $self->param('email')!~/\@..+/ ) {
$self->sendEvent('_internal_error_' );
}
}
# exit is called before serialization
sub event_exit {
my ( $self , $ctxt ) = @_;
# we do some caching here, but you can do whatever you like
# (e.g. release lockfiles)
if ( exists $ctxt->{-XML} && not exists $ctxt->{-ERROR} ){
open CACHEFILE , "> ex2_cache.xml";
print CACHEFILE $ctxt->{-XML}->toString();
close CACHEFILE;
}
}
sub event_default {
my ( $self , $ctxt ) = @_;
$ctxt->{-ROOT}->appendTextChild('message','Hey user from ' .
$self->remote_host() .
" pass your email!" );
# PAY ATTENTION HERE!
# the return value has to be greater or equal 0. If a value
# less than 0 is returned CGI::XMLApplication asumes an so called
# panic. This will have the effect, that no XSLT redering is tried
# and a special error message is returned (see setPanicMsg)
# CGI::XMLApplication knows 4 types of panics:
# -1 "no stylesheet set" (internal error) (no filename given)
# -2 "no stylesheet found" (internal error) (like file not found)
# -3 "no event function for registred event" (internal error) (...)
# -4 "application error" (this one is for you) ;)
#
# if it is a valid value, the value itself has no meaning anymore...
return 0;
}
# as one can see easily, the event functions has to have the same name
# as the event has. the prefix 'event_' is a requirement.
#
# i think, i'll introduce real callbacks quite soon, so one can choose
# any function name prefered and has only to register it to the related
# event.
sub event__internal_error_ {
my ( $self , $ctxt ) = @_;
$ctxt->{-ROOT}->appendTextChild('message',
'this email seems not to be valid');
$ctxt->{-ROOT}->appendTextChild( 'email', "".$self->param( 'email' ) );
$ctxt->{-ERROR} = 1;
return 0;
}
sub event_submit {
my ( $self , $ctxt ) = @_;
$ctxt->{-ROOT}->appendTextChild('message',
"ALL YOUR BASE DOES BELONG TO US!"); # ;)
$ctxt->{-stylesheet} = 1; # submit was ok, so display the thank you message
return 0;
}
1;