File Coverage

blib/lib/XML/Essex/Base.pm

Criterion	Covered	Total	%
statement	66	73	90.4
branch	21	32	65.6
condition	5	11	45.4
subroutine	12	13	92.3
pod	6	6	100.0
total	110	135	81.4

package XML::Essex::Base;

$VERSION = 0.000_1;

=head1 NAME

XML::Essex::Base - class for Essex SAX components

=head1 SYNOPSIS

   ## Not for external use.

=head1 DESCRIPTION

All Essex generators, filters and handlers must inherit from this
class among others.  This class provides methods common to all
three and specialized export semantics so that exports may be
inherited from base classes.

=for test_scripts XML-Generator-Essex.t XML-Filter-Essex.t

=cut

use strict;

use Carp ();  # keep from acquiring Croak's exported subs as methods.

our $self;

=head1 METHODS

=over

=cut

=item new

Creates and initializes an instance.

=cut

sub new {
    my $proto = shift;
    my $self = bless { @_ }, ref $proto || $proto;
    $self->_init;  ## These must use NEXT::, it's a diamond hierarchy at
                   ## times (eq XML::Filter::Dispatcher).
    return $self;
}

sub _classes {
    no strict "refs";
    return ( $_ ) unless exists ${"${_}::"}{ISA};
    return ( $_, map _classes( $_ ), @{"${_}::ISA"} );
}

=item import

Uses C<@EXPORT> and C<@EXPORT_OK> arrays like Exporter.pm, but
implements inheritence on it.  Understands the meaning of the tags
":all" and ":default", which are hardcoded (C<%EXPORT_TAGS> is ignored
thus far), but does not emulate Exporter's other, rarely used syntaxes.

=cut

use vars qw( $self );

sub import {
    my $class = shift;
    my $caller = caller;

    my $no_params = ! @_;

    no strict "refs";

    my @classes = do {
        local $_ = $class;
        my %seen;
        grep !$seen{$_}++, _classes;
    };

    my %tags;
    @_ = grep
        substr( $_, 0, 1 ) eq ":" ? $tags{$_} = undef : 1,
        @_;

    my %default_exports = (
        map { ( $_ => undef ) }
        map
            exists ${"${_}::"}{EXPORT}
                ? @{"${_}::EXPORT"}
                : (),
        @classes
    );

    push @_, keys %default_exports if exists $tags{":default"};

    my %all_exports = (
        %default_exports,
        ( exists $tags{":all"} || @_ )
            ? (
                map { ( $_ => undef ) }
                map
                    exists ${"${_}::"}{EXPORT_OK}
                        ? @{"${_}::EXPORT_OK"}
                        : (),
                @classes
            )
            : ()
        );
    push @_, keys %all_exports if exists $tags{":all"};

    @_= keys %default_exports if $no_params;

    my @not_exported;

    my %seen;
    for ( grep !$seen{$_}++, @_ ) {
        unless ( exists $all_exports{$_} ) {
            push @not_exported, $_;
            next;
        }

        *{"${caller}::$_"} = ( $class->can( $_ ) || \&{"${class}::$_"} );
    }

    Carp::croak
        "functions ",
        join( " ", @not_exported ),
        " not exported by $class"
        if @not_exported;
}

=item main

The main routine.  Overload this or pass in a code ref
to C \&foo )> or C to set this.

=cut

sub main {
    goto &{$_[0]->{Main}};
}

=item set_main

Sets the main routines to a code reference.

=cut

sub set_main {
    my $self = shift;
    $self->{Main} = shift;
}

=item reset

Called before the main routine is called.

=cut

sub reset {
    my $self = shift;

    $self->{NamespaceMaps} = [];

    $self->NEXT::reset;
}

=item finish

Called after the main routine is called.

=cut

=item execute

Prepares the runtime environment, calls C<<$self->main( @_ )>>, cleans
up afterwards and runs sanity checks.

This is called automatically in filters and handlers, must be
called manually in generators.

Calls reset() before and finish() after main().

=cut

sub execute {
    local $self = shift;

    return if $self->{NoExecute};  ## Used by XML::Essex

    ## Don't save a reference to the output_monitor in case some whacko
    ## manages to alter $self->{Handler} somehow.
    $self->reset;

    local $_;  ## get() explicitly sets $_ for the convenience of
               ## main() programmers.  In unthreaded mode, we want
               ## to be sure not to perturb the caller's sense of $_.

    my $r;
    my @r;
    my $ok = eval {
        wantarray
            ? @r = $self->main( @_ )
            : defined wantarray
                ? $r = $self->main( @_ )
                : $self->main( @_ );
        1;
    };

    my ( $result_set, $result ) = $self->finish( $ok, $@ );

    return $result if $result_set;
    return wantarray ? @r : $r;
}


=item namespace_map

aka: ns_map

    $self->ns_map(
        $ns1 => $prefix1,
        $ns2 => $prefix2,
        ...
    );

Creates a new set of mappings in addition to any that are already in
effect.  If a namespace is mapped to multiple prefixes, the last one
created is used.  The mappings stay in effect until the map objected
referred to by C<$map> is destroyed.

NOTE: the namespace prefixes from the source document override the
namespace prefixes set here when events are transmitted downstream.
This is so that namespace prefixes are not altered arbitrarily; the
philosophy is to make as few changes to the source document as possible
and remapping prefixes to match what happens to be declared in the
filter would not be proper.

For names in namespaces that are introduced by the filter and are not in
the source document, the prefixes from the filter are used.  This is a
bit dangerous: some other namespace in the source document may use the
same prefix and the result could be catastrophic.  Some future version
will try to detect these collisions, and there may even be a nice way to
avoid them.

Source document prefixes are generally invisible in the Essex
environment (aside from the start_prefix_mapping and end_prefix_mapping
events) because they could be anything.  If you root around inside essex
objects enough, though, you can ferret them out.  Trying to do that is a
pretty good indication that something's wrong.

=cut

sub namespace_map {
    local $self = shift if @_ && UNIVERSAL::isa( $_[0], __PACKAGE__ );
    require XML::Essex::NamespaceMap;
    push @{$self->{Namespaces}},
        XML::Essex::NamespaceMap->new( $self, @_ );
}

*ns_map = \&namespace_map;


=back

=head1 LIMITATIONS

Does not support other Exporter features like exporting past several calling
modules.

=head1 COPYRIGHT

    Copyright 2002, R. Barrie Slaymaker, Jr., All Rights Reserved

=head1 LICENSE

You may use this module under the terms of the BSD, Artistic, oir GPL licenses,
any version.

=head1 AUTHOR

Barrie Slaymaker

=cut

1;