src/ActiveDoc/SimpleDoc.pm

#
# SimpleDoc.pm
#
# Originally Written by Christopher Williams
#
# Description
# -----------
# Simple multi parsing functionality and group manipulation
#
# Interface
# ---------
# new()         : A new ActiveDoc object
# 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)
# --------------- 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->verbose("New SimpleDoc (".ref($self).") Created");
        $self->init(@_);
        return $self;
}

sub init {
        # dummy to be overridden by inheriting class
}

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 ( $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 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 ) {
                $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($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();
}

Revision:	1.1.2.1
Committed:	Fri Apr 7 08:05:29 2000 UTC (25 years, 1 month ago) by williamc
Content type:	text/plain
Branch:	V0_9branch
CVS Tags:	V0_11_4, V0_11_3, V0_11_2, V0_11_1, V0_11_0
Changes since 1.1:	+58 -1 lines
Log Message:	SimpleDoc with groups added
#	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			# new() : A new ActiveDoc object
13			# filetoparse([filename]) : Set/Return the filename of document
14			# newparse(parselabel) : Create a new parse type
15			# parse(parselabel) : Parse the document file for the given parse level
16			# addtag(parselabel,tagname,start,obj,text,obj,end,obj) :
17			# Add tags to the parse given by label
18	williamc	1.1.2.1	# grouptag(tagname, parselabel) : Allow a tag to switch context
19			# - if not you can never turn a context off!
20	williamc	1.1	# checktag(tagname, hashref, param) : check for existence of param in
21			# hashref from a tag call
22			# includeparse(local_parsename, objparsename, activedoc) : copy the parse from
23			# one object to another
24			# currentparser() : return the current parser object
25			# currentparsename([name]) : get/set current parse name
26			#
27			# addignoretags(parsename) : add <ignore> </igonore> tags funtionality to the
28			# specified parse
29	williamc	1.1.2.1	# opengroup(name) : declare a group to be open
30			# closegroup(name) : declare a group to be closed
31			# allowgroup(name,parse) : allow a group so named
32			# disallowgroup(name,parse) : disallow the named group
33			# restoregroup(name,parse) : restore group access setting (that before last change)
34	williamc	1.1	# --------------- Error handling routines ---------------
35			# verbose(string) : Print string in verbosity mode
36			# verbosity(0\|1) : verbosity off\|on
37			# line() : return the current line number in the current parse
38			# tagstartline() : return the line number where the current tag was
39			# opened
40			# parseerror(string) : print error and associate with line number etc.
41			# error(string) : handle an error
42
43			package ActiveDoc::SimpleDoc;
44			require 5.004;
45			use ActiveDoc::Parse;
46
47			sub new {
48			my $class=shift;
49			$self={};
50			bless $self, $class;
51			$self->verbose("New SimpleDoc (".ref($self).") Created");
52			$self->init(@_);
53			return $self;
54			}
55
56			sub init {
57			# dummy to be overridden by inheriting class
58			}
59
60			sub verbosity {
61			my $self=shift;
62			$self->{verbose}=shift;
63			}
64
65			sub verbose {
66			my $self=shift;
67			my $string=shift;
68
69			if ( $self->{verbose} ) {
70			print ">".ref($self)."($self) : \n->".$string."\n";
71			}
72			}
73
74			# ----- parse related routines --------------
75			sub parse {
76			my $self=shift;
77			$parselabel=shift;
78
79			my $file=$self->filetoparse();
80			if ( $file ) {
81			if ( exists $self->{parsers}{$parselabel} ) {
82			$self->verbose("Parsing $parselabel in file $file");
83			$self->{currentparsename}=$parselabel;
84			$self->{currentparser}=$self->{parsers}{$parselabel};
85			$self->{parsers}{$parselabel}->parse($file,@_);
86			delete $self->{currentparser};
87			$self->{currentparsename}="";
88			$self->verbose("Parse $parselabel Complete");
89			}
90			}
91			else {
92			$self->error("Cannot parse $parselabel - file not known");
93			}
94			}
95
96			sub currentparsename {
97			my $self=shift;
98			@_?$self->{currentparsename}=shift
99			:(defined $self->{currentparsename}?$self->{currentparsename}:"");
100			}
101
102			sub currentparser {
103			my $self=shift;
104			return $self->{currentparser};
105			}
106
107
108			sub newparse {
109			my $self=shift;
110			my $parselabel=shift;
111
112			$self->{parsers}{$parselabel}=ActiveDoc::Parse->new();
113			# $self->{parsers}{$parselabel}->addgrouptags();
114			}
115
116			sub addignoretags {
117			my $self=shift;
118			my $parselabel=shift;
119			$self->{parsers}{$parselabel}->addignoretags();
120			}
121
122			sub cleartags {
123			my $self=shift;
124			my $parselabel=shift;
125
126			$self->{parsers}{$parselabel}->cleartags();
127			}
128
129
130			sub includeparse {
131			my $self=shift;
132			my $parselabel=shift;
133			my $remoteparselabel=shift;
134			my $activedoc=shift;
135
136			# Some error trapping
137			if ( ! exists $self->{parsers}{$parselabel} ) {
138			$self->error("Unknown local parse name specified");
139			}
140			if ( ! exists $activedoc->{parsers}{$remoteparselabel} ) {
141			$self->error("Unknown parse name specified in remote obj $activedoc");
142			}
143
144			#
145			my $rp=$activedoc->{parsers}{$remoteparselabel};
146			$self->{parsers}{$parselabel}->includeparse($rp);
147			}
148
149			sub addtag {
150			my $self=shift;
151			my $parselabel=shift;
152			if ( $#_ != 6 ) {
153			$self->error("Incorrect addtags specification\n".
154			"called with :\n@_ \n");
155			}
156			$self->{parsers}{$parselabel}->addtag(@_);
157			}
158
159			sub filetoparse {
160			my $self=shift;
161
162			if ( @_ ) {
163			$self->{filename}=shift;
164			}
165			return $self->{filename};
166	williamc	1.1.2.1	}
167			# --------- Group services
168			sub grouptag {
169			my $self=shift;
170			my $name=shift;
171			my $parselabel=shift;
172
173			$self->{parsers}{$parselabel}->contexttag($name);
174			}
175
176			sub opengroup {
177			my $self=shift;
178			my $name=shift;
179
180			if ( defined $self->currentparser ) {
181			$self->currentparser()->opencontext($name);
182			}
183			else {
184			$self->error("Cannot Call opengroup outside of a parse (".
185			caller().")");
186			}
187			}
188
189			sub closegroup {
190			my $self=shift;
191			my $name=shift;
192
193			if ( defined $self->currentparser ) {
194			$self->currentparser()->closecontext($name);
195			}
196			else {
197			$self->error("Cannot Call closegroup outside of a parse (".
198			caller().")");
199			}
200			}
201
202			sub allowgroup {
203			my $self=shift;
204			my $name=shift;
205			my $parselabel=shift;
206
207			$self->{parsers}{$parselabel}->includecontext($name);
208			}
209
210			sub disallowgroup {
211			my $self=shift;
212			my $name=shift;
213			my $parselabel=shift;
214
215			$self->{parsers}{$parselabel}->excludecontext($name);
216	williamc	1.1	}
217
218			# -------- Error Handling and Error services --------------
219
220			sub error {
221			my $self=shift;
222			my $string=shift;
223
224			die $string."\n";
225			}
226
227			sub parseerror {
228			my $self=shift;
229			my $string=shift;
230
231			if ( $self->currentparsename() eq "" ) {
232			$self->error($string);
233			}
234			else {
235			$line=$self->line();
236			print "Parse Error in ".$self->filetoparse().", line ".
237			$line."\n";
238			print $string."\n";
239			exit;
240			}
241			}
242
243			sub checktag {
244			my $self=shift;
245			my $tagname=shift;
246			my $hashref=shift;
247			my $param=shift;
248
249			if ( ! exists $$hashref{$param} ) {
250			$self->parseerror("Incomplete Tag <$tagname> : $param required");
251			}
252			}
253
254			sub line {
255			my $self=shift;
256			return $self->{currentparser}->line();
257			}
258
259			sub tagstartline {
260			my $self=shift;
261			return $self->{currentparser}->tagstartline();
262			}
263