view Lib/IMPL/DOM/XMLReader.pm @ 245:7c517134c42f

Added Unsupported media type Web exception corrected resourceLocation setting in the resource Implemented localizable resources for text messages fixed TT view scopings, INIT block in controls now sets globals correctly.
author sergey
date Mon, 29 Oct 2012 03:15:22 +0400
parents 4d0e1962161c
children 0f59b2de72af
line wrap: on
line source

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

use parent qw(IMPL::Object IMPL::Object::Autofill);
use IMPL::Class::Property;
use IMPL::Class::Property::Direct;
use XML::Parser;
require IMPL::DOM::Schema;
require IMPL::DOM::Navigator::Builder;
require IMPL::DOM::Navigator::SimpleBuilder;

__PACKAGE__->PassThroughArgs;

BEGIN {
    public _direct property Navigator => prop_get | owner_set;
    public _direct property SkipWhitespace => prop_get | owner_set;
    private _direct property _current => prop_all;
    private _direct property _text => prop_all;
    private _direct property _textHistory => prop_all;
}

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->Navigator->inflateValue( $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;
    if ($schema) {
        my @errors = $parser->Navigator->BuildErrors;
        push @errors, $schema->Validate($doc);
        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