File Coverage

blib/lib/XML/NodeFilter.pm

Criterion	Covered	Total	%
statement	97	100	97.0
branch	18	22	81.8
condition	2	6	33.3
subroutine	25	25	100.0
pod	4	4	100.0
total	146	157	92.9

#------------------------------------------------------------------------#
package XML::NodeFilter;
#------------------------------------------------------------------------#
# $Id: NodeFilter.pm,v 1.1.1.1 2002/11/08 09:26:59 phish108 Exp $
#------------------------------------------------------------------------#
# (c) 2002 Christian Glahn                   #
# All rights reserved.                                                   #
#                                                                        #
# This code is free software; you can redistribute it and/or             #
# modify it under the same terms as Perl itself.                         #
#                                                                        #
#------------------------------------------------------------------------#

#------------------------------------------------------------------------#
# general settings                                                       #
#------------------------------------------------------------------------#
use 5.005;
use strict;

require Exporter;
use vars qw( $VERSION @ISA %EXPORT_TAGS @EXPORT @EXPORT_OK
             @FLAGNAMES %FLAGMAPPING);


$VERSION = '0.01';

@ISA = qw(Exporter);

#------------------------------------------------------------------------#
# export information                                                     #
#------------------------------------------------------------------------#

%EXPORT_TAGS = (
'results' => [ qw(
                  FILTER_DECLINED
                  FILTER_ACCEPT
                  FILTER_SKIP
                  FILTER_REJECT
) ],
'flags'   => [ qw(
                  SHOW_ALL
                  SHOW_ELEMENT
                  SHOW_ATTRIBUTE
                  SHOW_TEXT
                  SHOW_CDATA_SECTION
                  SHOW_ENTITY_REFERENCE
                  SHOW_ENTITY
                  SHOW_PROCESSING_INSTRUCTION
                  SHOW_COMMENT
                  SHOW_DOCUMENT
                  SHOW_DOCUMENT_TYPE
                  SHOW_DOCUMENT_FRAGMENT
                  SHOW_NOTATION
                  SHOW_NONE
) ],
'all'     => [ qw(
                  FILTER_DECLINED
                  FILTER_ACCEPT
                  FILTER_SKIP
                  FILTER_REJECT
                  SHOW_ALL
                  SHOW_ELEMENT
                  SHOW_ATTRIBUTE
                  SHOW_TEXT
                  SHOW_CDATA_SECTION
                  SHOW_ENTITY_REFERENCE
                  SHOW_ENTITY
                  SHOW_PROCESSING_INSTRUCTION
                  SHOW_COMMENT
                  SHOW_DOCUMENT
                  SHOW_DOCUMENT_TYPE
                  SHOW_DOCUMENT_FRAGMENT
                  SHOW_NOTATION
                  SHOW_NONE
) ] );

@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

@EXPORT = qw();

#------------------------------------------------------------------------#
# constants declaration                                                  #
#------------------------------------------------------------------------#

@FLAGNAMES = qw(
                SHOW_ELEMENT
                SHOW_ATTRIBUTE
                SHOW_TEXT
                SHOW_CDATA_SECTION
                SHOW_ENTITY_REFERENCE
                SHOW_ENTITY
                SHOW_PROCESSING_INSTRUCTION
                SHOW_COMMENT
                SHOW_DOCUMENT
                SHOW_DOCUMENT_TYPE
                SHOW_DOCUMENT_FRAGMENT
                SHOW_NOTATION
               );

use constant FILTER_DECLINED    => 0; # check what other filters say ...
use constant FILTER_ACCEPT      => 1;
use constant FILTER_SKIP        => 2;
use constant FILTER_REJECT      => 3;

use constant SHOW_ALL                    => 0xFFFFFFFF;
use constant SHOW_ELEMENT                => 0x00000001;
use constant SHOW_ATTRIBUTE              => 0x00000002;
use constant SHOW_TEXT                   => 0x00000004;
use constant SHOW_CDATA_SECTION          => 0x00000008;
use constant SHOW_ENTITY_REFERENCE       => 0x00000010;
use constant SHOW_ENTITY                 => 0x00000020;
use constant SHOW_PROCESSING_INSTRUCTION => 0x00000040;
use constant SHOW_COMMENT                => 0x00000080;
use constant SHOW_DOCUMENT               => 0x00000100;
use constant SHOW_DOCUMENT_TYPE          => 0x00000200;
use constant SHOW_DOCUMENT_FRAGMENT      => 0x00000400;
use constant SHOW_NOTATION               => 0x00000800;

# why are specs always incomplete regarding the NULL set???
use constant SHOW_NONE                   => 0x00000000;

@FLAGMAPPING{@FLAGNAMES} = (SHOW_ELEMENT,
                            SHOW_ATTRIBUTE,
                            SHOW_TEXT,
                            SHOW_CDATA_SECTION,
                            SHOW_ENTITY_REFERENCE,
                            SHOW_ENTITY,
                            SHOW_PROCESSING_INSTRUCTION,
                            SHOW_COMMENT,
                            SHOW_DOCUMENT,
                            SHOW_DOCUMENT_TYPE,
                            SHOW_DOCUMENT_FRAGMENT,
                            SHOW_NOTATION);

#------------------------------------------------------------------------#
# class constructor                                                      #
#------------------------------------------------------------------------#
sub new {
    my $class = shift;
    my %args  = @_;
    my $flags = SHOW_ALL;
    if ( defined $args{WHAT_TO_SHOW} ) {
        $flags = $args{WHAT_TO_SHOW};
        delete $args{WHAT_TO_SHOW};
    }
    elsif ( defined $args{-show} ) {
        $flags = $args{-show};
        delete $args{-show};
    }

    my $self = bless \%args, $class;

    $self->what_to_show( ref( $flags ) ? %{$flags} : $flags );

    return $self;
}

#------------------------------------------------------------------------#
# what_to_show                                                           #
#------------------------------------------------------------------------#
sub what_to_show {
    my $self = shift;
    my $mask = $self->{WHAT_TO_SHOW};

    if ( my $n = scalar @_ ) {
        if ( $n == 1) {
            $mask = shift;
            unless ( defined $mask ) {
                $self->{WHAT_TO_SHOW} = SHOW_ALL;
                $mask = SHOW_ALL;
            }
        }
        elsif ( $n > 1 ) {
            my %args = @_;
            $mask= SHOW_NONE;

            foreach ( keys %args ) {
                if ( defined $FLAGMAPPING{$_}
                     and defined $args{$_}
                     and $args{$_} ){
                    $mask |= $FLAGMAPPING{$_};
                }
            }

            if ( defined $args{SHOW_ALL} ) {
                $mask = SHOW_ALL;
            }

        }

        $self->{WHAT_TO_SHOW} = $mask;
    }

    if ( wantarray ) {
        my %retval = ();

        @retval{@FLAGNAMES} = map { $mask & $_ ? "1" : "0" } (
                                                SHOW_ELEMENT,
                                                SHOW_ATTRIBUTE,
                                                SHOW_TEXT,
                                                SHOW_CDATA_SECTION,
                                                SHOW_ENTITY_REFERENCE,
                                                SHOW_ENTITY,
                                                SHOW_PROCESSING_INSTRUCTION,
                                                SHOW_COMMENT,
                                                SHOW_DOCUMENT,
                                                SHOW_DOCUMENT_TYPE,
                                                SHOW_DOCUMENT_FRAGMENT,
                                                SHOW_NOTATION
                                                            );
        return %retval;
    }

    return $mask;
}

#------------------------------------------------------------------------#
# accept_node and acceptNode                                             #
#------------------------------------------------------------------------#
# accept_node() will call acceptNode() on default. This allows a         #
# transparent implementation towards spec conformance.                   #
#                                                                        #
# the default return value is FILTER_ACCEPT rather than FILTER_DECLINED, #
# because FILTER_DECLINED was not specified                              #
#------------------------------------------------------------------------#
sub accept_node { my $s = shift; return $s->acceptNode( @_ );  }
sub acceptNode  { return FILTER_ACCEPT; }

1;
#------------------------------------------------------------------------#
# Code End                                                               #
#------------------------------------------------------------------------#
__END__