t/live_app.t

   1 #!perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use FindBin;
   7 use IO::Socket;
   8 use Test::More;
   9 use Test::WWW::Mechanize;
  10
  11 # plan skip_all => 'set TEST_HTTP to enable this test' unless $ENV{TEST_HTTP};
  12 eval "use Catalyst::Devel 1.0";
  13 plan skip_all => 'Catalyst::Devel required' if $@;
  14
  15 plan tests => 17;
  16
  17 # How long to wait for test server to start and timeout for UA.
  18 my $seconds = 30;
  19
  20 # Spawn the standalone HTTP server.
  21 my $port = 30000 + int rand(1 + 10000);
  22
  23  my $pipe = "perl -I$FindBin::Bin/../lib -I$FindBin::Bin/TestApp/lib $FindBin::Bin/TestApp/script/testapp_server.pl -fork -port $port |";
  24
  25 # my $pipe = "perl -I$FindBin::Bin/../lib -I$FindBin::Bin/TestApp/lib $FindBin::Bin/TestApp/script/testapp_server.pl -f -port $port 2>&1 |";
  26
  27 my $pid = open my $server, $pipe
  28     or die "Unable to spawn standalone HTTP server: $!";
  29
  30 diag("Waiting (up to $seconds seconds) for server to start...");
  31
  32 eval {
  33     local $SIG{ALRM} = sub { die "Server took too long to start\n" }; # NB: \n required
  34     alarm($seconds);
  35
  36     while ( check_port( 'localhost', $port ) != 1 ) {
  37         sleep 1;
  38     }
  39     alarm(0)
  40 };
  41
  42 if ( $@ )
  43 {
  44     kill 'INT', $pid;
  45     close $server;
  46     die "Could not run test: $@\n$pipe";
  47 }
  48
  49 my $root = $ENV{CATALYST_SERVER} = "http://localhost:$port";
  50
  51 # Tests start --------------------------------------------
  52 ok("Started");
  53
  54
  55 my $mech = Test::WWW::Mechanize->new(timeout => $seconds);
  56
  57 $mech->get_ok($root, "GET $root");
  58 $mech->content_contains("not signed in", "Content looks right");
  59
  60 $mech->get_ok("$root/login", "GET $root/login");
  61
  62 # diag($mech->content);
  63
  64 $mech->submit_form_ok({ form_name => "login",
  65                         fields => { username => "paco",
  66                                     password => "l4s4v3n7ur45",
  67                                 },
  68                        },
  69                       "Trying cleartext login, 'memebers' realm");
  70
  71 $mech->content_contains("signed in", "Signed in successfully");
  72
  73 $mech->get_ok("$root/signin_openid", "GET $root/signin_openid");
  74
  75 $mech->content_contains("Sign in with OpenID", "Content looks right");
  76
  77 my $claimed_uri = "$root/provider/paco";
  78
  79 $mech->submit_form_ok({ form_name => "openid",
  80                         fields => { openid_identifier => $claimed_uri,
  81                                 },
  82                     },
  83                       "Trying OpenID login, 'openid' realm");
  84
  85 $mech->content_contains("You did it with OpenID!",
  86                         "Successfully signed in with OpenID");
  87
  88 $mech->get_ok($root, "GET $root");
  89
  90 $mech->content_contains("provider/paco", "OpenID signed in");
  91 #$mech->content_contains("paco", "OpenID signed in as paco");
  92
  93 # can't be verified
  94
  95 $mech->get_ok("$root/logout", "GET $root/logout");
  96
  97 $mech->get_ok("$root/signin_openid", "GET $root/signin_openid");
  98
  99 $mech->content_contains("Sign in with OpenID", "Content looks right");
 100
 101 $mech->submit_form_ok({ form_name => "openid",
 102                         fields => { openid_identifier => $claimed_uri,
 103                                 },
 104                     },
 105                       "Trying OpenID login, 'openid' realm");
 106
 107 $mech->content_contains("can't be verified",
 108                         "Proper failure for unauthenticated memember.");
 109
 110 # Tests end ----------------------------------------------
 111
 112 # shut it down
 113 kill 'INT', $pid;
 114 close $server;
 115
 116 exit 0;
 117
 118 sub check_port {
 119     my ( $host, $port ) = @_;
 120
 121     my $remote = IO::Socket::INET->new(
 122         Proto    => "tcp",
 123         PeerAddr => $host,
 124         PeerPort => $port
 125     );
 126     if ($remote) {
 127         close $remote;
 128         return 1;
 129     }
 130     else {
 131         return 0;
 132     }
 133 }
 134
 135 __END__
 136