/usr/local/CPAN/XUL-Node/XUL/Node/Server/ChangeManager.pm

package XUL::Node::Server::ChangeManager;

#
#              how do you sync changes to the server node tree
#                     with the client user interface?
#
#  * one per session
#  * run_and_flush lets you run application code, and capture any changes
#    to the node tree, so they can be sent to the client side
#  * any code that runs through run_and_flush (it takes a block as its
#    parameter), will have side effects sent to the client (e.g. change
#    in the value attribute of a textfield)
#  * messages to the client are returned as a string
#  * we get them from the node state objects, which we create for each node
#  * the node state objects know what messsages need to be sent to the
#    client, because we intercept attributes changes, and node
#    creation/removal
#  * our intercept code passes node changes to the relevant node state
#    objects
#  * we keep a list of top level nodes (windows), so we can flush their node
#    state objects for any changes, recursively, on every call to
#    run_and_flush
#  * we keep the next node ID, because we are also the ID factory, and the
#    object that provides an ID to the node state
#  * the ID is used as a key, for identifying a XUL object on the client
#  * it is also used to find the server node that should handle an event
#    we receive from the client
#

use strict;
use warnings;
use Carp;
use Aspect;
use XUL::Node;
use XUL::Node::Server::NodeState;

# creating --------------------------------------------------------------------

# windows is list of all top level nodes
# destroyed is buffer of all states scheduled for destruction on next flush
# next_node_id is next available node ID minus 1
sub new { bless {windows => [], destroyed => [], next_node_id => 0}, shift }

# public interface for sessions -----------------------------------------------

# run some code ref and capture messages to client created by code
# then return these messages so they can be sent to the client
sub run_and_flush {
	my ($self, $code) = @_;
	local $_;
	$code->();
	my $out =
		(join '', map { $self->flush_node($_) } @{$self->windows}).
		(join '', map { $_->flush } @{$self->{destroyed}});
	$self->{destroyed} = [];
	return $out;
}

sub destroy {
	my $self = shift;
	$_->destroy for @{$self->{windows}};
	delete $self->{windows};
}

# advice ----------------------------------------------------------------------

my $Self_Flow = cflow source => __PACKAGE__.'::run_and_flush';

# when node attributes changes, let the node state object know about it
# if node has no state object, give it one
before {
	my $context = shift;
	my $self    = $context->source->self;
	my $node    = $context->self;
	my $key     = $context->params->[1];
	my $value   = $context->params->[2];
	my $state   = $self->get_or_make_node_state($node);

	if ($key eq 'tag') {

		croak "cannot change node tag" if $node->tag;
		$state->set_tag($value);
		# for each new node we register it as a window, if it is one
		push @{$self->windows}, $node if $value eq 'Window';

	} else {

		my $old = $node->get_attribute($key);
		if (defined $old && $old eq $value)
			{ $context->return_value($node) }
		else
			{ $state->set_attribute($key, $value) }

	}

} call 'XUL::Node::_set_attribute' & $Self_Flow;

# when node added, set parent node ID and child index on child node state
# if node has no state object, give it one
before {
	my $context      = shift;
	my $self         = $context->source->self;
	my $parent       = $context->self;
	my $parent_state = $self->get_or_make_node_state($parent);
	my $child        = $context->params->[1];
	my $index        = $context->params->[2];
	my $child_state  = $self->node_state($child);
    my $parent_id    = $parent_state->get_id;
	$child_state->set_parent_id($parent_id);
	$child_state->set_index($index);

} call 'XUL::Node::_add_child_at_index' & $Self_Flow;

# when node destroyed, update state using set_destoyed
before {
	my $context     = shift;
	my $self        = $context->source->self;
	my $parent      = $context->self;
	my $child       = $parent->_compute_child_and_index($context->params->[1]);
	my $child_state = $self->node_state($child);

	$child_state->set_destroyed;
	push @{$self->{destroyed}}, $child_state;
	# could run with no event manager
	$self->event_manager->drop_node($child) if $self->event_manager;
	# TODO: support removing windows

} call 'XUL::Node::remove_child' & $Self_Flow;

# private ---------------------------------------------------------------------

sub flush_node {
	my ($self, $node) = @_;
	my $out = $self->node_state($node)->flush;
	$out .= $self->flush_node($_) for $node->children;
	return $out;
}

sub get_or_make_node_state {
	my ($self, $node) = @_;
	my $state = $self->node_state($node);
	return $state if $state;

	# we give the node state a new ID
	# we give it the node state object
	# we register the node for receiving events from its client half
	my $id = 'E'. ++$self->{next_node_id};
	$state = XUL::Node::Server::NodeState->new(id => $id);
	$self->node_state($node, $state);
	# could run with no event manager
	$self->event_manager->register_node($id, $node) if $self->event_manager;
	return $state;
}

sub node_state {
	my ($self, $node, $state) = @_;
	croak "not a node: [$node]" unless UNIVERSAL::isa($node, 'XUL::Node');
	return $node->{state} unless $state;
	$node->{state} = $state;
}

sub event_manager {
	my ($self, $event_manager) = @_;
	return $self->{event_manager} unless $event_manager;
	$self->{event_manager} = $event_manager;
}

# testing ---------------------------------------------------------------------

sub windows { shift->{windows} }

1;