src/ActiveDoc/ActiveDoc.pm

#
# ActiveDoc.pm
#
# Originally Written by Christopher Williams
#
# Description
#
# Interface
# ---------
# new()         : A new ActiveDoc object
# config([ActiveConfig]) :    Set up/return Configuration for the document
# url()         : Return/set the docs url - essential
# file()        : Return the local filename of document
# ProcessFile() : Return the filename of PreProcessed document
#
# parent()         : return the object ref of the calling parent
# getfile(url)  : get a processedfile object given a url
# activatedoc(url) : Return the object ref for a doc described by the given url
#                    -- any parse called "init" will also be run
# userinterface()       : Return the defaullt userinterface
# option(var)           : return the value of the option var ( or undef )
#
# addurltags(parse) : add the <base> tags to manage urls to parse
# -- 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::SimpleDoc;
use URL::URLhandler;

@ISA = qw(ActiveDoc::SimpleDoc);

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->verbose("url downloaded to $self->{File}");
        } 
        if ( defined $self->{File} ) {
          return $self->{File}->url();
        }
        else { return "undefined"; }
}

sub config {
        my $self=shift;
        @_?$self->{ActiveConfig}=shift
           : $self->{ActiveConfig};
}

sub getfile {
        my $self=shift;
        my $origurl=shift; 

        my $fileref;
        my ($url, $file);
        if ( (defined ($it=$self->option('url_update'))) &&
                ( $it eq "1" || $origurl=~/^$it/ )) {
             $self->verbose("Forced download of $origurl");
             ($url, $file)=$self->{urlhandler}->download($origurl);
        }
        else {
           $self->verbose("Attempting to get $origurl");
           ($url, $file)=$self->{urlhandler}->get($origurl);
        }
        # do we already have an appropriate object?
        ($fileref)=$self->config()->find($url);
        #undef $fileref;
        if (  defined $fileref ) {
         $self->verbose("Found $url in database");
         $fileref->update();
        }
        else {
         if ( $file eq "" ) {
           $self->parseerror("Unable to get $origurl");
         }
         #-- set up a new preprocess file
         $self->verbose("Making a new preprocessed file $url");
         $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
        my $tempdoc=ActiveDoc::ActiveDoc->new($self->config());
        $tempdoc->{urlhandler}=$self->{urlhandler};
        my $fullurl=$tempdoc->url($url);
        $url=$fullurl;
        $tempdoc->{doctypefound}=0;
        $tempdoc->newparse("doctype");
        $tempdoc->addtag("doctype","Doc", \&Doc_Start, $tempdoc,
                                          "", $tempdoc, "", $tempdoc);
        $tempdoc->parse("doctype");

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

sub parent {
        my $self=shift;

        @_?$self->{parent}=shift
          :$self->{parent};
}

# -------- Error Handling and Error services --------------

sub error {
        my $self=shift;
        my $string=shift;

        die $string."\n";
}

sub parseerror {
        my $self=shift;
        my $string=shift;

        if ( $self->currentparsename() eq "" ) {
                $self->error($string);
        }
        else {
         ($line, $file)=$self->line();
         print "Parse Error in ".$file->url().", line ".
                                        $line."\n";
         print $string."\n";
         exit;
        }
}

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();
}

sub ProcessFile {
        my $self=shift;

        return $self->{File}->ProcessedFile();
}

# --------------- 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 ) {
                $self->parseerror("Parse Error : unmatched </$name>");
        }
        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'};
        }
}
Revision:	1.25.2.1
Committed:	Wed May 17 13:59:42 2000 UTC (25 years ago) by williamc
Content type:	text/plain
Branch:	V0_9branch
CVS Tags:	V0_14_0, V0_12_12_4, V0_12_12_3, V0_12_12_2, V0_12_12_1, V0_12_12_0, PlayGround_0, V0_12_12, V0_12_11, V0_12_9b, V0_12_10, V0_12_9
Branch point for:	HPWbranch
Changes since 1.25:	+5 -254 lines
Log Message:	Add basics of ActiveDoc
#	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.25.2.1	# new() : A new ActiveDoc object
11			# config([ActiveConfig]) : Set up/return Configuration for the document
12	williamc	1.6	# url() : Return/set the docs url - essential
13			# file() : Return the local filename of document
14	williamc	1.21	# ProcessFile() : Return the filename of PreProcessed document
15	williamc	1.6	#
16	williamc	1.21	# parent() : return the object ref of the calling parent
17	williamc	1.6	# getfile(url) : get a processedfile object given a url
18	williamc	1.9	# activatedoc(url) : Return the object ref for a doc described by the given url
19	williamc	1.14	# -- any parse called "init" will also be run
20	williamc	1.10	# userinterface() : Return the defaullt userinterface
21	williamc	1.20	# option(var) : return the value of the option var ( or undef )
22	williamc	1.6	#
23	williamc	1.25.2.1	# addurltags(parse) : add the <base> tags to manage urls to parse
24	williamc	1.6	# -- error methods --
25			# error(string) : Report an general error to the user
26			# parseerror(string) : Report an error during parsing a file
27			# line() : Return the current line number of the document
28			# and the ProcessedFileObj it is in
29	williamc	1.23	#
30	williamc	1.2
31			package ActiveDoc::ActiveDoc;
32	williamc	1.6	require 5.004;
33	williamc	1.25.2.1	use ActiveDoc::SimpleDoc;
34	williamc	1.6	use URL::URLhandler;
35
36	williamc	1.25.2.1	@ISA = qw(ActiveDoc::SimpleDoc);
37	williamc	1.2
38	williamc	1.6	sub addurltags {
39			my $self=shift;
40			my $parselabel=shift;
41
42			$self->{parsers}{$parselabel}->
43			addtag("Base", \&Base_start, $self, "", $self,
44			\&Base_end, $self);
45	williamc	1.1	}
46
47	williamc	1.6	sub url {
48	williamc	1.2	my $self=shift;
49	williamc	1.8	# get file & preprocess
50	williamc	1.21	if ( @_ ) {
51			$self->{File}=$self->getfile(shift);
52			$self->verbose("url downloaded to $self->{File}");
53			}
54	williamc	1.25	if ( defined $self->{File} ) {
55			return $self->{File}->url();
56			}
57			else { return "undefined"; }
58	williamc	1.2	}
59
60	williamc	1.6	sub config {
61	williamc	1.1	my $self=shift;
62	williamc	1.6	@_?$self->{ActiveConfig}=shift
63			: $self->{ActiveConfig};
64			}
65	williamc	1.1
66	williamc	1.22	sub getfile {
67	williamc	1.3	my $self=shift;
68	williamc	1.6	my $origurl=shift;
69
70			my $fileref;
71	williamc	1.20	my ($url, $file);
72	williamc	1.21	if ( (defined ($it=$self->option('url_update'))) &&
73			( $it eq "1" \|\| $origurl=~/^$it/ )) {
74			$self->verbose("Forced download of $origurl");
75			($url, $file)=$self->{urlhandler}->download($origurl);
76	williamc	1.20	}
77			else {
78	williamc	1.21	$self->verbose("Attempting to get $origurl");
79	williamc	1.20	($url, $file)=$self->{urlhandler}->get($origurl);
80			}
81	williamc	1.6	# do we already have an appropriate object?
82	williamc	1.7	($fileref)=$self->config()->find($url);
83			#undef $fileref;
84	williamc	1.6	if ( defined $fileref ) {
85	williamc	1.20	$self->verbose("Found $url in database");
86	williamc	1.6	$fileref->update();
87			}
88			else {
89			if ( $file eq "" ) {
90			$self->parseerror("Unable to get $origurl");
91			}
92			#-- set up a new preprocess file
93	williamc	1.21	$self->verbose("Making a new preprocessed file $url");
94	williamc	1.6	$fileref=ActiveDoc::PreProcessedFile->new($self->config());
95			$fileref->url($url);
96			$fileref->update();
97			}
98			return $fileref;
99	williamc	1.3	}
100
101	williamc	1.9	sub activatedoc {
102			my $self=shift;
103			my $url=shift;
104
105			# first get a preprocessed copy of the file
106	williamc	1.14	# my $fileob=$self->getfile($url);
107	williamc	1.9
108			# now parse it for the <DocType> tag
109	williamc	1.14	my $tempdoc=ActiveDoc::ActiveDoc->new($self->config());
110	williamc	1.16	$tempdoc->{urlhandler}=$self->{urlhandler};
111	williamc	1.17	my $fullurl=$tempdoc->url($url);
112			$url=$fullurl;
113	williamc	1.14	$tempdoc->{doctypefound}=0;
114			$tempdoc->newparse("doctype");
115			$tempdoc->addtag("doctype","Doc", \&Doc_Start, $tempdoc,
116			"", $tempdoc, "", $tempdoc);
117			$tempdoc->parse("doctype");
118	williamc	1.9
119	williamc	1.14	if ( ! defined $tempdoc->{docobject} ) {
120			print "No <Doc type=> Specified in ".$url."\n";
121	williamc	1.9	exit 1;
122			}
123			# Set up a new object of the specified type
124	williamc	1.14	eval "require $tempdoc->{docobject}";
125			die $@ if $@;
126			my $newobj=$tempdoc->{docobject}->new($self->config());
127			undef $tempdoc;
128	williamc	1.10	$newobj->url($url);
129	williamc	1.21	$newobj->parent($self);
130	williamc	1.9	return $newobj;
131			}
132
133	williamc	1.21	sub parent {
134			my $self=shift;
135
136			@_?$self->{parent}=shift
137			:$self->{parent};
138			}
139
140	williamc	1.6	# -------- Error Handling and Error services --------------
141
142	williamc	1.3	sub error {
143	williamc	1.6	my $self=shift;
144			my $string=shift;
145
146			die $string."\n";
147			}
148
149			sub parseerror {
150			my $self=shift;
151			my $string=shift;
152
153	williamc	1.20	if ( $self->currentparsename() eq "" ) {
154	williamc	1.18	$self->error($string);
155			}
156			else {
157			($line, $file)=$self->line();
158			print "Parse Error in ".$file->url().", line ".
159	williamc	1.6	$line."\n";
160	williamc	1.18	print $string."\n";
161	williamc	1.20	exit;
162	williamc	1.18	}
163	williamc	1.6	}
164
165			sub line {
166	williamc	1.7	my $self=shift;
167	williamc	1.9
168	williamc	1.6	my ($line, $fileobj)=
169	williamc	1.9	$self->{File}->realline($self->{currentparser}->line());
170	williamc	1.6	return ($line, $fileobj);
171	williamc	1.7	}
172
173			sub tagstartline {
174			my $self=shift;
175	williamc	1.8	my ($line, $fileobj)=$self->{File}->line(
176	williamc	1.7	$self->{currentparser}->tagstartline());
177			return ($line, $fileobj);
178	williamc	1.3	}
179	williamc	1.6
180			sub file {
181	williamc	1.2	my $self=shift;
182
183	williamc	1.8	$self->{File}->file();
184	williamc	1.21	}
185
186			sub ProcessFile {
187			my $self=shift;
188
189			return $self->{File}->ProcessedFile();
190	williamc	1.2	}
191
192	williamc	1.6	# --------------- Initialisation Methods ---------------------------
193	williamc	1.2
194	williamc	1.6	sub init {
195			# Dummy Routine - override for derived classes
196	williamc	1.1	}
197
198	williamc	1.6	# ------------------- Tag Routines -----------------------------------
199	williamc	1.1	#
200	williamc	1.6	# Base - for setting url bases
201	williamc	1.1	#
202	williamc	1.6	sub Base_start {
203			my $self=shift;
204			my $name=shift;
205			my $hashref=shift;
206	williamc	1.2
207	williamc	1.6	$self->checktag($name, $hashref, 'type' );
208			$self->checktag($name, $hashref, 'base' );
209
210			# Keep track of base tags
211			push @{$self->{basestack}}, $$hashref{"type"};
212			# Set the base
213			$self->{urlhandler}->setbase($$hashref{"type"},$hashref);
214	williamc	1.1	}
215
216	williamc	1.6	sub Base_end {
217			my $self=shift;
218	williamc	1.1	my $name=shift;
219	williamc	1.6	my $type;
220	williamc	1.1
221	williamc	1.6	if ( $#{$self->{basestack}} == -1 ) {
222	williamc	1.19	$self->parseerror("Parse Error : unmatched </$name>");
223	williamc	1.6	}
224			else {
225			$type = pop @{$self->{basestack}};
226			$self->{urlhandler}->unsetbase($type);
227			}
228	williamc	1.9	}
229
230			sub Doc_Start {
231			my $self=shift;
232			my $name=shift;
233			my $hashref=shift;
234
235			$self->checktag($name, $hashref, "type");
236	williamc	1.10	$self->{doctypefound}++;
237			if ( $self->{doctypefound} == 1 ) { # only take first doctype
238			$self->{docobject}=$$hashref{'type'};
239			}
240	williamc	1.1	}