1# ---------------------------------------------------------------- 2 use strict; 3 use Test::More; 4# ---------------------------------------------------------------- 5SKIP: { 6 local $@; 7 eval { require LWP::UserAgent::WithCache; } unless defined $LWP::UserAgent::WithCache::VERSION; 8 if ( ! defined $LWP::UserAgent::WithCache::VERSION ) { 9 plan skip_all => 'LWP::UserAgent::WithCache is not loaded.'; 10 } 11 if ( ! defined $ENV{MORE_TESTS} ) { 12 plan skip_all => 'define $MORE_TESTS to test this.'; 13 } 14 plan tests => 6; 15 use_ok('XML::TreePP'); 16 17 my $http = LWP::UserAgent::WithCache->new(); 18 ok( ref $http, 'LWP::UserAgent::WithCache' ); 19 my $name = ( $0 =~ m#([^/:\\]+)$# )[0]; 20 $http->agent( "$name " ); 21 22 my $tpp = XML::TreePP->new(); 23 $tpp->set( lwp_useragent => $http ); 24 25 &test_http_post( $tpp, $name ); # use LWP::UserAgent::WithCache 26} 27# ---------------------------------------------------------------- 28sub test_http_post { 29 my $tpp = shift; 30 my $name = shift; 31 my $url = "http://www.kawa.net/works/perl/treepp/example/envxml.cgi"; 32 my( $tree, $xml ) = $tpp->parsehttp( POST => $url, '' ); 33 ok( ref $tree, $url ); 34 my $agent = $tree->{env}->{HTTP_USER_AGENT}; 35 ok( $agent, "User-Agent: $agent" ); 36 like( $agent, qr/libwww-perl/, "Test: libwww-perl" ); 37 like( $agent, qr/\Q$name\E/, "Test: $name" ); 38} 39# ---------------------------------------------------------------- 40;1; 41# ---------------------------------------------------------------- 42