ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/cvsroot/COMP/SCRAM/src/ActiveDoc/ActiveDoc.pm
Revision: 1.20
Committed: Fri Feb 11 14:55:22 2000 UTC (25 years, 3 months ago) by williamc
Content type: text/plain
Branch: MAIN
Changes since 1.19: +30 -5 lines
Log Message:
Add verbose function

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