Commit | Line | Data |
6dac2638 |
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 | |
cd196b66 |
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 | |
6dac2638 |
44 | sub test_uri { |
45 | my ($uri, $qs) = @_; |
6dac2638 |
46 | my $request = "/$uri"; |
47 | $request .= "?$qs" if defined $qs; |
48 | my $response = request($request); |
cd196b66 |
49 | ok($response->is_success, "ok $request"); |
6dac2638 |
50 | if (MECH) { |
51 | my $res = MECH()->get($request); |
cd196b66 |
52 | ok $res->is_success, "ok mech $request (" . $res->code . ')'; |
53 | MECH()->page_links_ok("All links ok from $request") |
6dac2638 |
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; |