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

http://xml-treepp.googlecode.com/ · Raku · 77 lines · 64 code · 7 blank · 6 comment · 5 complexity · dde39824b825dde2a165cc68da47cdf5 MD5 · raw file

  1. # ----------------------------------------------------------------
  2. use strict;
  3. use Test::More;
  4. # ----------------------------------------------------------------
  5. SKIP: {
  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. my $name = ( $0 =~ m#([^/:\\]+)$# )[0];
  21. my $url = "http://www.kawa.net/works/perl/treepp/example/envxml.cgi";
  22. my $query = time();
  23. {
  24. my $tpp = XML::TreePP->new();
  25. my $http = LWP::UserAgent->new();
  26. ok( ref $http, 'LWP::UserAgent->new()' );
  27. $tpp->set( lwp_useragent => $http );
  28. &test_http_req( $tpp, 'libwww-perl', POST => $url, $query );
  29. }
  30. {
  31. my $tpp = XML::TreePP->new();
  32. my $http = LWP::UserAgent->new();
  33. ok( ref $http, 'LWP::UserAgent->new()' );
  34. $tpp->set( lwp_useragent => $http );
  35. $http->agent( "$name " );
  36. &test_http_req( $tpp, $name, POST => $url, $query );
  37. }
  38. {
  39. my $tpp = XML::TreePP->new();
  40. my $http = LWP::UserAgent->new();
  41. ok( ref $http, 'LWP::UserAgent->new()' );
  42. $tpp->set( user_agent => "$name " );
  43. &test_http_req( $tpp, $name, POST => $url, $query );
  44. }
  45. {
  46. my $tpp = XML::TreePP->new();
  47. my $http = LWP::UserAgent->new();
  48. ok( ref $http, 'LWP::UserAgent->new()' );
  49. $tpp->set( user_agent => "$name " );
  50. my $ret = &test_http_req( $tpp, $name, GET => "$url?$query" );
  51. is( $ret, $query, "QUERY_STRING: $query" );
  52. }
  53. }
  54. # ----------------------------------------------------------------
  55. sub test_http_req {
  56. my $tpp = shift;
  57. my $name = shift;
  58. my( $tree, $xml, $code ) = $tpp->parsehttp( @_ );
  59. ok( ref $tree, "parsehttp: $_[1]" );
  60. my $decl = ( $xml =~ /(<\?xml[^>]+>)/ )[0];
  61. like( $xml, qr/(<\?xml[^>]+>)/, "XML Decl: $decl" );
  62. is( $code, 200, "HTTP Status: $code" );
  63. my $agent = $tree->{env}->{HTTP_USER_AGENT};
  64. ok( $agent, "User-Agent: $agent" );
  65. like( $agent, qr/\Q$name\E/, "Match: $name" );
  66. $tree->{env}->{QUERY_STRING};
  67. }
  68. # ----------------------------------------------------------------
  69. ;1;
  70. # ----------------------------------------------------------------