view lib/IMPL/DOM/XMLReader.pm @ 424:87af445663d7 ref20150831

IMPL::Object::_Base
author cin
date Tue, 03 Apr 2018 10:54:09 +0300
parents ee36115f6a34
children
line wrap: on
line source

package IMPL::DOM::XMLReader;
use strict;
use warnings;

use XML::Parser;

use IMPL::declare {
	require => {
		Schema => 'IMPL::DOM::Schema', # IMPL::DOM::Schema references IMPL::DOM::XML::Reader
    	Builder => 'IMPL::DOM::Navigator::Builder',
    	SimpleBuilder => 'IMPL::DOM::Navigator::SimpleBuilder'		
	},
	base => [
		'IMPL::Object' => undef
	],
	props => [
		Navigator => '*r',
		SkipWhitespace => '*r',
		_current => '*rw',
		_text => '*rw',
		_textHistory => '*rw'
	]
};

use IMPL::require {
    
};

sub CTOR {
	my ($this, %params) = @_;
	
	$this->{$Navigator} = $params{Navigator} if $params{Navigator};
	$this->{$SkipWhitespace} = $params{SkipWhitespace} if $params{SkipWhitespace};
}

sub Parse {
    my ($this,$in) = @_;
    
    my $parser = new XML::Parser(
        Handlers => {
            Start => sub {shift; goto &OnStart($this,@_)},
            End => sub {shift; goto &OnEnd($this,@_)},
            Char => sub {shift; goto &OnChar($this,@_)}
        }
    );
    
    $parser->parse($in);
}

sub ParseFile {
    my ($this,$in) = @_;
    
    my $parser = new XML::Parser(
        Handlers => {
            Start => sub {shift; unshift @_, $this; goto &_OnBegin;},
            End => sub {shift; unshift @_, $this; goto &_OnEnd;},
            Char => sub {shift; unshift @_, $this; goto &_OnChar;}
        }
    );
    
    $parser->parsefile($in);
}

sub _OnBegin {
    my ($this,$element,%attrs) = @_;
    
    push @{$this->{$_textHistory}},$this->{$_text};
    $this->{$_text} = "";
    $this->{$_current} = $this->Navigator->NavigateCreate($element,%attrs);
}

sub _OnEnd {
    my ($this,$element) = @_;
    $this->{$_current}->nodeValue($this->{$_text}) if length $this->{$_text} and (not $this->{$SkipWhitespace} or $this->{$_text} =~ /\S/);
    $this->{$_text} = pop @{$this->{$_textHistory}};
    $this->{$_current} = $this->Navigator->Back;
}

sub _OnChar {
    my ($this,$val) = @_;
    $this->{$_text} .= $val;
}

sub LoadDocument {
    my ($self,$file,$schema) = @_;
    
    my $parser;
    if ($schema) {
        $schema = IMPL::DOM::Schema->LoadSchema($schema) if not ref $schema;
        $parser = $self->new(
            Navigator => IMPL::DOM::Navigator::Builder->new(
                'IMPL::DOM::Document',
                $schema
            )
        );
    } else {
        $parser = $self->new(
            Navigator => IMPL::DOM::Navigator::SimpleBuilder->new()
        );
    }
    
    $parser->ParseFile($file);
    my $doc = $parser->Navigator->Document;
    my @errors;
    if ($schema) {
        push @errors, $schema->Validate($doc);
    }
    
    if (wantarray) {
    	return $doc,\@errors;
    } else {
    	die new IMPL::Exception("Loaded document doesn't match the schema", @errors) if @errors;
    	return $doc;
    } 
}

1;

__END__

=pod

=head1 SYNOPSIS

my $reader = new IMPL::DOM::XMLReader(Navigator => $DomBuilder);
my $obj = $reader->parsefile("data.xml");

=head1 DESCRIPTION

Простой класс, использующий навигатор для постороения документа. В зависимости от
используемого навигатора может быть получен различный результат.

Навигатор должен поодерживать методы C<NavigateCreate> и C<Back>

=head1 METHODS

=over

=item C<CTOR(Naviagtor => $builder)>

Создает новый экземпляр парсера, с указанным навигатором для построения документа

=item C<$obj->Parse($in)>

Строит документ. На вход получает либо xml строку, либо HANDLE.

=item C<$obj->ParseFile($fileName)>

Строит документ из файла с именем C<$fileName>.

=back

=cut