ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/cvsroot/COMP/SCRAM/src/ActiveDoc/ActiveDoc.pm
(Generate patch)

Comparing COMP/SCRAM/src/ActiveDoc/ActiveDoc.pm (file contents):
Revision 1.5 by williamc, Wed Sep 29 07:47:06 1999 UTC vs.
Revision 1.20 by williamc, Fri Feb 11 14:55:22 2000 UTC

# Line 1 | Line 1
1   #
2 < # The base functionality for the ActiveDocument - inherits from Basetags
2 > # ActiveDoc.pm
3 > #
4 > # Originally Written by Christopher Williams
5 > #
6 > # Description
7   #
4 # Inherits from BaseTags
5 # --------
8   # Interface
9   # ---------
10 < # new(filename, DOChandler): create a new object based on a file and
11 < #                                 associate with a base DOChandler
12 < # parse()                       : parse the input file
13 < # include(url) : Activate include file mechanism, returns the object ref if OK
14 < # treenode()   : return the associated TreeNode object reference
15 < # getincludeObjectStore : Return a pointer to the ObectStore that contains all
16 < #                         included objects
17 < # find(string)  : find the object reference related to string in the associated
18 < #                 tree. Mechanism for getting object references
19 < # _addgroup()   : Add group functionality to document
20 < # parseerror(String) : Report an error to the user
21 < # userinterface()       : return the default User Interface object
22 < # checktag($hashref, param , tagname) : Check a hash returned from switcher
23 < #                                       for a given parameter
10 > # new(ActiveConfig[,options])           : A new ActiveDoc object
11 > # 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 > # checktag(tagname, hashref, param) : check for existence of param in
19 > #                                       hashref from a tag call
20 > # includeparse(local_parsename, objparsename, activedoc) : copy the parse from
21 > #                                                       one object to another
22 > # currentparsename([name]) : get/set current parse name
23 > # getfile(url)  : get a processedfile object given a url
24 > # activatedoc(url) : Return the object ref for a doc described by the given url
25 > #                    -- any parse called "init" will also be run
26 > # 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 > # userinterface()       : Return the defaullt userinterface
31 > # option(var)           : return the value of the option var ( or undef )
32 > # requestoption("message") : Ask the user to supply a value for an option
33 > #                            if it dosnt already exist
34 > # askuser(Query)        : send a query object to the userinterface
35 > # verbose(string)       : Print string in verbosity mode
36 > #
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  
43   package ActiveDoc::ActiveDoc;
44 < require 5.001;
45 < use ActiveDoc::DOChandler;
46 < use ActiveDoc::TreeNode;
47 < use ActiveDoc::UserQuery;
48 < use ObjectStoreCont;
49 <
50 < @ISA = qw(ActiveDoc::BaseTags);
51 <
52 < # Initialise
53 < sub _init {
54 <        my $self=shift;
55 <        my $DOChandler=shift;
56 <        my $OC=shift;
57 <
58 <        $self->_addurl();
59 <        $self->{urlhandler}->setcache($DOChandler->defaultcache());
60 <        $self->{treenode}=ActiveDoc::TreeNode->new();
61 <        $self->{dochandler}=$DOChandler;
62 <        $self->{UserQuery}=$DOChandler->{UserQuery};
63 <        $self->{tags}->addtag("Use", \&Use_Start, "", "");
64 <        # Add the minimal functionality tag - feel free to override
65 <        $self->{tags}->addtag("Include", \&Include_Start, "", "");
66 <        $self->init();
44 > require 5.004;
45 > use ActiveDoc::Parse;
46 > use ActiveDoc::ActiveConfig;
47 > use ActiveDoc::PreProcessedFile;
48 > use ObjectUtilities::StorableObject;
49 > use URL::URLhandler;
50 >
51 > @ISA = qw(ObjectUtilities::StorableObject);
52 >
53 > sub new {
54 >        my $class=shift;
55 >        $self={};
56 >        bless $self, $class;
57 >        $self->config(shift);
58 >
59 >        # have some override options been passed
60 >        if ( @_ ) {
61 >           $self->basequery(shift);
62 >        }
63 >        else {
64 >           # --- is there a starter document?
65 >           my $basedoc=$self->config()->basedoc();
66 >           if ( defined $basedoc ) {
67 >             $self->verbose("Initialising from $basedoc");
68 >             $self->copydocquery($basedoc);
69 >           }
70 >           else {
71 >             $self->error("ActiveDoc Error : No base doc found");
72 >           }
73 >        }
74 >        $self->_init2();
75   }
76  
77 < sub init {
78 <        # Dummy Routine - override for derrived classes
77 > sub _init2 {
78 >
79 >        my $self=shift;
80 >        # A URL handler per document
81 >        $self->{urlhandler}=URL::URLhandler->new($self->config()->cache());
82 >
83 >        # A default UserInterface
84 >        $self->{userinterface}=ActiveDoc::SimpleUserInterface->new();
85 >        $self->init(@_);
86 >        return $self;
87 >
88   }
52 #
53 # use mechanism
54 #
55 sub include {
56        my $self=shift;
57        my $url=shift;
58        my $linkfile=shift;
59        my $filename;
60        my $obj;
89  
90 <        $file=$self->{urlhandler}->get($url);
91 <        if ( ( defined $linkfile) && ( $linkfile ne "" ) ) {
92 <          $filename=$file."/".$linkfile;
90 > 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 > # ----- parse related routines --------------
101 > sub parse {
102 >        my $self=shift;
103 >        $parselabel=shift;
104 >
105 >        my $file=$self->file();
106 >        if ( $file ) {
107 >          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          }
115          else {
116 <          $filename=$file;
116 >          print "Cannot parse - file not known\n";
117          }
118 <        $obj=$self->{dochandler}->newdoc($filename);
118 > }
119  
120 <        # Now Extend our tree
121 <        $self->{treenode}->grow($obj->treenode());
122 <        return $obj;
120 > sub currentparsename {
121 >        my $self=shift;
122 >        @_?$self->{currentparsename}=shift
123 >          :$self->{currentparsename};
124   }
125  
126 < sub userinterface {
126 > sub newparse {
127          my $self=shift;
128 <        return $self->{dochandler}->{UserInterface};
128 >        my $parselabel=shift;
129 >
130 >        $self->{parsers}{$parselabel}=ActiveDoc::Parse->new();
131 >        $self->{parsers}{$parselabel}->addignoretags();
132 >        $self->{parsers}{$parselabel}->addgrouptags();
133   }
134  
135 < sub treenode {
135 > sub cleartags {
136          my $self=shift;
137 <        return $self->{treenode};
137 >        my $parselabel=shift;
138 >
139 >        $self->{parsers}{$parselabel}->cleartags();
140   }
141  
142 < sub getincludeObjectStore {
143 <        my $self=shift;
144 <        return $self->{includeOS};
142 >
143 > 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   }
161  
162 < sub find($) {
162 > sub addtag {
163          my $self=shift;
164 <        my $string=shift;
165 <        my $tn;
164 >        my $parselabel=shift;
165 >        if ( $#_ != 6 ) {
166 >                $self->error("Incorrect addtags specification\n".
167 >                                "called with :\n@_ \n");
168 >        }
169 >        $self->{parsers}{$parselabel}->addtag(@_);
170 > }
171 >
172 > 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 > }
180 >
181 > sub url {
182 >        my $self=shift;
183 >        # get file & preprocess
184 >        if ( @_  ) {$self->{File}=$self->getfile(shift)}
185 >        $self->{File}->url();
186 > }
187  
188 <        $tn=$self->{treenode}->find($string);
189 <        if ( $tn eq "" ) {
190 <          $self->parseerror("Unable to find $string");
188 > sub copydocconfig {
189 >        my $self=shift;
190 >        my $ActiveDoc=shift;
191 >        
192 >        $self->config($ActiveDoc->config());
193 >
194 > }
195 >
196 > sub copydocquery {
197 >        my $self=shift;
198 >        my $ActiveDoc=shift;
199 >
200 >        if ( defined $ActiveDoc->basequery() ) {
201 >          $self->basequery($ActiveDoc->basequery());
202 >        }
203 >        else {
204 >          $self->error("Cannot copy basequery - undefined");
205          }
100        return $tn->associate();
206   }
207  
208 < sub line {
208 > sub config {
209          my $self=shift;
210 <        return $self->{switch}->line();
210 >        @_?$self->{ActiveConfig}=shift
211 >           : $self->{ActiveConfig};
212   }
213  
214 < sub error {
214 > sub basequery {
215 >        my $self=shift;
216 >        @_ ? $self->{Query}=shift
217 >           : $self->{Query};
218 >        return $self->{Query};
219 > }
220 >
221 > sub option {
222 >        my $self=shift;
223 >        my $param=shift;
224 >        if ( defined $self->basequery()) {
225 >                return $self->basequery()->getparam($param);
226 >        }
227 >        else {
228 >                return $undef;
229 >        }
230 > }
231 >
232 > sub requestoption {
233          my $self=shift;
234 +        my $param=shift;
235          my $string=shift;
236  
237 <        die $string."\n";
237 >        my $par=undef;
238 >        if ( defined $self->basequery()) {
239 >        $par=$self->basequery()->getparam($param);
240 >        while ( ! defined $par ) {
241 >          $self->basequery()->querytype( $param, "basic");
242 >          $self->basequery()->querymessage( $param, $string);
243 >          $self->userinterface()->askuser($self->basequery());
244 >          $par=$self->basequery()->getparam($param);
245 >        }
246 >        }
247 >        return $par;
248 > }
249  
250 + sub askuser {
251 +        my $self=shift;
252 +        return $self->userinterface()->askuser(@_);
253   }
254 < sub parseerror {
254 >
255 > sub getfile() {
256          my $self=shift;
257 <        my $string=shift;
257 >        my $origurl=shift;
258  
259 <        print "Parse Error in $self->{url}, line ".
260 <                                        $self->line()."\n";
261 <        print $string."\n";
262 <        die;
259 >        my $fileref;
260 >        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 >        # do we already have an appropriate object?
269 >        ($fileref)=$self->config()->find($url);
270 >        #undef $fileref;
271 >        if (  defined $fileref ) {
272 >         $self->verbose("Found $url in database");
273 >         $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   }
287  
288 < sub checktag {
288 > sub activatedoc {
289 >        my $self=shift;
290 >        my $url=shift;
291 >
292 >        # first get a preprocessed copy of the file
293 > #       my $fileob=$self->getfile($url);
294 >
295 >        # now parse it for the <DocType> tag
296 >        my $tempdoc=ActiveDoc::ActiveDoc->new($self->config());
297 >        $tempdoc->{urlhandler}=$self->{urlhandler};
298 >        my $fullurl=$tempdoc->url($url);
299 >        $url=$fullurl;
300 >        $tempdoc->{doctypefound}=0;
301 >        $tempdoc->newparse("doctype");
302 >        $tempdoc->addtag("doctype","Doc", \&Doc_Start, $tempdoc,
303 >                                          "", $tempdoc, "", $tempdoc);
304 >        $tempdoc->parse("doctype");
305 >
306 >        if ( ! defined $tempdoc->{docobject} ) {
307 >          print "No <Doc type=> Specified in ".$url."\n";
308 >          exit 1;
309 >        }
310 >        # Set up a new object of the specified type
311 >        eval "require $tempdoc->{docobject}";
312 >        die $@ if $@;
313 >        my $newobj=$tempdoc->{docobject}->new($self->config());
314 >        undef $tempdoc;
315 >        $newobj->url($url);
316 >        $newobj->_initparse();
317 >        return $newobj;
318 > }
319 >
320 > sub _initparse {
321          my $self=shift;
127        my $hashref=shift;
128        my $param=shift;
129        my $tagname=shift;
322  
323 <        if ( ! exists $$hashref{$param} ) {
324 <          $self->parseerror("Incomplete Tag <$tagname> : $param required");  
323 >        $self->parse("init");
324 > }
325 > # -------- Error Handling and Error services --------------
326 >
327 > sub error {
328 >        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 >        if ( $self->currentparsename() eq "" ) {
339 >                $self->error($string);
340 >        }
341 >        else {
342 >         ($line, $file)=$self->line();
343 >         print "Parse Error in ".$file->url().", line ".
344 >                                        $line."\n";
345 >         print $string."\n";
346 >         exit;
347          }
348   }
349  
350 < # ------------------------ Tag Routines ------------------------------
351 < #
352 < # The Include tag
353 < #
350 > sub checktag {
351 >        my $self=shift;
352 >        my $tagname=shift;
353 >        my $hashref=shift;
354 >        my $param=shift;
355  
356 < sub Include_Start {
356 >        if ( ! exists $$hashref{$param} ) {
357 >          $self->parseerror("Incomplete Tag <$tagname> : $param required");
358 >        }
359 > }
360 >
361 > sub line {
362          my $self=shift;
143        my $name=shift;
144        my $hashref=shift;
363  
364 <        $self->{switch}->checkparam( $name, "ref");
365 <        print "<Include> tag not yet implemented\n";
366 < #        $self->include($$hashref{'ref'},$$hashref{'linkdoc'});
364 >        my ($line, $fileobj)=
365 >                $self->{File}->realline($self->{currentparser}->line());
366 >        return ($line, $fileobj);
367   }
368  
369 < sub Use_Start {
369 > sub tagstartline {
370          my $self=shift;
371 +        my ($line, $fileobj)=$self->{File}->line(
372 +                $self->{currentparser}->tagstartline());
373 +        return ($line, $fileobj);
374 + }
375 +
376 + sub file {
377 +        my $self=shift;
378 +
379 +        $self->{File}->file();
380 + }
381 +
382 + # --------------- Initialisation Methods ---------------------------
383 +
384 + sub init {
385 +        # Dummy Routine - override for derived classes
386 + }
387 +
388 + # ------------------- Tag Routines -----------------------------------
389 + #
390 + # Base - for setting url bases
391 + #
392 + sub Base_start {
393 +        my $self=shift;
394          my $name=shift;
395          my $hashref=shift;
396  
397 <        print "<Use> tag not yet implemented\n";
397 >        $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 > }
405 >
406 > sub Base_end {
407 >        my $self=shift;
408 >        my $name=shift;
409 >        my $type;
410 >
411 >        if ( $#{$self->{basestack}} == -1 ) {
412 >                $self->parseerror("Parse Error : unmatched </$name>");
413 >        }
414 >        else {
415 >          $type = pop @{$self->{basestack}};
416 >          $self->{urlhandler}->unsetbase($type);
417 >        }
418 > }
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 >        $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   }

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines