src/ActiveDoc/SimpleXMLDoc.pm

#____________________________________________________________________ 
# File: SimpleXMLDoc.pm
#____________________________________________________________________ 
#  
# Author: Shaun Ashby <Shaun.Ashby@cern.ch>
# Update: 2005-04-22 17:09:26+0200
# Revision: $Id$ 
#
# Copyright: 2005 (C) Shaun Ashby
#
#--------------------------------------------------------------------

=head1 NAME

ActiveDoc::SimpleXMLDoc - Base SCRAM document class.

=head1 SYNOPSIS

        my $obj = ActiveDoc::SimpleXMLDoc->new();

=head1 DESCRIPTION
   
The ActiveDoc::SimpleXMLDoc class is the base class for all SCRAM documents. It hides all the
machinery needed to activate full XML parsing. The XML parser used is XML::Parser::Expat.

=head1 METHODS

=over

=cut

package ActiveDoc::SimpleXMLDoc;
use XML::Parser::Expat;
use ActiveDoc::Container;
require 5.004;
use Exporter;

@ISA=qw(Exporter);
@EXPORT_OK=qw();

sub new()
   {
   ###############################################################
   # new                                                         #
   ###############################################################
   # modified : Fri Apr 22 17:10:10 2005 / SFA                   #
   # params   :                                                  #
   #          :                                                  #
   # function :                                                  #
   #          :                                                  #
   ###############################################################
   my $proto=shift;
   my $class=ref($proto) || $proto;
   my $self={};
   bless $self,$class;
   my @handler_list=('Start','End','Char','Proc','Comment',
                     'Entity','Element','Attlist','Doctype','DoctypeFin'); # DTD handlers
   
   my ($context, @userhandlers)=@_;
   
   $CONTAINER=new ActiveDoc::Container; # The base container;
   
   # Set the default handlers:
   $self->{DEFAULT_HANDLERS}={ 'Start' => \&open_, 'End' => \&close_,
                               'Char'  => \&char_, 'Proc'  => \&proc_,
                               'Comment' => \&comment_,
                               'Entity' => \&entity_,
                               'Element' => \&element_,
                               'Attlist' => \&attlist_,
                               'Doctype' => \&doctype_,
                               'DoctypeFin' => \&doctypefin_ };
   
   # Check each supplied handler. If there's a code ref, we override the
   # default handler given in this package:
   my $i;
   for ($i = 0; $i <= $#userhandlers; $i++) 
      {
      if (ref($userhandlers[$i]) eq 'CODE')
         {
         $self->{DEFAULT_HANDLERS}->{$handler_list[$i]} = $userhandlers[$i];
         }
      }
   
   $self->{CONTEXT}=$context;

   # Initialise the XML parser:
   $self->{xmlparser} = XML::Parser::Expat->new(ErrorContext => 3,
                                                ParseParamEnt => 1);

   # Add the default XML tag handlers:
   foreach my $handler (@handler_list)
      {
      $self->{xmlparser}->setHandlers($handler => $self->{DEFAULT_HANDLERS}->{$handler});
      }
   
   return $self;
   }

sub parse()
   {
   my $self=shift;
   my ($filename)=@_;
   
   if (-f $filename)
      {
      $self->parsefile_($filename);
      }
   else
      {
      # Error: file not found
      die "SCRAM SimpleXMLDoc: File \"".$filename."\" not found! Context label = \"".$self->{CONTEXT}."\"\n";      
      }
   }

sub register_handlers_()
   {
   my $self=shift;  
   # Register tags to the container class:
   if (@_)
      {
      $CONTAINER->register_handlers_(@_);   
      }
   }

sub parsefile_()
   {
   my $self=shift;
   my ($filename)=@_;
   $self->{xmlparser}->parsefile($filename)
      || $self->{xmlparser}->xpcroak("SCRAM SimpleDoc XML parse error:");
   # Clean up:
   delete $self->{xmlparser};
   }

sub data()
   {
   my $self=shift;
   return $CONTAINER->data_();
   }

# The default handlers:
sub open_()
   {
   my $xmlparser=shift;
   my ($element, %attributes)=@_;
   $element=~tr[A-Z][a-z];
   # Handle document "doc" tags and load a
   # container class for the document type:
   if ($element eq 'doc')
      {
      if (exists ($attributes{'type'}))
         {
         my $doctype=$attributes{'type'}."::Container";
         eval "require $doctype";
         if ($@)
            {
            print "SCRAM SimpleXMLDoc: Unable to parse the current document because\n";
            print "                    the data container type (=DOCTYPE) is invalid!\n";
            print "\n";
            die $@,"\n";
            }
         # Bless the base container to its real type:
         bless($CONTAINER,$doctype);
         }
      else
         {
         die "SCRAM SimpleXMLDoc: Unable to handle a NULL document type!","\n";
         }
      return;
      }
   else
      {
      # Pass the call to the container class. This will use the AUTOLOAD
      # function of the class:
      $CONTAINER->open($element);
      $CONTAINER->$element(\%attributes);
      }
   }

sub close_()
   {
   my $xmlparser=shift;
   my ($element)=@_;
   $element=~tr[A-Z][a-z];
   return if $element eq 'doc';
   # Tell the container that the tag ended:
   $CONTAINER->close($element);
   }

sub char_()
   {
   my ($xmlparser, @items) = @_;
   my $string=join("",@items);
   return if ($string !~ /[a-zA-Z0-9_].*/);
   # Push the strings onto the container object, just in case
   # they form part of content for the active tag:
   $CONTAINER->text_($string);
   }

sub proc_()
   {
   my ($xmlparser,$target,$data)=@_;
   }

sub comment_()
   {
   my ($xmlparser,$string)=@_;
   }

# Entity (Parser, Name, Val, Sysid, Pubid, Ndata,IsParam)
sub entity_()
   {
   my ($xmlparser, $name, $val, $sysid, $pubid, $ndata)=@_;
   }

# Element (Parser, Name, Model)
sub element_()
   {
   my ($xmlparser,$name,$model)=@_;
   }

# Attlist (Parser, Elname, Attname, Type, Default, Fixed)
sub attlist_()
   {
   my ($xmlparser,$element, $attname, $type, $default,$fixed)=@_;
   }

# Doctype (Parser, Name, Sysid, Pubid, Internal)
sub doctype_()
   {
   my ($xmlparser,$name,$sysid,$pubid,$internal)=@_;
   }

# DoctypeFin (Parser)
sub doctypefin_()
   {
   my ($xmlparser)=@_;
   }

1;

=back

=head1 AUTHOR/MAINTAINER

Shaun ASHBY

=cut

Revision:	1.2
Committed:	Thu Dec 15 16:38:10 2005 UTC (19 years, 4 months ago) by sashby
Content type:	text/plain
Branch:	MAIN
Changes since 1.1:	+193 -91 lines
Log Message:	Start to migrate project boot to XML based parsing.
#	Content
1	#____________________________________________________________________
2	# File: SimpleXMLDoc.pm
3	#____________________________________________________________________
4	#
5	# Author: Shaun Ashby <Shaun.Ashby@cern.ch>
6	# Update: 2005-04-22 17:09:26+0200
7	# Revision: $Id$
8	#
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;
37
38	@ISA=qw(Exporter);
39	@EXPORT_OK=qw();
40
41	sub new()
42	{
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	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	# Initialise the XML parser:
87	$self->{xmlparser} = XML::Parser::Expat->new(ErrorContext => 3,
88	ParseParamEnt => 1);
89
90	# Add the default XML tag handlers:
91	foreach my $handler (@handler_list)
92	{
93	$self->{xmlparser}->setHandlers($handler => $self->{DEFAULT_HANDLERS}->{$handler});
94	}
95
96	return $self;
97	}
98
99	sub parse()
100	{
101	my $self=shift;
102	my ($filename)=@_;
103
104	if (-f $filename)
105	{
106	$self->parsefile_($filename);
107	}
108	else
109	{
110	# Error: file not found
111	die "SCRAM SimpleXMLDoc: File \"".$filename."\" not found! Context label = \"".$self->{CONTEXT}."\"\n";
112	}
113	}
114
115	sub register_handlers_()
116	{
117	my $self=shift;
118	# Register tags to the container class:
119	if (@_)
120	{
121	$CONTAINER->register_handlers_(@_);
122	}
123	}
124
125	sub parsefile_()
126	{
127	my $self=shift;
128	my ($filename)=@_;
129	$self->{xmlparser}->parsefile($filename)
130	\|\| $self->{xmlparser}->xpcroak("SCRAM SimpleDoc XML parse error:");
131	# Clean up:
132	delete $self->{xmlparser};
133	}
134
135	sub data()
136	{
137	my $self=shift;
138	return $CONTAINER->data_();
139	}
140
141	# The default handlers:
142	sub open_()
143	{
144	my $xmlparser=shift;
145	my ($element, %attributes)=@_;
146	$element=~tr[A-Z][a-z];
147	# Handle document "doc" tags and load a
148	# container class for the document type:
149	if ($element eq 'doc')
150	{
151	if (exists ($attributes{'type'}))
152	{
153	my $doctype=$attributes{'type'}."::Container";
154	eval "require $doctype";
155	if ($@)
156	{
157	print "SCRAM SimpleXMLDoc: Unable to parse the current document because\n";
158	print " the data container type (=DOCTYPE) is invalid!\n";
159	print "\n";
160	die $@,"\n";
161	}
162	# Bless the base container to its real type:
163	bless($CONTAINER,$doctype);
164	}
165	else
166	{
167	die "SCRAM SimpleXMLDoc: Unable to handle a NULL document type!","\n";
168	}
169	return;
170	}
171	else
172	{
173	# Pass the call to the container class. This will use the AUTOLOAD
174	# function of the class:
175	$CONTAINER->open($element);
176	$CONTAINER->$element(\%attributes);
177	}
178	}
179
180	sub close_()
181	{
182	my $xmlparser=shift;
183	my ($element)=@_;
184	$element=~tr[A-Z][a-z];
185	return if $element eq 'doc';
186	# Tell the container that the tag ended:
187	$CONTAINER->close($element);
188	}
189
190	sub char_()
191	{
192	my ($xmlparser, @items) = @_;
193	my $string=join("",@items);
194	return if ($string !~ /[a-zA-Z0-9_].*/);
195	# Push the strings onto the container object, just in case
196	# they form part of content for the active tag:
197	$CONTAINER->text_($string);
198	}
199
200	sub proc_()
201	{
202	my ($xmlparser,$target,$data)=@_;
203	}
204
205	sub comment_()
206	{
207	my ($xmlparser,$string)=@_;
208	}
209
210	# Entity (Parser, Name, Val, Sysid, Pubid, Ndata,IsParam)
211	sub entity_()
212	{
213	my ($xmlparser, $name, $val, $sysid, $pubid, $ndata)=@_;
214	}
215
216	# Element (Parser, Name, Model)
217	sub element_()
218	{
219	my ($xmlparser,$name,$model)=@_;
220	}
221
222	# Attlist (Parser, Elname, Attname, Type, Default, Fixed)
223	sub attlist_()
224	{
225	my ($xmlparser,$element, $attname, $type, $default,$fixed)=@_;
226	}
227
228	# Doctype (Parser, Name, Sysid, Pubid, Internal)
229	sub doctype_()
230	{
231	my ($xmlparser,$name,$sysid,$pubid,$internal)=@_;
232	}
233
234	# DoctypeFin (Parser)
235	sub doctypefin_()
236	{
237	my ($xmlparser)=@_;
238	}
239
240	1;
241
242	=back
243
244	=head1 AUTHOR/MAINTAINER
245
246	Shaun ASHBY
247
248	=cut
249