bomp

#!perl -T

use warnings;
use strict;
use Test::More tests => 27;
use URI::file;

BEGIN {
    delete @ENV{qw(PATH IFS CDPATH ENV BASH_ENV)};  # Placates taint-unsafe Cwd.pm in 5.6.1
    use_ok( 'WWW::Mechanize', 'abort' );
}

is \&abort, \&WWW::Mechanize::abort, 'abort export';

my $uri = URI::file->new_abs( 't/form_with_fields.html' )->as_string;

{ # tests 3-5
    my $mech = WWW::Mechanize->new( cookie_jar => undef );
    isa_ok( $mech, 'WWW::Mechanize' );

    my $sub = sub{[1,2,3]};
    $mech->add_handler(extract_forms => $sub);
    $mech->get($uri);
    $mech->get($uri);
    is_deeply scalar $mech->forms, [1..3],
        'The handler is still there after _push_page_stack';
    $mech->back;
    is_deeply scalar $mech->forms, [1..3],
        'It also survives _pop_page_stack.';

}
{ # test 6
    my $mech = WWW::Mechanize->new( cookie_jar => undef );
    $mech->add_handler(request_prepare => sub { abort });
    $mech->get($uri);
    is $mech->response, undef, 'abort from within request handler';
}

{ # tests 7-14
    my $mech = WWW::Mechanize->new( cookie_jar => undef );
    my (@m,$html);
    my @other;
    $mech->add_handler(parse_html => sub {
        push @other, ref shift;
        push @m, shift;
        push @other, ref shift;
        $html = shift
    });
    $mech->add_handler(extract_forms => sub {
        push @other, ref shift;
        push @m, shift;
        push @other, ref shift;
        [ 'forms?' ]
    });
    $mech->add_handler(extract_links => sub {
        push @other, ref shift;
        push @m, shift;
        push @other, ref shift;
        [ 'links?' ]
    });
    $mech->add_handler(extract_images => sub {
        push @other, ref shift;
        push @m, shift;
        push @other, ref shift;
        [ 'pictures?' ]
    });
    $mech->add_handler(get_content => sub {
        push @other, ref shift;
        push @m, shift;
        push @other, ref shift;
        "I hope you're content."
    });
    $mech->add_handler(get_text_content => sub {
        push @other, ref shift;
        push @m, shift;
        push @other, ref shift;
       "Plane text"
    });
    $mech->get($uri);

    like $html, qr/Like in PHP!/, 'parse_html';
    is_deeply $mech->forms, 'forms?', 'extract_forms';
    is_deeply $mech->links, 'links?', 'extract_links';
    is_deeply $mech->images, 'pictures?', 'extract_images';
    is $mech->content, "I hope you're content.", 'get_content';
    is $mech->content(format => 'text'), "Plane text", 'get_text_content';
    is join('', @m), $mech x 6, '$mech is passed to handlers';
    is join('', @other), "HTTP::ResponseHASH" x 6, 'other handler args';
    
}

{ # tests 15-20
    my $mech = WWW::Mechanize->new( cookie_jar => undef );
    $mech->add_handler(extract_forms => sub {});
    $mech->add_handler(extract_links => sub {});
    $mech->add_handler(extract_images => sub {});
    $mech->add_handler(get_content => sub {});
    $mech->add_handler(get_text_content => sub {});

    $mech->get($uri);
    is @{$mech->forms}, 2, 'return false from extract_forms';

    $mech->get(URI::file->new_abs( 't/find_link.html' )->as_string);
    cmp_ok @{$mech->links}, '>', 10, 'return false from extract_links';

    $mech->get(URI::file->new_abs( 't/image-parse.html' )->as_string);
    is @{$mech->images}, 3, 'return false from extract_images';

    $mech->get($uri);
    is $mech->content, $mech->response->content,
        'return false from get_content';

    SKIP: {
        skip 'HTML::TreeBuilder not available', 2 unless
            eval { require HTML::TreeBuilder; 1 };
        my $text =$mech->content('format', 'text');
        like $text, qr/Like in PHP/,
            'return false...';
        unlike $text, qr/<html>/, '...from get_text_content';
    }
}

{ # tests 21-2
    my $mech = WWW::Mechanize->new( cookie_jar => undef );

    my $uri2return;
    my $scratch;
    $mech->add_handler(get_uri =>
        sub { $scratch = \@_; return $uri2return }
    );

    $uri2return = new URI "data:text/html,";
    $mech->get($uri);
    is $mech->uri, 'data:text/html,', "uri returns get_uri's retval";
    $uri2return = 0;
    like $mech->uri, qr/form_with_fields/,'uri when get_uri returns false';
}

{ # tests 23-7
    my $mech = WWW::Mechanize->new( cookie_jar => undef );

    my $scratch;
    my $state;
    my $ff = sub {
        $scratch = \@_;
        for($state++) {
            $_ or return 0;
            $_ == 1 and return 76543;
            abort;
        }
    };

    $mech->add_handler(follow_link => $ff);
    my $uri = new URI 'data:text/html,';
    $uri->data(
        '<title>bomp</title><p><a href="data:text/plain,chob"></a>'
    );
    $mech->get($uri);
    $mech->follow_link(n=>1);
    is join('-', map ref, @$scratch),
        'HTTP::Response-WWW::Mechanize-HASH-WWW::Mechanize::Link',
        'make sure follow_link handler was called';
    is $mech->content, 'chob', 'return false from follow_link handler';
    $mech->back;
    is $mech->follow_link(n=>1), 76543,
        'retval of follow_link when handler returns true';
    is $mech->title,'bomp',
        'side-effect of follow_link handler returning true';
    $mech->follow_link(n=>1);
    is $mech->title,'bomp', 'aborted follow_link';
}