view release on metacpan or  search on metacpan

lib/POE/XUL/State.pm  view on Meta::CPAN

##############################################################
sub new 
{ 
    my( $package, $node ) = @_;
    my $self = bless {
            buffer => [], 
            deferred_buffer => [], 
            is_new => 1, 
            is_destroyed => 0, 
            is_textnode => 0
        }, $package;

    my $id;
    if( blessed $node and $node->can( 'getAttribute' ) and
                     $node->getAttribute( 'id' ) ) {
        $id = $node->getAttribute( 'id' );
    }
    else {
        $id = 'PX' . $ID++;
        if( $node ) {
            # set the nodes attribute to the generated ID
            # 2008/10 do NOT use setAttribute, it will call the CM which will
            # try to build a new State.  Infinite recursion.
            $node->{attributes}{id} ||= $id;
        }
    }
    $self->{orig_id} = $self->{id} = $id;

    return $self;
}

##############################################################
sub flush 
{
	my( $self ) = @_;
	my @out = $self->as_command;
	$self->{is_new} = 0;
    $self->{index} = delete $self->{trueindex} if defined $self->{trueindex};
	$self->clear_buffer;
	return @out;
}

# command building ------------------------------------------------------------

sub as_command {
	my $self = shift;

	my $is_new       = $self->{is_new};
	my $is_destroyed = $self->{is_destroyed};

    # TODO: this is probably a bad idea
	return if $is_new && $is_destroyed;

    if( $is_destroyed ) {
        return $self->get_buffer_as_commands;
    }
    elsif( $self->is_textnode ) {
        return $self->make_command_textnode;
    }
    elsif( $self->{cdata} ) {
    	return unless $self->{is_new};
        return $self->make_command_cdata;
    }
    else {
        return $self->make_command_new, $self->get_buffer_as_commands;
    }
}

sub as_deferred_command {
	my $self = shift;

	my $is_new       = $self->{is_new};
	my $is_destroyed = $self->{is_destroyed};

    # TODO: this is probably a bad idea
	return if $is_destroyed;
    return $self->get_buffer_as_deferred_commands;
}

##############################################################
sub make_command_new 
{
	my( $self ) = @_;
	return unless $self->{is_new};
    # return unless $self->get_tag;
    
	my @cmd = ( 'new', 
                $self->{orig_id}, 
                $self->get_tag, 
                ( $self->get_parent_id || '' )
              );
    if( exists $self->{index} ) {
        push @cmd, $self->{index};
    }

    delete $self->{orig_id};

    return \@cmd;
}

##############################################################
sub make_command_bye 
{
	my( $self, $parent_id, $index ) = @_;
    return [ bye => $self->{id} ] #, $parent_id, $index ];
}

##############################################################
sub make_command_textnode
{
	my( $self ) = @_;
    return unless $self->{buffer} and $self->{buffer}[-1];
    my $ret = [ 'textnode',
                $self->get_parent_id, 
                $self->{index},
                $self->{buffer}[-1][-1]
              ];
    return $ret;
}

##############################################################
sub make_command_textnode_bye 
{
	my( $self, $parent_id, $index ) = @_;
    return [ 'bye-textnode', $parent_id, $index ];
}

##############################################################
sub make_command_cdata
{
	my( $self ) = @_;
    # use Data::Dumper;
    # warn Dumper $self->{buffer};
    my $ret = [ 'cdata',
                $self->get_parent_id, 
                $self->{index},
                $self->{cdata}
              ];
    return $ret;
}

##############################################################
sub make_command_cdata_bye 
{
	my( $self, $parent_id, $index ) = @_;
    return [ 'bye-cdata', $parent_id, $index ];
}


##############################################################
sub make_command_SID
{
    my( $package, $SID ) = @_;
    return [ 'SID', $SID ];
}

##############################################################
sub make_command_boot
{
    my( $package, $msg ) = @_;
    return [ 'boot', $msg ];
}

#############################################################
sub make_command_set 
{
	my($self, $key, $value) = @_;

    return [ 'set', $self->{id}, $key, $value ];
}

#############################################################
sub make_command_method
{
	my($self, $key, $args) = @_;

    return [ 'method', $self->{id}, $key, $args ];
}

#############################################################
sub make_command_style
{
	my($self, $property, $value) = @_;

    $property =~ s/-([a-z])/\U$1/g;
    return [ 'style', $self->{id}, $property, $value ];
}

#############################################################
sub make_command_remove
{
	my($self, $key) = @_;
    return [ 'remove', $self->{id}, $key ];
}



#############################################################
sub get_buffer_as_commands 
{
	my( $self ) = @_;
    return $self->get_buffer;
}

#############################################################
sub get_buffer_as_deferred_commands