src/ActiveDoc/ActiveDoc.pm

#
# ActiveDoc.pm
#
# Originally Written by Christopher Williams
#
# Description
#
# Interface
# ---------
# new(ActiveConfig[,options])           : A new ActiveDoc object
# url()         : Return/set the docs url - essential
# file()        : Return the local filename of document
#
# parse(parselabel): Parse the document file for the given parse level
# newparse(parselabel) : Create a new parse type
# addtag(parselabel,tagname,start,obj,text,obj,end,obj)
#                               : Add tags to the parse given by label
# checktag(tagname, hashref, param) : check for existence of param in
#                                       hashref from a tag call
# includeparse(local_parsename, objparsename, activedoc) : copy the parse from 
#                                                       one object to another
# currentparsename([name]) : get/set current parse name
# newdoc(file)  : Return an new object of the appropriate type
# getfile(url)  : get a processedfile object given a url
# activatedoc(url) : Return the object ref for a doc described by the given url
#                    -- any parse called "init" will also be run
# config([ActiveConfig]) : Set up/return Configuration for the document
# basequery([ActiveConfig]) : Set up/return UserQuery for the doc
# copydocconfig(ActiveDoc) : Copy the basic configuration from the ActiveDoc
# copydocquery(ActiveDoc) : Copy the basicquery from the ActiveDoc
# userinterface()       : Return the defaullt userinterface
# option(var)           : return the value of the option var
# requestoption("message") : Ask the user to supply a value for an option 
#                            if it dosnt already exist
#
# -- error methods --
# error(string)       : Report an general error to the user
# parseerror(string)  : Report an error during parsing a file
# line()              : Return the current line number of the document
#                       and the ProcessedFileObj it is in

package ActiveDoc::ActiveDoc;
require 5.004;
use ActiveDoc::Parse;
use ActiveDoc::ActiveConfig;
use ActiveDoc::PreProcessedFile;
use ObjectUtilities::StorableObject;
use URL::URLhandler;

@ISA = qw(ObjectUtilities::StorableObject);

sub new {
        my $class=shift;
        $self={};
        bless $self, $class;
        $self->config(shift);

        # have some override options been passed
        if ( @_ ) {
           $self->basequery(shift);
        }
        else {
           # --- is there a starter document?
           my $basedoc=$self->config()->basedoc();
           if ( defined $basedoc ) {
             $self->copydocquery($basedoc);
           }
           else {
             $self->error("Error : No base doc found");
           }
        }
        $self->_init2();
}

sub _init2 {

        my $self=shift;
        # A URL handler per document
        $self->{urlhandler}=URL::URLhandler->new($self->config()->cache());

        # A default UserInterface
        $self->{userinterface}=ActiveDoc::SimpleUserInterface->new();
        $self->init(@_);
        return $self;

}

# ----- parse related routines --------------
sub parse {
        my $self=shift;
        $parselabel=shift;

        my $file=$self->file();
        if ( $file ) {
          if ( exists $self->{parsers}{$parselabel} ) {
            $self->{currentparsename}=$parselabel;
            $self->{currentparser}=$self->{parsers}{$parselabel};
            $self->{parsers}{$parselabel}->parse($file,@_);
            delete $self->{currentparser};
            $self->{currentparsename}="";
          }
        }
        else {
          print "Cannot parse - file not known\n";
        }
}

sub currentparsename {
        my $self=shift;
        @_?$self->{currentparsename}=shift
          :$self->{currentparsename};
}

sub newparse {
        my $self=shift;
        my $parselabel=shift;

        $self->{parsers}{$parselabel}=ActiveDoc::Parse->new();
        $self->{parsers}{$parselabel}->addignoretags();
        $self->{parsers}{$parselabel}->addgrouptags();
}

sub cleartags {
        my $self=shift;
        my $parselabel=shift;

        $self->{parsers}{$parselabel}->cleartags();
}


sub includeparse {
        my $self=shift;
        my $parselabel=shift;
        my $remoteparselabel=shift;
        my $activedoc=shift;

        # Some error trapping
        if ( ! exists $self->{parsers}{$parselabel} ) {
          $self->error("Unknown local parse name specified");
        }
        if ( ! exists $activedoc->{parsers}{$remoteparselabel} ) {
          $self->error("Unknown parse name specified in remote obj $activedoc");
        }

        #
        my $rp=$activedoc->{parsers}{$remoteparselabel};
        $self->{parsers}{$parselabel}->includeparse($rp);
}

sub addtag {
        my $self=shift;
        my $parselabel=shift;
        if ( $#_ != 6 ) {
                $self->error("Incorrect addtags specification\n".
                                "called with :\n@_ \n");
        }
        $self->{parsers}{$parselabel}->addtag(@_);
}

sub addurltags {
        my $self=shift;
        my $parselabel=shift;
        
        $self->{parsers}{$parselabel}->
                addtag("Base", \&Base_start, $self, "", $self,
                        \&Base_end, $self);
}

sub url {
        my $self=shift;
        # get file & preprocess
        if ( @_  ) {$self->{File}=$self->getfile(shift)} 
        $self->{File}->url();
}

sub copydocconfig {
        my $self=shift;
        my $ActiveDoc=shift;
        
        $self->config($ActiveDoc->config());

}

sub copydocquery {
        my $self=shift;
        my $ActiveDoc=shift;

        $self->basequery($ActiveDoc->basequery());
}

sub config {
        my $self=shift;
        @_?$self->{ActiveConfig}=shift
           : $self->{ActiveConfig};
}

sub basequery {
        my $self=shift;
        @_ ? $self->{Query}=shift
           : $self->{Query};
}

sub option {
        my $self=shift;
        my $param=shift;
        if ( defined $self->basequery()) {
                return $self->basequery()->getparam($param);
        }
        else {
                return $undef;
        }
}

sub requestoption {
        my $self=shift;
        my $param=shift;
        my $string=shift;

        my $par=undef;
        if ( defined $self->basequery()) {
        $par=$self->basequery()->getparam($param);
        while ( ! defined $par ) {
          $self->basequery()->querytype( $param, "basic");
          $self->basequery()->querymessage( $param, $string);
          $self->userinterface()->askuser($self->basequery());
          $par=$self->basequery()->getparam($param);
        }
        }
        return $par;
}

sub getfile() {
        my $self=shift;
        my $origurl=shift; 

        my $fileref;
        my ($url, $file)=$self->{urlhandler}->get($origurl);
        # do we already have an appropriate object?
        ($fileref)=$self->config()->find($url);
        #undef $fileref;
        if (  defined $fileref ) {
         print "found $url in database ----\n";
         $fileref->update();
        }
        else {
         if ( $file eq "" ) {
           $self->parseerror("Unable to get $origurl");
         }
         #-- set up a new preprocess file
         print "Making a new file $url----\n";
         $fileref=ActiveDoc::PreProcessedFile->new($self->config());
         $fileref->url($url);
         $fileref->update();
        }
        return $fileref;
}

sub activatedoc {
        my $self=shift;
        my $url=shift;

        # first get a preprocessed copy of the file 
#       my $fileob=$self->getfile($url);

        # now parse it for the <DocType> tag
        my $tempdoc=ActiveDoc::ActiveDoc->new($self->config());
        $tempdoc->url($url);
        $tempdoc->{doctypefound}=0;
        $tempdoc->newparse("doctype");
        $tempdoc->addtag("doctype","Doc", \&Doc_Start, $tempdoc,
                                          "", $tempdoc, "", $tempdoc);
        $tempdoc->parse("doctype");

        if ( ! defined $tempdoc->{docobject} ) {
          print "No <Doc type=> Specified in ".$url."\n";
          exit 1;
        }
        # Set up a new object of the specified type
        eval "require $tempdoc->{docobject}";
        die $@ if $@;
        my $newobj=$tempdoc->{docobject}->new($self->config());
        undef $tempdoc;
        $newobj->url($url);
        $newobj->_initparse();
        return $newobj;
}

sub _initparse {
        my $self=shift;

        $self->parse("init");
}
# -------- Error Handling and Error services --------------

sub error {
        my $self=shift;
        my $string=shift;

        die $string."\n";
}

sub parseerror {
        my $self=shift;
        my $string=shift;

        ($line, $file)=$self->line();
        print "Parse Error in ".$file->url().", line ".
                                        $line."\n";
        print $string."\n";
        die;
}

sub checktag {
        my $self=shift;
        my $tagname=shift;
        my $hashref=shift;
        my $param=shift;

        if ( ! exists $$hashref{$param} ) {
          $self->parseerror("Incomplete Tag <$tagname> : $param required");
        }
}

sub line {
        my $self=shift;

        my ($line, $fileobj)=
                $self->{File}->realline($self->{currentparser}->line());
        return ($line, $fileobj);
}

sub tagstartline {
        my $self=shift;
        my ($line, $fileobj)=$self->{File}->line(
                $self->{currentparser}->tagstartline());
        return ($line, $fileobj);
}

sub file {
        my $self=shift;

        $self->{File}->file();
}

# --------------- Initialisation Methods ---------------------------

sub init {
        # Dummy Routine - override for derived classes
}

# ------------------- Tag Routines -----------------------------------
#
# Base - for setting url bases
#
sub Base_start {
        my $self=shift;
        my $name=shift;
        my $hashref=shift;

        $self->checktag($name, $hashref, 'type' );
        $self->checktag($name, $hashref, 'base' );
       
        # Keep track of base tags
        push @{$self->{basestack}}, $$hashref{"type"};
        # Set the base
        print "BASE SET for ".$$hashref{"type"}."\n";
        $self->{urlhandler}->setbase($$hashref{"type"},$hashref);
        print "BASE SET for ".$$hashref{"type"}."\n";

}

sub Base_end {
        my $self=shift;
        my $name=shift;
        my $type;

        if ( $#{$self->{basestack}} == -1 ) {
                print "Parse Error : unmatched </".$name."> on line ".
                        $self->line()."\n";
                die;
        }
        else {
          $type = pop @{$self->{basestack}};
          $self->{urlhandler}->unsetbase($type);
        }
}

sub Doc_Start {
        my $self=shift;
        my $name=shift;
        my $hashref=shift;
        
        $self->checktag($name, $hashref, "type");
        $self->{doctypefound}++;
        if ( $self->{doctypefound} == 1 ) { # only take first doctype
           $self->{docobject}=$$hashref{'type'};
        }
}

sub userinterface {
        my $self=shift;
        @_?$self->{userinterface}=shift
          :$self->{userinterface}
}
Revision:	1.15
Committed:	Thu Jan 20 18:18:45 2000 UTC (25 years, 3 months ago) by williamc
Content type:	text/plain
Branch:	MAIN
Changes since 1.14:	+25 -9 lines
Log Message:	HIP additions
#	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	# newdoc(file) : Return an new object of the appropriate type
24			# getfile(url) : get a processedfile object given a url
25	williamc	1.9	# activatedoc(url) : Return the object ref for a doc described by the given url
26	williamc	1.14	# -- any parse called "init" will also be run
27	williamc	1.6	# 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
31	williamc	1.10	# userinterface() : Return the defaullt userinterface
32	williamc	1.14	# 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
35	williamc	1.6	#
36			# -- error methods --
37			# error(string) : Report an general error to the user
38			# parseerror(string) : Report an error during parsing a file
39			# line() : Return the current line number of the document
40			# and the ProcessedFileObj it is in
41	williamc	1.2
42			package ActiveDoc::ActiveDoc;
43	williamc	1.6	require 5.004;
44			use ActiveDoc::Parse;
45			use ActiveDoc::ActiveConfig;
46			use ActiveDoc::PreProcessedFile;
47	williamc	1.10	use ObjectUtilities::StorableObject;
48	williamc	1.6	use URL::URLhandler;
49
50	williamc	1.10	@ISA = qw(ObjectUtilities::StorableObject);
51	williamc	1.6
52			sub new {
53			my $class=shift;
54			$self={};
55			bless $self, $class;
56			$self->config(shift);
57	williamc	1.14
58	williamc	1.15	# have some override options been passed
59			if ( @_ ) {
60			$self->basequery(shift);
61	williamc	1.14	}
62			else {
63	williamc	1.15	# --- 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	williamc	1.14	}
72			$self->_init2();
73			}
74
75			sub _init2 {
76
77			my $self=shift;
78	williamc	1.6	# A URL handler per document
79			$self->{urlhandler}=URL::URLhandler->new($self->config()->cache());
80
81	williamc	1.10	# A default UserInterface
82	williamc	1.11	$self->{userinterface}=ActiveDoc::SimpleUserInterface->new();
83	williamc	1.6	$self->init(@_);
84			return $self;
85	williamc	1.14
86	williamc	1.6	}
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	williamc	1.14	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	williamc	1.6	}
103			else {
104			print "Cannot parse - file not known\n";
105			}
106	williamc	1.1	}
107
108	williamc	1.12	sub currentparsename {
109			my $self=shift;
110			@_?$self->{currentparsename}=shift
111			:$self->{currentparsename};
112			}
113
114	williamc	1.6	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	williamc	1.12	}
122
123	williamc	1.13	sub cleartags {
124			my $self=shift;
125			my $parselabel=shift;
126
127			$self->{parsers}{$parselabel}->cleartags();
128			}
129
130
131	williamc	1.12	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	williamc	1.2	}
149	williamc	1.6
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	williamc	1.4	}
157	williamc	1.6	$self->{parsers}{$parselabel}->addtag(@_);
158			}
159	williamc	1.2
160	williamc	1.6	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);
167	williamc	1.1	}
168
169	williamc	1.6	sub url {
170	williamc	1.2	my $self=shift;
171	williamc	1.8	# get file & preprocess
172			if ( @_ ) {$self->{File}=$self->getfile(shift)}
173			$self->{File}->url();
174	williamc	1.2	}
175
176	williamc	1.6	sub copydocconfig {
177	williamc	1.1	my $self=shift;
178	williamc	1.6	my $ActiveDoc=shift;
179
180			$self->config($ActiveDoc->config());
181
182	williamc	1.1	}
183
184	williamc	1.6	sub copydocquery {
185			my $self=shift;
186			my $ActiveDoc=shift;
187
188	williamc	1.14	$self->basequery($ActiveDoc->basequery());
189	williamc	1.1	}
190
191	williamc	1.6	sub config {
192	williamc	1.1	my $self=shift;
193	williamc	1.6	@_?$self->{ActiveConfig}=shift
194			: $self->{ActiveConfig};
195			}
196	williamc	1.1
197	williamc	1.6	sub basequery {
198			my $self=shift;
199	williamc	1.10	@_ ? $self->{Query}=shift
200			: $self->{Query};
201			}
202
203	williamc	1.14	sub option {
204	williamc	1.10	my $self=shift;
205			my $param=shift;
206	williamc	1.15	if ( defined $self->basequery()) {
207			return $self->basequery()->getparam($param);
208			}
209			else {
210			return $undef;
211			}
212	williamc	1.14	}
213
214			sub requestoption {
215			my $self=shift;
216			my $param=shift;
217			my $string=shift;
218
219	williamc	1.15	my $par=undef;
220			if ( defined $self->basequery()) {
221			$par=$self->basequery()->getparam($param);
222	williamc	1.14	while ( ! defined $par ) {
223			$self->basequery()->querytype( $param, "basic");
224			$self->basequery()->querymessage( $param, $string);
225			$self->userinterface()->askuser($self->basequery());
226	williamc	1.15	$par=$self->basequery()->getparam($param);
227	williamc	1.14	}
228	williamc	1.15	}
229	williamc	1.14	return $par;
230	williamc	1.2	}
231
232	williamc	1.6	sub getfile() {
233	williamc	1.3	my $self=shift;
234	williamc	1.6	my $origurl=shift;
235
236			my $fileref;
237			my ($url, $file)=$self->{urlhandler}->get($origurl);
238			# do we already have an appropriate object?
239	williamc	1.7	($fileref)=$self->config()->find($url);
240			#undef $fileref;
241	williamc	1.6	if ( defined $fileref ) {
242			print "found $url in database ----\n";
243			$fileref->update();
244			}
245			else {
246			if ( $file eq "" ) {
247			$self->parseerror("Unable to get $origurl");
248			}
249			#-- set up a new preprocess file
250			print "Making a new file $url----\n";
251			$fileref=ActiveDoc::PreProcessedFile->new($self->config());
252			$fileref->url($url);
253			$fileref->update();
254			}
255			return $fileref;
256	williamc	1.3	}
257
258	williamc	1.9	sub activatedoc {
259			my $self=shift;
260			my $url=shift;
261
262			# first get a preprocessed copy of the file
263	williamc	1.14	# my $fileob=$self->getfile($url);
264	williamc	1.9
265			# now parse it for the <DocType> tag
266	williamc	1.14	my $tempdoc=ActiveDoc::ActiveDoc->new($self->config());
267			$tempdoc->url($url);
268			$tempdoc->{doctypefound}=0;
269			$tempdoc->newparse("doctype");
270			$tempdoc->addtag("doctype","Doc", \&Doc_Start, $tempdoc,
271			"", $tempdoc, "", $tempdoc);
272			$tempdoc->parse("doctype");
273	williamc	1.9
274	williamc	1.14	if ( ! defined $tempdoc->{docobject} ) {
275			print "No <Doc type=> Specified in ".$url."\n";
276	williamc	1.9	exit 1;
277			}
278			# Set up a new object of the specified type
279	williamc	1.14	eval "require $tempdoc->{docobject}";
280			die $@ if $@;
281			my $newobj=$tempdoc->{docobject}->new($self->config());
282			undef $tempdoc;
283	williamc	1.10	$newobj->url($url);
284	williamc	1.14	$newobj->_initparse();
285	williamc	1.9	return $newobj;
286			}
287
288	williamc	1.14	sub _initparse {
289			my $self=shift;
290
291			$self->parse("init");
292			}
293	williamc	1.6	# -------- Error Handling and Error services --------------
294
295	williamc	1.3	sub error {
296	williamc	1.6	my $self=shift;
297			my $string=shift;
298
299			die $string."\n";
300			}
301
302			sub parseerror {
303			my $self=shift;
304			my $string=shift;
305
306			($line, $file)=$self->line();
307			print "Parse Error in ".$file->url().", line ".
308			$line."\n";
309			print $string."\n";
310			die;
311			}
312
313			sub checktag {
314			my $self=shift;
315			my $tagname=shift;
316			my $hashref=shift;
317			my $param=shift;
318	williamc	1.3
319	williamc	1.6	if ( ! exists $$hashref{$param} ) {
320			$self->parseerror("Incomplete Tag <$tagname> : $param required");
321			}
322			}
323	williamc	1.3
324	williamc	1.6	sub line {
325	williamc	1.7	my $self=shift;
326	williamc	1.9
327	williamc	1.6	my ($line, $fileobj)=
328	williamc	1.9	$self->{File}->realline($self->{currentparser}->line());
329	williamc	1.6	return ($line, $fileobj);
330	williamc	1.7	}
331
332			sub tagstartline {
333			my $self=shift;
334	williamc	1.8	my ($line, $fileobj)=$self->{File}->line(
335	williamc	1.7	$self->{currentparser}->tagstartline());
336			return ($line, $fileobj);
337	williamc	1.3	}
338	williamc	1.6
339			sub file {
340	williamc	1.2	my $self=shift;
341
342	williamc	1.8	$self->{File}->file();
343	williamc	1.2	}
344
345	williamc	1.6	# --------------- Initialisation Methods ---------------------------
346	williamc	1.2
347	williamc	1.6	sub init {
348			# Dummy Routine - override for derived classes
349	williamc	1.1	}
350
351	williamc	1.6	# ------------------- Tag Routines -----------------------------------
352	williamc	1.1	#
353	williamc	1.6	# Base - for setting url bases
354	williamc	1.1	#
355	williamc	1.6	sub Base_start {
356			my $self=shift;
357			my $name=shift;
358			my $hashref=shift;
359	williamc	1.2
360	williamc	1.6	$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	williamc	1.15	print "BASE SET for ".$$hashref{"type"}."\n";
367	williamc	1.6	$self->{urlhandler}->setbase($$hashref{"type"},$hashref);
368	williamc	1.15	print "BASE SET for ".$$hashref{"type"}."\n";
369	williamc	1.2
370	williamc	1.1	}
371
372	williamc	1.6	sub Base_end {
373			my $self=shift;
374	williamc	1.1	my $name=shift;
375	williamc	1.6	my $type;
376	williamc	1.1
377	williamc	1.6	if ( $#{$self->{basestack}} == -1 ) {
378			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			}
386	williamc	1.9	}
387
388			sub Doc_Start {
389			my $self=shift;
390			my $name=shift;
391			my $hashref=shift;
392
393			$self->checktag($name, $hashref, "type");
394	williamc	1.10	$self->{doctypefound}++;
395			if ( $self->{doctypefound} == 1 ) { # only take first doctype
396			$self->{docobject}=$$hashref{'type'};
397			}
398			}
399
400			sub userinterface {
401			my $self=shift;
402			@_?$self->{userinterface}=shift
403			:$self->{userinterface}
404	williamc	1.1	}