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 and
      # also keep a reference to the whole container object
      # just in case there is other data needed outside of 'content':
      $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_();
   $self->{fulldata_} = $CONTAINER;
   }

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