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.15 by williamc, Thu Jan 20 18:18:45 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
23 < # newdoc(file)  : Return an new object of the appropriate type
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
27 # config([ActiveConfig]) : Set up/return Configuration for the document
28 # basequery([ActiveConfig]) : Set up/return UserQuery for the doc
29 # copydocconfig(ActiveDoc) : Copy the basic configuration from the ActiveDoc
30 # copydocquery(ActiveDoc) : Copy the basicquery from the ActiveDoc
19   # userinterface()       : Return the defaullt userinterface
32 # option(var)           : return the value of the option var
33 # requestoption("message") : Ask the user to supply a value for an option
34 #                            if it dosnt already exist
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;
46 < use ActiveDoc::PreProcessedFile;
47 < use ObjectUtilities::StorableObject;
48 < 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
59 <        if ( @_ ) {
60 <           $self->basequery(shift);
61 <        }
62 <        else {
63 <           # --- is there a starter document?
64 <           my $basedoc=$self->config()->basedoc();
65 <           if ( defined $basedoc ) {
66 <             $self->copydocquery($basedoc);
67 <           }
68 <           else {
69 <             $self->error("Error : No base doc found");
70 <           }
71 <        }
72 <        $self->_init2();
73 < }
74 <
75 < sub _init2 {
76 <
77 <        my $self=shift;
78 <        # A URL handler per document
79 <        $self->{urlhandler}=URL::URLhandler->new($self->config()->cache());
80 <
81 <        # A default UserInterface
82 <        $self->{userinterface}=ActiveDoc::SimpleUserInterface->new();
83 <        $self->init(@_);
39 >        $self->{cache}=shift;
40 >        $self->{dbstore}=shift;
41 >        $self->{switch}=ActiveDoc::SimpleURLDoc->new($self->{cache});
42          return $self;
85
86 }
87
88 # ----- parse related routines --------------
89 sub parse {
90        my $self=shift;
91        $parselabel=shift;
92
93        my $file=$self->file();
94        if ( $file ) {
95          if ( exists $self->{parsers}{$parselabel} ) {
96            $self->{currentparsename}=$parselabel;
97            $self->{currentparser}=$self->{parsers}{$parselabel};
98            $self->{parsers}{$parselabel}->parse($file,@_);
99            delete $self->{currentparser};
100            $self->{currentparsename}="";
101          }
102        }
103        else {
104          print "Cannot parse - file not known\n";
105        }
106 }
107
108 sub currentparsename {
109        my $self=shift;
110        @_?$self->{currentparsename}=shift
111          :$self->{currentparsename};
112 }
113
114 sub newparse {
115        my $self=shift;
116        my $parselabel=shift;
117
118        $self->{parsers}{$parselabel}=ActiveDoc::Parse->new();
119        $self->{parsers}{$parselabel}->addignoretags();
120        $self->{parsers}{$parselabel}->addgrouptags();
121 }
122
123 sub cleartags {
124        my $self=shift;
125        my $parselabel=shift;
126
127        $self->{parsers}{$parselabel}->cleartags();
128 }
129
130
131 sub includeparse {
132        my $self=shift;
133        my $parselabel=shift;
134        my $remoteparselabel=shift;
135        my $activedoc=shift;
136
137        # Some error trapping
138        if ( ! exists $self->{parsers}{$parselabel} ) {
139          $self->error("Unknown local parse name specified");
140        }
141        if ( ! exists $activedoc->{parsers}{$remoteparselabel} ) {
142          $self->error("Unknown parse name specified in remote obj $activedoc");
143        }
144
145        #
146        my $rp=$activedoc->{parsers}{$remoteparselabel};
147        $self->{parsers}{$parselabel}->includeparse($rp);
148 }
149
150 sub addtag {
151        my $self=shift;
152        my $parselabel=shift;
153        if ( $#_ != 6 ) {
154                $self->error("Incorrect addtags specification\n".
155                                "called with :\n@_ \n");
156        }
157        $self->{parsers}{$parselabel}->addtag(@_);
158 }
159
160 sub addurltags {
161        my $self=shift;
162        my $parselabel=shift;
163        
164        $self->{parsers}{$parselabel}->
165                addtag("Base", \&Base_start, $self, "", $self,
166                        \&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;
178 <        my $ActiveDoc=shift;
179 <        
180 <        $self->config($ActiveDoc->config());
181 <
182 < }
183 <
184 < sub copydocquery {
185 <        my $self=shift;
186 <        my $ActiveDoc=shift;
187 <
188 <        $self->basequery($ActiveDoc->basequery());
189 < }
190 <
191 < sub config {
192 <        my $self=shift;
193 <        @_?$self->{ActiveConfig}=shift
194 <           : $self->{ActiveConfig};
195 < }
196 <
197 < sub basequery {
198 <        my $self=shift;
199 <        @_ ? $self->{Query}=shift
200 <           : $self->{Query};
201 < }
202 <
203 < sub option {
204 <        my $self=shift;
205 <        my $param=shift;
206 <        if ( defined $self->basequery()) {
207 <                return $self->basequery()->getparam($param);
208 <        }
209 <        else {
210 <                return $undef;
211 <        }
212 < }
213 <
214 < sub requestoption {
215 <        my $self=shift;
216 <        my $param=shift;
217 <        my $string=shift;
218 <
219 <        my $par=undef;
220 <        if ( defined $self->basequery()) {
221 <        $par=$self->basequery()->getparam($param);
222 <        while ( ! defined $par ) {
223 <          $self->basequery()->querytype( $param, "basic");
224 <          $self->basequery()->querymessage( $param, $string);
225 <          $self->userinterface()->askuser($self->basequery());
226 <          $par=$self->basequery()->getparam($param);
227 <        }
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 <        return $par;
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)=$self->{urlhandler}->get($origurl);
63 >        my ($url, $file);
64 >        if ( 0 ) {
65 >             $self->verbose("Forced download of $origurl");
66 >             ($url, $file)=$self->{switch}->urldownload($origurl);
67 >        }
68 >        else {
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);
240 <        #undef $fileref;
73 >        ($fileref)=$self->{dbstore}->find($url);
74          if (  defined $fileref ) {
75 <         print "found $url in database ----\n";
75 >         $self->verbose("Found $url in database");
76           $fileref->update();
77          }
78          else {
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 260 | 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->url($url);
102 <        $tempdoc->{doctypefound}=0;
103 <        $tempdoc->newparse("doctype");
104 <        $tempdoc->addtag("doctype","Doc", \&Doc_Start, $tempdoc,
105 <                                          "", $tempdoc, "", $tempdoc);
272 <        $tempdoc->parse("doctype");
273 <
274 <        if ( ! defined $tempdoc->{docobject} ) {
275 <          print "No <Doc type=> Specified in ".$url."\n";
276 <          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());
282 <        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   }
293 # -------- Error Handling and Error services --------------
123  
124 < sub error {
296 <        my $self=shift;
297 <        my $string=shift;
298 <
299 <        die $string."\n";
300 < }
124 > # -------- Error Handling and Error services --------------
125  
126   sub parseerror {
127          my $self=shift;
128          my $string=shift;
129  
130 <        ($line, $file)=$self->line();
131 <        print "Parse Error in ".$file->url().", line ".
130 >        if ( $self->currentparsename() eq "" ) {
131 >                $self->error($string);
132 >        }
133 >        else {
134 >         ($line, $file)=$self->line();
135 >         print "Parse Error in ".$file->url().", line ".
136                                          $line."\n";
137 <        print $string."\n";
138 <        die;
139 < }
312 <
313 < sub checktag {
314 <        my $self=shift;
315 <        my $tagname=shift;
316 <        my $hashref=shift;
317 <        my $param=shift;
318 <
319 <        if ( ! exists $$hashref{$param} ) {
320 <          $self->parseerror("Incomplete Tag <$tagname> : $param required");
321 <        }
137 >         print $string."\n";
138 >         exit;
139 >        }
140   }
141  
142   sub line {
# Line 342 | Line 160 | sub file {
160          $self->{File}->file();
161   }
162  
163 < # --------------- Initialisation Methods ---------------------------
163 > sub ProcessFile {
164 >        my $self=shift;
165  
166 < sub init {
348 <        # Dummy Routine - override for derived classes
166 >        return $self->{File}->ProcessedFile();
167   }
168  
351 # ------------------- 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;
357        my $name=shift;
358        my $hashref=shift;
359
360        $self->checktag($name, $hashref, 'type' );
361        $self->checktag($name, $hashref, 'base' );
362      
363        # Keep track of base tags
364        push @{$self->{basestack}}, $$hashref{"type"};
365        # Set the base
366        print "BASE SET for ".$$hashref{"type"}."\n";
367        $self->{urlhandler}->setbase($$hashref{"type"},$hashref);
368        print "BASE SET for ".$$hashref{"type"}."\n";
174  
175 < }
175 >        # dont propogate destroy methods
176 >        return if $AUTOLOAD=~/::DESTROY/;
177  
178 < sub Base_end {
179 <        my $self=shift;
374 <        my $name=shift;
375 <        my $type;
178 >        # remove this package name
179 >        ($name=$AUTOLOAD)=~s/ActiveDoc::ActiveDoc:://;
180  
181 <        if ( $#{$self->{basestack}} == -1 ) {
182 <                print "Parse Error : unmatched </".$name."> on line ".
379 <                        $self->line()."\n";
380 <                die;
381 <        }
382 <        else {
383 <          $type = pop @{$self->{basestack}};
384 <          $self->{urlhandler}->unsetbase($type);
385 <        }
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 396 | Line 195 | sub Doc_Start {
195             $self->{docobject}=$$hashref{'type'};
196          }
197   }
399
400 sub userinterface {
401        my $self=shift;
402        @_?$self->{userinterface}=shift
403          :$self->{userinterface}
404 }

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines