9 |
|
# |
10 |
|
# Interface |
11 |
|
# --------- |
12 |
< |
# new() : A new Parse object |
12 |
> |
# new() : A new Parse object |
13 |
|
# addtag(name,start,text,end,$object) : Add a new tag |
14 |
< |
# addgrouptags() : add <Group> tag functionality |
15 |
< |
# addignoretags() : add <ignore> tag functionality |
14 |
> |
# addgrouptags() : add <Group> tag functionality |
15 |
> |
# addignoretags() : add <ignore> tag functionality |
16 |
|
# parse(filename,[streamhandle], [streamexcludetag]) : |
17 |
|
# parse the given file - turn on the stream |
18 |
|
# function of the switcher if a filehandle |
19 |
|
# supplied as a second argument |
20 |
< |
# line() : return the current linenumber in the file |
20 |
> |
# line() : return the current linenumber in the file |
21 |
|
# tagstartline() : return the linenumber of the last tag opening |
22 |
< |
# includeparse(Parse) : include the settings from another parse object |
22 |
> |
# includeparse(Parse) : include the settings from another parse object |
23 |
|
# tags() : return list of defined tags |
24 |
|
# cleartags() : clear of all tags |
25 |
< |
# opencontext(name) : open a parse context |
25 |
> |
# opencontext(name) : open a parse context |
26 |
|
# closecontext(name) : close a parse context |
27 |
|
# includecontext(name) : Process when in a given context |
28 |
|
# excludecontext(name) : No Processing when given context |
30 |
|
# if not registerd - the close tag will be ignored |
31 |
|
# too if outside of the specified context! |
32 |
|
|
33 |
– |
|
33 |
|
package ActiveDoc::Parse; |
34 |
|
require 5.004; |
35 |
< |
use ActiveDoc::Switcher; |
36 |
< |
use ActiveDoc::TagContainer; |
37 |
< |
use ActiveDoc::GroupChecker; |
38 |
< |
|
39 |
< |
sub new { |
40 |
< |
my $class=shift; |
41 |
< |
$self={}; |
42 |
< |
bless $self, $class; |
43 |
< |
$self->init(); |
44 |
< |
return $self; |
45 |
< |
} |
46 |
< |
|
47 |
< |
sub init { |
48 |
< |
my $self=shift; |
49 |
< |
$self->{gc}=GroupChecker->new(); |
50 |
< |
$self->{gc}->include("all"); |
51 |
< |
$self->{tags}=ActiveDoc::TagContainer->new(); |
52 |
< |
} |
53 |
< |
|
54 |
< |
sub parse { |
55 |
< |
my $self=shift; |
56 |
< |
my $file=shift; |
57 |
< |
|
58 |
< |
# basic setup of switcher |
59 |
< |
$self->{switch}=ActiveDoc::Switcher->new($file); |
60 |
< |
$self->{switch}->usegroupchecker($self->{gc}); |
61 |
< |
$self->{switch}->usetags($self->{tags}); |
62 |
< |
|
63 |
< |
# do we need to switch on the streamer? |
64 |
< |
if ( @_ ) { |
65 |
< |
$fh=shift; |
66 |
< |
$self->{switch}->stream($fh); |
67 |
< |
foreach $tag ( @_ ) { |
68 |
< |
$self->{switch}->streamexclude($tag); |
69 |
< |
} |
70 |
< |
} |
71 |
< |
|
72 |
< |
# -- parse |
73 |
< |
$self->{switch}->parse(); |
74 |
< |
undef $self->{switch}; |
75 |
< |
} |
76 |
< |
|
77 |
< |
sub line { |
78 |
< |
my $self=shift; |
79 |
< |
if ( defined $self->{switch} ) { |
80 |
< |
return $self->{switch}->line(); |
81 |
< |
} |
82 |
< |
return undef; |
83 |
< |
} |
84 |
< |
|
85 |
< |
sub tagstartline { |
86 |
< |
my $self=shift; |
87 |
< |
if ( defined $self->{switch} ) { |
88 |
< |
return $self->{switch}->tagstartline(); |
89 |
< |
} |
90 |
< |
return undef; |
91 |
< |
} |
92 |
< |
|
93 |
< |
sub includeparse { |
94 |
< |
my $self=shift; |
95 |
< |
my $obj=shift; |
96 |
< |
|
97 |
< |
my $tag; |
98 |
< |
# copy the tags from the remote parse object |
99 |
< |
foreach $tag ( $obj->tags() ) { |
100 |
< |
$self->addtag($tag,$obj->{tags}->tagsettings($tag)); |
101 |
< |
} |
102 |
< |
# now the group settings |
103 |
< |
} |
104 |
< |
|
105 |
< |
sub addtag { |
106 |
< |
my $self=shift; |
107 |
< |
$self->{tags}->addtag(@_); |
108 |
< |
} |
110 |
< |
|
111 |
< |
sub addgrouptags { |
112 |
< |
my $self=shift; |
113 |
< |
$self->{tags}->addtag("Group", \&Group_Start,$self, |
114 |
< |
"", $self, \&Group_End, $self); |
115 |
< |
$self->{tags}->setgrouptag("Group"); |
116 |
< |
} |
117 |
< |
|
118 |
< |
sub addignoretags { |
119 |
< |
my $self=shift; |
120 |
< |
$self->{gc}->exclude("ignore"); |
121 |
< |
$self->{tags}->addtag("Ignore", \&Ignore_Start, $self, |
122 |
< |
"",$self, \&Ignore_End,$self); |
123 |
< |
$self->{tags}->setgrouptag("Ignore"); |
124 |
< |
} |
125 |
< |
|
126 |
< |
sub contexttag { |
127 |
< |
my $self=shift; |
128 |
< |
$self->{tags}->setgrouptag(shift); |
129 |
< |
} |
130 |
< |
|
131 |
< |
sub opencontext { |
132 |
< |
my $self=shift; |
133 |
< |
$self->{gc}->opencontext(shift); |
134 |
< |
} |
135 |
< |
|
136 |
< |
sub closecontext { |
137 |
< |
my $self=shift; |
138 |
< |
$self->{gc}->closecontext(shift); |
139 |
< |
} |
140 |
< |
|
141 |
< |
sub includecontext { |
142 |
< |
my $self=shift; |
143 |
< |
my $name=shift; |
144 |
< |
|
145 |
< |
$self->{gc}->unexclude($name); |
146 |
< |
$self->{gc}->include($name); |
147 |
< |
} |
148 |
< |
|
149 |
< |
sub excludecontext { |
150 |
< |
my $self=shift; |
151 |
< |
my $name=shift; |
152 |
< |
$self->{gc}->exclude($name); |
153 |
< |
$self->{gc}->uninclude($name); |
154 |
< |
} |
155 |
< |
|
156 |
< |
sub cleartags { |
157 |
< |
my $self=shift; |
158 |
< |
$self->{tags}->cleartags(); |
159 |
< |
} |
160 |
< |
|
161 |
< |
sub tags { |
162 |
< |
my $self=shift; |
163 |
< |
return $self->{tags}->tags(); |
164 |
< |
} |
165 |
< |
|
166 |
< |
# --------- Basic Group Related Tags --------------------------------- |
167 |
< |
|
168 |
< |
sub Group_Start { |
169 |
< |
my $self=shift; |
170 |
< |
my $name=shift; |
171 |
< |
my $vars=shift; |
172 |
< |
my $lastgp; |
173 |
< |
|
174 |
< |
$lastgp="group::".$$vars{name}; |
175 |
< |
$self->{switch}->checkparam($name, 'name'); |
176 |
< |
$self->{gc}->opencontext("group::".$$vars{name}); |
177 |
< |
|
178 |
< |
} |
179 |
< |
|
180 |
< |
sub Group_End { |
181 |
< |
my $self=shift; |
182 |
< |
my $name=shift; |
183 |
< |
my $lastgp; |
184 |
< |
|
185 |
< |
$self->{gc}->closelastcontext("group"); |
186 |
< |
} |
187 |
< |
|
188 |
< |
sub Ignore_Start { |
189 |
< |
my $self=shift; |
190 |
< |
my $name=shift; |
191 |
< |
|
192 |
< |
$self->{gc}->opencontext("ignore"); |
193 |
< |
} |
194 |
< |
|
195 |
< |
sub Ignore_End { |
196 |
< |
my $self=shift; |
197 |
< |
$self->{gc}->closecontext("ignore"); |
198 |
< |
} |
35 |
> |
use XML::Parser; |
36 |
> |
|
37 |
> |
sub new() |
38 |
> |
{ |
39 |
> |
my $class=shift; |
40 |
> |
$self={}; |
41 |
> |
bless $self, $class; |
42 |
> |
my ($dataclass, $parse_style)=@_; |
43 |
> |
|
44 |
> |
$self->{xmlparser} = new XML::Parser ( |
45 |
> |
Style => $parse_style, |
46 |
> |
ParseParamEnt => 1, |
47 |
> |
ErrorContext => 3, |
48 |
> |
Pkg => $dataclass); |
49 |
> |
return $self; |
50 |
> |
} |
51 |
> |
|
52 |
> |
sub parsefilelist() |
53 |
> |
{ |
54 |
> |
my $self=shift; |
55 |
> |
my ($files)=@_; |
56 |
> |
print __PACKAGE__."::parsefilelist(): Not used?\n"; |
57 |
> |
} |
58 |
> |
|
59 |
> |
sub parse() |
60 |
> |
{ |
61 |
> |
my $self=shift; |
62 |
> |
my ($file)=@_; |
63 |
> |
$self->{data} = $self->{xmlparser}->parse($self->getfilestring_($file)); |
64 |
> |
return $self; |
65 |
> |
} |
66 |
> |
|
67 |
> |
sub getfilestring_() |
68 |
> |
{ |
69 |
> |
my $self=shift; |
70 |
> |
my ($file)=@_; |
71 |
> |
open (IN, "< $file") or die __PACKAGE__.": Cannot read file $file: $!\n"; |
72 |
> |
my $filestring = join("", <IN>); |
73 |
> |
close (IN) or die __PACKAGE__.": Cannot read file $file: $!\n"; |
74 |
> |
# Strip spaces at the beginning and end of the line: |
75 |
> |
$filestring =~ s/^\s+//g; |
76 |
> |
$filestring =~ s/\s+$//g; |
77 |
> |
# Finally strip the newlines: |
78 |
> |
$filestring =~ s/\n//g; |
79 |
> |
# Strip out spaces in between tags: |
80 |
> |
$filestring =~ s/>\s+</></g; |
81 |
> |
$self->{filestring}=$filestring; |
82 |
> |
return $filestring; |
83 |
> |
} |
84 |
> |
|
85 |
> |
sub data() |
86 |
> |
{ |
87 |
> |
my $self=shift; |
88 |
> |
return $self->{data}->[0]; |
89 |
> |
} |
90 |
> |
|
91 |
> |
sub includeparse |
92 |
> |
{ |
93 |
> |
my $self=shift; |
94 |
> |
my $obj=shift; |
95 |
> |
my $tag; |
96 |
> |
|
97 |
> |
# copy the tags from the remote parse object |
98 |
> |
foreach $tag ( $obj->tags() ) |
99 |
> |
{ |
100 |
> |
$self->addtag($tag,$obj->{tags}->tagsettings($tag)); |
101 |
> |
} |
102 |
> |
} |
103 |
> |
|
104 |
> |
sub addtag |
105 |
> |
{ |
106 |
> |
my $self=shift; |
107 |
> |
$self->{tags}->addtag(@_); |
108 |
> |
} |
109 |
|
|
110 |
+ |
1; |