diff lib/IMPL/DOM/XMLReader.pm @ 407:c6e90e02dd17 ref20150831

renamed Lib->lib
author cin
date Fri, 04 Sep 2015 19:40:23 +0300
parents
children ee36115f6a34
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/IMPL/DOM/XMLReader.pm	Fri Sep 04 19:40:23 2015 +0300
@@ -0,0 +1,143 @@
+package IMPL::DOM::XMLReader;
+use strict;
+use warnings;
+
+use parent qw(IMPL::Object IMPL::Object::Autofill);
+
+use IMPL::Class::Property;
+use XML::Parser;
+
+use IMPL::require {
+    Schema => 'IMPL::DOM::Schema', # IMPL::DOM::Schema references IMPL::DOM::XML::Reader
+    Builder => 'IMPL::DOM::Navigator::Builder',
+    SimpleBuilder => '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->{$_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