src/ActiveDoc/ActiveDoc.pm

#
# ActiveDoc.pm
#
# Originally Written by Christopher Williams
#
# Description
#
# Interface
# ---------
# new(ActiveConfig[,options])           : A new ActiveDoc object
# url()         : Return/set the docs url - essential
# file()        : Return the local filename of document
# ProcessFile() : Return the filename of PreProcessed document
#
# parse(parselabel): Parse the document file for the given parse level
# parent()         : return the object ref of the calling parent
# 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
# includeparse(local_parsename, objparsename, activedoc) : copy the parse from 
#                                                       one object to another
# currentparser() : return the current parser object
# currentparsename([name]) : get/set current parse name
# 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
# 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
# option(var)           : return the value of the option var ( or undef )
# requestoption("message") : Ask the user to supply a value for an option 
#                            if it dosnt already exist
# askuser(Query)        : send a query object to the userinterface
# verbose(string)       : Print string in verbosity mode
#
# -- 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
#
# -- support for inheriting classes
# _saveactivedoc(filehandle)
# _restoreactivedoc(filehandle)

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

        # have some override options been passed
        if ( @_ ) {
           $self->basequery(shift);
        }
        else {
           # --- is there a starter document?
           my $basedoc=$self->config()->basedoc();
           if ( defined $basedoc ) {
             $self->copydocquery($basedoc);
             $self->verbose("Initialising from $basedoc");
           }
           else {
             $self->error("ActiveDoc Error : No base doc found");
           }
        }
        $self->verbose("New ActiveDoc (".ref($self).") Created");
        $self->_init2();
}

sub _init2 {

        my $self=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;

}

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

        if ( $self->option('verbose_all') || 
                        $self->option('verbose_'.ref($self)) ) {
          print ">".ref($self)."($self) : \n->".$string."\n";
        }
}

# ----- parse related routines --------------
sub parse {
        my $self=shift;
        $parselabel=shift;

        my $file=$self->ProcessFile();
        if ( $file ) {
          if ( exists $self->{parsers}{$parselabel} ) {
            $self->verbose("Parsing $parselabel in file $file");
            $self->{currentparsename}=$parselabel;
            $self->{currentparser}=$self->{parsers}{$parselabel};
            $self->{parsers}{$parselabel}->parse($file,@_);
            delete $self->{currentparser};
            $self->{currentparsename}="";
            $self->verbose("Parse $parselabel Complete");
          }
        }
        else {
          $self->error("Cannot parse $parselabel - file not known");
        }
}

sub currentparsename {
        my $self=shift;
        @_?$self->{currentparsename}=shift
          :(defined $self->{currentparsename}?$self->{currentparsename}:"");
}

sub currentparser {
        my $self=shift;
        return $self->{currentparser};
}


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

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

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

        $self->{parsers}{$parselabel}->cleartags();
}


sub includeparse {
        my $self=shift;
        my $parselabel=shift;
        my $remoteparselabel=shift;
        my $activedoc=shift;

        # Some error trapping
        if ( ! exists $self->{parsers}{$parselabel} ) {
          $self->error("Unknown local parse name specified");
        }
        if ( ! exists $activedoc->{parsers}{$remoteparselabel} ) {
          $self->error("Unknown parse name specified in remote obj $activedoc");
        }

        #
        my $rp=$activedoc->{parsers}{$remoteparselabel};
        $self->{parsers}{$parselabel}->includeparse($rp);
}

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

sub copydocconfig {
        my $self=shift;
        my $ActiveDoc=shift;
        
        $self->config($ActiveDoc->config());

}

sub copydocquery {
        my $self=shift;
        my $ActiveDoc=shift;

        if ( defined $ActiveDoc->basequery() ) {
          $self->basequery($ActiveDoc->basequery());
        }
        else {
          $self->error("Cannot copy basequery - undefined");
        }
}

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

sub basequery {
        my $self=shift;
        @_?$self->{Query}=shift
           :$self->{Query};
}

sub option {
        my $self=shift;
        my $param=shift;
        if ( defined $self->basequery()) {
                return $self->basequery()->getparam($param);
        }
        else {
                return $undef;
        }
}

sub requestoption {
        my $self=shift;
        my $param=shift;
        my $string=shift;

        my $par=undef;
        if ( defined $self->basequery()) {
        $par=$self->basequery()->getparam($param);
        while ( ! defined $par ) {
          $self->basequery()->querytype( $param, "basic");
          $self->basequery()->querymessage( $param, $string);
          $self->userinterface()->askuser($self->basequery());
          $par=$self->basequery()->getparam($param);
        }
        }
        return $par;
}

sub askuser {
        my $self=shift;
        return $self->userinterface()->askuser(@_);
}

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);
        $newobj->_initparse();
        return $newobj;
}

sub parent {
        my $self=shift;

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

sub _initparse {
        my $self=shift;

        $self->parse("init");
}
# -------- 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 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();
}

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'};
        }
}

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

sub _saveactivedoc {
        my $self=shift;
        my $fh=shift;
        print "Storing $self\n";
        print $fh $self->url()."\n";
}

sub _restoreactivedoc {
        my $self=shift;
        my $fh=shift;

        my $url=<$fh>;
        chomp $url;
        $self->url($url);
}
Revision:	1.25
Committed:	Wed Mar 29 09:45:47 2000 UTC (25 years, 1 month ago) by williamc
Content type:	text/plain
Branch:	MAIN
CVS Tags:	ProtoEnd
Branch point for:	V0_9branch
Changes since 1.24:	+4 -1 lines
Log Message:	tweaking
#	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.15	# new(ActiveConfig[,options]) : A new ActiveDoc object
11	williamc	1.6	# url() : Return/set the docs url - essential
12			# file() : Return the local filename of document
13	williamc	1.21	# ProcessFile() : Return the filename of PreProcessed document
14	williamc	1.6	#
15			# parse(parselabel): Parse the document file for the given parse level
16	williamc	1.21	# parent() : return the object ref of the calling parent
17	williamc	1.6	# 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	williamc	1.9	# checktag(tagname, hashref, param) : check for existence of param in
21			# hashref from a tag call
22	williamc	1.12	# includeparse(local_parsename, objparsename, activedoc) : copy the parse from
23			# one object to another
24	williamc	1.23	# currentparser() : return the current parser object
25	williamc	1.12	# currentparsename([name]) : get/set current parse name
26	williamc	1.6	# getfile(url) : get a processedfile object given a url
27	williamc	1.9	# activatedoc(url) : Return the object ref for a doc described by the given url
28	williamc	1.14	# -- any parse called "init" will also be run
29	williamc	1.6	# 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	williamc	1.10	# userinterface() : Return the defaullt userinterface
34	williamc	1.20	# option(var) : return the value of the option var ( or undef )
35	williamc	1.14	# requestoption("message") : Ask the user to supply a value for an option
36			# if it dosnt already exist
37	williamc	1.20	# askuser(Query) : send a query object to the userinterface
38			# verbose(string) : Print string in verbosity mode
39	williamc	1.6	#
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	williamc	1.23	#
46			# -- support for inheriting classes
47			# _saveactivedoc(filehandle)
48			# _restoreactivedoc(filehandle)
49	williamc	1.2
50			package ActiveDoc::ActiveDoc;
51	williamc	1.6	require 5.004;
52			use ActiveDoc::Parse;
53			use ActiveDoc::ActiveConfig;
54			use ActiveDoc::PreProcessedFile;
55	williamc	1.10	use ObjectUtilities::StorableObject;
56	williamc	1.6	use URL::URLhandler;
57
58	williamc	1.10	@ISA = qw(ObjectUtilities::StorableObject);
59	williamc	1.6
60			sub new {
61			my $class=shift;
62			$self={};
63			bless $self, $class;
64			$self->config(shift);
65	williamc	1.14
66	williamc	1.15	# have some override options been passed
67			if ( @_ ) {
68			$self->basequery(shift);
69	williamc	1.14	}
70			else {
71	williamc	1.15	# --- is there a starter document?
72			my $basedoc=$self->config()->basedoc();
73			if ( defined $basedoc ) {
74	williamc	1.21	$self->copydocquery($basedoc);
75	williamc	1.20	$self->verbose("Initialising from $basedoc");
76	williamc	1.15	}
77			else {
78	williamc	1.19	$self->error("ActiveDoc Error : No base doc found");
79	williamc	1.15	}
80	williamc	1.14	}
81	williamc	1.21	$self->verbose("New ActiveDoc (".ref($self).") Created");
82	williamc	1.14	$self->_init2();
83			}
84
85			sub _init2 {
86
87			my $self=shift;
88	williamc	1.6	# A URL handler per document
89			$self->{urlhandler}=URL::URLhandler->new($self->config()->cache());
90
91	williamc	1.10	# A default UserInterface
92	williamc	1.11	$self->{userinterface}=ActiveDoc::SimpleUserInterface->new();
93	williamc	1.6	$self->init(@_);
94			return $self;
95	williamc	1.14
96	williamc	1.6	}
97
98	williamc	1.20	sub verbose {
99			my $self=shift;
100			my $string=shift;
101
102			if ( $self->option('verbose_all') \|\|
103			$self->option('verbose_'.ref($self)) ) {
104	williamc	1.21	print ">".ref($self)."($self) : \n->".$string."\n";
105	williamc	1.20	}
106			}
107
108	williamc	1.6	# ----- parse related routines --------------
109			sub parse {
110			my $self=shift;
111			$parselabel=shift;
112
113	williamc	1.21	my $file=$self->ProcessFile();
114	williamc	1.6	if ( $file ) {
115	williamc	1.14	if ( exists $self->{parsers}{$parselabel} ) {
116	williamc	1.21	$self->verbose("Parsing $parselabel in file $file");
117	williamc	1.14	$self->{currentparsename}=$parselabel;
118			$self->{currentparser}=$self->{parsers}{$parselabel};
119			$self->{parsers}{$parselabel}->parse($file,@_);
120			delete $self->{currentparser};
121			$self->{currentparsename}="";
122	williamc	1.21	$self->verbose("Parse $parselabel Complete");
123	williamc	1.14	}
124	williamc	1.6	}
125			else {
126	williamc	1.24	$self->error("Cannot parse $parselabel - file not known");
127	williamc	1.6	}
128	williamc	1.1	}
129
130	williamc	1.12	sub currentparsename {
131			my $self=shift;
132			@_?$self->{currentparsename}=shift
133	williamc	1.24	:(defined $self->{currentparsename}?$self->{currentparsename}:"");
134	williamc	1.12	}
135
136	williamc	1.23	sub currentparser {
137			my $self=shift;
138			return $self->{currentparser};
139			}
140
141
142	williamc	1.6	sub newparse {
143			my $self=shift;
144			my $parselabel=shift;
145
146			$self->{parsers}{$parselabel}=ActiveDoc::Parse->new();
147			$self->{parsers}{$parselabel}->addignoretags();
148			$self->{parsers}{$parselabel}->addgrouptags();
149	williamc	1.12	}
150
151	williamc	1.13	sub cleartags {
152			my $self=shift;
153			my $parselabel=shift;
154
155			$self->{parsers}{$parselabel}->cleartags();
156			}
157
158
159	williamc	1.12	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	williamc	1.2	}
177	williamc	1.6
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	williamc	1.4	}
185	williamc	1.6	$self->{parsers}{$parselabel}->addtag(@_);
186			}
187	williamc	1.2
188	williamc	1.6	sub addurltags {
189			my $self=shift;
190			my $parselabel=shift;
191
192			$self->{parsers}{$parselabel}->
193			addtag("Base", \&Base_start, $self, "", $self,
194			\&Base_end, $self);
195	williamc	1.1	}
196
197	williamc	1.6	sub url {
198	williamc	1.2	my $self=shift;
199	williamc	1.8	# get file & preprocess
200	williamc	1.21	if ( @_ ) {
201			$self->{File}=$self->getfile(shift);
202			$self->verbose("url downloaded to $self->{File}");
203			}
204	williamc	1.25	if ( defined $self->{File} ) {
205			return $self->{File}->url();
206			}
207			else { return "undefined"; }
208	williamc	1.2	}
209
210	williamc	1.6	sub copydocconfig {
211	williamc	1.1	my $self=shift;
212	williamc	1.6	my $ActiveDoc=shift;
213
214			$self->config($ActiveDoc->config());
215
216	williamc	1.1	}
217
218	williamc	1.6	sub copydocquery {
219			my $self=shift;
220			my $ActiveDoc=shift;
221
222	williamc	1.19	if ( defined $ActiveDoc->basequery() ) {
223			$self->basequery($ActiveDoc->basequery());
224			}
225			else {
226			$self->error("Cannot copy basequery - undefined");
227			}
228	williamc	1.1	}
229
230	williamc	1.6	sub config {
231	williamc	1.1	my $self=shift;
232	williamc	1.6	@_?$self->{ActiveConfig}=shift
233			: $self->{ActiveConfig};
234			}
235	williamc	1.1
236	williamc	1.6	sub basequery {
237			my $self=shift;
238	williamc	1.21	@_?$self->{Query}=shift
239			:$self->{Query};
240	williamc	1.10	}
241
242	williamc	1.14	sub option {
243	williamc	1.10	my $self=shift;
244			my $param=shift;
245	williamc	1.15	if ( defined $self->basequery()) {
246			return $self->basequery()->getparam($param);
247			}
248			else {
249			return $undef;
250			}
251	williamc	1.14	}
252
253			sub requestoption {
254			my $self=shift;
255			my $param=shift;
256			my $string=shift;
257
258	williamc	1.15	my $par=undef;
259			if ( defined $self->basequery()) {
260			$par=$self->basequery()->getparam($param);
261	williamc	1.14	while ( ! defined $par ) {
262			$self->basequery()->querytype( $param, "basic");
263			$self->basequery()->querymessage( $param, $string);
264			$self->userinterface()->askuser($self->basequery());
265	williamc	1.15	$par=$self->basequery()->getparam($param);
266	williamc	1.14	}
267	williamc	1.15	}
268	williamc	1.14	return $par;
269	williamc	1.2	}
270
271	williamc	1.20	sub askuser {
272			my $self=shift;
273			return $self->userinterface()->askuser(@_);
274			}
275
276	williamc	1.22	sub getfile {
277	williamc	1.3	my $self=shift;
278	williamc	1.6	my $origurl=shift;
279
280			my $fileref;
281	williamc	1.20	my ($url, $file);
282	williamc	1.21	if ( (defined ($it=$self->option('url_update'))) &&
283			( $it eq "1" \|\| $origurl=~/^$it/ )) {
284			$self->verbose("Forced download of $origurl");
285			($url, $file)=$self->{urlhandler}->download($origurl);
286	williamc	1.20	}
287			else {
288	williamc	1.21	$self->verbose("Attempting to get $origurl");
289	williamc	1.20	($url, $file)=$self->{urlhandler}->get($origurl);
290			}
291	williamc	1.6	# do we already have an appropriate object?
292	williamc	1.7	($fileref)=$self->config()->find($url);
293			#undef $fileref;
294	williamc	1.6	if ( defined $fileref ) {
295	williamc	1.20	$self->verbose("Found $url in database");
296	williamc	1.6	$fileref->update();
297			}
298			else {
299			if ( $file eq "" ) {
300			$self->parseerror("Unable to get $origurl");
301			}
302			#-- set up a new preprocess file
303	williamc	1.21	$self->verbose("Making a new preprocessed file $url");
304	williamc	1.6	$fileref=ActiveDoc::PreProcessedFile->new($self->config());
305			$fileref->url($url);
306			$fileref->update();
307			}
308			return $fileref;
309	williamc	1.3	}
310
311	williamc	1.9	sub activatedoc {
312			my $self=shift;
313			my $url=shift;
314
315			# first get a preprocessed copy of the file
316	williamc	1.14	# my $fileob=$self->getfile($url);
317	williamc	1.9
318			# now parse it for the <DocType> tag
319	williamc	1.14	my $tempdoc=ActiveDoc::ActiveDoc->new($self->config());
320	williamc	1.16	$tempdoc->{urlhandler}=$self->{urlhandler};
321	williamc	1.17	my $fullurl=$tempdoc->url($url);
322			$url=$fullurl;
323	williamc	1.14	$tempdoc->{doctypefound}=0;
324			$tempdoc->newparse("doctype");
325			$tempdoc->addtag("doctype","Doc", \&Doc_Start, $tempdoc,
326			"", $tempdoc, "", $tempdoc);
327			$tempdoc->parse("doctype");
328	williamc	1.9
329	williamc	1.14	if ( ! defined $tempdoc->{docobject} ) {
330			print "No <Doc type=> Specified in ".$url."\n";
331	williamc	1.9	exit 1;
332			}
333			# Set up a new object of the specified type
334	williamc	1.14	eval "require $tempdoc->{docobject}";
335			die $@ if $@;
336			my $newobj=$tempdoc->{docobject}->new($self->config());
337			undef $tempdoc;
338	williamc	1.10	$newobj->url($url);
339	williamc	1.21	$newobj->parent($self);
340	williamc	1.14	$newobj->_initparse();
341	williamc	1.9	return $newobj;
342			}
343
344	williamc	1.21	sub parent {
345			my $self=shift;
346
347			@_?$self->{parent}=shift
348			:$self->{parent};
349			}
350
351	williamc	1.14	sub _initparse {
352			my $self=shift;
353
354			$self->parse("init");
355			}
356	williamc	1.6	# -------- Error Handling and Error services --------------
357
358	williamc	1.3	sub error {
359	williamc	1.6	my $self=shift;
360			my $string=shift;
361
362			die $string."\n";
363			}
364
365			sub parseerror {
366			my $self=shift;
367			my $string=shift;
368
369	williamc	1.20	if ( $self->currentparsename() eq "" ) {
370	williamc	1.18	$self->error($string);
371			}
372			else {
373			($line, $file)=$self->line();
374			print "Parse Error in ".$file->url().", line ".
375	williamc	1.6	$line."\n";
376	williamc	1.18	print $string."\n";
377	williamc	1.20	exit;
378	williamc	1.18	}
379	williamc	1.6	}
380
381			sub checktag {
382			my $self=shift;
383			my $tagname=shift;
384			my $hashref=shift;
385			my $param=shift;
386	williamc	1.3
387	williamc	1.6	if ( ! exists $$hashref{$param} ) {
388			$self->parseerror("Incomplete Tag <$tagname> : $param required");
389			}
390			}
391	williamc	1.3
392	williamc	1.6	sub line {
393	williamc	1.7	my $self=shift;
394	williamc	1.9
395	williamc	1.6	my ($line, $fileobj)=
396	williamc	1.9	$self->{File}->realline($self->{currentparser}->line());
397	williamc	1.6	return ($line, $fileobj);
398	williamc	1.7	}
399
400			sub tagstartline {
401			my $self=shift;
402	williamc	1.8	my ($line, $fileobj)=$self->{File}->line(
403	williamc	1.7	$self->{currentparser}->tagstartline());
404			return ($line, $fileobj);
405	williamc	1.3	}
406	williamc	1.6
407			sub file {
408	williamc	1.2	my $self=shift;
409
410	williamc	1.8	$self->{File}->file();
411	williamc	1.21	}
412
413			sub ProcessFile {
414			my $self=shift;
415
416			return $self->{File}->ProcessedFile();
417	williamc	1.2	}
418
419	williamc	1.6	# --------------- Initialisation Methods ---------------------------
420	williamc	1.2
421	williamc	1.6	sub init {
422			# Dummy Routine - override for derived classes
423	williamc	1.1	}
424
425	williamc	1.6	# ------------------- Tag Routines -----------------------------------
426	williamc	1.1	#
427	williamc	1.6	# Base - for setting url bases
428	williamc	1.1	#
429	williamc	1.6	sub Base_start {
430			my $self=shift;
431			my $name=shift;
432			my $hashref=shift;
433	williamc	1.2
434	williamc	1.6	$self->checktag($name, $hashref, 'type' );
435			$self->checktag($name, $hashref, 'base' );
436
437			# Keep track of base tags
438			push @{$self->{basestack}}, $$hashref{"type"};
439			# Set the base
440			$self->{urlhandler}->setbase($$hashref{"type"},$hashref);
441	williamc	1.1	}
442
443	williamc	1.6	sub Base_end {
444			my $self=shift;
445	williamc	1.1	my $name=shift;
446	williamc	1.6	my $type;
447	williamc	1.1
448	williamc	1.6	if ( $#{$self->{basestack}} == -1 ) {
449	williamc	1.19	$self->parseerror("Parse Error : unmatched </$name>");
450	williamc	1.6	}
451			else {
452			$type = pop @{$self->{basestack}};
453			$self->{urlhandler}->unsetbase($type);
454			}
455	williamc	1.9	}
456
457			sub Doc_Start {
458			my $self=shift;
459			my $name=shift;
460			my $hashref=shift;
461
462			$self->checktag($name, $hashref, "type");
463	williamc	1.10	$self->{doctypefound}++;
464			if ( $self->{doctypefound} == 1 ) { # only take first doctype
465			$self->{docobject}=$$hashref{'type'};
466			}
467			}
468
469			sub userinterface {
470			my $self=shift;
471			@_?$self->{userinterface}=shift
472			:$self->{userinterface}
473	williamc	1.23	}
474
475			sub _saveactivedoc {
476			my $self=shift;
477			my $fh=shift;
478			print "Storing $self\n";
479			print $fh $self->url()."\n";
480			}
481
482			sub _restoreactivedoc {
483			my $self=shift;
484			my $fh=shift;
485
486			my $url=<$fh>;
487			chomp $url;
488			$self->url($url);
489	williamc	1.1	}