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.1 by williamc, Fri Aug 20 09:09:28 1999 UTC vs.
Revision 1.20 by williamc, Fri Feb 11 14:55:22 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, ObjectStoreCont): create a new object based on a file and
11	<	#                                 associate with the given ObjectStoreCont
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
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	>	#
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	>	# 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	>	# getfile(url)  : get a processedfile object given a url
24	>	# activatedoc(url) : Return the object ref for a doc described by the given url
25	>	#                    -- 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
30	>	# 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
36	>	#
37	>	# -- error methods --
38	>	# error(string)       : Report an general error to the user
39	>	# parseerror(string)  : Report an error during parsing a file
40	>	# line()              : Return the current line number of the document
41	>	#                       and the ProcessedFileObj it is in
42	>
43	>	package ActiveDoc::ActiveDoc;
44	>	require 5.004;
45	>	use ActiveDoc::Parse;
46	>	use ActiveDoc::ActiveConfig;
47	>	use ActiveDoc::PreProcessedFile;
48	>	use ObjectUtilities::StorableObject;
49	>	use URL::URLhandler;
50	>
51	>	@ISA = qw(ObjectUtilities::StorableObject);
52	>
53	>	sub new {
54	>	my $class=shift;
55	>	$self={};
56	>	bless $self, $class;
57	>	$self->config(shift);
58	>
59	>	# 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	<	package ActiveDoc;
80	<	use BaseTags;
81	<	use DOChandler;
22	<	use ObjectStoreCont;
79	>	my $self=shift;
80	>	# A URL handler per document
81	>	$self->{urlhandler}=URL::URLhandler->new($self->config()->cache());
82
83	<	@ISA = qw (BaseTags);
83	>	# A default UserInterface
84	>	$self->{userinterface}=ActiveDoc::SimpleUserInterface->new();
85	>	$self->init(@_);
86	>	return $self;
87
88	<	# Initialise
89	<	sub _init {
88	>	}
89	>
90	>	sub verbose {
91		my $self=shift;
92	<	my $OC=shift;
92	>	my $string=shift;
93
94	<	$self->_addurl();
95	<	$self->{OC}=$OC;
96	<	$self->{treenode)=TreeNode->new();
97	<	$self->{includeOS}=$self->{OC}->newStore();
35	<	$self->{dochandler}=DOChandler->new($self->{includeOS});
36	<	# Add the minimal functionality tag - feel free to override
37	<	$self->{tags}->addtag("Include", \&Include_Start, "", "");
94	>	if ( $self->option('verbose_all') ||
95	>	$self->option('verbose_'.ref($self)) ) {
96	>	print ">".ref($self)." : ".$string."\n";
97	>	}
98		}
99
100	<	#
101	<	# Include mechanism
102	<	#
103	<	sub include {
44	<	my $self=shift;
45	<	my $url=shift;
46	<	my $obj;
100	>	# ----- parse related routines --------------
101	>	sub parse {
102	>	my $self=shift;
103	>	$parselabel=shift;
104
105	<	$obj=$self->{dochandler}->newdoc($url);
106	<	# Now Extend our tree
107	<	$self->{treenode}->grow($obj->treenode());
108	<	return $obj;
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 treenode {
120	>	sub currentparsename {
121		my $self=shift;
122	<	return $self->treenode;
122	>	@_?$self->{currentparsename}=shift
123	>	:$self->{currentparsename};
124		}
125
126	<	sub getincludeObjectStore {
127	<	my $self=shift;
128	<	return $self->{includeOS};
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);
179	>	}
180	>
181	>	sub url {
182	>	my $self=shift;
183	>	# get file & preprocess
184	>	if ( @_  ) {$self->{File}=$self->getfile(shift)}
185	>	$self->{File}->url();
186	>	}
187	>
188	>	sub copydocconfig {
189	>	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());
202	>	}
203	>	else {
204	>	$self->error("Cannot copy basequery - undefined");
205	>	}
206		}
207
208	<	sub find($) {
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	<	$self->{treenode}->find($string);
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	<	# ------------------------ Tag Routines ------------------------------
251	<	#
252	<	# A default Include tag
253	<	#
254	<	sub Include_Start {
255	<	my $returnval;
256	<	# Just call the basic - this is only a default wrapper for the
257	<	# <INCLUDE> tag assuming with no futher processing of the DOCObjref
258	<	$returnval=_includetag(@_)
259	<	# dont return anything if its a basic tag
250	>	sub askuser {
251	>	my $self=shift;
252	>	return $self->userinterface()->askuser(@_);
253	>	}
254	>
255	>	sub getfile() {
256	>	my $self=shift;
257	>	my $origurl=shift;
258	>
259	>	my $fileref;
260	>	my ($url, $file);
261	>	if ( defined $self->option('url_update') ) {
262	>	$self->verbose("Forced download of $origurl");
263	>	($url, $file)=$self->{urlhandler}->download($origurl);
264	>	}
265	>	else {
266	>	($url, $file)=$self->{urlhandler}->get($origurl);
267	>	}
268	>	# do we already have an appropriate object?
269	>	($fileref)=$self->config()->find($url);
270	>	#undef $fileref;
271	>	if (  defined $fileref ) {
272	>	$self->verbose("Found $url in database");
273	>	$fileref->update();
274	>	}
275	>	else {
276	>	if ( $file eq "" ) {
277	>	$self->parseerror("Unable to get $origurl");
278	>	}
279	>	#-- set up a new preprocess file
280	>	print "Making a new file $url----\n";
281	>	$fileref=ActiveDoc::PreProcessedFile->new($self->config());
282	>	$fileref->url($url);
283	>	$fileref->update();
284	>	}
285	>	return $fileref;
286	>	}
287	>
288	>	sub activatedoc {
289	>	my $self=shift;
290	>	my $url=shift;
291	>
292	>	# first get a preprocessed copy of the file
293	>	#       my $fileob=$self->getfile($url);
294	>
295	>	# now parse it for the <DocType> tag
296	>	my $tempdoc=ActiveDoc::ActiveDoc->new($self->config());
297	>	$tempdoc->{urlhandler}=$self->{urlhandler};
298	>	my $fullurl=$tempdoc->url($url);
299	>	$url=$fullurl;
300	>	$tempdoc->{doctypefound}=0;
301	>	$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;
309	>	}
310	>	# Set up a new object of the specified type
311	>	eval "require $tempdoc->{docobject}";
312	>	die $@ if $@;
313	>	my $newobj=$tempdoc->{docobject}->new($self->config());
314	>	undef $tempdoc;
315	>	$newobj->url($url);
316	>	$newobj->_initparse();
317	>	return $newobj;
318	>	}
319	>
320	>	sub _initparse {
321	>	my $self=shift;
322	>
323	>	$self->parse("init");
324		}
325	+	# -------- Error Handling and Error services --------------
326	+
327	+	sub error {
328	+	my $self=shift;
329	+	my $string=shift;
330	+
331	+	die $string."\n";
332	+	}
333	+
334	+	sub parseerror {
335	+	my $self=shift;
336	+	my $string=shift;
337
338	<	# ----------------------- Support Routines ---------------------------
338	>	if ( $self->currentparsename() eq "" ) {
339	>	$self->error($string);
340	>	}
341	>	else {
342	>	($line, $file)=$self->line();
343	>	print "Parse Error in ".$file->url().", line ".
344	>	$line."\n";
345	>	print $string."\n";
346	>	exit;
347	>	}
348	>	}
349	>
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	>
361	>	sub line {
362	>	my $self=shift;
363	>
364	>	my ($line, $fileobj)=
365	>	$self->{File}->realline($self->{currentparser}->line());
366	>	return ($line, $fileobj);
367	>	}
368	>
369	>	sub tagstartline {
370	>	my $self=shift;
371	>	my ($line, $fileobj)=$self->{File}->line(
372	>	$self->{currentparser}->tagstartline());
373	>	return ($line, $fileobj);
374	>	}
375	>
376	>	sub file {
377	>	my $self=shift;
378	>
379	>	$self->{File}->file();
380	>	}
381	>
382	>	# --------------- Initialisation Methods ---------------------------
383	>
384	>	sub init {
385	>	# Dummy Routine - override for derived classes
386	>	}
387	>
388	>	# ------------------- Tag Routines -----------------------------------
389		#
390	<	# the real workings of the include tag returns the ref
390	>	# Base - for setting url bases
391		#
392	<	sub _includetag {
392	>	sub Base_start {
393		my $self=shift;
394		my $name=shift;
395		my $hashref=shift;
396
397	<	$self->{switch}->checkparam( $name, "ref");
398	<	$url=$$hashref{'ref'};
399	<	return $self->include($url);
397	>	$self->checktag($name, $hashref, 'type' );
398	>	$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	>	}
405	>
406	>	sub Base_end {
407	>	my $self=shift;
408	>	my $name=shift;
409	>	my $type;
410	>
411	>	if ( $#{$self->{basestack}} == -1 ) {
412	>	$self->parseerror("Parse Error : unmatched </$name>");
413	>	}
414	>	else {
415	>	$type = pop @{$self->{basestack}};
416	>	$self->{urlhandler}->unsetbase($type);
417	>	}
418	>	}
419	>
420	>	sub Doc_Start {
421	>	my $self=shift;
422	>	my $name=shift;
423	>	my $hashref=shift;
424	>
425	>	$self->checktag($name, $hashref, "type");
426	>	$self->{doctypefound}++;
427	>	if ( $self->{doctypefound} == 1 ) { # only take first doctype
428	>	$self->{docobject}=$$hashref{'type'};
429	>	}
430		}
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