Mercurial > pub > Impl

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

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
renamed Lib->lib
author cin
date Fri, 04 Sep 2015 19:40:23 +0300
parents
children ee36115f6a34
comparison
equal deleted inserted replaced
406:f23fcb19d3c1 407:c6e90e02dd17
1 package IMPL::DOM::XMLReader;
2 use strict;
3 use warnings;
4
5 use parent qw(IMPL::Object IMPL::Object::Autofill);
6
7 use IMPL::Class::Property;
8 use XML::Parser;
9
10 use IMPL::require {
11 Schema => 'IMPL::DOM::Schema', # IMPL::DOM::Schema references IMPL::DOM::XML::Reader
12 Builder => 'IMPL::DOM::Navigator::Builder',
13 SimpleBuilder => 'IMPL::DOM::Navigator::SimpleBuilder'
14 };
15
16 __PACKAGE__->PassThroughArgs;
17
18 BEGIN {
19 public _direct property Navigator => prop_get | owner_set;
20 public _direct property SkipWhitespace => prop_get | owner_set;
21 private _direct property _current => prop_all;
22 private _direct property _text => prop_all;
23 private _direct property _textHistory => prop_all;
24 }
25
26 sub Parse {
27 my ($this,$in) = @_;
28
29 my $parser = new XML::Parser(
30 Handlers => {
31 Start => sub {shift; goto &OnStart($this,@_)},
32 End => sub {shift; goto &OnEnd($this,@_)},
33 Char => sub {shift; goto &OnChar($this,@_)}
34 }
35 );
36
37 $parser->parse($in);
38 }
39
40 sub ParseFile {
41 my ($this,$in) = @_;
42
43 my $parser = new XML::Parser(
44 Handlers => {
45 Start => sub {shift; unshift @_, $this; goto &_OnBegin;},
46 End => sub {shift; unshift @_, $this; goto &_OnEnd;},
47 Char => sub {shift; unshift @_, $this; goto &_OnChar;}
48 }
49 );
50
51 $parser->parsefile($in);
52 }
53
54 sub _OnBegin {
55 my ($this,$element,%attrs) = @_;
56
57 push @{$this->{$_textHistory}},$this->{$_text};
58 $this->{$_text} = "";
59 $this->{$_current} = $this->Navigator->NavigateCreate($element,%attrs);
60 }
61
62 sub _OnEnd {
63 my ($this,$element) = @_;
64 $this->{$_current}->nodeValue($this->{$_text}) if length $this->{$_text} and (not $this->{$SkipWhitespace} or $this->{$_text} =~ /\S/);
65 $this->{$_text} = pop @{$this->{$_textHistory}};
66 $this->{$_current} = $this->Navigator->Back;
67 }
68
69 sub _OnChar {
70 my ($this,$val) = @_;
71 $this->{$_text} .= $val;
72 }
73
74 sub LoadDocument {
75 my ($self,$file,$schema) = @_;
76
77 my $parser;
78 if ($schema) {
79 $schema = IMPL::DOM::Schema->LoadSchema($schema) if not ref $schema;
80 $parser = $self->new(
81 Navigator => IMPL::DOM::Navigator::Builder->new(
82 'IMPL::DOM::Document',
83 $schema
84 )
85 );
86 } else {
87 $parser = $self->new(
88 Navigator => IMPL::DOM::Navigator::SimpleBuilder->new()
89 );
90 }
91
92 $parser->ParseFile($file);
93 my $doc = $parser->Navigator->Document;
94 my @errors;
95 if ($schema) {
96 push @errors, $schema->Validate($doc);
97 }
98
99 if (wantarray) {
100 return $doc,\@errors;
101 } else {
102 die new IMPL::Exception("Loaded document doesn't match the schema", @errors) if @errors;
103 return $doc;
104 }
105 }
106
107 1;
108
109 __END__
110
111 =pod
112
113 =head1 SYNOPSIS
114
115 my $reader = new IMPL::DOM::XMLReader(Navigator => $DomBuilder);
116 my $obj = $reader->parsefile("data.xml");
117
118 =head1 DESCRIPTION
119
120 Простой класс, использующий навигатор для постороения документа. В зависимости от
121 используемого навигатора может быть получен различный результат.
122
123 Навигатор должен поодерживать методы C<NavigateCreate> и C<Back>
124
125 =head1 METHODS
126
127 =over
128
129 =item C<CTOR(Naviagtor => $builder)>
130
131 Создает новый экземпляр парсера, с указанным навигатором для построения документа
132
133 =item C<$obj->Parse($in)>
134
135 Строит документ. На вход получает либо xml строку, либо HANDLE.
136
137 =item C<$obj->ParseFile($fileName)>
138
139 Строит документ из файла с именем C<$fileName>.
140
141 =back
142
143 =cut