5 |
|
# |
6 |
|
# Description |
7 |
|
# ----------- |
8 |
< |
# Simple multi parsing functionality |
8 |
> |
# Simple multi parsing functionality and group manipulation |
9 |
|
# |
10 |
|
# Interface |
11 |
|
# --------- |
12 |
< |
# new() : A new ActiveDoc object |
12 |
> |
# new([DocVersionTag]) : A new ActiveDoc object. You can also |
13 |
> |
# specify an alternative doc version tag |
14 |
|
# filetoparse([filename]) : Set/Return the filename of document |
15 |
|
# newparse(parselabel) : Create a new parse type |
16 |
|
# parse(parselabel) : Parse the document file for the given parse level |
17 |
< |
# addtag(parselabel,tagname,start,obj,text,obj,end,obj) : |
17 |
> |
# addtag(parselabel,tagname,start,obj,[text,obj,end,obj]) : |
18 |
|
# Add tags to the parse given by label |
19 |
+ |
# grouptag(tagname, parselabel) : Allow a tag to switch context |
20 |
+ |
# - if not you can never turn a context off! |
21 |
|
# checktag(tagname, hashref, param) : check for existence of param in |
22 |
|
# hashref from a tag call |
23 |
|
# includeparse(local_parsename, objparsename, activedoc) : copy the parse from |
27 |
|
# |
28 |
|
# addignoretags(parsename) : add <ignore> </igonore> tags funtionality to the |
29 |
|
# specified parse |
30 |
+ |
# opengroup(name) : declare a group to be open |
31 |
+ |
# closegroup(name) : declare a group to be closed |
32 |
+ |
# allowgroup(name,parse) : allow a group so named |
33 |
+ |
# disallowgroup(name,parse) : disallow the named group |
34 |
+ |
# restoregroup(name,parse) : restore group access setting (that before last change) |
35 |
+ |
# doctype() : return the (type,version) of the document |
36 |
+ |
# as specified by the DocVersionTag |
37 |
|
# --------------- Error handling routines --------------- |
38 |
|
# verbose(string) : Print string in verbosity mode |
39 |
|
# verbosity(0|1) : verbosity off|on |
51 |
|
my $class=shift; |
52 |
|
$self={}; |
53 |
|
bless $self, $class; |
54 |
< |
$self->verbose("New SimpleDoc (".ref($self).") Created"); |
45 |
< |
$self->init(@_); |
54 |
> |
$self->_initdoc("doc",@_); |
55 |
|
return $self; |
56 |
|
} |
57 |
|
|
58 |
< |
sub init { |
59 |
< |
# dummy to be overridden by inheriting class |
58 |
> |
sub doctype { |
59 |
> |
my $self=shift; |
60 |
> |
my $rv=1; |
61 |
> |
|
62 |
> |
undef $self->{docversion}; |
63 |
> |
undef $self->{doctype}; |
64 |
> |
$self->parse("doc"); |
65 |
> |
return ($self->{doctype},$self->{docversion}); |
66 |
> |
} |
67 |
> |
|
68 |
> |
sub _initdoc { |
69 |
> |
my $self=shift; |
70 |
> |
my $parsename=shift; |
71 |
> |
|
72 |
> |
$self->{doctag}="DOC"; |
73 |
> |
if ( @_ ) { |
74 |
> |
$self->{doctag}=shift; |
75 |
> |
} |
76 |
> |
$self->newparse($parsename); |
77 |
> |
$self->addtag($parsename,$self->{doctag},\&Doc_Start, $self); |
78 |
|
} |
79 |
|
|
80 |
|
sub verbosity { |
97 |
|
$parselabel=shift; |
98 |
|
|
99 |
|
my $file=$self->filetoparse(); |
100 |
< |
if ( $file ) { |
100 |
> |
if ( -f $file ) { |
101 |
|
if ( exists $self->{parsers}{$parselabel} ) { |
102 |
|
$self->verbose("Parsing $parselabel in file $file"); |
103 |
|
$self->{currentparsename}=$parselabel; |
109 |
|
} |
110 |
|
} |
111 |
|
else { |
112 |
< |
$self->error("Cannot parse $parselabel - file not known"); |
112 |
> |
$self->error("Cannot parse \"$parselabel\" - file $file not known"); |
113 |
|
} |
114 |
|
} |
115 |
|
|
169 |
|
sub addtag { |
170 |
|
my $self=shift; |
171 |
|
my $parselabel=shift; |
172 |
< |
if ( $#_ != 6 ) { |
172 |
> |
if ( ( $#_ != 6 ) && ( $#_ != 2) ) { |
173 |
|
$self->error("Incorrect addtags specification\n". |
174 |
|
"called with :\n@_ \n"); |
175 |
|
} |
184 |
|
} |
185 |
|
return $self->{filename}; |
186 |
|
} |
187 |
+ |
# --------- Group services |
188 |
+ |
sub grouptag { |
189 |
+ |
my $self=shift; |
190 |
+ |
my $name=shift; |
191 |
+ |
my $parselabel=shift; |
192 |
+ |
|
193 |
+ |
$self->{parsers}{$parselabel}->contexttag($name); |
194 |
+ |
} |
195 |
+ |
|
196 |
+ |
sub opengroup { |
197 |
+ |
my $self=shift; |
198 |
+ |
my $name=shift; |
199 |
+ |
|
200 |
+ |
if ( defined $self->currentparser ) { |
201 |
+ |
$self->currentparser()->opencontext($name); |
202 |
+ |
} |
203 |
+ |
else { |
204 |
+ |
$self->error("Cannot Call opengroup outside of a parse (". |
205 |
+ |
caller().")"); |
206 |
+ |
} |
207 |
+ |
} |
208 |
+ |
|
209 |
+ |
sub closegroup { |
210 |
+ |
my $self=shift; |
211 |
+ |
my $name=shift; |
212 |
+ |
|
213 |
+ |
if ( defined $self->currentparser ) { |
214 |
+ |
$self->currentparser()->closecontext($name); |
215 |
+ |
} |
216 |
+ |
else { |
217 |
+ |
$self->error("Cannot Call closegroup outside of a parse (". |
218 |
+ |
caller().")"); |
219 |
+ |
} |
220 |
+ |
} |
221 |
+ |
|
222 |
+ |
sub allowgroup { |
223 |
+ |
my $self=shift; |
224 |
+ |
my $name=shift; |
225 |
+ |
my $parselabel=shift; |
226 |
+ |
|
227 |
+ |
$self->{parsers}{$parselabel}->includecontext($name); |
228 |
+ |
} |
229 |
+ |
|
230 |
+ |
sub disallowgroup { |
231 |
+ |
my $self=shift; |
232 |
+ |
my $name=shift; |
233 |
+ |
my $parselabel=shift; |
234 |
+ |
|
235 |
+ |
$self->{parsers}{$parselabel}->excludecontext($name); |
236 |
+ |
} |
237 |
|
|
238 |
|
# -------- Error Handling and Error services -------------- |
239 |
|
|
249 |
|
my $string=shift; |
250 |
|
|
251 |
|
if ( $self->currentparsename() eq "" ) { |
252 |
< |
$self->error($string); |
252 |
> |
$self->error("Error In file ".$self->filetoparse."\n".$string); |
253 |
|
} |
254 |
|
else { |
255 |
|
$line=$self->line(); |
281 |
|
return $self->{currentparser}->tagstartline(); |
282 |
|
} |
283 |
|
|
284 |
+ |
# -- tag routines |
285 |
+ |
sub Doc_Start { |
286 |
+ |
my $self=shift; |
287 |
+ |
my $name=shift; |
288 |
+ |
my $hashref=shift; |
289 |
+ |
|
290 |
+ |
$self->checktag($name, $hashref, "type"); |
291 |
+ |
$self->checktag($name, $hashref, "version"); |
292 |
+ |
|
293 |
+ |
$self->{doctype}=$$hashref{'type'}; |
294 |
+ |
$self->{docversion}=$$hashref{'version'}; |
295 |
+ |
} |