ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/cvsroot/COMP/SCRAM/src/ActiveDoc/ActiveDoc.pm
Revision: 1.19
Committed: Thu Jan 27 17:50:38 2000 UTC (25 years, 3 months ago) by williamc
Content type: text/plain
Branch: MAIN
Changes since 1.18: +9 -6 lines
Log Message:
Many mods for BootStrapping

File Contents

# User Rev Content
1 williamc 1.1 #
2 williamc 1.6 # ActiveDoc.pm
3     #
4     # Originally Written by Christopher Williams
5     #
6     # Description
7 williamc 1.1 #
8     # Interface
9     # ---------
10 williamc 1.15 # new(ActiveConfig[,options]) : A new ActiveDoc object
11 williamc 1.6 # url() : Return/set the docs url - essential
12     # file() : Return the local filename of document
13     #
14     # parse(parselabel): Parse the document file for the given parse level
15     # newparse(parselabel) : Create a new parse type
16     # addtag(parselabel,tagname,start,obj,text,obj,end,obj)
17     # : Add tags to the parse given by label
18 williamc 1.9 # checktag(tagname, hashref, param) : check for existence of param in
19     # hashref from a tag call
20 williamc 1.12 # includeparse(local_parsename, objparsename, activedoc) : copy the parse from
21     # one object to another
22     # currentparsename([name]) : get/set current parse name
23 williamc 1.6 # getfile(url) : get a processedfile object given a url
24 williamc 1.9 # activatedoc(url) : Return the object ref for a doc described by the given url
25 williamc 1.14 # -- any parse called "init" will also be run
26 williamc 1.6 # config([ActiveConfig]) : Set up/return Configuration for the document
27     # basequery([ActiveConfig]) : Set up/return UserQuery for the doc
28     # copydocconfig(ActiveDoc) : Copy the basic configuration from the ActiveDoc
29     # copydocquery(ActiveDoc) : Copy the basicquery from the ActiveDoc
30 williamc 1.10 # userinterface() : Return the defaullt userinterface
31 williamc 1.14 # option(var) : return the value of the option var
32     # requestoption("message") : Ask the user to supply a value for an option
33     # if it dosnt already exist
34 williamc 1.6 #
35     # -- error methods --
36     # error(string) : Report an general error to the user
37     # parseerror(string) : Report an error during parsing a file
38     # line() : Return the current line number of the document
39     # and the ProcessedFileObj it is in
40 williamc 1.2
41     package ActiveDoc::ActiveDoc;
42 williamc 1.6 require 5.004;
43     use ActiveDoc::Parse;
44     use ActiveDoc::ActiveConfig;
45     use ActiveDoc::PreProcessedFile;
46 williamc 1.10 use ObjectUtilities::StorableObject;
47 williamc 1.6 use URL::URLhandler;
48    
49 williamc 1.10 @ISA = qw(ObjectUtilities::StorableObject);
50 williamc 1.6
51     sub new {
52     my $class=shift;
53     $self={};
54     bless $self, $class;
55     $self->config(shift);
56 williamc 1.14
57 williamc 1.15 # have some override options been passed
58     if ( @_ ) {
59     $self->basequery(shift);
60 williamc 1.14 }
61     else {
62 williamc 1.15 # --- is there a starter document?
63     my $basedoc=$self->config()->basedoc();
64     if ( defined $basedoc ) {
65     $self->copydocquery($basedoc);
66     }
67     else {
68 williamc 1.19 $self->error("ActiveDoc Error : No base doc found");
69 williamc 1.15 }
70 williamc 1.14 }
71     $self->_init2();
72     }
73    
74     sub _init2 {
75    
76     my $self=shift;
77 williamc 1.6 # A URL handler per document
78     $self->{urlhandler}=URL::URLhandler->new($self->config()->cache());
79    
80 williamc 1.10 # A default UserInterface
81 williamc 1.11 $self->{userinterface}=ActiveDoc::SimpleUserInterface->new();
82 williamc 1.6 $self->init(@_);
83     return $self;
84 williamc 1.14
85 williamc 1.6 }
86    
87     # ----- parse related routines --------------
88     sub parse {
89     my $self=shift;
90     $parselabel=shift;
91    
92     my $file=$self->file();
93     if ( $file ) {
94 williamc 1.14 if ( exists $self->{parsers}{$parselabel} ) {
95     $self->{currentparsename}=$parselabel;
96     $self->{currentparser}=$self->{parsers}{$parselabel};
97     $self->{parsers}{$parselabel}->parse($file,@_);
98     delete $self->{currentparser};
99     $self->{currentparsename}="";
100     }
101 williamc 1.6 }
102     else {
103     print "Cannot parse - file not known\n";
104     }
105 williamc 1.1 }
106    
107 williamc 1.12 sub currentparsename {
108     my $self=shift;
109     @_?$self->{currentparsename}=shift
110     :$self->{currentparsename};
111     }
112    
113 williamc 1.6 sub newparse {
114     my $self=shift;
115     my $parselabel=shift;
116    
117     $self->{parsers}{$parselabel}=ActiveDoc::Parse->new();
118     $self->{parsers}{$parselabel}->addignoretags();
119     $self->{parsers}{$parselabel}->addgrouptags();
120 williamc 1.12 }
121    
122 williamc 1.13 sub cleartags {
123     my $self=shift;
124     my $parselabel=shift;
125    
126     $self->{parsers}{$parselabel}->cleartags();
127     }
128    
129    
130 williamc 1.12 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 williamc 1.2 }
148 williamc 1.6
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 williamc 1.4 }
156 williamc 1.6 $self->{parsers}{$parselabel}->addtag(@_);
157     }
158 williamc 1.2
159 williamc 1.6 sub addurltags {
160     my $self=shift;
161     my $parselabel=shift;
162    
163     $self->{parsers}{$parselabel}->
164     addtag("Base", \&Base_start, $self, "", $self,
165     \&Base_end, $self);
166 williamc 1.1 }
167    
168 williamc 1.6 sub url {
169 williamc 1.2 my $self=shift;
170 williamc 1.8 # get file & preprocess
171     if ( @_ ) {$self->{File}=$self->getfile(shift)}
172     $self->{File}->url();
173 williamc 1.2 }
174    
175 williamc 1.6 sub copydocconfig {
176 williamc 1.1 my $self=shift;
177 williamc 1.6 my $ActiveDoc=shift;
178    
179     $self->config($ActiveDoc->config());
180    
181 williamc 1.1 }
182    
183 williamc 1.6 sub copydocquery {
184     my $self=shift;
185     my $ActiveDoc=shift;
186    
187 williamc 1.19 if ( defined $ActiveDoc->basequery() ) {
188     $self->basequery($ActiveDoc->basequery());
189     }
190     else {
191     $self->error("Cannot copy basequery - undefined");
192     }
193 williamc 1.1 }
194    
195 williamc 1.6 sub config {
196 williamc 1.1 my $self=shift;
197 williamc 1.6 @_?$self->{ActiveConfig}=shift
198     : $self->{ActiveConfig};
199     }
200 williamc 1.1
201 williamc 1.6 sub basequery {
202     my $self=shift;
203 williamc 1.10 @_ ? $self->{Query}=shift
204     : $self->{Query};
205 williamc 1.19 return $self->{Query};
206 williamc 1.10 }
207    
208 williamc 1.14 sub option {
209 williamc 1.10 my $self=shift;
210     my $param=shift;
211 williamc 1.15 if ( defined $self->basequery()) {
212     return $self->basequery()->getparam($param);
213     }
214     else {
215     return $undef;
216     }
217 williamc 1.14 }
218    
219     sub requestoption {
220     my $self=shift;
221     my $param=shift;
222     my $string=shift;
223    
224 williamc 1.15 my $par=undef;
225     if ( defined $self->basequery()) {
226     $par=$self->basequery()->getparam($param);
227 williamc 1.14 while ( ! defined $par ) {
228     $self->basequery()->querytype( $param, "basic");
229     $self->basequery()->querymessage( $param, $string);
230     $self->userinterface()->askuser($self->basequery());
231 williamc 1.15 $par=$self->basequery()->getparam($param);
232 williamc 1.14 }
233 williamc 1.15 }
234 williamc 1.14 return $par;
235 williamc 1.2 }
236    
237 williamc 1.6 sub getfile() {
238 williamc 1.3 my $self=shift;
239 williamc 1.6 my $origurl=shift;
240    
241     my $fileref;
242     my ($url, $file)=$self->{urlhandler}->get($origurl);
243     # do we already have an appropriate object?
244 williamc 1.7 ($fileref)=$self->config()->find($url);
245     #undef $fileref;
246 williamc 1.6 if ( defined $fileref ) {
247     print "found $url in database ----\n";
248     $fileref->update();
249     }
250     else {
251     if ( $file eq "" ) {
252     $self->parseerror("Unable to get $origurl");
253     }
254     #-- set up a new preprocess file
255     print "Making a new file $url----\n";
256     $fileref=ActiveDoc::PreProcessedFile->new($self->config());
257     $fileref->url($url);
258     $fileref->update();
259     }
260     return $fileref;
261 williamc 1.3 }
262    
263 williamc 1.9 sub activatedoc {
264     my $self=shift;
265     my $url=shift;
266    
267     # first get a preprocessed copy of the file
268 williamc 1.14 # my $fileob=$self->getfile($url);
269 williamc 1.9
270     # now parse it for the <DocType> tag
271 williamc 1.14 my $tempdoc=ActiveDoc::ActiveDoc->new($self->config());
272 williamc 1.16 $tempdoc->{urlhandler}=$self->{urlhandler};
273 williamc 1.17 my $fullurl=$tempdoc->url($url);
274     $url=$fullurl;
275 williamc 1.14 $tempdoc->{doctypefound}=0;
276     $tempdoc->newparse("doctype");
277     $tempdoc->addtag("doctype","Doc", \&Doc_Start, $tempdoc,
278     "", $tempdoc, "", $tempdoc);
279     $tempdoc->parse("doctype");
280 williamc 1.9
281 williamc 1.14 if ( ! defined $tempdoc->{docobject} ) {
282     print "No <Doc type=> Specified in ".$url."\n";
283 williamc 1.9 exit 1;
284     }
285     # Set up a new object of the specified type
286 williamc 1.14 eval "require $tempdoc->{docobject}";
287     die $@ if $@;
288     my $newobj=$tempdoc->{docobject}->new($self->config());
289     undef $tempdoc;
290 williamc 1.10 $newobj->url($url);
291 williamc 1.14 $newobj->_initparse();
292 williamc 1.9 return $newobj;
293     }
294    
295 williamc 1.14 sub _initparse {
296     my $self=shift;
297    
298     $self->parse("init");
299     }
300 williamc 1.6 # -------- Error Handling and Error services --------------
301    
302 williamc 1.3 sub error {
303 williamc 1.6 my $self=shift;
304     my $string=shift;
305    
306     die $string."\n";
307     }
308    
309     sub parseerror {
310     my $self=shift;
311     my $string=shift;
312    
313 williamc 1.18 if ( ! defined $self->{currentparse} ) {
314     $self->error($string);
315     }
316     else {
317     ($line, $file)=$self->line();
318     print "Parse Error in ".$file->url().", line ".
319 williamc 1.6 $line."\n";
320 williamc 1.18 print $string."\n";
321     die;
322     }
323 williamc 1.6 }
324    
325     sub checktag {
326     my $self=shift;
327     my $tagname=shift;
328     my $hashref=shift;
329     my $param=shift;
330 williamc 1.3
331 williamc 1.6 if ( ! exists $$hashref{$param} ) {
332     $self->parseerror("Incomplete Tag <$tagname> : $param required");
333     }
334     }
335 williamc 1.3
336 williamc 1.6 sub line {
337 williamc 1.7 my $self=shift;
338 williamc 1.9
339 williamc 1.6 my ($line, $fileobj)=
340 williamc 1.9 $self->{File}->realline($self->{currentparser}->line());
341 williamc 1.6 return ($line, $fileobj);
342 williamc 1.7 }
343    
344     sub tagstartline {
345     my $self=shift;
346 williamc 1.8 my ($line, $fileobj)=$self->{File}->line(
347 williamc 1.7 $self->{currentparser}->tagstartline());
348     return ($line, $fileobj);
349 williamc 1.3 }
350 williamc 1.6
351     sub file {
352 williamc 1.2 my $self=shift;
353    
354 williamc 1.8 $self->{File}->file();
355 williamc 1.2 }
356    
357 williamc 1.6 # --------------- Initialisation Methods ---------------------------
358 williamc 1.2
359 williamc 1.6 sub init {
360     # Dummy Routine - override for derived classes
361 williamc 1.1 }
362    
363 williamc 1.6 # ------------------- Tag Routines -----------------------------------
364 williamc 1.1 #
365 williamc 1.6 # Base - for setting url bases
366 williamc 1.1 #
367 williamc 1.6 sub Base_start {
368     my $self=shift;
369     my $name=shift;
370     my $hashref=shift;
371 williamc 1.2
372 williamc 1.6 $self->checktag($name, $hashref, 'type' );
373     $self->checktag($name, $hashref, 'base' );
374    
375     # Keep track of base tags
376     push @{$self->{basestack}}, $$hashref{"type"};
377     # Set the base
378     $self->{urlhandler}->setbase($$hashref{"type"},$hashref);
379 williamc 1.1 }
380    
381 williamc 1.6 sub Base_end {
382     my $self=shift;
383 williamc 1.1 my $name=shift;
384 williamc 1.6 my $type;
385 williamc 1.1
386 williamc 1.6 if ( $#{$self->{basestack}} == -1 ) {
387 williamc 1.19 $self->parseerror("Parse Error : unmatched </$name>");
388 williamc 1.6 }
389     else {
390     $type = pop @{$self->{basestack}};
391     $self->{urlhandler}->unsetbase($type);
392     }
393 williamc 1.9 }
394    
395     sub Doc_Start {
396     my $self=shift;
397     my $name=shift;
398     my $hashref=shift;
399    
400     $self->checktag($name, $hashref, "type");
401 williamc 1.10 $self->{doctypefound}++;
402     if ( $self->{doctypefound} == 1 ) { # only take first doctype
403     $self->{docobject}=$$hashref{'type'};
404     }
405     }
406    
407     sub userinterface {
408     my $self=shift;
409     @_?$self->{userinterface}=shift
410     :$self->{userinterface}
411 williamc 1.1 }