1use Test::More; 2use HTTP::Proxy::Engine; 3 4plan tests => 18; 5 6my $e; 7my $p = bless {}, "HTTP::Proxy"; 8 9$e = HTTP::Proxy::Engine->new( proxy => $p, engine => Legacy ); 10isa_ok( $e, 'HTTP::Proxy::Engine::Legacy' ); 11 12# use the default engine for $^O 13eval { HTTP::Proxy::Engine->new() }; 14isa_ok( $e, 'HTTP::Proxy::Engine' ); 15 16eval { HTTP::Proxy::Engine->new( engine => Legacy ) }; 17like( $@, qr/^No proxy defined/, "proxy required" ); 18 19eval { HTTP::Proxy::Engine->new( proxy => "P", engine => Legacy ) }; 20like( $@, qr/^P is not a HTTP::Proxy object/, "REAL proxy required" ); 21 22# direct engine creation 23# HTTP::Proxy::Engine::Legacy was required before 24$e = HTTP::Proxy::Engine::Legacy->new( proxy => $p ); 25isa_ok( $e, 'HTTP::Proxy::Engine::Legacy' ); 26 27eval { HTTP::Proxy::Engine::Legacy->new() }; 28like( $@, qr/^No proxy defined/, "proxy required" ); 29 30eval { HTTP::Proxy::Engine::Legacy->new( proxy => "P" ) }; 31like( $@, qr/^P is not a HTTP::Proxy object/, "REAL proxy required" ); 32 33# non-existent engine 34eval { HTTP::Proxy::Engine->new( proxy => $p, engine => Bonk ) }; 35like( 36 $@, 37 qr/^Can't locate HTTP.+?Proxy.+?Engine.+?Bonk\.pm in \@INC/, 38 "Engine Bonk does not exist" 39); 40 41# check the base accessor 42$e = HTTP::Proxy::Engine->new( proxy => $p, engine => Legacy ); 43is( $e->proxy, $p, "proxy() get" ); 44 45# check subclasses accessors 46$e = HTTP::Proxy::Engine->new( proxy => $p, engine => Legacy, select => 2 ); 47is( $e->select, 2, "subclass get()" ); 48is( $e->select(4), 4, "subclass set()" ); 49is( $e->select, 4, "subclass get()" ); 50 51$e = HTTP::Proxy::Engine::Legacy->new( proxy => $p, select => 3 ); 52is( $e->select, 3, "subclass get()" ); 53is( $e->select(4), 4, "subclass set()" ); 54is( $e->select, 4, "subclass get()" ); 55 56# but where is the code? 57is( *{HTTP::Proxy::Engine::select}{CODE}, 58 undef, "code not in the base class" ); 59is( ref *{HTTP::Proxy::Engine::select}{CODE}, 60 '', "code not in the base class" ); 61my $c = \&HTTP::Proxy::Engine::Legacy::select; # remove "used only once" warning 62is( ref *{HTTP::Proxy::Engine::Legacy::select}{CODE}, 63 'CODE', "code in the subclass" ); 64