ViewVC Help

View File | Revision Log | Show Annotations | Root Listing

root/cvsroot/COMP/SCRAM/src/ActiveDoc/SimpleXMLDoc.pm

Comparing COMP/SCRAM/src/ActiveDoc/SimpleXMLDoc.pm (file contents):
Revision 1.1 by sashby, Thu Apr 28 09:17:21 2005 UTC vs.
Revision 1.4 by sashby, Thu Jan 19 17:26:29 2006 UTC

#	Line 9 | Line 9
9		# Copyright: 2005 (C) Shaun Ashby
10		#
11		#--------------------------------------------------------------------
12	+
13	+	=head1 NAME
14	+
15	+	ActiveDoc::SimpleXMLDoc - Base SCRAM document class.
16	+
17	+	=head1 SYNOPSIS
18	+
19	+	my $obj = ActiveDoc::SimpleXMLDoc->new();
20	+
21	+	=head1 DESCRIPTION
22	+
23	+	The ActiveDoc::SimpleXMLDoc class is the base class for all SCRAM documents. It hides all the
24	+	machinery needed to activate full XML parsing. The XML parser used is XML::Parser::Expat.
25	+
26	+	=head1 METHODS
27	+
28	+	=over
29	+
30	+	=cut
31	+
32		package ActiveDoc::SimpleXMLDoc;
33	+	use XML::Parser::Expat;
34	+	use ActiveDoc::Container;
35		require 5.004;
36		use Exporter;
15	–	use XML::Parser::Expat;
37
38		@ISA=qw(Exporter);
39	<	@EXPORT_OK=qw( );
39	>	@EXPORT_OK=qw();
40
41		sub new()
21	–	###############################################################
22	–	# new                                                         #
23	–	###############################################################
24	–	# modified : Fri Apr 22 17:10:10 2005 / SFA                   #
25	–	# params   :                                                  #
26	–	#          :                                                  #
27	–	# function :                                                  #
28	–	#          :                                                  #
29	–	###############################################################
30	–	{
31	–	my $proto=shift;
32	–	my $class=ref($proto) || $proto;
33	–	my $self={};
34	–	my ($start, $end, $char, $context)=@_;
35	–	bless $self,$class;
36	–
37	–	$self->{CONTEXT}=$context;
38	–	$self->{DEFAULT_HANDLERS}=[ $start, $end, $char ];
39	–	$self->{FUNCTIONDB}={};
40	–	$self->{ATTRIBUTEDB}={};
41	–	$self->{nested} = [];
42	–
43	–	$self->_initxmlparser();
44	–
45	–	return $self;
46	–	}
47	–
48	–	sub _initxmlparser()
49	–	{
50	–	my $self=shift;
51	–	$self->{xmlparser} = new XML::Parser::Expat;
52	–	}
53	–
54	–	sub setHandlers()
42		{
43	<	my $self=shift;
44	<	my ($start, $end, $char)=@_;
43	>	###############################################################
44	>	# new                                                         #
45	>	###############################################################
46	>	# modified : Fri Apr 22 17:10:10 2005 / SFA                   #
47	>	# params   :                                                  #
48	>	#          :                                                  #
49	>	# function :                                                  #
50	>	#          :                                                  #
51	>	###############################################################
52	>	my $proto=shift;
53	>	my $class=ref($proto) || $proto;
54	>	my $self={};
55	>	bless $self,$class;
56	>	my @handler_list=('Start','End','Char','Proc','Comment',
57	>	'Entity','Element','Attlist','Doctype','DoctypeFin'); # DTD handlers
58
59	<	# Add the recognised XML tag handlers:
60	<	$self->{xmlparser}->setHandlers('Start' => $self->{DEFAULT_HANDLERS}->[0],
61	<	'End'   => $self->{DEFAULT_HANDLERS}->[1],
62	<	'Char'  => $self->{DEFAULT_HANDLERS}->[2]);
63	<	}
59	>	my ($context, @userhandlers)=@_;
60	>
61	>	$CONTAINER=new ActiveDoc::Container; # The base container;
62	>
63	>	# Set the default handlers:
64	>	$self->{DEFAULT_HANDLERS}={ 'Start' => \&open_, 'End' => \&close_,
65	>	'Char'  => \&char_, 'Proc'  => \&proc_,
66	>	'Comment' => \&comment_,
67	>	'Entity' => \&entity_,
68	>	'Element' => \&element_,
69	>	'Attlist' => \&attlist_,
70	>	'Doctype' => \&doctype_,
71	>	'DoctypeFin' => \&doctypefin_ };
72	>
73	>	# Check each supplied handler. If there's a code ref, we override the
74	>	# default handler given in this package:
75	>	my $i;
76	>	for ($i = 0; $i <= $#userhandlers; $i++)
77	>	{
78	>	if (ref($userhandlers[$i]) eq 'CODE')
79	>	{
80	>	$self->{DEFAULT_HANDLERS}->{$handler_list[$i]} = $userhandlers[$i];
81	>	}
82	>	}
83	>
84	>	$self->{CONTEXT}=$context;
85
86	<	sub registerTag()
87	<	{
88	<	my $self=shift;
68	<	my ($context,$tagname,$tagfunction,$attributes,$nested)=@_;
69	<	$self->addattributestocontext($context,$tagname,$attributes);
70	<	$self->addtagtocontext($context,$tagname,$tagfunction);
86	>	# Initialise the XML parser:
87	>	$self->{xmlparser} = XML::Parser::Expat->new(ErrorContext => 3,
88	>	ParseParamEnt => 1);
89
90	<	if ($nested)
90	>	# Add the default XML tag handlers:
91	>	foreach my $handler (@handler_list)
92		{
93	<	# Add the name of the tag which is nested:
75	<	$self->nested($tagname);
93	>	$self->{xmlparser}->setHandlers($handler => $self->{DEFAULT_HANDLERS}->{$handler});
94		}
95	+
96	+	return $self;
97		}
98
99	<	sub addtagtocontext()
99	>	sub parse()
100		{
101		my $self=shift;
102	<	my ($context,$tagname,$tagfunction)=@_;
103	<	$self->{FUNCTIONDB}->{$context}->{$tagname} = $tagfunction;
102	>	my ($filename)=@_;
103	>
104	>	if (-f $filename)
105	>	{
106	>	$self->parsefile_($filename);
107	>	# Move the data from the container to {data_} key:
108	>	$self->data();
109	>	}
110	>	else
111	>	{
112	>	# Error: file not found
113	>	die "SCRAM SimpleXMLDoc: File \"".$filename."\" not found! Context label = \"".$self->{CONTEXT}."\"\n";
114	>	}
115		}
116
117	<	sub addattributestocontext()
117	>	sub register_handlers_()
118		{
119	<	my $self=shift;
120	<	my ($context,$tagname,$attributes)=@_;
121	<	return if ($attributes == 0);
122	<	$self->{ATTRIBUTEDB}->{$context}->{$tagname} = $attributes;
119	>	my $self=shift;
120	>	# Register tags to the container class:
121	>	if (@_)
122	>	{
123	>	$CONTAINER->register_handlers_(@_);
124	>	}
125		}
126
127	<	sub parsefile()
127	>	sub parsefile_()
128		{
129		my $self=shift;
130		my ($filename)=@_;
131	<	$self->{xmlparser}->parsefile($filename);
131	>	$self->{xmlparser}->parsefile($filename)
132	>	|| $self->{xmlparser}->xpcroak("SCRAM SimpleDoc XML parse error:");
133		# Clean up:
134		delete $self->{xmlparser};
101	–	delete $self->{FUNCTIONDB};
102	–	delete $self->{DEFAULT_HANDLERS};
135		}
136
137	<	sub gettagfunction()
137	>	sub data()
138		{
139		my $self=shift;
140	<	my ($tagname)=@_;
141	<	# Return the function to be executed for the current tag name
142	<	# in the current context:
143	<	if (exists($self->{FUNCTIONDB}->{$self->{CONTEXT}}->{$tagname}))
140	>	$self->{data_} = $CONTAINER->data_();
141	>	#   return $CONTAINER->data_();
142	>	}
143	>
144	>	# The default handlers:
145	>	sub open_()
146	>	{
147	>	my $xmlparser=shift;
148	>	my ($element, %attributes)=@_;
149	>	$element=~tr[A-Z][a-z];
150	>	# Handle document "doc" tags and load a
151	>	# container class for the document type:
152	>	if ($element eq 'doc')
153		{
154	<	return $self->{FUNCTIONDB}->{$self->{CONTEXT}}->{$tagname};
154	>	if (exists ($attributes{'type'}))
155	>	{
156	>	my $doctype=$attributes{'type'}."::Container";
157	>	eval "require $doctype";
158	>	if ($@)
159	>	{
160	>	print "SCRAM SimpleXMLDoc: Unable to parse the current document because\n";
161	>	print "                    the data container type (=DOCTYPE) is invalid!\n";
162	>	print "\n";
163	>	die $@,"\n";
164	>	}
165	>	# Bless the base container to its real type:
166	>	bless($CONTAINER,$doctype);
167	>	}
168	>	else
169	>	{
170	>	die "SCRAM SimpleXMLDoc: Unable to handle a NULL document type!","\n";
171	>	}
172	>	return;
173		}
174		else
175		{
176	<	die "SCRAM Error: No function registered for tag name \"".$tagname."\" ","\n";
176	>	# Pass the call to the container class. This will use the AUTOLOAD
177	>	# function of the class:
178	>	$CONTAINER->open($element);
179	>	$CONTAINER->$element($element,\%attributes);
180		}
181		}
182
183	<	sub checkattributes()
183	>	sub close_()
184		{
185	<	my $self=shift;
186	<	my ($tagname,$attributes)=@_;
187	<
188	<	# If there's an entry in attributes DB for this element, check
189	<	# that each tag exists in %attributes:
190	<	if (exists($self->{ATTRIBUTEDB}->{$self->{CONTEXT}}->{$tagname}))
129	<	{
130	<	foreach my $param (@{$self->{ATTRIBUTEDB}->{$self->{CONTEXT}}->{$tagname}})
131	<	{
132	<	if ( ! exists($$attributes{$param}))
133	<	{
134	<	die "SCRAM Error: Incomplete Tag <$tagname> : $param required.","\n";
135	<	}
136	<	}
137	<	}
185	>	my $xmlparser=shift;
186	>	my ($element)=@_;
187	>	$element=~tr[A-Z][a-z];
188	>	return if $element eq 'doc';
189	>	# Tell the container that the tag ended:
190	>	$CONTAINER->close($element);
191		}
192
193	<	sub nested()
193	>	sub char_()
194		{
195	<	my $self=shift;
196	<	@_ ? push(@{$self->{nested}},@_)
197	<	: $self->{nested};
195	>	my ($xmlparser, @items) = @_;
196	>	my $string=join("",@items);
197	>	return if ($string !~ /[a-zA-Z0-9_].*/);
198	>	# Push the strings onto the container object, just in case
199	>	# they form part of content for the active tag:
200	>	$CONTAINER->text_($string);
201	>	}
202	>
203	>	sub proc_()
204	>	{
205	>	my ($xmlparser,$target,$data)=@_;
206	>	}
207	>
208	>	sub comment_()
209	>	{
210	>	my ($xmlparser,$string)=@_;
211	>	}
212	>
213	>	# Entity (Parser, Name, Val, Sysid, Pubid, Ndata,IsParam)
214	>	sub entity_()
215	>	{
216	>	my ($xmlparser, $name, $val, $sysid, $pubid, $ndata)=@_;
217	>	}
218	>
219	>	# Element (Parser, Name, Model)
220	>	sub element_()
221	>	{
222	>	my ($xmlparser,$name,$model)=@_;
223	>	}
224	>
225	>	# Attlist (Parser, Elname, Attname, Type, Default, Fixed)
226	>	sub attlist_()
227	>	{
228	>	my ($xmlparser,$element, $attname, $type, $default,$fixed)=@_;
229	>	}
230	>
231	>	# Doctype (Parser, Name, Sysid, Pubid, Internal)
232	>	sub doctype_()
233	>	{
234	>	my ($xmlparser,$name,$sysid,$pubid,$internal)=@_;
235	>	}
236	>
237	>	# DoctypeFin (Parser)
238	>	sub doctypefin_()
239	>	{
240	>	my ($xmlparser)=@_;
241		}
242
243		1;
244	+
245	+	=back
246	+
247	+	=head1 AUTHOR/MAINTAINER
248	+
249	+	Shaun ASHBY
250	+
251	+	=cut
252	+

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines