src/ActiveDoc/SimpleDoc.pm

#
# SimpleDoc.pm
#
# Originally Written by Christopher Williams
#
# Description
# -----------
# Simple multi parsing functionality and group manipulation
#
# Interface
# ---------
# new([DocVersionTag])          : A new ActiveDoc object. You can also
#                                 specify an alternative doc version tag
# filetoparse([filename])       : Set/Return the filename of document
# newparse(parselabel) : Create a new parse type
# parse(parselabel)    : Parse the document file for the given parse level
# addtag(parselabel,tagname,start,obj,[text,obj,end,obj]) :
#                                Add tags to the parse given by label
# grouptag(tagname, parselabel) : Allow a tag to switch context 
#                                 - if not you can never turn a context off!
# checktag(tagname, hashref, param) : check for existence of param in
#                                       hashref from a tag call
# includeparse(local_parsename, objparsename, activedoc) : copy the parse from 
#                                                       one object to another
# currentparser() : return the current parser object
# currentparsename([name]) : get/set current parse name
#
# addignoretags(parsename) : add <ignore> </igonore> tags funtionality to the
#                               specified parse
# opengroup(name) : declare a group to be open
# closegroup(name) : declare a group to be closed
# allowgroup(name,parse) : allow a group so named
# disallowgroup(name,parse) : disallow the named group
# restoregroup(name,parse) : restore group access setting (that before last change)
# doctype()             : return the (type,version) of the document
#                         as specified by the DocVersionTag
# --------------- Error handling routines ---------------
# verbose(string)       : Print string in verbosity mode
# verbosity(0|1)        : verbosity off|on 
# line()                : return the current line number in the current parse
# tagstartline()        : return the line number where the current tag was
#                         opened
# parseerror(string)   :  print error and associate with line number etc.
# error(string) : handle an error

package ActiveDoc::SimpleDoc;
require 5.004;
use ActiveDoc::Parse;

sub new {
        my $class=shift;
        $self={};
        bless $self, $class;
        $self->_initdoc("doc",@_);
        return $self;
}

sub doctype {
        my $self=shift;
        my $rv=1;

        undef $self->{docversion};
        undef $self->{doctype};
        $self->parse("doc");
        if ( ! defined $self->{doctype} ) {
          $self->parseerror("Unable to find <".$self->{doctag}.">");
        }
        return ($self->{doctype},$self->{docversion});
}

sub _initdoc {
        my $self=shift;
        my $parsename=shift;

        $self->{doctag}="DOC";
        if ( @_ ) {
          $self->{doctag}=shift;
        }
        $self->newparse($parsename);
        $self->addtag($parsename,$self->{doctag},\&Doc_Start, $self);
}

sub verbosity {
        my $self=shift;
        $self->{verbose}=shift;
}

sub verbose {
        my $self=shift;
        my $string=shift;

        if ( $self->{verbose} ) {
          print ">".ref($self)."($self) : \n->".$string."\n";
        }
}

# ----- parse related routines --------------
sub parse {
        my $self=shift;
        $parselabel=shift;

        my $file=$self->filetoparse();
        if ( -f $file ) {
          if ( exists $self->{parsers}{$parselabel} ) {
            $self->verbose("Parsing $parselabel in file $file");
            $self->{currentparsename}=$parselabel;
            $self->{currentparser}=$self->{parsers}{$parselabel};
            $self->{parsers}{$parselabel}->parse($file,@_);
            delete $self->{currentparser};
            $self->{currentparsename}="";
            $self->verbose("Parse $parselabel Complete");
          }
        }
        else {
          $self->error("Cannot parse \"$parselabel\" - file $file not known");
        }
}

sub currentparsename {
        my $self=shift;
        @_?$self->{currentparsename}=shift
          :(defined $self->{currentparsename}?$self->{currentparsename}:"");
}

sub currentparser {
        my $self=shift;
        return $self->{currentparser};
}


sub newparse {
        my $self=shift;
        my $parselabel=shift;

        $self->{parsers}{$parselabel}=ActiveDoc::Parse->new();
#       $self->{parsers}{$parselabel}->addgrouptags();
}

sub addignoretags {
        my $self=shift;
        my $parselabel=shift;
        $self->{parsers}{$parselabel}->addignoretags();
}

sub cleartags {
        my $self=shift;
        my $parselabel=shift;

        $self->{parsers}{$parselabel}->cleartags();
}


sub includeparse {
        my $self=shift;
        my $parselabel=shift;
        my $remoteparselabel=shift;
        my $activedoc=shift;

        # Some error trapping
        if ( ! exists $self->{parsers}{$parselabel} ) {
          $self->error("Unknown local parse name specified");
        }
        if ( ! exists $activedoc->{parsers}{$remoteparselabel} ) {
          $self->error("Unknown parse name specified in remote obj $activedoc");
        }

        #
        my $rp=$activedoc->{parsers}{$remoteparselabel};
        $self->{parsers}{$parselabel}->includeparse($rp);
}

sub addtag {
        my $self=shift;
        my $parselabel=shift;
        if ( ( $#_ != 6 ) && ( $#_ != 2) ) {
                $self->error("Incorrect addtags specification\n".
                                "called with :\n@_ \n");
        }
        $self->{parsers}{$parselabel}->addtag(@_);
}

sub filetoparse {
        my $self=shift;

        if ( @_ ) {
           $self->{filename}=shift;
        }
        return $self->{filename};
}
# --------- Group services
sub grouptag {
        my $self=shift;
        my $name=shift;
        my $parselabel=shift;

        $self->{parsers}{$parselabel}->contexttag($name);
}

sub opengroup {
        my $self=shift;
        my $name=shift;

        if ( defined $self->currentparser ) {
           $self->currentparser()->opencontext($name);
        }
        else {
           $self->error("Cannot Call opengroup outside of a parse (".
                        caller().")");
        }
}

sub closegroup {
        my $self=shift;
        my $name=shift;

        if ( defined $self->currentparser ) {
           $self->currentparser()->closecontext($name);
        }
        else {
           $self->error("Cannot Call closegroup outside of a parse (".
                        caller().")");
        }
}

sub allowgroup {
        my $self=shift;
        my $name=shift;
        my $parselabel=shift;

        $self->{parsers}{$parselabel}->includecontext($name);
}

sub disallowgroup {
        my $self=shift;
        my $name=shift;
        my $parselabel=shift;

        $self->{parsers}{$parselabel}->excludecontext($name);
}

# -------- Error Handling and Error services --------------

sub error {
        my $self=shift;
        my $string=shift;

        die $string."\n";
}

sub parseerror {
        my $self=shift;
        my $string=shift;

        if ( $self->currentparsename() eq "" ) {
                $self->error("Error In file ".$self->filetoparse."\n".$string);
        }
        else {
         $line=$self->line();
         print "Parse Error in ".$self->filetoparse().", line ".
                                        $line."\n";
         print $string."\n";
         exit;
        }
}

sub checktag {
        my $self=shift;
        my $tagname=shift;
        my $hashref=shift;
        my $param=shift;

        if ( ! exists $$hashref{$param} ) {
          $self->parseerror("Incomplete Tag <$tagname> : $param required");
        }
}

sub line {
        my $self=shift;
        return $self->{currentparser}->line();
}

sub tagstartline {
        my $self=shift;
        return $self->{currentparser}->tagstartline();
}

# -- tag routines
sub Doc_Start {
        my $self=shift;
        my $name=shift;
        my $hashref=shift;

        $self->checktag($name, $hashref, "type");
        $self->checktag($name, $hashref, "version");

        $self->{doctype}=$$hashref{'type'};
        $self->{docversion}=$$hashref{'version'};
}
Revision:	1.1.2.3.2.1
Committed:	Thu Aug 10 12:46:59 2000 UTC (24 years, 9 months ago) by williamc
Content type:	text/plain
Branch:	HPWbranch
Changes since 1.1.2.3:	+41 -6 lines
Log Message:	Add doc tags
#	User	Rev	Content
1	williamc	1.1	#
2			# SimpleDoc.pm
3			#
4			# Originally Written by Christopher Williams
5			#
6			# Description
7			# -----------
8	williamc	1.1.2.1	# Simple multi parsing functionality and group manipulation
9	williamc	1.1	#
10			# Interface
11			# ---------
12	williamc	1.1.2.3.2.1	# new([DocVersionTag]) : A new ActiveDoc object. You can also
13			# specify an alternative doc version tag
14	williamc	1.1	# 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	williamc	1.1.2.3	# addtag(parselabel,tagname,start,obj,[text,obj,end,obj]) :
18	williamc	1.1	# Add tags to the parse given by label
19	williamc	1.1.2.1	# grouptag(tagname, parselabel) : Allow a tag to switch context
20			# - if not you can never turn a context off!
21	williamc	1.1	# 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
24			# one object to another
25			# currentparser() : return the current parser object
26			# currentparsename([name]) : get/set current parse name
27			#
28			# addignoretags(parsename) : add <ignore> </igonore> tags funtionality to the
29			# specified parse
30	williamc	1.1.2.1	# 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	williamc	1.1.2.3.2.1	# doctype() : return the (type,version) of the document
36			# as specified by the DocVersionTag
37	williamc	1.1	# --------------- Error handling routines ---------------
38			# verbose(string) : Print string in verbosity mode
39			# verbosity(0\|1) : verbosity off\|on
40			# line() : return the current line number in the current parse
41			# tagstartline() : return the line number where the current tag was
42			# opened
43			# parseerror(string) : print error and associate with line number etc.
44			# error(string) : handle an error
45
46			package ActiveDoc::SimpleDoc;
47			require 5.004;
48			use ActiveDoc::Parse;
49
50			sub new {
51			my $class=shift;
52			$self={};
53			bless $self, $class;
54	williamc	1.1.2.3.2.1	$self->_initdoc("doc",@_);
55	williamc	1.1	return $self;
56			}
57
58	williamc	1.1.2.3.2.1	sub doctype {
59			my $self=shift;
60			my $rv=1;
61
62			undef $self->{docversion};
63			undef $self->{doctype};
64			$self->parse("doc");
65			if ( ! defined $self->{doctype} ) {
66			$self->parseerror("Unable to find <".$self->{doctag}.">");
67			}
68			return ($self->{doctype},$self->{docversion});
69			}
70
71			sub _initdoc {
72			my $self=shift;
73			my $parsename=shift;
74
75			$self->{doctag}="DOC";
76			if ( @_ ) {
77			$self->{doctag}=shift;
78			}
79			$self->newparse($parsename);
80			$self->addtag($parsename,$self->{doctag},\&Doc_Start, $self);
81	williamc	1.1	}
82
83			sub verbosity {
84			my $self=shift;
85			$self->{verbose}=shift;
86			}
87
88			sub verbose {
89			my $self=shift;
90			my $string=shift;
91
92			if ( $self->{verbose} ) {
93			print ">".ref($self)."($self) : \n->".$string."\n";
94			}
95			}
96
97			# ----- parse related routines --------------
98			sub parse {
99			my $self=shift;
100			$parselabel=shift;
101
102			my $file=$self->filetoparse();
103	williamc	1.1.2.2	if ( -f $file ) {
104	williamc	1.1	if ( exists $self->{parsers}{$parselabel} ) {
105			$self->verbose("Parsing $parselabel in file $file");
106			$self->{currentparsename}=$parselabel;
107			$self->{currentparser}=$self->{parsers}{$parselabel};
108			$self->{parsers}{$parselabel}->parse($file,@_);
109			delete $self->{currentparser};
110			$self->{currentparsename}="";
111			$self->verbose("Parse $parselabel Complete");
112			}
113			}
114			else {
115	williamc	1.1.2.2	$self->error("Cannot parse \"$parselabel\" - file $file not known");
116	williamc	1.1	}
117			}
118
119			sub currentparsename {
120			my $self=shift;
121			@_?$self->{currentparsename}=shift
122			:(defined $self->{currentparsename}?$self->{currentparsename}:"");
123			}
124
125			sub currentparser {
126			my $self=shift;
127			return $self->{currentparser};
128			}
129
130
131			sub newparse {
132			my $self=shift;
133			my $parselabel=shift;
134
135			$self->{parsers}{$parselabel}=ActiveDoc::Parse->new();
136			# $self->{parsers}{$parselabel}->addgrouptags();
137			}
138
139			sub addignoretags {
140			my $self=shift;
141			my $parselabel=shift;
142			$self->{parsers}{$parselabel}->addignoretags();
143			}
144
145			sub cleartags {
146			my $self=shift;
147			my $parselabel=shift;
148
149			$self->{parsers}{$parselabel}->cleartags();
150			}
151
152
153			sub includeparse {
154			my $self=shift;
155			my $parselabel=shift;
156			my $remoteparselabel=shift;
157			my $activedoc=shift;
158
159			# Some error trapping
160			if ( ! exists $self->{parsers}{$parselabel} ) {
161			$self->error("Unknown local parse name specified");
162			}
163			if ( ! exists $activedoc->{parsers}{$remoteparselabel} ) {
164			$self->error("Unknown parse name specified in remote obj $activedoc");
165			}
166
167			#
168			my $rp=$activedoc->{parsers}{$remoteparselabel};
169			$self->{parsers}{$parselabel}->includeparse($rp);
170			}
171
172			sub addtag {
173			my $self=shift;
174			my $parselabel=shift;
175	williamc	1.1.2.3	if ( ( $#_ != 6 ) && ( $#_ != 2) ) {
176	williamc	1.1	$self->error("Incorrect addtags specification\n".
177			"called with :\n@_ \n");
178			}
179			$self->{parsers}{$parselabel}->addtag(@_);
180			}
181
182			sub filetoparse {
183			my $self=shift;
184
185			if ( @_ ) {
186			$self->{filename}=shift;
187			}
188			return $self->{filename};
189	williamc	1.1.2.1	}
190			# --------- Group services
191			sub grouptag {
192			my $self=shift;
193			my $name=shift;
194			my $parselabel=shift;
195
196			$self->{parsers}{$parselabel}->contexttag($name);
197			}
198
199			sub opengroup {
200			my $self=shift;
201			my $name=shift;
202
203			if ( defined $self->currentparser ) {
204			$self->currentparser()->opencontext($name);
205			}
206			else {
207			$self->error("Cannot Call opengroup outside of a parse (".
208			caller().")");
209			}
210			}
211
212			sub closegroup {
213			my $self=shift;
214			my $name=shift;
215
216			if ( defined $self->currentparser ) {
217			$self->currentparser()->closecontext($name);
218			}
219			else {
220			$self->error("Cannot Call closegroup outside of a parse (".
221			caller().")");
222			}
223			}
224
225			sub allowgroup {
226			my $self=shift;
227			my $name=shift;
228			my $parselabel=shift;
229
230			$self->{parsers}{$parselabel}->includecontext($name);
231			}
232
233			sub disallowgroup {
234			my $self=shift;
235			my $name=shift;
236			my $parselabel=shift;
237
238			$self->{parsers}{$parselabel}->excludecontext($name);
239	williamc	1.1	}
240
241			# -------- Error Handling and Error services --------------
242
243			sub error {
244			my $self=shift;
245			my $string=shift;
246
247			die $string."\n";
248			}
249
250			sub parseerror {
251			my $self=shift;
252			my $string=shift;
253
254			if ( $self->currentparsename() eq "" ) {
255	williamc	1.1.2.3.2.1	$self->error("Error In file ".$self->filetoparse."\n".$string);
256	williamc	1.1	}
257			else {
258			$line=$self->line();
259			print "Parse Error in ".$self->filetoparse().", line ".
260			$line."\n";
261			print $string."\n";
262			exit;
263			}
264			}
265
266			sub checktag {
267			my $self=shift;
268			my $tagname=shift;
269			my $hashref=shift;
270			my $param=shift;
271
272			if ( ! exists $$hashref{$param} ) {
273			$self->parseerror("Incomplete Tag <$tagname> : $param required");
274			}
275			}
276
277			sub line {
278			my $self=shift;
279			return $self->{currentparser}->line();
280			}
281
282			sub tagstartline {
283			my $self=shift;
284			return $self->{currentparser}->tagstartline();
285			}
286
287	williamc	1.1.2.3.2.1	# -- tag routines
288			sub Doc_Start {
289			my $self=shift;
290			my $name=shift;
291			my $hashref=shift;
292
293			$self->checktag($name, $hashref, "type");
294			$self->checktag($name, $hashref, "version");
295
296			$self->{doctype}=$$hashref{'type'};
297			$self->{docversion}=$$hashref{'version'};
298			}