Commit | Line | Data |
6dac2638 |
1 | package TestGitalist; |
2 | use strict; |
3 | use warnings; |
92b4b5c9 |
4 | use Exporter (); |
5 | use FindBin qw/$Bin/; |
6 | BEGIN { |
7 | $ENV{GITALIST_CONFIG} = $Bin; |
8 | $ENV{GITALIST_REPO_DIR} = ''; |
9 | } |
6dac2638 |
10 | use Catalyst::Test qw/Gitalist/; |
11 | use Test::More; |
92b4b5c9 |
12 | use Test::Exception; |
6dac2638 |
13 | |
92b4b5c9 |
14 | our @EXPORT = (@Test::More::EXPORT, @Test::Exception::EXPORT, qw/ |
6dac2638 |
15 | test_uri |
16 | curry_test_uri |
c98f0498 |
17 | MECH |
92b4b5c9 |
18 | request |
19 | get |
20 | ctx_request |
21 | content_like |
22 | action_ok |
23 | action_redirect |
24 | action_notfound |
25 | contenttype_is |
26 | /); |
27 | |
28 | sub import { |
29 | my $into = caller(); |
30 | strict->import; |
31 | warnings->import; |
32 | goto \&Exporter::import; |
33 | } |
6dac2638 |
34 | |
35 | use constant (); |
36 | BEGIN { |
37 | my $mech = eval { |
38 | require Test::WWW::Mechanize::Catalyst; |
c98f0498 |
39 | require WWW::Mechanize::TreeBuilder; |
40 | my $mech = Test::WWW::Mechanize::Catalyst->new(catalyst_app => 'Gitalist'); |
92b4b5c9 |
41 | WWW::Mechanize::TreeBuilder->meta->apply($mech, |
c98f0498 |
42 | tree_class => 'HTML::TreeBuilder::XPath', |
92b4b5c9 |
43 | ); |
c98f0498 |
44 | return $mech; |
6dac2638 |
45 | }; |
46 | constant->import('MECH', $mech ); |
47 | } |
48 | |
cd196b66 |
49 | # Rechecking the same link multiple times is slow and lame! |
50 | # Nicked this from WWW::Mechanize and memoized it... |
51 | my %seen_links; |
52 | sub Test::WWW::Mechanize::Catalyst::page_links_ok { |
53 | my $self = shift; |
54 | my $desc = shift; |
55 | |
56 | $desc = 'All links ok' unless defined $desc; |
57 | |
58 | my @links = $self->followable_links(); |
59 | my @urls = Test::WWW::Mechanize::_format_links(\@links); |
60 | |
61 | my @failures = $self->_check_links_status( [ grep { ! $seen_links{$_}++ } @urls ] ); |
62 | my $ok = (@failures==0); |
63 | |
64 | ok( $ok, $desc ); |
65 | diag( $_ ) for @failures; |
66 | |
67 | return $ok; |
68 | } |
69 | |
70 | |
6dac2638 |
71 | sub test_uri { |
72 | my ($uri, $qs) = @_; |
6dac2638 |
73 | my $request = "/$uri"; |
74 | $request .= "?$qs" if defined $qs; |
75 | my $response = request($request); |
2d376b54 |
76 | ok($response->is_success || $response->is_redirect, "ok $request"); |
6dac2638 |
77 | if (MECH) { |
78 | my $res = MECH()->get($request); |
cd196b66 |
79 | ok $res->is_success, "ok mech $request (" . $res->code . ')'; |
80 | MECH()->page_links_ok("All links ok from $request") |
6dac2638 |
81 | if $res->content_type =~ m|text/html|; |
82 | } |
83 | return $response; |
84 | } |
85 | |
86 | sub curry_test_uri { |
87 | my $prefix = shift; |
88 | my $to_curry = shift || \&test_uri; |
89 | sub { |
90 | my $uri = shift; |
91 | $to_curry->("$prefix/$uri", @_); |
92 | }; |
93 | } |
94 | |
95 | 1; |