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.
#	User	Rev	Content
1	sashby	1.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	sashby	1.2
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	sashby	1.1	package ActiveDoc::SimpleXMLDoc;
33	sashby	1.2	use XML::Parser::Expat;
34			use ActiveDoc::Container;
35	sashby	1.1	require 5.004;
36			use Exporter;
37
38			@ISA=qw(Exporter);
39	sashby	1.2	@EXPORT_OK=qw();
40	sashby	1.1
41			sub new()
42			{
43	sashby	1.2	###############################################################
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	sashby	1.1
84	sashby	1.2	$self->{CONTEXT}=$context;
85	sashby	1.1
86	sashby	1.2	# Initialise the XML parser:
87			$self->{xmlparser} = XML::Parser::Expat->new(ErrorContext => 3,
88			ParseParamEnt => 1);
89	sashby	1.1
90	sashby	1.2	# Add the default XML tag handlers:
91			foreach my $handler (@handler_list)
92	sashby	1.1	{
93	sashby	1.2	$self->{xmlparser}->setHandlers($handler => $self->{DEFAULT_HANDLERS}->{$handler});
94	sashby	1.1	}
95	sashby	1.2
96			return $self;
97	sashby	1.1	}
98
99	sashby	1.2	sub parse()
100	sashby	1.1	{
101			my $self=shift;
102	sashby	1.2	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	sashby	1.1	}
114
115	sashby	1.2	sub register_handlers_()
116	sashby	1.1	{
117	sashby	1.2	my $self=shift;
118			# Register tags to the container class:
119			if (@_)
120			{
121			$CONTAINER->register_handlers_(@_);
122			}
123	sashby	1.1	}
124
125	sashby	1.2	sub parsefile_()
126	sashby	1.1	{
127			my $self=shift;
128			my ($filename)=@_;
129	sashby	1.2	$self->{xmlparser}->parsefile($filename)
130			\|\| $self->{xmlparser}->xpcroak("SCRAM SimpleDoc XML parse error:");
131	sashby	1.1	# Clean up:
132			delete $self->{xmlparser};
133			}
134
135	sashby	1.2	sub data()
136	sashby	1.1	{
137			my $self=shift;
138	sashby	1.2	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	sashby	1.1	{
151	sashby	1.2	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	sashby	1.1	}
171			else
172			{
173	sashby	1.2	# 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	sashby	1.1	}
178			}
179
180	sashby	1.2	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	sashby	1.1	{
207	sashby	1.2	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	sashby	1.1	}
233
234	sashby	1.2	# DoctypeFin (Parser)
235			sub doctypefin_()
236	sashby	1.1	{
237	sashby	1.2	my ($xmlparser)=@_;
238	sashby	1.1	}
239
240			1;
241	sashby	1.2
242			=back
243
244			=head1 AUTHOR/MAINTAINER
245
246			Shaun ASHBY
247
248			=cut
249