src/ActiveDoc/Container.pm

#____________________________________________________________________ 
# File: ActiveDoc::Container.pm
#____________________________________________________________________ 
#  
# Author: Shaun Ashby <Shaun.Ashby@cern.ch>
# Update: 2005-11-25 15:54:24+0100
# Revision: $Id$ 
#
# Copyright: 2005 (C) Shaun Ashby
#
#--------------------------------------------------------------------
package ActiveDoc::Container;
require 5.004;
use Exporter;

@ISA=qw(Exporter);
@EXPORT_OK=qw( );
our $AUTOLOAD;

=head1 NAME

ActiveDoc::Container - A container base class which handles basic data
storage in a nested data structure.

=head1 SYNOPSIS

Not to be instantiated directly. Every SCRAM document class that inherits from
ActiveDoc::SimpleXMLDoc must implement a class called Container which inherits
from this base class. The container class must be located in the X::Y namespace where X::Y
is the class of the SCRAM document.
   
=head1 DESCRIPTION

Not to be instantiated. Every SCRAM document class that inherits from
ActiveDoc::SimpleXMLDoc must implement a class called Container which inherits
from this base class. The container class must be located in the X::Y namespace where X::Y
is the class of the SCRAM document.
   
=head1 METHODS

=over

=cut

sub new()
   {
   ###############################################################
   # new                                                         #
   ###############################################################
   # modified : Fri Nov 25 15:54:30 2005 / SFA                   #
   # params   :                                                  #
   #          :                                                  #
   # function :                                                  #
   #          :                                                  #
   ###############################################################
   my $proto=shift;
   my $class=ref($proto) || $proto;
   my $self={};

   bless $self,$class;
   
   $self->{activelevel}=0;
   $self->{currenttag} = [];
   $self->{nested} = {};
   $self->{content}= {};
   $self->{leveldata_}={};
   
   return $self;
   }

sub register_handlers_()
   {
   my $self=shift;
   my ($handler_data)=@_;
   $self->{HANDLER_DATA}=$handler_data;
   map
      { 
      if ($self->{HANDLER_DATA}->{$_}->[1])
         {
         # Store nested tags:
         $self->nested_($_,1);
         }
      else
         {
         $self->nested_($_,0);
         }
      } keys %$handler_data;
   }

sub currentenv_()
   {
   my $self=shift;
   # Return the name of the env at the top of the stack:
   return $self->{currenttag}->[$#{$self->{currenttag}}];
   }

sub parentenv_()
   {
   my $self=shift;
   # Return the name of the env before the top of the stack:
   return $self->{currenttag}->[$#{$self->{currenttag}}-1];
   }

sub nested_()
   {
   my $self=shift;
   my ($tag,$val)=@_;
   
   if ($val ne "")
      {
      $self->{nested}->{$tag} = $val;
      }
   else
      {      
      return $self->{nested}->{$tag};
      }
   }

sub open()
   {
   my $self=shift;
   my ($current)=@_;
   $self->{activelevel}++;
   push (@{$self->{currenttag}},$current);   
   }

sub close()
   {
   my $self=shift;
   my ($current)=@_;
   
   if ($current ne $self->parentenv_())
      {      
      $self->{leveldata_}->{$self->{activelevel}-1}->{$self->parentenv_()}->{$current} =
         $self->{leveldata_}->{$self->{activelevel}}->{$current};
      }
   else
      {
      $self->{content}->{$current} = $self->{leveldata_}->{$self->{activelevel}}->{$current};
      }
   
   # Look for text content for current env:
   $self->textstorage_($current);
   # Clean up the data for this tag at current level:
   delete $self->{leveldata_}->{$self->{activelevel}}->{$current};
   # Drop down to the next level:
   $self->{activelevel}--;
   pop @{$self->{currenttag}};
   }

sub text_()
   {
   my $self=shift;
   if (exists($self->{textcontent}->{$self->currentenv_()}))
      {
      push(@{$self->{textcontent}->{$self->currentenv_()}},@_);
      }
   }

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

sub textstorage_()
   {
   my $self=shift;
   my ($current)=@_;
   
   # Look for text content for current env:
   if (exists($self->{textcontent}->{$current}))
      {
      if (exists($self->{leveldata_}->{$self->{activelevel}-1}->{$self->parentenv_()}->{$current}->{'content'}))
         {
         $self->{leveldata_}->{$self->{activelevel}-1}->{$self->parentenv_()}->{$current}->{'content'} =
            $self->{textcontent}->{$current};
         }
      elsif ($self->{content}->{$current}->{'content'})
         {
         $self->{content}->{$current}->{'content'} = $self->{textcontent}->{$current};
         }
      
      delete $self->{textcontent}->{$current};
      }
   }

sub AUTOLOAD()
   {
   my $self=shift;
   my ($attributes)=@_;
   
   return if $AUTOLOAD =~ /::DESTROY$/;
   my $name=$AUTOLOAD;
   $name =~ s/.*://;
   
   if (exists($self->{leveldata_}->{$self->{activelevel}}))
      {
      $self->{leveldata_}->{$self->{activelevel}}->{$name} = $attributes;
      }
   else
      {
      $self->{leveldata_}->{$self->{activelevel}} = { $name => $attributes };
      }
   }

sub DESTROY()
   {
   my $self=shift;
   # Clean up the contents which aren't needed any more:
   delete $self->{textcontent};
   delete $self->{HANDLER_DATA};
   delete $self->{activelevel};
   delete $self->{leveldata_};
   delete $self->{nested};
   delete $self->{currenttag};
   }

1;

=back
   
=head1 AUTHOR/MAINTAINER

Shaun ASHBY

=cut

Revision:	1.1
Committed:	Thu Dec 15 16:38:10 2005 UTC (19 years, 5 months ago) by sashby
Content type:	text/plain
Branch:	MAIN
Log Message:	Start to migrate project boot to XML based parsing.
#	User	Rev	Content
1	sashby	1.1	#____________________________________________________________________
2			# File: ActiveDoc::Container.pm
3			#____________________________________________________________________
4			#
5			# Author: Shaun Ashby <Shaun.Ashby@cern.ch>
6			# Update: 2005-11-25 15:54:24+0100
7			# Revision: $Id$
8			#
9			# Copyright: 2005 (C) Shaun Ashby
10			#
11			#--------------------------------------------------------------------
12			package ActiveDoc::Container;
13			require 5.004;
14			use Exporter;
15
16			@ISA=qw(Exporter);
17			@EXPORT_OK=qw( );
18			our $AUTOLOAD;
19
20			=head1 NAME
21
22			ActiveDoc::Container - A container base class which handles basic data
23			storage in a nested data structure.
24
25			=head1 SYNOPSIS
26
27			Not to be instantiated directly. Every SCRAM document class that inherits from
28			ActiveDoc::SimpleXMLDoc must implement a class called Container which inherits
29			from this base class. The container class must be located in the X::Y namespace where X::Y
30			is the class of the SCRAM document.
31
32			=head1 DESCRIPTION
33
34			Not to be instantiated. Every SCRAM document class that inherits from
35			ActiveDoc::SimpleXMLDoc must implement a class called Container which inherits
36			from this base class. The container class must be located in the X::Y namespace where X::Y
37			is the class of the SCRAM document.
38
39			=head1 METHODS
40
41			=over
42
43			=cut
44
45			sub new()
46			{
47			###############################################################
48			# new #
49			###############################################################
50			# modified : Fri Nov 25 15:54:30 2005 / SFA #
51			# params : #
52			# : #
53			# function : #
54			# : #
55			###############################################################
56			my $proto=shift;
57			my $class=ref($proto) \|\| $proto;
58			my $self={};
59
60			bless $self,$class;
61
62			$self->{activelevel}=0;
63			$self->{currenttag} = [];
64			$self->{nested} = {};
65			$self->{content}= {};
66			$self->{leveldata_}={};
67
68			return $self;
69			}
70
71			sub register_handlers_()
72			{
73			my $self=shift;
74			my ($handler_data)=@_;
75			$self->{HANDLER_DATA}=$handler_data;
76			map
77			{
78			if ($self->{HANDLER_DATA}->{$_}->[1])
79			{
80			# Store nested tags:
81			$self->nested_($_,1);
82			}
83			else
84			{
85			$self->nested_($_,0);
86			}
87			} keys %$handler_data;
88			}
89
90			sub currentenv_()
91			{
92			my $self=shift;
93			# Return the name of the env at the top of the stack:
94			return $self->{currenttag}->[$#{$self->{currenttag}}];
95			}
96
97			sub parentenv_()
98			{
99			my $self=shift;
100			# Return the name of the env before the top of the stack:
101			return $self->{currenttag}->[$#{$self->{currenttag}}-1];
102			}
103
104			sub nested_()
105			{
106			my $self=shift;
107			my ($tag,$val)=@_;
108
109			if ($val ne "")
110			{
111			$self->{nested}->{$tag} = $val;
112			}
113			else
114			{
115			return $self->{nested}->{$tag};
116			}
117			}
118
119			sub open()
120			{
121			my $self=shift;
122			my ($current)=@_;
123			$self->{activelevel}++;
124			push (@{$self->{currenttag}},$current);
125			}
126
127			sub close()
128			{
129			my $self=shift;
130			my ($current)=@_;
131
132			if ($current ne $self->parentenv_())
133			{
134			$self->{leveldata_}->{$self->{activelevel}-1}->{$self->parentenv_()}->{$current} =
135			$self->{leveldata_}->{$self->{activelevel}}->{$current};
136			}
137			else
138			{
139			$self->{content}->{$current} = $self->{leveldata_}->{$self->{activelevel}}->{$current};
140			}
141
142			# Look for text content for current env:
143			$self->textstorage_($current);
144			# Clean up the data for this tag at current level:
145			delete $self->{leveldata_}->{$self->{activelevel}}->{$current};
146			# Drop down to the next level:
147			$self->{activelevel}--;
148			pop @{$self->{currenttag}};
149			}
150
151			sub text_()
152			{
153			my $self=shift;
154			if (exists($self->{textcontent}->{$self->currentenv_()}))
155			{
156			push(@{$self->{textcontent}->{$self->currentenv_()}},@_);
157			}
158			}
159
160			sub data_()
161			{
162			my $self=shift;
163			return $self->{content};
164			}
165
166			sub textstorage_()
167			{
168			my $self=shift;
169			my ($current)=@_;
170
171			# Look for text content for current env:
172			if (exists($self->{textcontent}->{$current}))
173			{
174			if (exists($self->{leveldata_}->{$self->{activelevel}-1}->{$self->parentenv_()}->{$current}->{'content'}))
175			{
176			$self->{leveldata_}->{$self->{activelevel}-1}->{$self->parentenv_()}->{$current}->{'content'} =
177			$self->{textcontent}->{$current};
178			}
179			elsif ($self->{content}->{$current}->{'content'})
180			{
181			$self->{content}->{$current}->{'content'} = $self->{textcontent}->{$current};
182			}
183
184			delete $self->{textcontent}->{$current};
185			}
186			}
187
188			sub AUTOLOAD()
189			{
190			my $self=shift;
191			my ($attributes)=@_;
192
193			return if $AUTOLOAD =~ /::DESTROY$/;
194			my $name=$AUTOLOAD;
195			$name =~ s/.*://;
196
197			if (exists($self->{leveldata_}->{$self->{activelevel}}))
198			{
199			$self->{leveldata_}->{$self->{activelevel}}->{$name} = $attributes;
200			}
201			else
202			{
203			$self->{leveldata_}->{$self->{activelevel}} = { $name => $attributes };
204			}
205			}
206
207			sub DESTROY()
208			{
209			my $self=shift;
210			# Clean up the contents which aren't needed any more:
211			delete $self->{textcontent};
212			delete $self->{HANDLER_DATA};
213			delete $self->{activelevel};
214			delete $self->{leveldata_};
215			delete $self->{nested};
216			delete $self->{currenttag};
217			}
218
219			1;
220
221			=back
222
223			=head1 AUTHOR/MAINTAINER
224
225			Shaun ASHBY
226
227			=cut
228