view release on metacpan or  search on metacpan

t/lib/TestGitalist.pm  view on Meta::CPAN

package TestGitalist;
use strict;
use warnings;
use Exporter ();
use FindBin qw/$Bin/;
BEGIN {
    $ENV{GITALIST_CONFIG} = $Bin;
    $ENV{GITALIST_REPO_DIR} = '';
}
use Catalyst::Test qw/Gitalist/;
use Test::More;
use Test::Exception;

our @EXPORT = (@Test::More::EXPORT, @Test::Exception::EXPORT, qw/
    test_uri
    curry_test_uri
    MECH
    request
    get
    ctx_request
    content_like
    action_ok
    action_redirect
    action_notfound
    contenttype_is
/);

sub import {
    my $into = caller();
    strict->import;
    warnings->import;
    goto \&Exporter::import;
}

use constant ();
BEGIN {
    my $mech = eval {
        require Test::WWW::Mechanize::Catalyst;
        require WWW::Mechanize::TreeBuilder;
        my $mech = Test::WWW::Mechanize::Catalyst->new(catalyst_app => 'Gitalist');
        WWW::Mechanize::TreeBuilder->meta->apply($mech,
           tree_class => 'HTML::TreeBuilder::XPath',
        );
        return $mech;
    };
    constant->import('MECH', $mech );
}

# Rechecking the same link multiple times is slow and lame!
# Nicked this from WWW::Mechanize and memoized it...
my %seen_links;
sub Test::WWW::Mechanize::Catalyst::page_links_ok {
    my $self = shift;
    my $desc = shift;

    $desc = 'All links ok' unless defined $desc;

    my @links = $self->followable_links();
    my @urls = Test::WWW::Mechanize::_format_links(\@links);

    my @failures = $self->_check_links_status( [ grep { ! $seen_links{$_}++ } @urls ] );
    my $ok = (@failures==0);

    ok( $ok, $desc );
    diag( $_ ) for @failures;

    return $ok;
}


sub test_uri {
    my ($uri, $qs) = @_;
    my $request = "/$uri";
    $request .= "?$qs" if defined $qs;
    my $response = request($request);
    ok($response->is_success || $response->is_redirect, "ok $request");
    if (MECH) {
        my $res = MECH()->get($request);
        ok $res->is_success, "ok mech $request (" . $res->code . ')';
        MECH()->page_links_ok("All links ok from $request")
            if $res->content_type =~ m|text/html|;
    }
    return $response;
}

sub curry_test_uri {
    my $prefix = shift;
    my $to_curry = shift || \&test_uri;
    sub {
        my $uri = shift;