view release on metacpan or  search on metacpan

examples/example2.pm  view on Meta::CPAN

# 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;