src/ActiveDoc/ActiveDoc.pm

#
# ActiveDoc.pm
#
# Originally Written by Christopher Williams
#
# Description
#
# Interface
# ---------
# new()         : 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
# 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
# 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
# options(var)          : return the value of the option var
#
# -- 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);
        
        # 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 ) {
          $self->{currentparser}=$self->{parsers}{$parselabel};
          $self->{parsers}{$parselabel}->parse($file,@_);
          delete $self->{currentparser};
        }
        else {
          print "Cannot parse - file not known\n";
        }
}

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

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

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 options {
        my $self=shift;
        my $param=shift;
        $self->basequery()->getparam('option_'.$param);
}

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
        $self->{doctypefound}=0;
        $self->newparse("doctype");
        $self->addtag("doctype","Doc", \&Doc_Start, $self,
                                          "", $self, "", $self);
        $self->parse("doctype");

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

# -------- 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
        $self->{urlhandler}->setbase($$hashref{"type"},$hashref);

}

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.11
Committed:	Fri Dec 17 15:29:01 1999 UTC (25 years, 4 months ago) by williamc
Content type:	text/plain
Branch:	MAIN
Changes since 1.10:	+1 -1 lines
Log Message:	change default user interface to SimpleUserInterface
#	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.6	# new() : 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	williamc	1.9	# checktag(tagname, hashref, param) : check for existence of param in
19			# hashref from a tag call
20	williamc	1.6	# newdoc(file) : Return an new object of the appropriate type
21			# getfile(url) : get a processedfile object given a url
22	williamc	1.9	# activatedoc(url) : Return the object ref for a doc described by the given url
23	williamc	1.6	# config([ActiveConfig]) : Set up/return Configuration for the document
24			# basequery([ActiveConfig]) : Set up/return UserQuery for the doc
25			# copydocconfig(ActiveDoc) : Copy the basic configuration from the ActiveDoc
26			# copydocquery(ActiveDoc) : Copy the basicquery from the ActiveDoc
27	williamc	1.10	# userinterface() : Return the defaullt userinterface
28			# options(var) : return the value of the option var
29	williamc	1.6	#
30			# -- error methods --
31			# error(string) : Report an general error to the user
32			# parseerror(string) : Report an error during parsing a file
33			# line() : Return the current line number of the document
34			# and the ProcessedFileObj it is in
35	williamc	1.2
36			package ActiveDoc::ActiveDoc;
37	williamc	1.6	require 5.004;
38			use ActiveDoc::Parse;
39			use ActiveDoc::ActiveConfig;
40			use ActiveDoc::PreProcessedFile;
41	williamc	1.10	use ObjectUtilities::StorableObject;
42	williamc	1.6	use URL::URLhandler;
43
44	williamc	1.10	@ISA = qw(ObjectUtilities::StorableObject);
45	williamc	1.6
46			sub new {
47			my $class=shift;
48			$self={};
49			bless $self, $class;
50			$self->config(shift);
51
52			# A URL handler per document
53			$self->{urlhandler}=URL::URLhandler->new($self->config()->cache());
54
55	williamc	1.10	# A default UserInterface
56	williamc	1.11	$self->{userinterface}=ActiveDoc::SimpleUserInterface->new();
57	williamc	1.6	$self->init(@_);
58			return $self;
59			}
60
61			# ----- parse related routines --------------
62			sub parse {
63			my $self=shift;
64			$parselabel=shift;
65
66			my $file=$self->file();
67			if ( $file ) {
68	williamc	1.7	$self->{currentparser}=$self->{parsers}{$parselabel};
69	williamc	1.6	$self->{parsers}{$parselabel}->parse($file,@_);
70	williamc	1.7	delete $self->{currentparser};
71	williamc	1.6	}
72			else {
73			print "Cannot parse - file not known\n";
74			}
75	williamc	1.1	}
76
77	williamc	1.6	sub newparse {
78			my $self=shift;
79			my $parselabel=shift;
80
81			$self->{parsers}{$parselabel}=ActiveDoc::Parse->new();
82			$self->{parsers}{$parselabel}->addignoretags();
83			$self->{parsers}{$parselabel}->addgrouptags();
84	williamc	1.2	}
85	williamc	1.6
86			sub addtag {
87			my $self=shift;
88			my $parselabel=shift;
89			if ( $#_ != 6 ) {
90			$self->error("Incorrect addtags specification\n".
91			"called with :\n@_ \n");
92	williamc	1.4	}
93	williamc	1.6	$self->{parsers}{$parselabel}->addtag(@_);
94			}
95	williamc	1.2
96	williamc	1.6	sub addurltags {
97			my $self=shift;
98			my $parselabel=shift;
99
100			$self->{parsers}{$parselabel}->
101			addtag("Base", \&Base_start, $self, "", $self,
102			\&Base_end, $self);
103	williamc	1.1	}
104
105	williamc	1.6	sub url {
106	williamc	1.2	my $self=shift;
107	williamc	1.8	# get file & preprocess
108			if ( @_ ) {$self->{File}=$self->getfile(shift)}
109			$self->{File}->url();
110	williamc	1.2	}
111
112	williamc	1.6	sub copydocconfig {
113	williamc	1.1	my $self=shift;
114	williamc	1.6	my $ActiveDoc=shift;
115
116			$self->config($ActiveDoc->config());
117
118	williamc	1.1	}
119
120	williamc	1.6	sub copydocquery {
121			my $self=shift;
122			my $ActiveDoc=shift;
123
124			$self->basequery($ActiveDoc->basequery());
125	williamc	1.1	}
126
127	williamc	1.6	sub config {
128	williamc	1.1	my $self=shift;
129	williamc	1.6	@_?$self->{ActiveConfig}=shift
130			: $self->{ActiveConfig};
131			}
132	williamc	1.1
133	williamc	1.6	sub basequery {
134			my $self=shift;
135	williamc	1.10	@_ ? $self->{Query}=shift
136			: $self->{Query};
137			}
138
139			sub options {
140			my $self=shift;
141			my $param=shift;
142			$self->basequery()->getparam('option_'.$param);
143	williamc	1.2	}
144
145	williamc	1.6	sub getfile() {
146	williamc	1.3	my $self=shift;
147	williamc	1.6	my $origurl=shift;
148
149			my $fileref;
150			my ($url, $file)=$self->{urlhandler}->get($origurl);
151			# do we already have an appropriate object?
152	williamc	1.7	($fileref)=$self->config()->find($url);
153			#undef $fileref;
154	williamc	1.6	if ( defined $fileref ) {
155			print "found $url in database ----\n";
156			$fileref->update();
157			}
158			else {
159			if ( $file eq "" ) {
160			$self->parseerror("Unable to get $origurl");
161			}
162			#-- set up a new preprocess file
163			print "Making a new file $url----\n";
164			$fileref=ActiveDoc::PreProcessedFile->new($self->config());
165			$fileref->url($url);
166			$fileref->update();
167			}
168			return $fileref;
169	williamc	1.3	}
170
171	williamc	1.9	sub activatedoc {
172			my $self=shift;
173			my $url=shift;
174
175			# first get a preprocessed copy of the file
176			my $fileob=$self->getfile($url);
177
178			# now parse it for the <DocType> tag
179	williamc	1.10	$self->{doctypefound}=0;
180	williamc	1.9	$self->newparse("doctype");
181			$self->addtag("doctype","Doc", \&Doc_Start, $self,
182			"", $self, "", $self);
183			$self->parse("doctype");
184
185			if ( ! defined $self->{docobject} ) {
186			print "No <Doc type=> Specified in ".$fileob->url()."\n";
187			exit 1;
188			}
189			# Set up a new object of the specified type
190			my $newobj=$self->{docobject}->new($self->config());
191	williamc	1.10	$newobj->url($url);
192	williamc	1.9	return $newobj;
193			}
194
195	williamc	1.6	# -------- Error Handling and Error services --------------
196
197	williamc	1.3	sub error {
198	williamc	1.6	my $self=shift;
199			my $string=shift;
200
201			die $string."\n";
202			}
203
204			sub parseerror {
205			my $self=shift;
206			my $string=shift;
207
208			($line, $file)=$self->line();
209			print "Parse Error in ".$file->url().", line ".
210			$line."\n";
211			print $string."\n";
212			die;
213			}
214
215			sub checktag {
216			my $self=shift;
217			my $tagname=shift;
218			my $hashref=shift;
219			my $param=shift;
220	williamc	1.3
221	williamc	1.6	if ( ! exists $$hashref{$param} ) {
222			$self->parseerror("Incomplete Tag <$tagname> : $param required");
223			}
224			}
225	williamc	1.3
226	williamc	1.6	sub line {
227	williamc	1.7	my $self=shift;
228	williamc	1.9
229	williamc	1.6	my ($line, $fileobj)=
230	williamc	1.9	$self->{File}->realline($self->{currentparser}->line());
231	williamc	1.6	return ($line, $fileobj);
232	williamc	1.7	}
233
234			sub tagstartline {
235			my $self=shift;
236	williamc	1.8	my ($line, $fileobj)=$self->{File}->line(
237	williamc	1.7	$self->{currentparser}->tagstartline());
238			return ($line, $fileobj);
239	williamc	1.3	}
240	williamc	1.6
241			sub file {
242	williamc	1.2	my $self=shift;
243
244	williamc	1.8	$self->{File}->file();
245	williamc	1.2	}
246
247	williamc	1.6	# --------------- Initialisation Methods ---------------------------
248	williamc	1.2
249	williamc	1.6	sub init {
250			# Dummy Routine - override for derived classes
251	williamc	1.1	}
252
253	williamc	1.6	# ------------------- Tag Routines -----------------------------------
254	williamc	1.1	#
255	williamc	1.6	# Base - for setting url bases
256	williamc	1.1	#
257	williamc	1.6	sub Base_start {
258			my $self=shift;
259			my $name=shift;
260			my $hashref=shift;
261	williamc	1.2
262	williamc	1.6	$self->checktag($name, $hashref, 'type' );
263			$self->checktag($name, $hashref, 'base' );
264
265			# Keep track of base tags
266			push @{$self->{basestack}}, $$hashref{"type"};
267			# Set the base
268			$self->{urlhandler}->setbase($$hashref{"type"},$hashref);
269	williamc	1.2
270	williamc	1.1	}
271
272	williamc	1.6	sub Base_end {
273			my $self=shift;
274	williamc	1.1	my $name=shift;
275	williamc	1.6	my $type;
276	williamc	1.1
277	williamc	1.6	if ( $#{$self->{basestack}} == -1 ) {
278			print "Parse Error : unmatched </".$name."> on line ".
279			$self->line()."\n";
280			die;
281			}
282			else {
283			$type = pop @{$self->{basestack}};
284			$self->{urlhandler}->unsetbase($type);
285			}
286	williamc	1.9	}
287
288			sub Doc_Start {
289			my $self=shift;
290			my $name=shift;
291			my $hashref=shift;
292
293			$self->checktag($name, $hashref, "type");
294	williamc	1.10	$self->{doctypefound}++;
295			if ( $self->{doctypefound} == 1 ) { # only take first doctype
296			$self->{docobject}=$$hashref{'type'};
297			}
298			}
299
300			sub userinterface {
301			my $self=shift;
302			@_?$self->{userinterface}=shift
303			:$self->{userinterface}
304	williamc	1.1	}