ViewVC Help

View File | Revision Log | Show Annotations | Root Listing

root/cvsroot/COMP/SCRAM/src/ActiveDoc/ActiveDoc.pm

Comparing COMP/SCRAM/src/ActiveDoc/ActiveDoc.pm (file contents):
Revision 1.2 by williamc, Mon Sep 20 16:27:57 1999 UTC vs.
Revision 1.21 by williamc, Mon Feb 21 14:30:16 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	>	# ProcessFile() : Return the filename of PreProcessed document
14	>	#
15	>	# parse(parselabel): Parse the document file for the given parse level
16	>	# 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	>	# currentparsename([name]) : get/set current parse name
25	>	# getfile(url)  : get a processedfile object given a url
26	>	# activatedoc(url) : Return the object ref for a doc described by the given url
27	>	#                    -- any parse called "init" will also be run
28	>	# config([ActiveConfig]) : Set up/return Configuration for the document
29	>	# basequery([ActiveConfig]) : Set up/return UserQuery for the doc
30	>	# copydocconfig(ActiveDoc) : Copy the basic configuration from the ActiveDoc
31	>	# copydocquery(ActiveDoc) : Copy the basicquery from the ActiveDoc
32	>	# userinterface()       : Return the defaullt userinterface
33	>	# option(var)           : return the value of the option var ( or undef )
34	>	# requestoption("message") : Ask the user to supply a value for an option
35	>	#                            if it dosnt already exist
36	>	# askuser(Query)        : send a query object to the userinterface
37	>	# verbose(string)       : Print string in verbosity mode
38	>	#
39	>	# -- error methods --
40	>	# error(string)       : Report an general error to the user
41	>	# parseerror(string)  : Report an error during parsing a file
42	>	# line()              : Return the current line number of the document
43	>	#                       and the ProcessedFileObj it is in
44
45		package ActiveDoc::ActiveDoc;
46	<	require 5.001;
47	<	use ActiveDoc::DOChandler;
48	<	use ActiveDoc::TreeNode;
49	<	use ActiveDoc::UserQuery;
50	<	use ObjectStoreCont;
51	<
52	<	@ISA = qw(BaseTags);
53	<
54	<	# Initialise
55	<	sub _init {
56	<	my $self=shift;
57	<	my $DOChandler=shift;
58	<	my $OC=shift;
59	<
60	<	$self->_addurl();
61	<	$self->{urlhandler}->setcache($DOChandler->defaultcache());
62	<	$self->{treenode}=ActiveDoc::TreeNode->new();
63	<	$self->{dochandler}=$DOChandler;
64	<	$self->{UserQuery}=$DOChandler->{UserQuery};
65	<	$self->{tags}->addtag("Use", \&Use_Start, "", "");
66	<	# Add the minimal functionality tag - feel free to override
67	<	$self->{tags}->addtag("Include", \&Include_Start, "", "");
68	<	$self->init();
46	>	require 5.004;
47	>	use ActiveDoc::Parse;
48	>	use ActiveDoc::ActiveConfig;
49	>	use ActiveDoc::PreProcessedFile;
50	>	use ObjectUtilities::StorableObject;
51	>	use URL::URLhandler;
52	>
53	>	@ISA = qw(ObjectUtilities::StorableObject);
54	>
55	>	sub new {
56	>	my $class=shift;
57	>	$self={};
58	>	bless $self, $class;
59	>	$self->config(shift);
60	>
61	>	# have some override options been passed
62	>	if ( @_ ) {
63	>	$self->basequery(shift);
64	>	}
65	>	else {
66	>	# --- is there a starter document?
67	>	my $basedoc=$self->config()->basedoc();
68	>	if ( defined $basedoc ) {
69	>	$self->copydocquery($basedoc);
70	>	$self->verbose("Initialising from $basedoc");
71	>	}
72	>	else {
73	>	$self->error("ActiveDoc Error : No base doc found");
74	>	}
75	>	}
76	>	$self->verbose("New ActiveDoc (".ref($self).") Created");
77	>	$self->_init2();
78		}
79
80	<	sub init {
81	<	# Dummy Routine - override for derrived classes
80	>	sub _init2 {
81	>
82	>	my $self=shift;
83	>	# A URL handler per document
84	>	$self->{urlhandler}=URL::URLhandler->new($self->config()->cache());
85	>
86	>	# A default UserInterface
87	>	$self->{userinterface}=ActiveDoc::SimpleUserInterface->new();
88	>	$self->init(@_);
89	>	return $self;
90	>
91		}
92	<	#
93	<	# use mechanism
94	<	#
95	<	sub include {
96	<	my $self=shift;
97	<	my $url=shift;
98	<	my $linkfile=shift;
99	<	my $filename;
100	<	my $obj;
61	<
62	<	$file=$self->{urlhandler}->get($url);
63	<	if ( $linkfile ne "" ) {
64	<	$filename=$file."/".$linkfile;
65	<	}
66	<	$obj=$self->{dochandler}->newdoc($filename);
67	<
68	<	# Now Extend our tree
69	<	$self->{treenode}->grow($obj->treenode());
70	<	return $obj;
92	>
93	>	sub verbose {
94	>	my $self=shift;
95	>	my $string=shift;
96	>
97	>	if ( $self->option('verbose_all') ||
98	>	$self->option('verbose_'.ref($self)) ) {
99	>	print ">".ref($self)."($self) : \n->".$string."\n";
100	>	}
101		}
102
103	<	sub userinterface {
103	>	# ----- parse related routines --------------
104	>	sub parse {
105		my $self=shift;
106	<	return $self->{dochandler}->{UserInterface};
106	>	$parselabel=shift;
107	>
108	>	my $file=$self->ProcessFile();
109	>	if ( $file ) {
110	>	if ( exists $self->{parsers}{$parselabel} ) {
111	>	$self->verbose("Parsing $parselabel in file $file");
112	>	$self->{currentparsename}=$parselabel;
113	>	$self->{currentparser}=$self->{parsers}{$parselabel};
114	>	$self->{parsers}{$parselabel}->parse($file,@_);
115	>	delete $self->{currentparser};
116	>	$self->{currentparsename}="";
117	>	$self->verbose("Parse $parselabel Complete");
118	>	}
119	>	}
120	>	else {
121	>	print "Cannot parse - file not known\n";
122	>	}
123		}
124
125	<	sub treenode {
125	>	sub currentparsename {
126		my $self=shift;
127	<	return $self->{treenode};
127	>	@_?$self->{currentparsename}=shift
128	>	:$self->{currentparsename};
129		}
130
131	<	sub getincludeObjectStore {
132	<	my $self=shift;
133	<	return $self->{includeOS};
131	>	sub newparse {
132	>	my $self=shift;
133	>	my $parselabel=shift;
134	>
135	>	$self->{parsers}{$parselabel}=ActiveDoc::Parse->new();
136	>	$self->{parsers}{$parselabel}->addignoretags();
137	>	$self->{parsers}{$parselabel}->addgrouptags();
138		}
139
140	<	sub find($) {
140	>	sub cleartags {
141		my $self=shift;
142	<	my $string=shift;
91	<	my $tn;
142	>	my $parselabel=shift;
143
144	<	$tn=$self->{treenode}->find($string);
145	<	if ( $tn eq "" ) {
146	<	$self->parseerror("Unable to find $string");
144	>	$self->{parsers}{$parselabel}->cleartags();
145	>	}
146	>
147	>
148	>	sub includeparse {
149	>	my $self=shift;
150	>	my $parselabel=shift;
151	>	my $remoteparselabel=shift;
152	>	my $activedoc=shift;
153	>
154	>	# Some error trapping
155	>	if ( ! exists $self->{parsers}{$parselabel} ) {
156	>	$self->error("Unknown local parse name specified");
157		}
158	<	return $tn->associate();
158	>	if ( ! exists $activedoc->{parsers}{$remoteparselabel} ) {
159	>	$self->error("Unknown parse name specified in remote obj $activedoc");
160	>	}
161	>
162	>	#
163	>	my $rp=$activedoc->{parsers}{$remoteparselabel};
164	>	$self->{parsers}{$parselabel}->includeparse($rp);
165		}
166
167	<	sub parseerror {
167	>	sub addtag {
168		my $self=shift;
169	<	my $string=shift;
169	>	my $parselabel=shift;
170	>	if ( $#_ != 6 ) {
171	>	$self->error("Incorrect addtags specification\n".
172	>	"called with :\n@_ \n");
173	>	}
174	>	$self->{parsers}{$parselabel}->addtag(@_);
175	>	}
176
177	<	print "Parse Error in $self->{url}, line $self-{switch}->line()\n";
178	<	print $string."\n";
179	<	die;
177	>	sub addurltags {
178	>	my $self=shift;
179	>	my $parselabel=shift;
180	>
181	>	$self->{parsers}{$parselabel}->
182	>	addtag("Base", \&Base_start, $self, "", $self,
183	>	\&Base_end, $self);
184		}
185
186	<	sub checktag {
186	>	sub url {
187	>	my $self=shift;
188	>	# get file & preprocess
189	>	if ( @_  ) {
190	>	$self->{File}=$self->getfile(shift);
191	>	$self->verbose("url downloaded to $self->{File}");
192	>	}
193	>	$self->{File}->url();
194	>	}
195	>
196	>	sub copydocconfig {
197	>	my $self=shift;
198	>	my $ActiveDoc=shift;
199	>
200	>	$self->config($ActiveDoc->config());
201	>
202	>	}
203	>
204	>	sub copydocquery {
205	>	my $self=shift;
206	>	my $ActiveDoc=shift;
207	>
208	>	if ( defined $ActiveDoc->basequery() ) {
209	>	$self->basequery($ActiveDoc->basequery());
210	>	}
211	>	else {
212	>	$self->error("Cannot copy basequery - undefined");
213	>	}
214	>	}
215	>
216	>	sub config {
217	>	my $self=shift;
218	>	@_?$self->{ActiveConfig}=shift
219	>	: $self->{ActiveConfig};
220	>	}
221	>
222	>	sub basequery {
223	>	my $self=shift;
224	>	@_?$self->{Query}=shift
225	>	:$self->{Query};
226	>	}
227	>
228	>	sub option {
229		my $self=shift;
111	–	my $hashref=shift;
230		my $param=shift;
231	<	my $tagname=shift;
231	>	if ( defined $self->basequery()) {
232	>	return $self->basequery()->getparam($param);
233	>	}
234	>	else {
235	>	return $undef;
236	>	}
237	>	}
238
239	<	if ( ! exists $$hashref{$param} ) {
240	<	$self->parseerror("Incomplete Tag <$tagname> : $param required");
239	>	sub requestoption {
240	>	my $self=shift;
241	>	my $param=shift;
242	>	my $string=shift;
243	>
244	>	my $par=undef;
245	>	if ( defined $self->basequery()) {
246	>	$par=$self->basequery()->getparam($param);
247	>	while ( ! defined $par ) {
248	>	$self->basequery()->querytype( $param, "basic");
249	>	$self->basequery()->querymessage( $param, $string);
250	>	$self->userinterface()->askuser($self->basequery());
251	>	$par=$self->basequery()->getparam($param);
252	>	}
253		}
254	+	return $par;
255		}
256
257	<	# ------------------------ Tag Routines ------------------------------
258	<	#
259	<	# The Include tag
260	<	#
257	>	sub askuser {
258	>	my $self=shift;
259	>	return $self->userinterface()->askuser(@_);
260	>	}
261
262	<	sub Include_Start {
262	>	sub getfile() {
263		my $self=shift;
264	<	my $name=shift;
128	<	my $hashref=shift;
264	>	my $origurl=shift;
265
266	<	$self->{switch}->checkparam( $name, "ref");
267	<	print "<Include> tag not yet implemented\n";
268	<	#        $self->include($$hashref{'ref'},$$hashref{'linkdoc'});
266	>	my $fileref;
267	>	my ($url, $file);
268	>	if ( (defined ($it=$self->option('url_update'))) &&
269	>	( $it eq "1" || $origurl=~/^$it/ )) {
270	>	$self->verbose("Forced download of $origurl");
271	>	($url, $file)=$self->{urlhandler}->download($origurl);
272	>	}
273	>	else {
274	>	$self->verbose("Attempting to get $origurl");
275	>	($url, $file)=$self->{urlhandler}->get($origurl);
276	>	}
277	>	# do we already have an appropriate object?
278	>	($fileref)=$self->config()->find($url);
279	>	#undef $fileref;
280	>	if (  defined $fileref ) {
281	>	$self->verbose("Found $url in database");
282	>	$fileref->update();
283	>	}
284	>	else {
285	>	if ( $file eq "" ) {
286	>	$self->parseerror("Unable to get $origurl");
287	>	}
288	>	#-- set up a new preprocess file
289	>	$self->verbose("Making a new preprocessed file $url");
290	>	$fileref=ActiveDoc::PreProcessedFile->new($self->config());
291	>	$fileref->url($url);
292	>	$fileref->update();
293	>	}
294	>	return $fileref;
295	>	}
296	>
297	>	sub activatedoc {
298	>	my $self=shift;
299	>	my $url=shift;
300	>
301	>	# first get a preprocessed copy of the file
302	>	#       my $fileob=$self->getfile($url);
303	>
304	>	# now parse it for the <DocType> tag
305	>	my $tempdoc=ActiveDoc::ActiveDoc->new($self->config());
306	>	$tempdoc->{urlhandler}=$self->{urlhandler};
307	>	my $fullurl=$tempdoc->url($url);
308	>	$url=$fullurl;
309	>	$tempdoc->{doctypefound}=0;
310	>	$tempdoc->newparse("doctype");
311	>	$tempdoc->addtag("doctype","Doc", \&Doc_Start, $tempdoc,
312	>	"", $tempdoc, "", $tempdoc);
313	>	$tempdoc->parse("doctype");
314	>
315	>	if ( ! defined $tempdoc->{docobject} ) {
316	>	print "No <Doc type=> Specified in ".$url."\n";
317	>	exit 1;
318	>	}
319	>	# Set up a new object of the specified type
320	>	eval "require $tempdoc->{docobject}";
321	>	die $@ if $@;
322	>	my $newobj=$tempdoc->{docobject}->new($self->config());
323	>	undef $tempdoc;
324	>	$newobj->url($url);
325	>	$newobj->parent($self);
326	>	$newobj->_initparse();
327	>	return $newobj;
328	>	}
329	>
330	>	sub parent {
331	>	my $self=shift;
332	>
333	>	@_?$self->{parent}=shift
334	>	:$self->{parent};
335	>	}
336	>
337	>	sub _initparse {
338	>	my $self=shift;
339	>
340	>	$self->parse("init");
341	>	}
342	>	# -------- Error Handling and Error services --------------
343	>
344	>	sub error {
345	>	my $self=shift;
346	>	my $string=shift;
347	>
348	>	die $string."\n";
349	>	}
350	>
351	>	sub parseerror {
352	>	my $self=shift;
353	>	my $string=shift;
354	>
355	>	if ( $self->currentparsename() eq "" ) {
356	>	$self->error($string);
357	>	}
358	>	else {
359	>	($line, $file)=$self->line();
360	>	print "Parse Error in ".$file->url().", line ".
361	>	$line."\n";
362	>	print $string."\n";
363	>	exit;
364	>	}
365	>	}
366	>
367	>	sub checktag {
368	>	my $self=shift;
369	>	my $tagname=shift;
370	>	my $hashref=shift;
371	>	my $param=shift;
372	>
373	>	if ( ! exists $$hashref{$param} ) {
374	>	$self->parseerror("Incomplete Tag <$tagname> : $param required");
375	>	}
376	>	}
377	>
378	>	sub line {
379	>	my $self=shift;
380	>
381	>	my ($line, $fileobj)=
382	>	$self->{File}->realline($self->{currentparser}->line());
383	>	return ($line, $fileobj);
384	>	}
385	>
386	>	sub tagstartline {
387	>	my $self=shift;
388	>	my ($line, $fileobj)=$self->{File}->line(
389	>	$self->{currentparser}->tagstartline());
390	>	return ($line, $fileobj);
391	>	}
392	>
393	>	sub file {
394	>	my $self=shift;
395	>
396	>	$self->{File}->file();
397		}
398
399	<	sub Use_Start {
399	>	sub ProcessFile {
400		my $self=shift;
401	+
402	+	return $self->{File}->ProcessedFile();
403	+	}
404	+
405	+	# --------------- Initialisation Methods ---------------------------
406	+
407	+	sub init {
408	+	# Dummy Routine - override for derived classes
409	+	}
410	+
411	+	# ------------------- Tag Routines -----------------------------------
412	+	#
413	+	# Base - for setting url bases
414	+	#
415	+	sub Base_start {
416	+	my $self=shift;
417		my $name=shift;
418		my $hashref=shift;
419
420	<	print "<Use> tag not yet implemented\n";
420	>	$self->checktag($name, $hashref, 'type' );
421	>	$self->checktag($name, $hashref, 'base' );
422	>
423	>	# Keep track of base tags
424	>	push @{$self->{basestack}}, $$hashref{"type"};
425	>	# Set the base
426	>	$self->{urlhandler}->setbase($$hashref{"type"},$hashref);
427	>	}
428	>
429	>	sub Base_end {
430	>	my $self=shift;
431	>	my $name=shift;
432	>	my $type;
433	>
434	>	if ( $#{$self->{basestack}} == -1 ) {
435	>	$self->parseerror("Parse Error : unmatched </$name>");
436	>	}
437	>	else {
438	>	$type = pop @{$self->{basestack}};
439	>	$self->{urlhandler}->unsetbase($type);
440	>	}
441	>	}
442	>
443	>	sub Doc_Start {
444	>	my $self=shift;
445	>	my $name=shift;
446	>	my $hashref=shift;
447	>
448	>	$self->checktag($name, $hashref, "type");
449	>	$self->{doctypefound}++;
450	>	if ( $self->{doctypefound} == 1 ) { # only take first doctype
451	>	$self->{docobject}=$$hashref{'type'};
452	>	}
453	>	}
454	>
455	>	sub userinterface {
456	>	my $self=shift;
457	>	@_?$self->{userinterface}=shift
458	>	:$self->{userinterface}
459		}

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines