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: Container.pm,v 1.1 2005/12/15 16:38:10 sashby Exp $ 
#
# 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_()}},@_);
      }
   else
      {
      $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'}))
         {
         # For all nested tags with "content" as a key, the first value for content will
         # be the destination of the text (i.e. STDOUT or file:x). Store this destination
         # as a key "dest":
         $self->{leveldata_}->{$self->{activelevel}-1}->{$self->parentenv_()}->{$current}->{'dest'} =
            $self->{leveldata_}->{$self->{activelevel}-1}->{$self->parentenv_()}->{$current}->{'content'},"\n";
         # Now just overwrite previsou value with the text:
         $self->{leveldata_}->{$self->{activelevel}-1}->{$self->parentenv_()}->{$current}->{'content'} =
            $self->{textcontent}->{$current};
         }
      elsif ($self->{content}->{$current}->{'content'})
         {
         $self->{content}->{$current}->{'dest'} = $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/.*://;
   $self->store_($name, $attributes);   
   }

sub store_()
   {
   my $self=shift;
   my ($name,$attributes)=@_;

   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.2
Committed:	Fri Jan 13 18:48:29 2006 UTC (19 years, 4 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.1:	+22 -5 lines
Log Message:	Added new container classes. More updates to XML based doc classes.
#	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	sashby	1.2	# Revision: $Id: Container.pm,v 1.1 2005/12/15 16:38:10 sashby Exp $
8	sashby	1.1	#
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	sashby	1.2	else
159			{
160			$self->{textcontent}->{$self->currentenv_()} = [ @_ ];
161			}
162	sashby	1.1	}
163
164			sub data_()
165			{
166			my $self=shift;
167			return $self->{content};
168			}
169
170			sub textstorage_()
171			{
172			my $self=shift;
173			my ($current)=@_;
174
175			# Look for text content for current env:
176			if (exists($self->{textcontent}->{$current}))
177			{
178			if (exists($self->{leveldata_}->{$self->{activelevel}-1}->{$self->parentenv_()}->{$current}->{'content'}))
179			{
180	sashby	1.2	# For all nested tags with "content" as a key, the first value for content will
181			# be the destination of the text (i.e. STDOUT or file:x). Store this destination
182			# as a key "dest":
183			$self->{leveldata_}->{$self->{activelevel}-1}->{$self->parentenv_()}->{$current}->{'dest'} =
184			$self->{leveldata_}->{$self->{activelevel}-1}->{$self->parentenv_()}->{$current}->{'content'},"\n";
185			# Now just overwrite previsou value with the text:
186	sashby	1.1	$self->{leveldata_}->{$self->{activelevel}-1}->{$self->parentenv_()}->{$current}->{'content'} =
187			$self->{textcontent}->{$current};
188			}
189			elsif ($self->{content}->{$current}->{'content'})
190			{
191	sashby	1.2	$self->{content}->{$current}->{'dest'} = $self->{content}->{$current}->{'content'};
192	sashby	1.1	$self->{content}->{$current}->{'content'} = $self->{textcontent}->{$current};
193			}
194
195			delete $self->{textcontent}->{$current};
196			}
197			}
198
199			sub AUTOLOAD()
200			{
201			my $self=shift;
202	sashby	1.2	my ($attributes)=@_;
203	sashby	1.1	return if $AUTOLOAD =~ /::DESTROY$/;
204			my $name=$AUTOLOAD;
205			$name =~ s/.*://;
206	sashby	1.2	$self->store_($name, $attributes);
207			}
208
209			sub store_()
210			{
211			my $self=shift;
212			my ($name,$attributes)=@_;
213
214	sashby	1.1	if (exists($self->{leveldata_}->{$self->{activelevel}}))
215			{
216			$self->{leveldata_}->{$self->{activelevel}}->{$name} = $attributes;
217			}
218			else
219			{
220			$self->{leveldata_}->{$self->{activelevel}} = { $name => $attributes };
221	sashby	1.2	}
222	sashby	1.1	}
223
224			sub DESTROY()
225			{
226			my $self=shift;
227			# Clean up the contents which aren't needed any more:
228			delete $self->{textcontent};
229			delete $self->{HANDLER_DATA};
230			delete $self->{activelevel};
231			delete $self->{leveldata_};
232			delete $self->{nested};
233			delete $self->{currenttag};
234			}
235
236			1;
237
238			=back
239
240			=head1 AUTHOR/MAINTAINER
241
242			Shaun ASHBY
243
244			=cut
245