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, 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.1:	+22 -5 lines
Log Message:	Added new container classes. More updates to XML based doc classes.
#	Content
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: Container.pm,v 1.1 2005/12/15 16:38:10 sashby Exp $
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	else
159	{
160	$self->{textcontent}->{$self->currentenv_()} = [ @_ ];
161	}
162	}
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	# 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	$self->{leveldata_}->{$self->{activelevel}-1}->{$self->parentenv_()}->{$current}->{'content'} =
187	$self->{textcontent}->{$current};
188	}
189	elsif ($self->{content}->{$current}->{'content'})
190	{
191	$self->{content}->{$current}->{'dest'} = $self->{content}->{$current}->{'content'};
192	$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	my ($attributes)=@_;
203	return if $AUTOLOAD =~ /::DESTROY$/;
204	my $name=$AUTOLOAD;
205	$name =~ s/.*://;
206	$self->store_($name, $attributes);
207	}
208
209	sub store_()
210	{
211	my $self=shift;
212	my ($name,$attributes)=@_;
213
214	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	}
222	}
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