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