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.20 by williamc, Fri Feb 11 14:55:22 2000 UTC vs.
Revision 1.25.2.1.2.3 by williamc, Mon Aug 21 15:32: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
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
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
18		#
19		# -- error methods --
20		# error(string)       : Report an general error to the user
21		# parseerror(string)  : Report an error during parsing a file
22	<	# line()              : Return the current line number of the document
23	<	#                       and the ProcessedFileObj it is in
22	>	# line([linenumber])     : Return the line number of the document
23	>	#                       and the ProcessedFileObj it is in corresponding to the
24	>	#                       supplied number of the expanded document
25	>	#                       If no number supplied - the currentparse number will be #                       used
26
27		package ActiveDoc::ActiveDoc;
28		require 5.004;
29	<	use ActiveDoc::Parse;
46	<	use ActiveDoc::ActiveConfig;
29	>	use ActiveDoc::SimpleURLDoc;
30		use ActiveDoc::PreProcessedFile;
31	<	use ObjectUtilities::StorableObject;
49	<	use URL::URLhandler;
31	>	use Utilities::Verbose;
32
33	<	@ISA = qw(ObjectUtilities::StorableObject);
33	>	@ISA = qw(ActiveDoc::SimpleURLDoc 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
42	<	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	<	my $self=shift;
80	<	# A URL handler per document
81	<	$self->{urlhandler}=URL::URLhandler->new($self->config()->cache());
82	<
83	<	# A default UserInterface
84	<	$self->{userinterface}=ActiveDoc::SimpleUserInterface->new();
85	<	$self->init(@_);
39	>	$self->cache(shift);
40	>	$self->{dbstore}=shift;
41	>	$self->_initdoc(@_);
42	>	#       $self->{switch}=ActiveDoc::SimpleURLDoc->new($self->{cache});
43		return $self;
87	–
88	–	}
89	–
90	–	sub verbose {
91	–	my $self=shift;
92	–	my $string=shift;
93	–
94	–	if ( $self->option('verbose_all') ||
95	–	$self->option('verbose_'.ref($self)) ) {
96	–	print ">".ref($self)." : ".$string."\n";
97	–	}
98	–	}
99	–
100	–	# ----- parse related routines --------------
101	–	sub parse {
102	–	my $self=shift;
103	–	$parselabel=shift;
104	–
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 currentparsename {
121	–	my $self=shift;
122	–	@_?$self->{currentparsename}=shift
123	–	:$self->{currentparsename};
124	–	}
125	–
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);
44		}
45
46		sub url {
47		my $self=shift;
48		# get file & preprocess
49	<	if ( @_  ) {$self->{File}=$self->getfile(shift)}
50	<	$self->{File}->url();
51	<	}
52	<
53	<	sub copydocconfig {
54	<	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 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;
49	>	if ( @_  ) {
50	>	$self->{File}=$self->getfile(shift);
51	>	$self->verbose("url downloaded to $self->{File}");
52	>	}
53	>	if ( defined $self->{File} ) {
54	>	return $self->{File}->url();
55		}
56	+	else { return "undefined"; }
57		}
58
59	<	sub requestoption {
233	<	my $self=shift;
234	<	my $param=shift;
235	<	my $string=shift;
236	<
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	<	sub askuser {
251	<	my $self=shift;
252	<	return $self->userinterface()->askuser(@_);
253	<	}
254	<
255	<	sub getfile() {
59	>	sub getfile {
60		my $self=shift;
61		my $origurl=shift;
62
63		my $fileref;
64		my ($url, $file);
65	<	if ( defined $self->option('url_update') ) {
66	<	$self->verbose("Forced download of $origurl");
67	<	($url, $file)=$self->{urlhandler}->download($origurl);
65	>	if ( 0 ) {
66	>	$self->verbose("Forced download of $origurl");
67	>	($url, $file)=$self->urldownload($origurl);
68		}
69		else {
70	<	($url, $file)=$self->{urlhandler}->get($origurl);
70	>	$self->verbose("Attempting to get $origurl");
71	>	($url, $file)=$self->urlget($origurl);
72		}
73		# do we already have an appropriate object?
74	<	($fileref)=$self->config()->find($url);
270	<	#undef $fileref;
74	>	($fileref)=$self->{dbstore}->find($url);
75		if (  defined $fileref ) {
76		$self->verbose("Found $url in database");
77		$fileref->update();
#	Line 276 | Line 80 | sub getfile() {
80		if ( $file eq "" ) {
81		$self->parseerror("Unable to get $origurl");
82		}
83	<	#-- set up a new preprocess file
84	<	print "Making a new file $url----\n";
85	<	$fileref=ActiveDoc::PreProcessedFile->new($self->config());
83	>	# -- set up a new preprocess file
84	>	$self->verbose("Making a new preprocessed file $url");
85	>	$fileref=ActiveDoc::PreProcessedFile->new($self->{cache},
86	>	$self->{dbstore});
87		$fileref->url($url);
88		$fileref->update();
89		}
#	Line 290 | Line 95 | sub activatedoc {
95		my $url=shift;
96
97		# first get a preprocessed copy of the file
98	<	#       my $fileob=$self->getfile($url);
98	>	my $fileobj=$self->getfile($url);
99
100	<	# now parse it for the <DocType> tag
101	<	my $tempdoc=ActiveDoc::ActiveDoc->new($self->config());
102	<	$tempdoc->{urlhandler}=$self->{urlhandler};
103	<	my $fullurl=$tempdoc->url($url);
104	<	$url=$fullurl;
105	<	$tempdoc->{doctypefound}=0;
106	<	$tempdoc->newparse("doctype");
107	<	$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;
100	>	# now parse it for the <Doc> tag
101	>	my $tempdoc=ActiveDoc::SimpleURLDoc->new($self->{cache});
102	>	$tempdoc->filetoparse($fileobj->ProcessFile());
103	>	my ($doctype,$docversion)=$tempdoc->doctype();
104	>	undef $tempdoc;
105	>
106	>	if ( ! defined $doctype ) {
107	>	$self->parseerror("No <Doc type=> Specified in ".$url);
108		}
109	+	$self->verbose("doctype required is $doctype $docversion");
110	+
111		# Set up a new object of the specified type
112	<	eval "require $tempdoc->{docobject}";
112	>	eval "require $doctype";
113		die $@ if $@;
114	<	my $newobj=$tempdoc->{docobject}->new($self->config());
314	<	undef $tempdoc;
114	>	my $newobj=$doctype->new($self->{cache},$self->{dbstore});
115		$newobj->url($url);
116	<	$newobj->_initparse();
116	>	$newobj->parent($self);
117		return $newobj;
118		}
119
120	<	sub _initparse {
120	>	sub parent {
121		my $self=shift;
122
123	<	$self->parse("init");
123	>	@_?$self->{parent}=shift
124	>	:$self->{parent};
125		}
325	–	# -------- Error Handling and Error services --------------
126
127	<	sub error {
328	<	my $self=shift;
329	<	my $string=shift;
330	<
331	<	die $string."\n";
332	<	}
127	>	# -------- Error Handling and Error services --------------
128
129		sub parseerror {
130		my $self=shift;
#	Line 347 | Line 142 | sub parseerror {
142		}
143		}
144
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	–
145		sub line {
146		my $self=shift;
147	+	my $parseline;
148	+
149	+	if ( @_ ) {
150	+	$parseline=shift;
151	+	}
152	+	else {
153	+	$parseline=$self->{currentparser}->line();
154	+	}
155
156		my ($line, $fileobj)=
157	<	$self->{File}->realline($self->{currentparser}->line());
157	>	$self->{File}->realline($parseline);
158		return ($line, $fileobj);
159		}
160
#	Line 379 | Line 171 | sub file {
171		$self->{File}->file();
172		}
173
174	<	# --------------- Initialisation Methods ---------------------------
174	>	sub ProcessFile {
175	>	my $self=shift;
176
177	<	sub init {
385	<	# Dummy Routine - override for derived classes
177	>	return $self->{File}->ProcessedFile();
178		}
179
388	–	# ------------------- Tag Routines -----------------------------------
180		#
181	<	# Base - for setting url bases
181	>	# Delegate all else to the switch
182		#
183	<	sub Base_start {
184	<	my $self=shift;
394	<	my $name=shift;
395	<	my $hashref=shift;
183	>	#sub AUTOLOAD {
184	>	#        my $self=shift;
185
186	<	$self->checktag($name, $hashref, 'type' );
187	<	$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	<	}
186	>	# dont propogate destroy methods
187	>	#        return if $AUTOLOAD=~/::DESTROY/;
188
189	<	sub Base_end {
190	<	my $self=shift;
408	<	my $name=shift;
409	<	my $type;
189	>	# remove this package name
190	>	#        ($name=$AUTOLOAD)=~s/ActiveDoc::ActiveDoc:://;
191
192	<	if ( $#{$self->{basestack}} == -1 ) {
193	<	$self->parseerror("Parse Error : unmatched </$name>");
194	<	}
414	<	else {
415	<	$type = pop @{$self->{basestack}};
416	<	$self->{urlhandler}->unsetbase($type);
417	<	}
418	<	}
192	>	# pass the message to SimpleDoc
193	>	#        $self->{switch}->$name(@_);
194	>	#}
195
196	+
197	+	# ------------------- Tag Routines -----------------------------------
198		sub Doc_Start {
199		my $self=shift;
200		my $name=shift;
#	Line 428 | Line 206 | sub Doc_Start {
206		$self->{docobject}=$$hashref{'type'};
207		}
208		}
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