view release on metacpan or  search on metacpan

t/Client.pm  view on Meta::CPAN

        ok( $self->{NODES}->{$id}, " ... we know that node" );
        isnt( $self->{NODES}->{$id}{tag}, 'textnode', 
                        " ... can't reference a text node" );
        my $old = delete $self->{NODES}->{$id};

        my( $parent, $index ) = $self->find_parent( $old );

        if( $parent and defined $index ) {
            ok( $parent, " ... and we know the parent" );
            ok( defined $index, " ... we know the offset" );
            my $node = splice @{ $parent->{zC} }, $index, 1;
            is( $old, $node, " ... it's right node" );
        }
        else {
            pass( " ... parent is already bye-bye" );
        }
        $self->drop_node( $old );
    }
    elsif( $op eq 'bye-textnode' ) {
        ok( 1==@args, "Going to delete textnode $args[0] from $id" );
        if( $self->{NODES}->{$id} ) {
            ok( $self->{NODES}->{$id}, " ... we know of the node" );
            ok( ( $args[0] < @{ $self->{NODES}->{$id}{zC} } ), " ... in range" );
            my $node = splice @{ $self->{NODES}->{$id}{zC} }, $args[0], 1;
            is( $node->{tag}, 'textnode', " ... it's a textnode" );
        }
        else {
            pass( " ... already bye-bye" );
        }
    }
    elsif( $op eq 'framify' ) {
        ok( 0==@args, "Going to framify element $id" );
        ok( $self->{NODES}->{$id}, " ... we know of the node" );
        isnt( $self->{NODES}->{$id}{tag}, 'textnode', 
                        " ... can't framify a text node" );
        my $old = delete $self->{NODES}->{$id};

        my( $parent, $index ) = $self->find_parent( $old );

        ok( $parent, " ... and we know the parent of $old->{id}" )
                or die "We need to know the parent!";
        ok( ( $index < @{ $parent->{zC} } ), " ... in range" );

        my $new = {
                    tag => 'iframe',
                    id  => "IFRAME-$old->{id}",
                    src => { type      => 'XUL-from', 
                             source_id => $old->{id}
                           }
                };
        ok( !$self->{NODES}->{$new->{id}}, " ... never been framified" );
        $self->{NODES}->{$new->{id}} = $new;

        my $node = splice @{ $parent->{zC} }, $index, 1, $new;
        is( $old, $node, " ... it's right node" );
        $self->drop_node( $node );
    }
    elsif( $op eq 'timeslice' ) {
        # ignore
    }
    elsif( $op eq 'popup_window' ) {
        $self->popup_window( $id, @args );
    }
    elsif( $op eq 'close_window' ) {
        push @{ $self->{close_window} }, $id;
    }
    elsif( $op eq 'timeslice' ) {
        # ignore it
    }
    elsif( $op eq 'style' ) {
        ok( 2==@args, "Going to set style $args[0]" );
        ok( $self->{NODES}->{$id}, " ... on an existing node" )
                or die "Where is $id in ", join ', ', sort keys %{ $self->{NODES} }, 
                                Dumper [ $op, $id, @args ];

        my $N = $self->{NODES}->{$id};
        
        isnt( $N->{tag}, 'textnode', "One can't set the style of a text node!" );
        
        $self->{style} ||= {};
        if( not ref $N->{style} ) {
            $N->{style} = { map { split /:\s*/, $_, 2 } 
                                split /;\s*/, $N->{style} #**
                          };
        }
        $N->{style}{$args[0]} = $args[1];
    }
    else {
         die "What do i do with op=$op";
    }
}

######################################################
sub find_parent
{
    my( $self, $node ) = @_;
    return unless defined $node;
    foreach my $N ( values %{$self->{NODES}} ) {
        next if $N->{tag} eq 'textnode' or $N->{tag} eq 'cdata';
        use Data::Dumper;
        die Dumper $N unless $N->{zC};
        for( my $q1=0; $q1 < @{ $N->{zC} }; $q1++ ) {
            unless( defined $N->{zC}[ $q1 ] ) {
                # die "$q1=", Dumper $N->{zC};
                next;
            }
            next unless $N->{zC}[$q1] == $node;
            return $N, $q1 if wantarray;
            return $N;
        }
    }
    return;
}

############################################################
sub is_visible
{
    my( $self, $node ) = @_;
    $node = $self->find_ID( $node ) unless ref $node;
    return unless $node;
    my $style = $self->style( $node );
    return not ( $style =~ /display:\s*none/ );

t/Client.pm  view on Meta::CPAN

############################################################
sub server_size
{
    my( $self, $UA ) = @_;
    my $SIZEuri = $self->base_uri;
    $SIZEuri->path( '/__poe_size' );

    my $resp = $UA->get( $SIZEuri );
    ok( $resp->is_success, "Got the kernel size" );
    is( $resp->content_type, 'text/plain', " ... as text/plain" );

    my $size = 0+$resp->content;
    ok( $size, " ... and it is non-null" );
    return $size;
}

############################################################
sub server_dump
{
    my( $self, $UA ) = @_;
    my $URI = $self->base_uri;
    $URI->path( '/__poe_kernel' );

    my $resp = $UA->get( $URI );
    ok( $resp->is_success, "Got the kernel dump" );
    is( $resp->content_type, 'text/plain', " ... as text/plain" );

    return $resp->content;
}

############################################################
sub compare_dumps
{
    my( $self, $DUMP1, $DUMP2 ) = @_;
    return unless $HAVE_ALGORITHM_DIFF;

    my $diff = Algorithm::Diff->new( [ split "\n", $DUMP1 ],
                                     [ split "\n", $DUMP2 ] );
    $diff->Base( 1 );   # Return line numbers, not indices
    while(  $diff->Next()  ) {
        next   if  $diff->Same();
        my $sep = '';
        if(  ! $diff->Items(2)  ) {
            printf "%d,%dd%d\n",
               $diff->Get(qw( Min1 Max1 Max2 ));
        } elsif(  ! $diff->Items(1)  ) {
            printf "%da%d,%d\n",
               $diff->Get(qw( Max1 Min2 Max2 ));
        } else {
            $sep = "---\n";
            printf "%d,%dc%d,%d\n",
               $diff->Get(qw( Min1 Max1 Min2 Max2 ));
        }
        print "- $_\n"   for  $diff->Items(1);
        # print $sep;
        print "+ $_\n"   for  $diff->Items(2);
    }
}

############################################################
sub popup_window
{
    my( $self, $id, @args ) = @_;
    
    ok( !$self->{windows}{$id}, "Popup window $id" )
            or die "Pain follows";

    push @{ $self->{new_windows} }, $id;
    $self->{windows}{ $id } = { id => $id };
}


############################################################
sub close_window
{
    my( $self, $id ) = @_;
    if( $self->{parent} ) {
        return $self->{parent}->close_window( $id );
    }

    my $win = delete $self->{windows}{$id};
    ok( $win, "Close window $id" )
            or die "Closing a closed window??!";


    $win = $win->{browser};
    $win->{closed} = 1;
    $win->{NODES} = {};
    $self->Disconnect( $win );
    delete $win->{parent};
}

############################################################
sub open_window
{
    my( $self ) = @_;
    my $win_id = pop @{ $self->{new_windows} };
    my $win2 = ref( $self )->new( parent => $self, name => $win_id );

    my @copy = qw( HOST PORT UA APP SID );
    @{ $win2 }{ @copy } = @{ $self }{ @copy };

    $self->{windows}{ $win_id }{browser} = $win2;

    return $win2;
}

1;