view release on metacpan or  search on metacpan

lib/DBIx/Class/Schema/Loader/Utils.pm  view on Meta::CPAN

sub class_path {
    my $class = shift;

    my $class_path = $class;
    $class_path =~ s{::}{/}g;
    $class_path .= '.pm';

    return $class_path;
}

sub no_warnings(&;$) {
    my ($code, $test_name) = @_;

    my $failed = 0;

    my $warn_handler = $SIG{__WARN__} || sub { warn @_ };
    local $SIG{__WARN__} = sub {
        $failed = 1;
        $warn_handler->(@_);
    };

    $code->();

    Test::More::ok ((not $failed), $test_name);
}

sub warnings_exist(&$$) {
    my ($code, $re, $test_name) = @_;

    my $matched = 0;

    my $warn_handler = $SIG{__WARN__} || sub { warn @_ };
    local $SIG{__WARN__} = sub {
        if ($_[0] =~ $re) {
            $matched = 1;
        }
        else {
            $warn_handler->(@_)
        }
    };

    $code->();

    Test::More::ok $matched, $test_name;
}

sub warnings_exist_silent(&$$) {
    my ($code, $re, $test_name) = @_;

    my $matched = 0;

    local $SIG{__WARN__} = sub { $matched = 1 if $_[0] =~ $re; };

    $code->();

    Test::More::ok $matched, $test_name;
}