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.20 by williamc, Fri Feb 11 14:55:22 2000 UTC vs.
Revision 1.25.2.1.2.1 by williamc, Thu Aug 17 15:59:21 2000 UTC

# Line 7 | Line 7
7   #
8   # Interface
9   # ---------
10 < # new(ActiveConfig[,options])           : A new ActiveDoc object
10 > # new(cache,dbstore)            : 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 < # 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
15 > # parent()         : return the object ref of the calling parent
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
18   #                    -- 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
19   # 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
20   #
21   # -- error methods --
22   # error(string)       : Report an general error to the user
23   # parseerror(string)  : Report an error during parsing a file
24   # line()              : Return the current line number of the document
25   #                       and the ProcessedFileObj it is in
26 + #
27  
28   package ActiveDoc::ActiveDoc;
29   require 5.004;
30 < use ActiveDoc::Parse;
31 < use ActiveDoc::ActiveConfig;
47 < use ActiveDoc::PreProcessedFile;
48 < use ObjectUtilities::StorableObject;
49 < use URL::URLhandler;
30 > use ActiveDoc::SimpleURLDoc;
31 > use Utilities::Verbose;
32  
33 < @ISA = qw(ObjectUtilities::StorableObject);
33 > @ISA = qw(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
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 _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(@_);
39 >        $self->{cache}=shift;
40 >        $self->{dbstore}=shift;
41 >        $self->{switch}=ActiveDoc::SimpleURLDoc->new($self->{cache});
42          return $self;
87
88 }
89
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          print "Cannot parse - file not known\n";
117        }
118 }
119
120 sub currentparsename {
121        my $self=shift;
122        @_?$self->{currentparsename}=shift
123          :$self->{currentparsename};
124 }
125
126 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 }
134
135 sub cleartags {
136        my $self=shift;
137        my $parselabel=shift;
138
139        $self->{parsers}{$parselabel}->cleartags();
140 }
141
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 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        }
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);
43   }
44  
45   sub url {
46          my $self=shift;
47          # get file & preprocess
48 <        if ( @_  ) {$self->{File}=$self->getfile(shift)}
49 <        $self->{File}->url();
50 < }
51 <
52 < sub copydocconfig {
53 <        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());
48 >        if ( @_  ) {
49 >                $self->{File}=$self->getfile(shift);
50 >                $self->verbose("url downloaded to $self->{File}");
51 >        }
52 >        if ( defined $self->{File} ) {
53 >          return $self->{File}->url();
54          }
55 <        else {
204 <          $self->error("Cannot copy basequery - undefined");
205 <        }
206 < }
207 <
208 < sub config {
209 <        my $self=shift;
210 <        @_?$self->{ActiveConfig}=shift
211 <           : $self->{ActiveConfig};
212 < }
213 <
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 <        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(@_);
55 >        else { return "undefined"; }
56   }
57  
58 < sub getfile() {
58 > sub getfile {
59          my $self=shift;
60          my $origurl=shift;
61  
62          my $fileref;
63          my ($url, $file);
64 <        if ( defined $self->option('url_update') ) {
65 <           $self->verbose("Forced download of $origurl");
66 <           ($url, $file)=$self->{urlhandler}->download($origurl);
64 >        if ( 0 ) {
65 >             $self->verbose("Forced download of $origurl");
66 >             ($url, $file)=$self->{switch}->urldownload($origurl);
67          }
68          else {
69 <           ($url, $file)=$self->{urlhandler}->get($origurl);
69 >           $self->verbose("Attempting to get $origurl");
70 >           ($url, $file)=$self->{switch}->urlget($origurl);
71          }
72          # do we already have an appropriate object?
73 <        ($fileref)=$self->config()->find($url);
270 <        #undef $fileref;
73 >        ($fileref)=$self->{dbstore}->find($url);
74          if (  defined $fileref ) {
75           $self->verbose("Found $url in database");
76           $fileref->update();
# Line 276 | Line 79 | sub getfile() {
79           if ( $file eq "" ) {
80             $self->parseerror("Unable to get $origurl");
81           }
82 <         #-- set up a new preprocess file
83 <         print "Making a new file $url----\n";
84 <         $fileref=ActiveDoc::PreProcessedFile->new($self->config());
82 >         # -- set up a new preprocess file
83 >         $self->verbose("Making a new preprocessed file $url");
84 >         $fileref=ActiveDoc::PreProcessedFile->new($self->{cache},
85 >                                                        $self->{dbstore});
86           $fileref->url($url);
87           $fileref->update();
88          }
# Line 290 | Line 94 | sub activatedoc {
94          my $url=shift;
95  
96          # first get a preprocessed copy of the file
97 < #       my $fileob=$self->getfile($url);
97 >        #my $fileob=$self->getfile($url);
98  
99 <        # now parse it for the <DocType> tag
100 <        my $tempdoc=ActiveDoc::ActiveDoc->new($self->config());
101 <        $tempdoc->{urlhandler}=$self->{urlhandler};
102 <        my $fullurl=$tempdoc->url($url);
103 <        $url=$fullurl;
104 <        $tempdoc->{doctypefound}=0;
105 <        $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;
99 >        # now parse it for the <Doc> tag
100 >        my $tempdoc=ActiveDoc::SimpleURLDoc->new($self->{cache});
101 >        my ($doctype,$docversion)=$tempdoc->doctype();
102 >        undef $tempdoc;
103 >        
104 >        if ( ! defined $doctype ) {
105 >          $self->parseerror("No <Doc type=> Specified in ".$url);
106          }
107 +
108          # Set up a new object of the specified type
109 <        eval "require $tempdoc->{docobject}";
109 >        eval "require $doctype";
110          die $@ if $@;
111 <        my $newobj=$tempdoc->{docobject}->new($self->config());
314 <        undef $tempdoc;
111 >        my $newobj=$doctype->new($self->{cache},$self->{dbstore});
112          $newobj->url($url);
113 <        $newobj->_initparse();
113 >        $newobj->parent($self);
114          return $newobj;
115   }
116  
117 < sub _initparse {
117 > sub parent {
118          my $self=shift;
119  
120 <        $self->parse("init");
120 >        @_?$self->{parent}=shift
121 >          :$self->{parent};
122   }
325 # -------- Error Handling and Error services --------------
123  
124 < sub error {
328 <        my $self=shift;
329 <        my $string=shift;
330 <
331 <        die $string."\n";
332 < }
124 > # -------- Error Handling and Error services --------------
125  
126   sub parseerror {
127          my $self=shift;
# Line 347 | Line 139 | sub parseerror {
139          }
140   }
141  
350 sub checktag {
351        my $self=shift;
352        my $tagname=shift;
353        my $hashref=shift;
354        my $param=shift;
355
356        if ( ! exists $$hashref{$param} ) {
357          $self->parseerror("Incomplete Tag <$tagname> : $param required");
358        }
359 }
360
142   sub line {
143          my $self=shift;
144  
# Line 379 | Line 160 | sub file {
160          $self->{File}->file();
161   }
162  
163 < # --------------- Initialisation Methods ---------------------------
163 > sub ProcessFile {
164 >        my $self=shift;
165  
166 < sub init {
385 <        # Dummy Routine - override for derived classes
166 >        return $self->{File}->ProcessedFile();
167   }
168  
388 # ------------------- Tag Routines -----------------------------------
169   #
170 < # Base - for setting url bases
170 > # Delegate all else to the switch
171   #
172 < sub Base_start {
172 > sub AUTOLOAD {
173          my $self=shift;
394        my $name=shift;
395        my $hashref=shift;
174  
175 <        $self->checktag($name, $hashref, 'type' );
176 <        $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 < }
175 >        # dont propogate destroy methods
176 >        return if $AUTOLOAD=~/::DESTROY/;
177  
178 < sub Base_end {
179 <        my $self=shift;
408 <        my $name=shift;
409 <        my $type;
178 >        # remove this package name
179 >        ($name=$AUTOLOAD)=~s/ActiveDoc::ActiveDoc:://;
180  
181 <        if ( $#{$self->{basestack}} == -1 ) {
182 <                $self->parseerror("Parse Error : unmatched </$name>");
413 <        }
414 <        else {
415 <          $type = pop @{$self->{basestack}};
416 <          $self->{urlhandler}->unsetbase($type);
417 <        }
181 >        # pass the message to SimpleDoc
182 >        $self->{switch}->$name(@_);
183   }
184  
185 +
186 + # ------------------- Tag Routines -----------------------------------
187   sub Doc_Start {
188          my $self=shift;
189          my $name=shift;
# Line 428 | Line 195 | sub Doc_Start {
195             $self->{docobject}=$$hashref{'type'};
196          }
197   }
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