src/ActiveDoc/SimpleXMLDoc.pm

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