t/lib/TestGitalist.pm

   1 package TestGitalist;
   2 use strict;
   3 use warnings;
   4 use Exporter ();
   5 use FindBin qw/$Bin/;
   6 BEGIN {
   7     $ENV{GITALIST_CONFIG} = $Bin;
   8     $ENV{GITALIST_REPO_DIR} = '';
   9 }
  10 use Catalyst::Test qw/Gitalist/;
  11 use Test::More;
  12 use Test::Exception;
  13
  14 our @EXPORT = (@Test::More::EXPORT, @Test::Exception::EXPORT, qw/
  15     test_uri
  16     curry_test_uri
  17     MECH
  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 }
  34
  35 use constant ();
  36 BEGIN {
  37     my $mech = eval {
  38         require Test::WWW::Mechanize::Catalyst;
  39         require WWW::Mechanize::TreeBuilder;
  40         my $mech = Test::WWW::Mechanize::Catalyst->new(catalyst_app => 'Gitalist');
  41         WWW::Mechanize::TreeBuilder->meta->apply($mech,
  42            tree_class => 'HTML::TreeBuilder::XPath',
  43         );
  44         return $mech;
  45     };
  46     constant->import('MECH', $mech );
  47 }
  48
  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
  71 sub test_uri {
  72     my ($uri, $qs) = @_;
  73     my $request = "/$uri";
  74     $request .= "?$qs" if defined $qs;
  75     my $response = request($request);
  76     ok($response->is_success, "ok $request");
  77     if (MECH) {
  78         my $res = MECH()->get($request);
  79         ok $res->is_success, "ok mech $request (" . $res->code . ')';
  80         MECH()->page_links_ok("All links ok from $request")
  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;