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.23 by williamc, Wed Feb 23 14:53:28 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	>	# currentparser() : return the current parser object
25	>	# currentparsename([name]) : get/set current parse name
26	>	# getfile(url)  : get a processedfile object given a url
27	>	# 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
39	>	#
40	>	# -- error methods --
41	>	# error(string)       : Report an general error to the user
42	>	# parseerror(string)  : Report an error during parsing a file
43	>	# line()              : Return the current line number of the document
44	>	#                       and the ProcessedFileObj it is in
45	>	#
46	>	# -- support for inheriting classes
47	>	# _saveactivedoc(filehandle)
48	>	# _restoreactivedoc(filehandle)
49
50		package ActiveDoc::ActiveDoc;
51	<	require 5.001;
52	<	use ActiveDoc::DOChandler;
53	<	use ActiveDoc::TreeNode;
54	<	use ActiveDoc::UserQuery;
55	<	use ObjectStoreCont;
56	<
57	<	@ISA = qw(BaseTags);
58	<
59	<	# Initialise
60	<	sub _init {
61	<	my $self=shift;
62	<	my $DOChandler=shift;
63	<	my $OC=shift;
64	<
65	<	$self->_addurl();
66	<	$self->{urlhandler}->setcache($DOChandler->defaultcache());
67	<	$self->{treenode}=ActiveDoc::TreeNode->new();
68	<	$self->{dochandler}=$DOChandler;
69	<	$self->{UserQuery}=$DOChandler->{UserQuery};
70	<	$self->{tags}->addtag("Use", \&Use_Start, "", "");
71	<	# Add the minimal functionality tag - feel free to override
72	<	$self->{tags}->addtag("Include", \&Include_Start, "", "");
73	<	$self->init();
51	>	require 5.004;
52	>	use ActiveDoc::Parse;
53	>	use ActiveDoc::ActiveConfig;
54	>	use ActiveDoc::PreProcessedFile;
55	>	use ObjectUtilities::StorableObject;
56	>	use URL::URLhandler;
57	>
58	>	@ISA = qw(ObjectUtilities::StorableObject);
59	>
60	>	sub new {
61	>	my $class=shift;
62	>	$self={};
63	>	bless $self, $class;
64	>	$self->config(shift);
65	>
66	>	# have some override options been passed
67	>	if ( @_ ) {
68	>	$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 init {
86	<	# Dummy Routine - override for derrived classes
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(@_);
94	>	return $self;
95	>
96		}
97	<	#
98	<	# use mechanism
99	<	#
100	<	sub include {
101	<	my $self=shift;
102	<	my $url=shift;
103	<	my $linkfile=shift;
104	<	my $filename;
105	<	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;
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	<	sub userinterface {
108	>	# ----- parse related routines --------------
109	>	sub parse {
110		my $self=shift;
111	<	return $self->{dochandler}->{UserInterface};
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	>	print "Cannot parse - file not known\n";
127	>	}
128		}
129
130	<	sub treenode {
130	>	sub currentparsename {
131		my $self=shift;
132	<	return $self->{treenode};
132	>	@_?$self->{currentparsename}=shift
133	>	:$self->{currentparsename};
134		}
135
136	<	sub getincludeObjectStore {
137	<	my $self=shift;
138	<	return $self->{includeOS};
136	>	sub currentparser {
137	>	my $self=shift;
138	>	return $self->{currentparser};
139		}
140
141	<	sub find($) {
141	>
142	>	sub newparse {
143		my $self=shift;
144	<	my $string=shift;
145	<	my $tn;
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	<	$tn=$self->{treenode}->find($string);
179	<	if ( $tn eq "" ) {
180	<	$self->parseerror("Unable to find $string");
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	<	return $tn->associate();
185	>	$self->{parsers}{$parselabel}->addtag(@_);
186		}
187
188	<	sub parseerror {
188	>	sub addurltags {
189		my $self=shift;
190	<	my $string=shift;
190	>	my $parselabel=shift;
191	>
192	>	$self->{parsers}{$parselabel}->
193	>	addtag("Base", \&Base_start, $self, "", $self,
194	>	\&Base_end, $self);
195	>	}
196
197	<	print "Parse Error in $self->{url}, line $self-{switch}->line()\n";
198	<	print $string."\n";
199	<	die;
197	>	sub url {
198	>	my $self=shift;
199	>	# get file & preprocess
200	>	if ( @_  ) {
201	>	$self->{File}=$self->getfile(shift);
202	>	$self->verbose("url downloaded to $self->{File}");
203	>	}
204	>	$self->{File}->url();
205		}
206
207	<	sub checktag {
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;
111	–	my $hashref=shift;
241		my $param=shift;
242	<	my $tagname=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	>	}
264	>	}
265	>	return $par;
266	>	}
267	>
268	>	sub askuser {
269	>	my $self=shift;
270	>	return $self->userinterface()->askuser(@_);
271	>	}
272	>
273	>	sub getfile {
274	>	my $self=shift;
275	>	my $origurl=shift;
276
277	<	if ( ! exists $$hashref{$param} ) {
278	<	$self->parseerror("Incomplete Tag <$tagname> : $param required");
277	>	my $fileref;
278	>	my ($url, $file);
279	>	if ( (defined ($it=$self->option('url_update'))) &&
280	>	( $it eq "1" || $origurl=~/^$it/ )) {
281	>	$self->verbose("Forced download of $origurl");
282	>	($url, $file)=$self->{urlhandler}->download($origurl);
283	>	}
284	>	else {
285	>	$self->verbose("Attempting to get $origurl");
286	>	($url, $file)=$self->{urlhandler}->get($origurl);
287	>	}
288	>	# do we already have an appropriate object?
289	>	($fileref)=$self->config()->find($url);
290	>	#undef $fileref;
291	>	if (  defined $fileref ) {
292	>	$self->verbose("Found $url in database");
293	>	$fileref->update();
294		}
295	+	else {
296	+	if ( $file eq "" ) {
297	+	$self->parseerror("Unable to get $origurl");
298	+	}
299	+	#-- set up a new preprocess file
300	+	$self->verbose("Making a new preprocessed file $url");
301	+	$fileref=ActiveDoc::PreProcessedFile->new($self->config());
302	+	$fileref->url($url);
303	+	$fileref->update();
304	+	}
305	+	return $fileref;
306	+	}
307	+
308	+	sub activatedoc {
309	+	my $self=shift;
310	+	my $url=shift;
311	+
312	+	# first get a preprocessed copy of the file
313	+	#       my $fileob=$self->getfile($url);
314	+
315	+	# now parse it for the <DocType> tag
316	+	my $tempdoc=ActiveDoc::ActiveDoc->new($self->config());
317	+	$tempdoc->{urlhandler}=$self->{urlhandler};
318	+	my $fullurl=$tempdoc->url($url);
319	+	$url=$fullurl;
320	+	$tempdoc->{doctypefound}=0;
321	+	$tempdoc->newparse("doctype");
322	+	$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;
329	+	}
330	+	# Set up a new object of the specified type
331	+	eval "require $tempdoc->{docobject}";
332	+	die $@ if $@;
333	+	my $newobj=$tempdoc->{docobject}->new($self->config());
334	+	undef $tempdoc;
335	+	$newobj->url($url);
336	+	$newobj->parent($self);
337	+	$newobj->_initparse();
338	+	return $newobj;
339	+	}
340	+
341	+	sub parent {
342	+	my $self=shift;
343	+
344	+	@_?$self->{parent}=shift
345	+	:$self->{parent};
346	+	}
347	+
348	+	sub _initparse {
349	+	my $self=shift;
350	+
351	+	$self->parse("init");
352	+	}
353	+	# -------- Error Handling and Error services --------------
354	+
355	+	sub error {
356	+	my $self=shift;
357	+	my $string=shift;
358	+
359	+	die $string."\n";
360	+	}
361	+
362	+	sub parseerror {
363	+	my $self=shift;
364	+	my $string=shift;
365	+
366	+	if ( $self->currentparsename() eq "" ) {
367	+	$self->error($string);
368	+	}
369	+	else {
370	+	($line, $file)=$self->line();
371	+	print "Parse Error in ".$file->url().", line ".
372	+	$line."\n";
373	+	print $string."\n";
374	+	exit;
375	+	}
376	+	}
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	+	}
387	+	}
388	+
389	+	sub line {
390	+	my $self=shift;
391	+
392	+	my ($line, $fileobj)=
393	+	$self->{File}->realline($self->{currentparser}->line());
394	+	return ($line, $fileobj);
395	+	}
396	+
397	+	sub tagstartline {
398	+	my $self=shift;
399	+	my ($line, $fileobj)=$self->{File}->line(
400	+	$self->{currentparser}->tagstartline());
401	+	return ($line, $fileobj);
402	+	}
403	+
404	+	sub file {
405	+	my $self=shift;
406	+
407	+	$self->{File}->file();
408		}
409
410	<	# ------------------------ Tag Routines ------------------------------
410	>	sub ProcessFile {
411	>	my $self=shift;
412	>
413	>	return $self->{File}->ProcessedFile();
414	>	}
415	>
416	>	# --------------- Initialisation Methods ---------------------------
417	>
418	>	sub init {
419	>	# Dummy Routine - override for derived classes
420	>	}
421	>
422	>	# ------------------- Tag Routines -----------------------------------
423		#
424	<	# The Include tag
424	>	# Base - for setting url bases
425		#
426	+	sub Base_start {
427	+	my $self=shift;
428	+	my $name=shift;
429	+	my $hashref=shift;
430	+
431	+	$self->checktag($name, $hashref, 'type' );
432	+	$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	+	}
439	+
440	+	sub Base_end {
441	+	my $self=shift;
442	+	my $name=shift;
443	+	my $type;
444	+
445	+	if ( $#{$self->{basestack}} == -1 ) {
446	+	$self->parseerror("Parse Error : unmatched </$name>");
447	+	}
448	+	else {
449	+	$type = pop @{$self->{basestack}};
450	+	$self->{urlhandler}->unsetbase($type);
451	+	}
452	+	}
453
454	<	sub Include_Start {
454	>	sub Doc_Start {
455		my $self=shift;
456		my $name=shift;
457		my $hashref=shift;
458	+
459	+	$self->checktag($name, $hashref, "type");
460	+	$self->{doctypefound}++;
461	+	if ( $self->{doctypefound} == 1 ) { # only take first doctype
462	+	$self->{docobject}=$$hashref{'type'};
463	+	}
464	+	}
465
466	<	$self->{switch}->checkparam( $name, "ref");
467	<	print "<Include> tag not yet implemented\n";
468	<	#        $self->include($$hashref{'ref'},$$hashref{'linkdoc'});
466	>	sub userinterface {
467	>	my $self=shift;
468	>	@_?$self->{userinterface}=shift
469	>	:$self->{userinterface}
470		}
471
472	<	sub Use_Start {
472	>	sub _saveactivedoc {
473		my $self=shift;
474	<	my $name=shift;
475	<	my $hashref=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	<	print "<Use> tag not yet implemented\n";
483	>	my $url=<$fh>;
484	>	chomp $url;
485	>	$self->url($url);
486		}

Diff Legend

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