App-CamelPKI

 view release on metacpan or  search on metacpan

inc/My/Tests/Below.pm  view on Meta::CPAN

=head1 NAME

B<My::Tests::Below> - invoke a test suite at the end of a module.

=head1 SYNOPSIS

 package MyPackage;

 <the text of the package goes here>

 require My::Tests::Below unless caller();

 1;

 __END__

 use MyPackage;


 # And there you go with your test suite

inc/My/Tests/Below.pm  view on Meta::CPAN

package My::Tests::Below;

use strict;
use File::Temp ();

our $VERSION = 2.0;

## This is done at the top level, not in a sub, as "require
## My::Tests::Below" is what gets the ball rolling:
our $singleton = __PACKAGE__->_parse(\*main::DATA, caller(0));
unless (defined $singleton) {
    die "My::Tests::Below invoked, but no tests were found below!";
}
close(main::DATA);
$singleton->run();

## Creates an instance of My::Tests::Below from a source file
## that has tests at the bottom.
sub _parse {
    my ($class, $fd, $package, $packfilename, $packline) = @_;

inc/My/Tests/Below.pm  view on Meta::CPAN

package Fake::Module;
use strict;

use base 'Exporter';
our @EXPORT = qw(zoinx);

sub zoinx {1}

package Fake::Module::Sub;

require My::Tests::Below unless (caller());

1;

__END__

use Fake::Module;

print "1..2\n";
if (__PACKAGE__ eq "main") {
   print "ok 1 # In package 'main' for tests\n";

inc/My/Tests/Below.pm  view on Meta::CPAN

like($result, qr/ok 2/, "Test result #2");

write_file($fakemodule, <<'BUGGY_MODULE_WITH_TEST_MORE');
#!perl -Tw

package Fake::Module;
use strict;

1;

require My::Tests::Below unless (caller());

__END__

use Test::More qw(no_plan);

ok(1);
die;
BUGGY_MODULE_WITH_TEST_MORE

$result = run_perl($fakemodule);

lib/App/CamelPKI/Error.pm  view on Meta::CPAN

            Data::Dumper::Dumper($self->{$k});
        } || "<huh?>";
        $retval .= "  $k => $v";
    }
    $retval .= $self->stacktrace;
    return $retval;
}



require My::Tests::Below unless caller();
1;

__END__

use Test::More qw(no_plan);
use Test::Group;
use App::CamelPKI::Error;

test "synopsis: basics" => sub {
    my $code = My::Tests::Below->pod_code_snippet("synopsis basic");

lib/Class/Facet.pm  view on Meta::CPAN

%named_args is a (flat) hash of named options similar to those
documented in L</on_error>; the C<-file>, C<-line> and C<-facetclass>
will be filled out (if not already present) and the resulting
associative array will be passed to the C<$sub> error handler declared
with C<on_error()>, if any.

=cut

sub _carp {
    my ($class, $facetclass, %args) = @_;
    my (undef, $filename, $line) = caller(1);
    $args{-facetclass} ||= $facetclass;
    $args{-file}       ||= $filename;
    $args{-line}       ||= $line;
    if (my $die = $facetclass->can("_facet_die")) {
        $die->($facetclass, %args);
    }
    # Still here? Either $die didn't, or there is no on_error handler.
    if (exists(&{"${facetclass}::"})) {
        no strict "refs";
        &{"${facetclass}::_facet_die"}(%args);

lib/Class/Facet.pm  view on Meta::CPAN

        # package the sub will be transplanted to. This is just so
        # deliciously evil :-)
        ($thispackage, $methname) = (${"AUTOLOAD"} =~ m/^(.*)::(.*?)$/);
    }
    return if $methname eq "DESTROY";
    if ((ref($_[0]) eq $thispackage) &&
        ($_[0]->{delegate}->can($methname))) {
        Class::Facet->_carp($thispackage, -method => $methname,
                            -reason => "forbidden_method");
    }
    my (undef, $file, $line) = caller();
    die sprintf(qq{Can't locate object method "%s" via package "%s" }
                . qq{at %s line %d.\n},
                $methname, $thispackage, $file, $line);
}

require My::Tests::Below unless caller;
1;

__END__