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.24 by williamc, Wed Mar 1 11:47:39 2000 UTC vs.
Revision 1.25.2.1.2.7 by williamc, Thu Aug 24 10:00:38 2000 UTC

# Line 7 | Line 7
7   #
8   # Interface
9   # ---------
10 < # new(ActiveConfig[,options])           : A new ActiveDoc object
10 > # new(ActiveStore)              : A new ActiveDoc object
11   # url()         : Return/set the docs url - essential
12   # file()        : Return the local filename of document
13   # ProcessFile() : Return the filename of PreProcessed document
14   #
15 # parse(parselabel): Parse the document file for the given parse level
15   # parent()         : return the object ref of the calling parent
17 # 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 # 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
16   # getfile(url)  : get a processedfile object given a url
17   # activatedoc(url) : Return the object ref for a doc described by the given url
28 #                    -- any parse called "init" will also be run
29 # config([ActiveConfig]) : Set up/return Configuration for the document
30 # basequery([ActiveConfig]) : Set up/return UserQuery for the doc
31 # copydocconfig(ActiveDoc) : Copy the basic configuration from the ActiveDoc
32 # copydocquery(ActiveDoc) : Copy the basicquery from the ActiveDoc
33 # userinterface()       : Return the defaullt userinterface
34 # option(var)           : return the value of the option var ( or undef )
35 # requestoption("message") : Ask the user to supply a value for an option
36 #                            if it dosnt already exist
37 # askuser(Query)        : send a query object to the userinterface
38 # verbose(string)       : Print string in verbosity mode
18   #
19   # -- error methods --
20   # error(string)       : Report an general error to the user
21   # parseerror(string)  : Report an error during parsing a file
22 < # line()              : Return the current line number of the document
23 < #                       and the ProcessedFileObj it is in
24 < #
25 < # -- support for inheriting classes
47 < # _saveactivedoc(filehandle)
48 < # _restoreactivedoc(filehandle)
22 > # line([linenumber])     : Return the line number of the document
23 > #                       and the ProcessedFileObj it is in corresponding to the
24 > #                       supplied number of the expanded document
25 > #                       If no number supplied - the currentparse number will be #                       used
26  
27   package ActiveDoc::ActiveDoc;
28   require 5.004;
29 < use ActiveDoc::Parse;
53 < use ActiveDoc::ActiveConfig;
29 > use ActiveDoc::SimpleURLDoc;
30   use ActiveDoc::PreProcessedFile;
31 < use ObjectUtilities::StorableObject;
56 < use URL::URLhandler;
31 > use Utilities::Verbose;
32  
33 < @ISA = qw(ObjectUtilities::StorableObject);
33 > @ISA = qw(ActiveDoc::SimpleURLDoc Utilities::Verbose);
34  
35   sub new {
36          my $class=shift;
37 <        $self={};
37 >        my $self={};
38          bless $self, $class;
39 <        $self->config(shift);
40 <
41 <        # have some override options been passed
42 <        if ( @_ ) {
43 <           $self->basequery(shift);
69 <        }
70 <        else {
71 <           # --- is there a starter document?
72 <           my $basedoc=$self->config()->basedoc();
73 <           if ( defined $basedoc ) {
74 <             $self->copydocquery($basedoc);
75 <             $self->verbose("Initialising from $basedoc");
76 <           }
77 <           else {
78 <             $self->error("ActiveDoc Error : No base doc found");
79 <           }
80 <        }
81 <        $self->verbose("New ActiveDoc (".ref($self).") Created");
82 <        $self->_init2();
83 < }
84 <
85 < sub _init2 {
86 <
87 <        my $self=shift;
88 <        # A URL handler per document
89 <        $self->{urlhandler}=URL::URLhandler->new($self->config()->cache());
90 <
91 <        # A default UserInterface
92 <        $self->{userinterface}=ActiveDoc::SimpleUserInterface->new();
93 <        $self->init(@_);
39 >        $self->{Ostore}=shift;
40 >        $self->cache($self->{Ostore}->cache());
41 >        $self->{dbstore}=$self->{Ostore};
42 >        $self->_initdoc("doc",@_);
43 > #       $self->{switch}=ActiveDoc::SimpleURLDoc->new($self->{cache});
44          return $self;
95
96 }
97
98 sub verbose {
99        my $self=shift;
100        my $string=shift;
101
102        if ( $self->option('verbose_all') ||
103                        $self->option('verbose_'.ref($self)) ) {
104          print ">".ref($self)."($self) : \n->".$string."\n";
105        }
106 }
107
108 # ----- parse related routines --------------
109 sub parse {
110        my $self=shift;
111        $parselabel=shift;
112
113        my $file=$self->ProcessFile();
114        if ( $file ) {
115          if ( exists $self->{parsers}{$parselabel} ) {
116            $self->verbose("Parsing $parselabel in file $file");
117            $self->{currentparsename}=$parselabel;
118            $self->{currentparser}=$self->{parsers}{$parselabel};
119            $self->{parsers}{$parselabel}->parse($file,@_);
120            delete $self->{currentparser};
121            $self->{currentparsename}="";
122            $self->verbose("Parse $parselabel Complete");
123          }
124        }
125        else {
126          $self->error("Cannot parse $parselabel - file not known");
127        }
128 }
129
130 sub currentparsename {
131        my $self=shift;
132        @_?$self->{currentparsename}=shift
133          :(defined $self->{currentparsename}?$self->{currentparsename}:"");
134 }
135
136 sub currentparser {
137        my $self=shift;
138        return $self->{currentparser};
139 }
140
141
142 sub newparse {
143        my $self=shift;
144        my $parselabel=shift;
145
146        $self->{parsers}{$parselabel}=ActiveDoc::Parse->new();
147        $self->{parsers}{$parselabel}->addignoretags();
148        $self->{parsers}{$parselabel}->addgrouptags();
149 }
150
151 sub cleartags {
152        my $self=shift;
153        my $parselabel=shift;
154
155        $self->{parsers}{$parselabel}->cleartags();
156 }
157
158
159 sub includeparse {
160        my $self=shift;
161        my $parselabel=shift;
162        my $remoteparselabel=shift;
163        my $activedoc=shift;
164
165        # Some error trapping
166        if ( ! exists $self->{parsers}{$parselabel} ) {
167          $self->error("Unknown local parse name specified");
168        }
169        if ( ! exists $activedoc->{parsers}{$remoteparselabel} ) {
170          $self->error("Unknown parse name specified in remote obj $activedoc");
171        }
172
173        #
174        my $rp=$activedoc->{parsers}{$remoteparselabel};
175        $self->{parsers}{$parselabel}->includeparse($rp);
176 }
177
178 sub addtag {
179        my $self=shift;
180        my $parselabel=shift;
181        if ( $#_ != 6 ) {
182                $self->error("Incorrect addtags specification\n".
183                                "called with :\n@_ \n");
184        }
185        $self->{parsers}{$parselabel}->addtag(@_);
186 }
187
188 sub addurltags {
189        my $self=shift;
190        my $parselabel=shift;
191        
192        $self->{parsers}{$parselabel}->
193                addtag("Base", \&Base_start, $self, "", $self,
194                        \&Base_end, $self);
45   }
46  
47   sub url {
48          my $self=shift;
49          # get file & preprocess
50          if ( @_  ) {
51 <                $self->{File}=$self->getfile(shift);
52 <                $self->verbose("url downloaded to $self->{File}");
51 >                $self->{origurl}=shift;
52 >                $self->{File}=$self->getfile($self->{origurl});
53 >                $self->filetoparse($self->{File}->ProcessedFile());
54 >                $self->verbose("url downloaded to ".$self->{File}->ProcessedFile());
55          }
56 <        $self->{File}->url();
57 < }
206 <
207 < sub copydocconfig {
208 <        my $self=shift;
209 <        my $ActiveDoc=shift;
210 <        
211 <        $self->config($ActiveDoc->config());
212 <
213 < }
214 <
215 < sub copydocquery {
216 <        my $self=shift;
217 <        my $ActiveDoc=shift;
218 <
219 <        if ( defined $ActiveDoc->basequery() ) {
220 <          $self->basequery($ActiveDoc->basequery());
221 <        }
222 <        else {
223 <          $self->error("Cannot copy basequery - undefined");
224 <        }
225 < }
226 <
227 < sub config {
228 <        my $self=shift;
229 <        @_?$self->{ActiveConfig}=shift
230 <           : $self->{ActiveConfig};
231 < }
232 <
233 < sub basequery {
234 <        my $self=shift;
235 <        @_?$self->{Query}=shift
236 <           :$self->{Query};
237 < }
238 <
239 < sub option {
240 <        my $self=shift;
241 <        my $param=shift;
242 <        if ( defined $self->basequery()) {
243 <                return $self->basequery()->getparam($param);
244 <        }
245 <        else {
246 <                return $undef;
247 <        }
248 < }
249 <
250 < sub requestoption {
251 <        my $self=shift;
252 <        my $param=shift;
253 <        my $string=shift;
254 <
255 <        my $par=undef;
256 <        if ( defined $self->basequery()) {
257 <        $par=$self->basequery()->getparam($param);
258 <        while ( ! defined $par ) {
259 <          $self->basequery()->querytype( $param, "basic");
260 <          $self->basequery()->querymessage( $param, $string);
261 <          $self->userinterface()->askuser($self->basequery());
262 <          $par=$self->basequery()->getparam($param);
263 <        }
56 >        if ( defined $self->{File} ) {
57 >          return $self->{File}->url();
58          }
59 <        return $par;
266 < }
267 <
268 < sub askuser {
269 <        my $self=shift;
270 <        return $self->userinterface()->askuser(@_);
59 >        else { return "undefined"; }
60   }
61  
62   sub getfile {
# Line 276 | Line 65 | sub getfile {
65  
66          my $fileref;
67          my ($url, $file);
68 <        if ( (defined ($it=$self->option('url_update'))) &&
280 <                ( $it eq "1" || $origurl=~/^$it/ )) {
68 >        if ( 0 ) {
69               $self->verbose("Forced download of $origurl");
70 <             ($url, $file)=$self->{urlhandler}->download($origurl);
70 >             ($url, $file)=$self->urldownload($origurl);
71          }
72          else {
73             $self->verbose("Attempting to get $origurl");
74 <           ($url, $file)=$self->{urlhandler}->get($origurl);
74 >           ($url, $file)=$self->urlget($origurl);
75          }
76          # do we already have an appropriate object?
77 <        ($fileref)=$self->config()->find($url);
290 <        #undef $fileref;
77 >        ($fileref)=$self->{dbstore}->find($url);
78          if (  defined $fileref ) {
79           $self->verbose("Found $url in database");
80           $fileref->update();
# Line 296 | Line 83 | sub getfile {
83           if ( $file eq "" ) {
84             $self->parseerror("Unable to get $origurl");
85           }
86 <         #-- set up a new preprocess file
86 >         # -- set up a new preprocess file
87           $self->verbose("Making a new preprocessed file $url");
88 <         $fileref=ActiveDoc::PreProcessedFile->new($self->config());
88 >         $fileref=ActiveDoc::PreProcessedFile->new($self->{Ostore});
89 >         #$fileref->cache($self->{cache});
90           $fileref->url($url);
91           $fileref->update();
92          }
# Line 310 | Line 98 | sub activatedoc {
98          my $url=shift;
99  
100          # first get a preprocessed copy of the file
101 < #       my $fileob=$self->getfile($url);
101 >        my $fileobj=$self->getfile($url);
102  
103 <        # now parse it for the <DocType> tag
104 <        my $tempdoc=ActiveDoc::ActiveDoc->new($self->config());
105 <        $tempdoc->{urlhandler}=$self->{urlhandler};
106 <        my $fullurl=$tempdoc->url($url);
107 <        $url=$fullurl;
108 <        $tempdoc->{doctypefound}=0;
109 <        $tempdoc->newparse("doctype");
110 <        $tempdoc->addtag("doctype","Doc", \&Doc_Start, $tempdoc,
323 <                                          "", $tempdoc, "", $tempdoc);
324 <        $tempdoc->parse("doctype");
325 <
326 <        if ( ! defined $tempdoc->{docobject} ) {
327 <          print "No <Doc type=> Specified in ".$url."\n";
328 <          exit 1;
103 >        # now parse it for the <Doc> tag
104 >        my $tempdoc=ActiveDoc::SimpleURLDoc->new($self->{cache});
105 >        $tempdoc->filetoparse($fileobj->ProcessFile());
106 >        my ($doctype,$docversion)=$tempdoc->doctype();
107 >        undef $tempdoc;
108 >        
109 >        if ( ! defined $doctype ) {
110 >          $self->parseerror("No <Doc type=> Specified in ".$url);
111          }
112 +        $self->verbose("doctype required is $doctype $docversion");
113 +
114          # Set up a new object of the specified type
115 <        eval "require $tempdoc->{docobject}";
115 >        eval "require $doctype";
116          die $@ if $@;
117 <        my $newobj=$tempdoc->{docobject}->new($self->config());
334 <        undef $tempdoc;
117 >        my $newobj=$doctype->new($self->{Ostore});
118          $newobj->url($url);
119          $newobj->parent($self);
337        $newobj->_initparse();
120          return $newobj;
121   }
122  
# Line 345 | Line 127 | sub parent {
127            :$self->{parent};
128   }
129  
348 sub _initparse {
349        my $self=shift;
350
351        $self->parse("init");
352 }
130   # -------- Error Handling and Error services --------------
131  
355 sub error {
356        my $self=shift;
357        my $string=shift;
358
359        die $string."\n";
360 }
361
132   sub parseerror {
133          my $self=shift;
134          my $string=shift;
# Line 366 | Line 136 | sub parseerror {
136          if ( $self->currentparsename() eq "" ) {
137                  $self->error($string);
138          }
139 +        elsif ( ! defined $self->{File} ) {
140 +         print "Parse Error in ".$self->filenameref()." line "
141 +                                .$self->{currentparser}->line()."\n";
142 +         print $string."\n";
143 +        }
144          else {
145           ($line, $file)=$self->line();
146           print "Parse Error in ".$file->url().", line ".
147                                          $line."\n";
148           print $string."\n";
374         exit;
149          }
150 < }
377 <
378 < sub checktag {
379 <        my $self=shift;
380 <        my $tagname=shift;
381 <        my $hashref=shift;
382 <        my $param=shift;
383 <
384 <        if ( ! exists $$hashref{$param} ) {
385 <          $self->parseerror("Incomplete Tag <$tagname> : $param required");
386 <        }
150 >        exit;
151   }
152  
153   sub line {
154          my $self=shift;
155 +        my $parseline;
156 +
157 +        if ( @_ ) {
158 +          $parseline=shift;
159 +        }
160 +        else {
161 +          $parseline=$self->{currentparser}->line();
162 +        }
163  
164          my ($line, $fileobj)=
165 <                $self->{File}->realline($self->{currentparser}->line());
165 >                $self->{File}->realline($parseline);
166          return ($line, $fileobj);
167   }
168  
# Line 413 | Line 185 | sub ProcessFile {
185          return $self->{File}->ProcessedFile();
186   }
187  
416 # --------------- Initialisation Methods ---------------------------
417
418 sub init {
419        # Dummy Routine - override for derived classes
420 }
421
422 # ------------------- Tag Routines -----------------------------------
188   #
189 < # Base - for setting url bases
189 > # Delegate all else to the switch
190   #
191 < sub Base_start {
192 <        my $self=shift;
428 <        my $name=shift;
429 <        my $hashref=shift;
191 > #sub AUTOLOAD {
192 > #        my $self=shift;
193  
194 <        $self->checktag($name, $hashref, 'type' );
195 <        $self->checktag($name, $hashref, 'base' );
433 <      
434 <        # Keep track of base tags
435 <        push @{$self->{basestack}}, $$hashref{"type"};
436 <        # Set the base
437 <        $self->{urlhandler}->setbase($$hashref{"type"},$hashref);
438 < }
194 >        # dont propogate destroy methods
195 > #        return if $AUTOLOAD=~/::DESTROY/;
196  
197 < sub Base_end {
198 <        my $self=shift;
442 <        my $name=shift;
443 <        my $type;
197 >        # remove this package name
198 > #        ($name=$AUTOLOAD)=~s/ActiveDoc::ActiveDoc:://;
199  
200 <        if ( $#{$self->{basestack}} == -1 ) {
201 <                $self->parseerror("Parse Error : unmatched </$name>");
202 <        }
448 <        else {
449 <          $type = pop @{$self->{basestack}};
450 <          $self->{urlhandler}->unsetbase($type);
451 <        }
452 < }
200 >        # pass the message to SimpleDoc
201 > #        $self->{switch}->$name(@_);
202 > #}
203  
204 +
205 + # ------------------- Tag Routines -----------------------------------
206   sub Doc_Start {
207          my $self=shift;
208          my $name=shift;
# Line 462 | Line 214 | sub Doc_Start {
214             $self->{docobject}=$$hashref{'type'};
215          }
216   }
465
466 sub userinterface {
467        my $self=shift;
468        @_?$self->{userinterface}=shift
469          :$self->{userinterface}
470 }
471
472 sub _saveactivedoc {
473        my $self=shift;
474        my $fh=shift;
475        print "Storing $self\n";
476        print $fh $self->url()."\n";
477 }
478
479 sub _restoreactivedoc {
480        my $self=shift;
481        my $fh=shift;
482
483        my $url=<$fh>;
484        chomp $url;
485        $self->url($url);
486 }

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines