view release on metacpan or  search on metacpan

lib/XML/Parser/LiteCopy.pm  view on Meta::CPAN

# NOTE: This module originally came from SOAP::Lite, which you probably
# don't have. It was first repackaged here just to avoid the huge 
# dependancy tree, but this version has several features (CDATA
# support, better PI and Comment support) that have been added.

#
# Copyright (C) 2000-2007 Paul Kulchenko (paulclinger@yahoo.com)
# Copyright (C) 2008 Martin Kutter (martin.kutter@fen-net.de)
# Copyright (C) 2009-2011 Cal Henderson (cal@iamcal.com)
#
# SOAP::Lite is free software; you can redistribute it
# and/or modify it under the same terms as Perl itself.
#

package XML::Parser::LiteCopy;

use strict;
use vars qw($VERSION);
$VERSION = '0.720.00';

my $ReturnErrors = 0;

sub new {
    my $class = shift;

    return $class if ref $class;
    my $self = bless {} => $class;

    my %parameters = @_;
    $self->setHandlers(); # clear first
    $self->setHandlers(%{$parameters{Handlers} || {}});

    $ReturnErrors = $parameters{ReturnErrors} || 0;

    return $self;
}

sub setHandlers {
    my $self = shift;

    # allow symbolic refs, avoid "subroutine redefined" warnings
    no strict 'refs'; local $^W;
    # clear all handlers if called without parameters
    if (not @_) {
        for (qw(Start End Char Final Init CData Comment Doctype PI Error)) {
            *$_ = sub {}
        }
    }

    # we could use each here, too...
    while (@_) {
        my($name, $func) = splice(@_, 0, 2);
        *$name = defined $func
            ? $func
            : sub {}
    }
    return $self;
}

sub _regexp {
    my $patch = shift || '';
    my $package = __PACKAGE__;

    # This parser is based on "shallow parser" http://www.cs.sfu.ca/~cameron/REX.html

    # Robert D. Cameron "REX: XML Shallow Parsing with Regular Expressions",
    # Technical Report TR 1998-17, School of Computing Science, Simon Fraser University, November, 1998.
    # Copyright (c) 1998, Robert D. Cameron.
    # The following code may be freely used and distributed provided that
    # this copyright and citation notice remains intact and that modifications
    # or additions are clearly identified.

    use re 'eval';
    my $TextSE = "[^<]+";

    # the following backrefs have been added:
    # 1 : TextSE
    # 2 : MarkupSPE / DeclCE / CommentCE
    # 3 : MarkupSPE / DeclCE / CDATA_CE
    # 4 : MarkupSPE / DeclCE / DocTypeCE
    # 5 : MarkupSPE / PI_CE
    # 6 : MarkupSPE / EndTagCE
    # 7+: MarkupSPE / ElemTagCE

    my $Until2Hyphens = "(?:[^-]*)-(?:[^-]+-)*-";
    my $CommentCE = "($Until2Hyphens)(?{${package}::comment(\$2)})>?";