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