The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w

use strict;

sub POE::Kernel::CATCH_EXCEPTIONS () { 0 }

use POE;
use POE::Component::XUL;

my $port = shift;
my $root = shift;
POE::Component::XUL->spawn( {
        port => $port,
        root => $root,
        timeout=> 5,
        apps => {
            Test => 'My::App',
        }
    } );

warn "# http://localhost:$port" unless $ENV{AUTOMATED_TESTING};
$poe_kernel->run();

warn "# exit" unless $ENV{AUTOMATED_TESTING};

###############################################################
package My::App;

use strict;
use POE;

use POE::XUL::Node;

use constant DEBUG => 0;

###############################################################
sub spawn
{
    my( $package, $event ) = @_;
    my $SID = $event->SID;

    DEBUG and warn "# spawn";

    my $self = bless { SID=>$event->SID }, $package;
    POE::Session->create(
            object_states => [
                $self => [ qw( _start boot Click1 Click2 Click2_later 
                               shutdown _stop ) ]
            ]
        );
}

###############################################################
sub _start
{
    my( $self, $kernel ) = @_[ OBJECT, KERNEL ];
    $kernel->alias_set( $self->{SID} );
}

sub shutdown
{
    my( $self, $kernel ) = @_[ OBJECT, KERNEL ];
    $kernel->alias_remove( delete $self->{SID} );
}

sub _stop
{
    my( $self, $kernel ) = @_[ OBJECT, KERNEL ];
    warn "# _stop" unless $ENV{AUTOMATED_TESTING};
}

###############################################################
sub boot
{
    my( $self, $kernel, $event ) = @_[ OBJECT, KERNEL, ARG0 ];
    DEBUG and warn "# boot";
    $event->wrap( sub {
            DEBUG and warn "# boot CM=$POE::XUL::Node::CM";
            $self->{D} = Description( "do the following" );
            $self->{B1} = Button( label => "click me", 
                                 Click => 'Click1' );
            $self->{W} = Window( HBox( $self->{D}, $self->{B1} ) );

            $event->finish;
        } );
}

###############################################################
sub Click1
{
    my( $self, $kernel, $session, $event ) = 
                @_[ OBJECT, KERNEL, SESSION, ARG0 ];

    DEBUG and warn "# Click1";

    DEBUG and warn "# Click1 CM=$POE::XUL::Node::CM";
    $self->{D}->textNode( 'You did it!' );

    $self->{B2} = Button( label=>'click me too', 
                            Click => $session->callback( 'Click2' )
                        );
    $self->{W}->firstChild->appendChild( $self->{B2} );   
}


###############################################################
sub Click2
{
    my( $self, $kernel, $event ) = @_[ OBJECT, KERNEL, ARG1 ];

    $event = $event->[0];
    DEBUG and warn "# Click2 event=$event";
    $event->done( 0 );
    $kernel->post( $event->SID(), 'Click2_later', $event );
}

sub Click2_later
{
    my( $self, $kernel, $event ) = @_[ OBJECT, KERNEL, ARG0 ];

    DEBUG and warn "# Click2_later";
    $event->wrap( sub {
            DEBUG and warn "# Click2 CM=$POE::XUL::Node::CM";
            $self->{D}->textNode( 'Thank you' );

            $event->done( 1 );
            $event->finish;
        } );
}