/XML-TreePP/t/27_http-lite-force.t

http://xml-treepp.googlecode.com/ · Raku · 65 lines · 51 code · 8 blank · 6 comment · 5 complexity · 264cb7e72d8173209858c9a66bc96a9a 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. plan skip_all => 'HTTP::Lite is not loaded.';
  10. }
  11. eval { require LWP::UserAgent; } unless defined $LWP::UserAgent::VERSION;
  12. if ( ! defined $LWP::UserAgent::VERSION ) {
  13. # ok
  14. }
  15. if ( ! defined $ENV{MORE_TESTS} ) {
  16. plan skip_all => 'define $MORE_TESTS to test this.';
  17. }
  18. plan tests => 14;
  19. use_ok('XML::TreePP');
  20. my $name = 'HTTP::Lite';
  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 = HTTP::Lite->new();
  26. ok( ref $http, 'HTTP::Lite->new()' );
  27. $tpp->set( http_lite => $http );
  28. $tpp->set( user_agent => '' );
  29. &test_http_req( $tpp, $name, POST => $url, $query ); # use HTTP::Lite
  30. }
  31. {
  32. my $tpp = XML::TreePP->new();
  33. my $http = HTTP::Lite->new();
  34. ok( ref $http, 'HTTP::Lite->new()' );
  35. $tpp->set( http_lite => $http );
  36. $tpp->set( user_agent => '' );
  37. my $ret = &test_http_req( $tpp, $name, GET => "$url?$query" );
  38. is( $ret, $query, "QUERY_STRING: $query" );
  39. }
  40. }
  41. # ----------------------------------------------------------------
  42. sub test_http_req {
  43. my $tpp = shift;
  44. my $name = shift;
  45. my( $tree, $xml, $code ) = $tpp->parsehttp( @_ );
  46. ok( ref $tree, "parsehttp: $_[1]" );
  47. my $decl = ( $xml =~ /(<\?xml[^>]+>)/ )[0];
  48. like( $xml, qr/(<\?xml[^>]+>)/, "XML Decl: $decl" );
  49. is( $code, 200, "HTTP Status: $code" );
  50. my $agent = $tree->{env}->{HTTP_USER_AGENT};
  51. ok( $agent, "User-Agent: $agent" );
  52. like( $agent, qr/\Q$name\E/, "Match: $name" );
  53. $tree->{env}->{QUERY_STRING};
  54. }
  55. # ----------------------------------------------------------------
  56. ;1;
  57. # ----------------------------------------------------------------