/XML-TreePP/t/28_http-lwp-force.t

 1# ----------------------------------------------------------------
 2    use strict;
 3    use Test::More;
 4# ----------------------------------------------------------------
 5SKIP: {
 6    local $@;
 7    eval { require HTTP::Lite; } unless defined $HTTP::Lite::VERSION;
 8    if ( ! defined $HTTP::Lite::VERSION ) {
 9        # ok
10    }
11    eval { require LWP::UserAgent; } unless defined $LWP::UserAgent::VERSION;
12    if ( ! defined $LWP::UserAgent::VERSION ) {
13        plan skip_all => 'LWP::UserAgent is not loaded.';
14    }
15    if ( ! defined $ENV{MORE_TESTS} ) {
16        plan skip_all => 'define $MORE_TESTS to test this.';
17    }
18    plan tests => 26;
19    use_ok('XML::TreePP');
20
21    my $name = ( $0 =~ m#([^/:\\]+)$# )[0];
22    my $url = "http://www.kawa.net/works/perl/treepp/example/envxml.cgi";
23    my $query = time();
24
25    {
26        my $tpp = XML::TreePP->new();
27        my $http = LWP::UserAgent->new();
28        ok( ref $http, 'LWP::UserAgent->new()' );
29        $tpp->set( lwp_useragent => $http );
30        &test_http_req( $tpp, 'libwww-perl', POST => $url, $query );
31    }
32    {
33        my $tpp = XML::TreePP->new();
34        my $http = LWP::UserAgent->new();
35        ok( ref $http, 'LWP::UserAgent->new()' );
36        $tpp->set( lwp_useragent => $http );
37        $http->agent( "$name " );
38        &test_http_req( $tpp, $name, POST => $url, $query );
39    }
40    {
41        my $tpp = XML::TreePP->new();
42        my $http = LWP::UserAgent->new();
43        ok( ref $http, 'LWP::UserAgent->new()' );
44        $tpp->set( user_agent => "$name " );
45        &test_http_req( $tpp, $name, POST => $url, $query );
46    }
47    {
48        my $tpp = XML::TreePP->new();
49        my $http = LWP::UserAgent->new();
50        ok( ref $http, 'LWP::UserAgent->new()' );
51        $tpp->set( user_agent => "$name " );
52        my $ret = &test_http_req( $tpp, $name, GET => "$url?$query" );
53        is( $ret, $query, "QUERY_STRING: $query" );
54    }
55}
56# ----------------------------------------------------------------
57sub test_http_req {
58    my $tpp = shift;
59    my $name = shift;
60
61    my( $tree, $xml, $code ) = $tpp->parsehttp( @_ );
62    ok( ref $tree, "parsehttp: $_[1]" );
63
64    my $decl = ( $xml =~ /(<\?xml[^>]+>)/ )[0];
65    like( $xml, qr/(<\?xml[^>]+>)/, "XML Decl: $decl" );
66
67    is( $code, 200, "HTTP Status: $code" );
68
69    my $agent = $tree->{env}->{HTTP_USER_AGENT};
70    ok( $agent, "User-Agent: $agent" );
71    like( $agent, qr/\Q$name\E/, "Match: $name" );
72
73    $tree->{env}->{QUERY_STRING};
74}
75# ----------------------------------------------------------------
76;1;
77# ----------------------------------------------------------------