[SAWA-devel] sawa/t/src/libxslt/lib/libxslt Base.pm, NONE, 1.1 Output.pm, NONE, 1.1 handler.pm, NONE, 1.1

[Kip H. <ki...@us...>]

Update of /cvsroot/sawa/sawa/t/src/libxslt/lib/libxslt
In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv11548/t/src/libxslt/lib/libxslt

Added Files:
	Base.pm Output.pm handler.pm 
Log Message:
Massive update to the test suite. Now decoupled from Apache::Test

--- NEW FILE: Base.pm ---
package libxslt::Base;
use SAWA::Constants;
use SAWA::Event::Simple;
use strict;
our @ISA = qw( SAWA::Event::Simple );

BEGIN { srand(time() ^ ($$ + ($$ << 15))) }

sub registerEvents {
    return qw/ complete /;
}

sub event_default {
    my $self = shift;
    my $ctxt = shift;
    $ctxt->{stylesheet} = 'prompt.xsl';
    $ctxt->{message} = 'Please complete the following form to generate your fabulous new movie star name';
    return OK;
}

sub event_complete {
    my $self    = shift;
    my $ctxt    = shift;

    my @param_names = $self->query->param;
   
    my @first_names = map { $self->query->param("$_") } grep { $_ =~ /^first\./ } @param_names;
    my @last_names  = map { $self->query->param("$_") } grep { $_ =~ /^last\./ }  @param_names;

    if ( ((scalar @first_names) + (scalar @last_names) != 6) || ( grep { length == 0 } @first_names, @last_names ) ) {
        $ctxt->{message} = 'All fields must be filled in. Please try again.';
        $ctxt->{stylesheet} = 'prompt.xsl';
        return OK;
    }

    $ctxt->{first_name} = $first_names[ int( rand( @first_names )) ];
    $ctxt->{last_name} = $last_names[ int( rand( @last_names )) ];
    $ctxt->{message} = 'Congratulations! Your Movie Star name has been magically determined!';
    $ctxt->{stylesheet} = 'complete.xsl';
    return OK;
}

1;

--- NEW FILE: handler.pm ---
package libxslt::handler;
use SAWA::Machine;
use mod_perl;
use constant MP2 => $mod_perl::VERSION >= 1.99;
BEGIN {
        if (MP2) {
                require Apache::Response;
                require Apache::Const;
                require Apache::RequestIO;
        } else {
                require Apache::Constants;
        }
}

sub handler {
    my $r = shift;
    my $app = SAWA::Machine->new();
    $app->pipeline( qw(
        libxslt::Base
        libxslt::Output
    ) );
    $app->run({});
    return MP2 ? Apache::OK : Apache::Constants::OK;
}

1;

--- NEW FILE: Output.pm ---
package libxslt::Output;
use strict;
use warnings;
use XML::LibXML;
use SAWA::Constants;
use SAWA::Output::XML::LibXSLT;
our @ISA = qw/ SAWA::Output::XML::LibXSLT /;

sub get_stylesheet {
    my $self = shift;
    my $ctxt = shift;

    # this is more complest than it usually would be
    # due to the fact that the test dir may be installed 
    # in any dir
    my $style_path = $self->static_path . '/styles/moviename/';

#     if ($ENV{MOD_PERL}) {
#         $style_path = $self->query->r->document_root;
#         $style_path .= '/styles/moviename/';
#     }
#     else {
#         require Cwd;
#         $style_path = Cwd::abs_path('../htdocs/styles/moviename');
#         $style_path .= '/';
#     }

    $self->stylesheet(  $style_path . $ctxt->{stylesheet} );
    return OK;
}
    
sub get_document {
    my $self = shift;
    my $ctxt = shift;
    my $dom  = XML::LibXML::Document->new();
    my $root = $dom->createElement( 'application' );
    $dom->setDocumentElement( $root );

    foreach my $token ( qw( message first_name last_name ) ) {
        if ( defined( $ctxt->{ $token } )) {
            my $element = $dom->createElement( $token );
            $element->appendChild( $dom->createTextNode( $ctxt->{ $token } ) );
            $root->appendChild( $element );
        }
    }

    $self->document( $dom );
    return OK;
}

sub get_style_params {
    # just copy all params through (should this be the default?)
    my $self = shift;
    my $ctxt = shift;
    my %style_params = ();
    
    for ( $self->query->param ) {
        $style_params{$_} = $self->query->param($_);
    }

    $self->style_params( \%style_params );
    return OK;
}

1;