/usr/share/doc/libcgi-xmlapplication-perl/examples/example3.pm is in libcgi-xmlapplication-perl 1.1.3-7.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 | # this is the application class # This example shows how to pass a
# configuration to CGI::XMLApplication. In fact the data passed to
# CGI::XMLApplication can be of any type you like. The data is simply
# inserted to the context (see CGI::XMLApplication for
# details). Basicly this module has the same function as example2, so
# I asume you have through that module already.
package example3;
use vars qw( @ISA @HANLDER );
use CGI::XMLApplication;
use XML::LibXML;
@ISA = qw(CGI::XMLApplication);
sub registerEvents { qw( submit _internal_error_ ); } # the handler list
sub requestDOM { my ( undef, $ctxt ) = @_; return $ctxt->{-XML}; }
sub selectStylesheet {
my ( undef, $ctxt ) = @_;
return './' . qw( ex2_form.xsl ex2_finish.xsl )[ $ctxt->{-stylesheet} ];
}
sub event_init {
my ( $self , $ctxt ) = @_;
# lets see if our configuration is here :)
if ( exists $ctxt->{-DUMMY} ){
# not very useful, huh? =)
# the thing here is, that the data passed to run() in the script,
# is available in ALL events. this may be useful, if one has to
# load script configurations on runtime
warn "example3 found the dummy!\n";
}
# initialize the internal 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
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!" );
return 0;
}
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;
|