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.
#	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$
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