view release on metacpan or  search on metacpan

XMLApplication.pm  view on Meta::CPAN

##
# CGI::XMLApplication - Application Module for CGI scripts

# ################################################################
# module loading and global variable initializing
# ################################################################
use strict;

use CGI;
use Carp;
#use Data::Dumper;

# ################################################################
# inheritance
# ################################################################
@CGI::XMLApplication::ISA = qw( CGI );

# ################################################################

$CGI::XMLApplication::VERSION = "1.1.5";

# ################################################################
# general configuration
# ################################################################

# some hardcoded error messages, the application has always, e.g.
# to tell that a stylesheet is missing
@CGI::XMLApplication::panic = (
          'No Stylesheet specified! ',
          'Stylesheet is not available! ',
          'Event not implemented',
          'Application Error',
         );

# The Debug Level for verbose error messages
$CGI::XMLApplication::DEBUG = 0;

# ################################################################
# methods
# ################################################################
sub new {
    my $class = shift;
    my $self = $class->SUPER::new( @_ );
    bless $self, $class;

    $self->{XML_CGIAPP_HANDLER_}    = [$self->registerEvents()];
    $self->{XML_CGIAPP_STYLESHEET_} = [];
    $self->{XML_CGIAPP_STYLESDIR_}  = '';

    return $self;
}

# ################################################################
# straight forward coded methods

# application related ############################################
# both functions are only for backward compatibilty with older scripts
sub debug_msg {
    my $level = shift;
    if ( $level <= $CGI::XMLApplication::DEBUG && scalar @_ ) {
        my ($module, undef, $line) = caller(1);
        warn "[$module; line: $line] ", join(' ', @_) , "\n";
    }
}

##
# dummy functions
#
# each function is required to be overwritten by any class inheritated
sub registerEvents   { return (); }

# all following function will recieve the context, too
sub getDOM           { return undef; }
sub requestDOM       { return undef; }  # old style use getDOM!

sub getStylesheetString { return ""; }     # return a XSL String
sub getStylesheet       { return ""; }     # returns either name of a stylesheetfile or the xsl DOM
sub selectStylesheet    { return ""; }     # old style getStylesheet

sub getXSLParameter  { return (); }  # should return a plain hash of parameters passed to xsl
sub setHttpHeader    { return (); }  # should return a hash of header

sub skipSerialization{
    my $self = shift;
    $self->{CGI_XMLAPP_SKIP_TRANSFORM} = shift if scalar @_;
    return $self->{CGI_XMLAPP_SKIP_TRANSFORM};
}

# returns boolean
sub passthru {
    my $self = shift;
    if ( scalar @_ ) {
        $self->{CGI_XMLAPP_PASSXML} = shift;
        $self->delete( 'passthru' ); # delete any passthru parameter
    }
    elsif ( defined $self->param( "passthru" ) ) {
        $self->{CGI_XMLAPP_PASSXML} = 1    ;
        $self->delete( 'passthru' );
    }
    return $self->{CGI_XMLAPP_PASSXML};
}

sub redirectToURI {
    my $self = shift;
    $self->{CGI_XMLAPP_REDIRECT} = shift if scalar @_;
    return $self->{CGI_XMLAPP_REDIRECT};
}

# ################################################################
# content related functions

# stylesheet directory information ###############################
sub setStylesheetDir  { $_[0]->{XML_CGIAPP_STYLESDIR_} = $_[1];}
sub setStylesheetPath { $_[0]->{XML_CGIAPP_STYLESDIR_} = $_[1];}
sub getStylesheetDir  { $_[0]->{XML_CGIAPP_STYLESDIR_}; }
sub getStylesheetPath { $_[0]->{XML_CGIAPP_STYLESDIR_}; }

# event control ###################################################

sub addEvent          { my $s=shift; push @{$s->{XML_CGIAPP_HANDLER_}}, @_;}