t/lib/TestGitalist.pm

   1 package TestGitalist;
   2 use strict;
   3 use warnings;
   4 use Exporter qw/import/;
   5 use Catalyst::Test qw/Gitalist/;
   6 use Test::More;
   7
   8 our @EXPORT = qw/
   9     test_uri
  10     curry_test_uri
  11 /;
  12
  13 use constant ();
  14 BEGIN {
  15     my $mech = eval {
  16         require Test::WWW::Mechanize::Catalyst;
  17         Test::WWW::Mechanize::Catalyst->new(catalyst_app => 'Gitalist')
  18     };
  19     constant->import('MECH', $mech );
  20 }
  21
  22 # Rechecking the same link multiple times is slow and lame!
  23 # Nicked this from WWW::Mechanize and memoized it...
  24 my %seen_links;
  25 sub Test::WWW::Mechanize::Catalyst::page_links_ok {
  26     my $self = shift;
  27     my $desc = shift;
  28
  29     $desc = 'All links ok' unless defined $desc;
  30
  31     my @links = $self->followable_links();
  32     my @urls = Test::WWW::Mechanize::_format_links(\@links);
  33
  34     my @failures = $self->_check_links_status( [ grep { ! $seen_links{$_}++ } @urls ] );
  35     my $ok = (@failures==0);
  36
  37     ok( $ok, $desc );
  38     diag( $_ ) for @failures;
  39
  40     return $ok;
  41 }
  42
  43
  44 sub test_uri {
  45     my ($uri, $qs) = @_;
  46     my $request = "/$uri";
  47     $request .= "?$qs" if defined $qs;
  48     my $response = request($request);
  49     ok($response->is_success, "ok $request");
  50     if (MECH) {
  51         my $res = MECH()->get($request);
  52         ok $res->is_success, "ok mech $request (" . $res->code . ')';
  53         MECH()->page_links_ok("All links ok from $request")
  54             if $res->content_type =~ m|text/html|;
  55     }
  56     return $response;
  57 }
  58
  59 sub curry_test_uri {
  60     my $prefix = shift;
  61     my $to_curry = shift || \&test_uri;
  62     sub {
  63         my $uri = shift;
  64         $to_curry->("$prefix/$uri", @_);
  65     };
  66 }
  67
  68 1;