The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl
# $Id: 90_complete.t 1192 2009-02-12 18:38:58Z fil $

use strict;
use warnings;

use POE::Component::XUL;
use JSON::XS;
use Data::Dumper;

use constant DEBUG=>0;

use t::PreReq;
use Test::More qw( no_plan );
t::PreReq::load( 1, qw( HTTP::Request LWP::UserAgent ) );

use t::Client;
use t::Server;

################################################################

my $Q = 5;
$Q *= 3 if $ENV{AUTOMATED_TESTING};

if( $ENV{HARNESS_PERL_SWITCHES} ) {
    $Q *= 3;
}

my $browser = t::Client->new( APP=>'Complete' );

my $pid = t::Server->spawn( $browser->{PORT} );
END { kill 2, $pid if $pid; }


diag( "sleep $Q" ) unless $ENV{AUTOMATED_TESTING};
sleep $Q;

my $UA = LWP::UserAgent->new;

$UA->timeout( 2*60 );

############################################################
my $URI = $browser->boot_uri;
my $resp = $UA->get( $URI );

my $data = $browser->decode_resp( $resp, 'boot' );
$browser->check_boot( $data );
$browser->handle_resp( $data, 'boot' );

ok( $browser->{W}, "Got a window" );
is( $browser->{W}->{tag}, 'window', " ... yep" );
ok( $browser->{W}->{id}, " ... yep" );

############################################################
my $B1 = $browser->get_node( 'B1' );
ok( $B1, "Found the button" );
$resp = Click( $browser, $B1 );
$data = $browser->decode_resp( $resp, 'click B1' );
$browser->handle_resp( $data, 'click B1' );

my $message = $browser->get_node( 'USER-Message' );
my $text = Dumper $message;
ok( ( $text =~ /Clicked button #1/ ), "Clicked OK" );

############################################################
my $B2 = $browser->get_node( 'B2' );
ok( $B2, "Found the button" );
$resp = Click( $browser, $B2 );
$data = $browser->decode_resp( $resp, 'click B2' );
$browser->handle_resp( $data, 'click B2' );

$text = Dumper $message;
ok( ( $text =~ /Clicked button #2/ ), "Clicked OK" );

is( $B2->{label}, "Click #1", "Button updated" );



############################################################
my $TB1 = $browser->get_node( 'TB1' );
ok( $TB1, "Found the first textbox" );

my $B3 = $browser->get_node( 'B3' );
ok( $B3, "Found the third button" );
ok( $B3->{disabled}, " ... it is disabled" );

$TB1->{value} = "Hello world!";
$resp = Change( $browser, $TB1 );
$data = $browser->decode_resp( $resp, 'change TB1' );
$browser->handle_resp( $data, 'change TB1' );

is( $TB1->{value}, '', "First textbox was emptied" );

my $TB2 = $browser->get_node( 'TB2' );
ok( $TB2, "Found the second textbox" );
is( $TB2->{value}, "Hello world!", " ... it was updated" );

ok( !$B3->{disabled}, "Third button was enabled" );

$resp = Click( $browser, $B3 );
$data = $browser->decode_resp( $resp, 'click B3' );
$browser->handle_resp( $data, 'click B3' );

$text = Dumper $message;
ok( ( $text =~ /Hello world!/ ), "Clicked OK" );
is( $TB1->{value}, '', "Second textbox was emptied" );


############################################################
# Test javascript and CDATA
my $AB = $browser->get_node( 'alert-button' );
ok( $AB, "Found the alert-button" ) 
        or die "I really need that button";

$resp = Click( $browser, $AB );
$data = $browser->decode_resp( $resp, 'click alert-button' );
$browser->handle_resp( $data, 'click alert-button' );

my $JS = $browser->{W}->{zC}[-1];
ok( ($JS and $JS->{type} eq 'text/javascript'), "Found the javascript" ) 
        or die "I really need that javascript";
my $code = delete $JS->{zC}[0]{cdata};
ok( ($code =~ /alert/), "Got the javascript" )
        or die $JS;

############################################################
# Test menulist
my $ML = $browser->get_node( 'ML1' );
ok( $ML, "Got the menulist" );

die Dumper $ML unless $ML->{zC};

$ML->{selectedIndex} = 2;       # Bears
$resp = Select( $browser, $ML );
$data = $browser->decode_resp( $resp, 'select bears' );
$browser->handle_resp( $data, 'select bears' );

is( $ML->{selectedIndex}, 2, "Bears were selected" );
my $I = $ML->{zC}[0]{zC}[ $ML->{selectedIndex} ];
ok( $I, "Found the selected item" );
is( $I->{label}, "Bears", " ... and it's bears" )
        or die Dumper $ML;

my $other;

SKIP: {
    skip "Side-effects no longer echoed back to browser", 2;
    ok( $I->{selected}, " ... and it's selected" )
            or die Dumper $ML;

    $other = $ML->{zC}[0]{zC}[ 0 ];
    ok( !$other->{selected}, " ... and the other one isn't" )
            or die Dumper $ML;
}

###########
$ML->{selectedIndex} = 0;       # Lions
$resp = Select( $browser, $ML );
$data = $browser->decode_resp( $resp, 'select lions' );
$browser->handle_resp( $data, 'select lions' );

is( $ML->{selectedIndex}, 0, "Lions were selected" );
$I = $ML->{zC}[0]{zC}[ $ML->{selectedIndex} ];
ok( $I, "Found the selected item" );
is( $I->{label}, "Lions", " ... and it's lions" )
        or die Dumper $ML;

SKIP: {
    skip "Side-effects no longer echoed back to browser", 2;
    ok( $I->{selected}, " ... and it's selected" )
        or die Dumper $ML;

    $other = $ML->{zC}[0]{zC}[ 2 ];
    ok( !exists $other->{selected}, " ... and the other one isn't" )
        or die Dumper $ML;
}



############################################################
# Test textnode manipulation
my $MC = $browser->get_node( 'message-clear' );

ok( $MC, "Found the Clear button" )
                or die "We need that button!";
$resp = Click( $browser, $MC );
$data = $browser->decode_resp( $resp, 'clear messages' );

$browser->handle_resp( $data, 'clear messages' );

$text = Dumper $message;

my $count = () = ($text =~ /nodeValue/g);
is( $count, 1, "Only one message" )
            or die $text, Dumper $resp;
ok( ($text =~ /hello world/), " ... and it's the one we want" )
            or die $text;



############################################################
# Test radio buttons
my $RG1 = $browser->get_node( 'RG1' );
ok( $RG1, "Got the radiogroup" );

$resp = RadioClick( $browser, $RG1, 0 );
$data = $browser->decode_resp( $resp, 'orange' );
$browser->handle_resp( $data, 'orange' );

#########
$text = Dumper $message;

$count = () = ($text =~ /nodeValue/g);
is( $count, 2, "Two messages" )
            or die $text;
ok( ($text =~ /Orange/), " ... and one we want" )
            or die $text;
# CSS updated
ok( ($text =~/background-color: orange;/), " ... it's in orange" );

#########
my $R = RadioSelected( $RG1 );
is( $R->{label}, 'Orange', "I like orange" );

#########
$resp = RadioClick( $browser, $RG1, 1 );
$data = $browser->decode_resp( $resp, 'violet' );
$browser->handle_resp( $data, 'violet' );

#########
$text = Dumper $message;

$count = () = ($text =~ /nodeValue/g);
is( $count, 3, "Two messages" )
            or die $text;
ok( ($text =~ /Violet/), " ... and one we want" )
            or die $text;
# CSS updated
ok( ($text =~/background-color: violet;/), " ... it's in violet" );

#########
$R = RadioSelected( $RG1 );
SKIP: {
    skip "Side-effects no longer echoed back to browser", 1;
    is( $R->{label}, 'Violet', "Start wearing purple all the time" );
}

#########


$JS = $browser->{W}->{zC}[-1];
ok( $JS, "Found the javascript" ) 
        or die "I really need that javascript";
is( $JS->{type}, 'text/javascript', "Found the javascript" ) 
        or die Dumper $JS;
$code = $JS->{zC}[0]{cdata};
ok( !$code, "Didn't get more javascript" )
        or die Dumper $JS;



############################################################
# Test listbox
my $SB = $browser->get_node( 'SB1' );
ok( $SB, "Got the listbox" );

die Dumper $SB unless $SB->{zC};

my $Cosmo = $SB->{zC}[5];           # Cosmo 3 + listcols + listheaders
$SB->{selectedIndex} = 3;
$resp = Select( $browser, $SB );
$data = $browser->decode_resp( $resp, 'select Cosmo' );
$browser->handle_resp( $data, 'select Cosmo' );

SKIP: {
    skip "Side-effects no longer echoed back to browser", 1;
    is( $Cosmo->{selected}, 'true', "Cosmo was selected" );
}

$text = Dumper $message;

$count = () = ($text =~ /Cosmo-Female-White/g);
is( $count, 1, "Got the one message" )
            or die $text;

#########
my $Butter = $SB->{zC}[11];           # Butter 9 + listcols + listheaders
$SB->{selectedIndex} = 9;
$resp = Select( $browser, $SB );
$data = $browser->decode_resp( $resp, 'select Butter' );
$browser->handle_resp( $data, 'select Butter' );

SKIP: {
    skip "Side-effects no longer echoed back to browser", 2;
    is( $Butter->{selected}, 'true', "Butter was selected" );
    is( $Cosmo->{selected}, undef(), " ... and cosmo isn't" );
}
$text = Dumper $message;

$count = () = ($text =~ /Butter-Male-Orange/g);
is( $count, 1, "Got the one message" )
            or die $text;







############################################################
sub Click 
{
    my( $browser, $button ) = @_;
    my $URI = $browser->Click_uri( $button );
    return $UA->get( $URI );
}

############################################################
sub Change
{
    my( $browser, $textbox ) = @_;
    my $URI = $browser->base_uri;
    my $args = $browser->Change_args( $textbox );
    return $UA->post( $URI, $args );
}

############################################################
sub Select
{
    my( $browser, $ML ) = @_;
    my $URI = $browser->base_uri;
    my $args = $browser->Select_args( $ML );
    return $UA->post( $URI, $args );
}

############################################################
sub RadioClick
{
    my( $browser, $RG, $index ) = @_;
    my $URI = $browser->base_uri;
    my $args = $browser->RadioClick_args( $RG, $index );
    return $UA->post( $URI, $args );
}

# Find which radio button is checked
sub RadioSelected
{
    my( $RG ) = @_;
    my $sel;
    foreach my $R ( @{ $RG->{zC} } ){
        next unless $R->{selected};
        ok( !$sel, "Only one radio selected" );
        $sel = $R;
    }
    ok( $sel, "Found a selected radio" )
        or die Dumper $RG;
    return $sel;
}