ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/cvsroot/COMP/SCRAM/src/ActiveDoc/ActiveDoc.pm
Revision: 1.22
Committed: Mon Feb 21 17:36:33 2000 UTC (25 years, 2 months ago) by williamc
Content type: text/plain
Branch: MAIN
Changes since 1.21: +1 -1 lines
Log Message:
Works with PreProcessedFile OK

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