The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#Copyright barry king <barry@wyrdwright.com> and released under the GPL.
#See http://www.gnu.org/licenses/gpl.html#TOC1 for details
use 5.006;
use strict;
use warnings;
no warnings qw(uninitialized);

package Apache::Wyrd::Interfaces::Mother;
use base qw(Apache::Wyrd::Interfaces::Setter);
our $VERSION = '0.98';

=pod

=head1 NAME

Apache::Wyrd::Interfaces::Mother - Reverse-parsing interface for Wyrds

=head1 SYNOPSIS

NONE

=head1 DESCRIPTION

If the enclosing Wyrd is the parent of an enclosed wyrd, the Mother
interface allows "children" of a Wyrd to be processed AFTER the parent,
reversing the normal flow of interpretation and calling the C<output>
method.

This is used, for example, in Forms, where the C<Apache::Wyrd::Form>
will need to alter values in the enclosed C<Apache::Wyrd::Input>s and
similar children after they have been parsed.

To accomplish this, every child must call the C<register_child> method. 
This will give the mother a private attribute C<_children> containing an
arrayref to the child objects.

When the mother has manipulated its children via access to the
C<_children> arrayref, it calls C<_set_children> to output the children
to their place within the enclosed HTML.  For this to function, each
child must have a C<final_output> method to call, and must output
C<'$:'>+ the id returned by the C<_register_child> method.  Typically
this is done with the following code:

    $self->_data('$:' . $id);

=head1 METHODS

I<(format: (returns) name (accepts))>

=over

=item (void) C<_set_children> ([string])

Prior to producing output, the mother should, assuming C<_data> contains
the enclosed data at the time, call C<_set_children> to perform the
delayed processing of its children.  Set children operates on the _data
attribute, so be sure the children's placemarkers are in _data before
calling this method.

When used with the optional argument, that attribute is assumed to be the
storage place for the children rather than _data.

=cut

sub _set_children {
	my ($self, $attribute) = @_;
	$attribute ||= '_data';
	my $out = $self->{$attribute};
	my $children = $self->_child_hash;
	$self->{$attribute} = $self->_set($children, $out);
}

=pod

=item (scalar) C<register_child> (void)

Adds the child to the mother's C<_children> attribute and returns a
placemarker string the mother will use to find it.  Every child of the
mother should call register_child.  In so doing, it should set it's
output (usually during the C<_generate_output> phase) with the string
"$:B<idname>" where B<idname> is the id returned by this method.  It can
do this in any way it likes, for example by replacing it's _data
attribute, as long as it's C<output> method returns this value.

=cut

sub register_child {
	my ($self, $child) = @_;
	$self->{'_children'} = [] unless ($self->{'_children'});
	my $child_count = $#{$self->{'_children'}} + 1;
	my $id = $self->_name_child;
	push @{$self->{'_children'}}, $child;
	$self->{'_child_index'}->{$id} = $child_count;
	$self->_process_child($child);
	return $id;
}

=pod

=item (scalar) C<_process_child> (Apache::Wyrd-derived object)

Hook method for performing some action on or using each child.

=cut

sub _process_child {
	#hook for child processing
	return;
}

=pod

=back

=head1 BUGS/CAVEATS/RESERVED METHODS

The methods C<_name_child>, C<_generate_id>, C<_set_children>, and
C<_child_hash> are reserved by this interface.

Children must ensure that the '$:' string before the ID string is not
interpreted by perl as the $: variable, i.e. use single quotes/q()
around the string.  See C<Apache::Wyrd::Interfaces::Setter>.

=head1 AUTHOR

Barry King E<lt>wyrd@nospam.wyrdwright.comE<gt>

=head1 SEE ALSO

=over

=item Apache::Wyrd

General-purpose HTML-embeddable perl object

=back

=head1 LICENSE

Copyright 2002-2007 Wyrdwright, Inc. and licensed under the GNU GPL.

See LICENSE under the documentation for C<Apache::Wyrd>.

=cut

sub _name_child {
	my ($self) = @_;
	my $id = $self->_generate_id($self->{'_current_identifier'});
	$self->{'_current_identifier'} = $self->{'_current_identifier'} + 1;
	return $id;
}

sub _generate_id {
	my ($self, $sequence) = @_;
	return '_PLACEMARKER_' . substr("000000$sequence", -6);
}

sub _child_hash {
	my ($self) = @_;
	my %children = ();
	foreach my $child (keys(%{$self->{'_child_index'}})) {
		$self->_verbose("processing child $child :" . $self->{'_child_index'}->{$child} . ' : ' . $self->{'_children'}->[$self->{'_child_index'}->{$child}]->{'name'});
		my $object = $self->{'_children'}->[$self->{'_child_index'}->{$child}];
		my $output = $object->final_output;
		$children{$child} = $output;
	}
	return \%children;
}

1;