Result:
found more than 877 distributions - search limited to the first 2001 files matching your query
( run in 0.761 )
Cache-Adaptive-ByLoad
view release on metacpan or search on metacpan
inc/Test/Base.pm view on Meta::CPAN
$default_object ||= $default_class->new;
return $default_object;
}
my $import_called = 0;
sub import() {
$import_called = 1;
my $class = (grep /^-base$/i, @_)
? scalar(caller)
: $_[0];
if (not defined $default_class) {
inc/Test/Base.pm view on Meta::CPAN
$caller =~ s/.*:://;
croak "Too late to call $caller()"
}
}
sub find_my_self() {
my $self = ref($_[0]) eq $default_class
? splice(@_, 0, 1)
: default_object();
return $self, @_;
}
sub blocks() {
(my ($self), @_) = find_my_self(@_);
croak "Invalid arguments passed to 'blocks'"
if @_ > 1;
croak sprintf("'%s' is invalid argument to blocks()", shift(@_))
inc/Test/Base.pm view on Meta::CPAN
}
return (@blocks);
}
sub next_block() {
(my ($self), @_) = find_my_self(@_);
my $list = $self->_next_list;
if (@$list == 0) {
$list = [@{$self->block_list}, undef];
$self->_next_list($list);
inc/Test/Base.pm view on Meta::CPAN
$block->run_filters;
}
return $block;
}
sub first_block() {
(my ($self), @_) = find_my_self(@_);
$self->_next_list([]);
$self->next_block;
}
sub filters_delay() {
(my ($self), @_) = find_my_self(@_);
$self->_filters_delay(defined $_[0] ? shift : 1);
}
sub no_diag_on_only() {
(my ($self), @_) = find_my_self(@_);
$self->_no_diag_on_only(defined $_[0] ? shift : 1);
}
sub delimiters() {
(my ($self), @_) = find_my_self(@_);
$self->check_late;
my ($block_delimiter, $data_delimiter) = @_;
$block_delimiter ||= $self->block_delim_default;
$data_delimiter ||= $self->data_delim_default;
$self->block_delim($block_delimiter);
$self->data_delim($data_delimiter);
return $self;
}
sub spec_file() {
(my ($self), @_) = find_my_self(@_);
$self->check_late;
$self->_spec_file(shift);
return $self;
}
sub spec_string() {
(my ($self), @_) = find_my_self(@_);
$self->check_late;
$self->_spec_string(shift);
return $self;
}
sub filters() {
(my ($self), @_) = find_my_self(@_);
if (ref($_[0]) eq 'HASH') {
$self->_filters_map(shift);
}
else {
inc/Test/Base.pm view on Meta::CPAN
push @$filters, @_;
}
return $self;
}
sub filter_arguments() {
$Test::Base::Filter::arguments;
}
sub have_text_diff {
eval { require Text::Diff; 1 } &&
$Text::Diff::VERSION >= 0.35 &&
$Algorithm::Diff::VERSION >= 1.15;
}
sub is($$;$) {
(my ($self), @_) = find_my_self(@_);
my ($actual, $expected, $name) = @_;
local $Test::Builder::Level = $Test::Builder::Level + 1;
if ($ENV{TEST_SHOW_NO_DIFFS} or
not defined $actual or
inc/Test/Base.pm view on Meta::CPAN
ok $actual eq $expected,
$name . "\n" . Text::Diff::diff(\$expected, \$actual);
}
}
sub run(&;$) {
(my ($self), @_) = find_my_self(@_);
my $callback = shift;
for my $block (@{$self->block_list}) {
$block->run_filters unless $block->is_filtered;
&{$callback}($block);
inc/Test/Base.pm view on Meta::CPAN
sub END {
run_compare() unless $Have_Plan or $DIED or not $import_called;
}
sub run_compare() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
local $Test::Builder::Level = $Test::Builder::Level + 1;
for my $block (@{$self->block_list}) {
inc/Test/Base.pm view on Meta::CPAN
is($block->$x, $block->$y, $block->name ? $block->name : ());
}
}
}
sub run_is() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
local $Test::Builder::Level = $Test::Builder::Level + 1;
for my $block (@{$self->block_list}) {
inc/Test/Base.pm view on Meta::CPAN
$block->name ? $block->name : ()
);
}
}
sub run_is_deeply() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and exists($block->{$y});
inc/Test/Base.pm view on Meta::CPAN
$block->name ? $block->name : ()
);
}
}
sub run_like() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and defined($y);
inc/Test/Base.pm view on Meta::CPAN
$block->name ? $block->name : ()
);
}
}
sub run_unlike() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and defined($y);
inc/Test/Base.pm view on Meta::CPAN
};
}
return $spec;
}
sub _strict_warnings() {
require Filter::Util::Call;
my $done = 0;
Filter::Util::Call::filter_add(
sub {
return 0 if $done;
inc/Test/Base.pm view on Meta::CPAN
$done = 1;
}
);
}
sub tie_output() {
my $handle = shift;
die "No buffer to tie" unless @_;
tie $handle, 'Test::Base::Handle', $_[0];
}
inc/Test/Base.pm view on Meta::CPAN
$ENV{TEST_SHOW_NO_DIFFS} = 1;
}
package Test::Base::Handle;
sub TIEHANDLE() {
my $class = shift;
bless \ $_[0], $class;
}
sub PRINT {
inc/Test/Base.pm view on Meta::CPAN
sub AUTOLOAD {
return;
}
sub block_accessor() {
my $accessor = shift;
no strict 'refs';
return if defined &$accessor;
*$accessor = sub {
my $self = shift;
Cache-Adaptive
view release on metacpan or search on metacpan
inc/Test/Base.pm view on Meta::CPAN
$default_object ||= $default_class->new;
return $default_object;
}
my $import_called = 0;
sub import() {
$import_called = 1;
my $class = (grep /^-base$/i, @_)
? scalar(caller)
: $_[0];
if (not defined $default_class) {
inc/Test/Base.pm view on Meta::CPAN
$caller =~ s/.*:://;
croak "Too late to call $caller()"
}
}
sub find_my_self() {
my $self = ref($_[0]) eq $default_class
? splice(@_, 0, 1)
: default_object();
return $self, @_;
}
sub blocks() {
(my ($self), @_) = find_my_self(@_);
croak "Invalid arguments passed to 'blocks'"
if @_ > 1;
croak sprintf("'%s' is invalid argument to blocks()", shift(@_))
inc/Test/Base.pm view on Meta::CPAN
}
return (@blocks);
}
sub next_block() {
(my ($self), @_) = find_my_self(@_);
my $list = $self->_next_list;
if (@$list == 0) {
$list = [@{$self->block_list}, undef];
$self->_next_list($list);
inc/Test/Base.pm view on Meta::CPAN
$block->run_filters;
}
return $block;
}
sub first_block() {
(my ($self), @_) = find_my_self(@_);
$self->_next_list([]);
$self->next_block;
}
sub filters_delay() {
(my ($self), @_) = find_my_self(@_);
$self->_filters_delay(defined $_[0] ? shift : 1);
}
sub no_diag_on_only() {
(my ($self), @_) = find_my_self(@_);
$self->_no_diag_on_only(defined $_[0] ? shift : 1);
}
sub delimiters() {
(my ($self), @_) = find_my_self(@_);
$self->check_late;
my ($block_delimiter, $data_delimiter) = @_;
$block_delimiter ||= $self->block_delim_default;
$data_delimiter ||= $self->data_delim_default;
$self->block_delim($block_delimiter);
$self->data_delim($data_delimiter);
return $self;
}
sub spec_file() {
(my ($self), @_) = find_my_self(@_);
$self->check_late;
$self->_spec_file(shift);
return $self;
}
sub spec_string() {
(my ($self), @_) = find_my_self(@_);
$self->check_late;
$self->_spec_string(shift);
return $self;
}
sub filters() {
(my ($self), @_) = find_my_self(@_);
if (ref($_[0]) eq 'HASH') {
$self->_filters_map(shift);
}
else {
inc/Test/Base.pm view on Meta::CPAN
push @$filters, @_;
}
return $self;
}
sub filter_arguments() {
$Test::Base::Filter::arguments;
}
sub have_text_diff {
eval { require Text::Diff; 1 } &&
$Text::Diff::VERSION >= 0.35 &&
$Algorithm::Diff::VERSION >= 1.15;
}
sub is($$;$) {
(my ($self), @_) = find_my_self(@_);
my ($actual, $expected, $name) = @_;
local $Test::Builder::Level = $Test::Builder::Level + 1;
if ($ENV{TEST_SHOW_NO_DIFFS} or
not defined $actual or
inc/Test/Base.pm view on Meta::CPAN
ok $actual eq $expected,
$name . "\n" . Text::Diff::diff(\$expected, \$actual);
}
}
sub run(&;$) {
(my ($self), @_) = find_my_self(@_);
my $callback = shift;
for my $block (@{$self->block_list}) {
$block->run_filters unless $block->is_filtered;
&{$callback}($block);
inc/Test/Base.pm view on Meta::CPAN
sub END {
run_compare() unless $Have_Plan or $DIED or not $import_called;
}
sub run_compare() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
local $Test::Builder::Level = $Test::Builder::Level + 1;
for my $block (@{$self->block_list}) {
inc/Test/Base.pm view on Meta::CPAN
is($block->$x, $block->$y, $block->name ? $block->name : ());
}
}
}
sub run_is() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
local $Test::Builder::Level = $Test::Builder::Level + 1;
for my $block (@{$self->block_list}) {
inc/Test/Base.pm view on Meta::CPAN
$block->name ? $block->name : ()
);
}
}
sub run_is_deeply() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and exists($block->{$y});
inc/Test/Base.pm view on Meta::CPAN
$block->name ? $block->name : ()
);
}
}
sub run_like() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and defined($y);
inc/Test/Base.pm view on Meta::CPAN
$block->name ? $block->name : ()
);
}
}
sub run_unlike() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and defined($y);
inc/Test/Base.pm view on Meta::CPAN
};
}
return $spec;
}
sub _strict_warnings() {
require Filter::Util::Call;
my $done = 0;
Filter::Util::Call::filter_add(
sub {
return 0 if $done;
inc/Test/Base.pm view on Meta::CPAN
$done = 1;
}
);
}
sub tie_output() {
my $handle = shift;
die "No buffer to tie" unless @_;
tie $handle, 'Test::Base::Handle', $_[0];
}
inc/Test/Base.pm view on Meta::CPAN
$ENV{TEST_SHOW_NO_DIFFS} = 1;
}
package Test::Base::Handle;
sub TIEHANDLE() {
my $class = shift;
bless \ $_[0], $class;
}
sub PRINT {
inc/Test/Base.pm view on Meta::CPAN
sub AUTOLOAD {
return;
}
sub block_accessor() {
my $accessor = shift;
no strict 'refs';
return if defined &$accessor;
*$accessor = sub {
my $self = shift;
Cache-Ehcache
view release on metacpan or search on metacpan
inc/Test/Base.pm view on Meta::CPAN
$default_object ||= $default_class->new;
return $default_object;
}
my $import_called = 0;
sub import() {
$import_called = 1;
my $class = (grep /^-base$/i, @_)
? scalar(caller)
: $_[0];
if (not defined $default_class) {
inc/Test/Base.pm view on Meta::CPAN
$caller =~ s/.*:://;
croak "Too late to call $caller()"
}
}
sub find_my_self() {
my $self = ref($_[0]) eq $default_class
? splice(@_, 0, 1)
: default_object();
return $self, @_;
}
sub blocks() {
(my ($self), @_) = find_my_self(@_);
croak "Invalid arguments passed to 'blocks'"
if @_ > 1;
croak sprintf("'%s' is invalid argument to blocks()", shift(@_))
inc/Test/Base.pm view on Meta::CPAN
}
return (@blocks);
}
sub next_block() {
(my ($self), @_) = find_my_self(@_);
my $list = $self->_next_list;
if (@$list == 0) {
$list = [@{$self->block_list}, undef];
$self->_next_list($list);
inc/Test/Base.pm view on Meta::CPAN
$block->run_filters;
}
return $block;
}
sub first_block() {
(my ($self), @_) = find_my_self(@_);
$self->_next_list([]);
$self->next_block;
}
sub filters_delay() {
(my ($self), @_) = find_my_self(@_);
$self->_filters_delay(defined $_[0] ? shift : 1);
}
sub no_diag_on_only() {
(my ($self), @_) = find_my_self(@_);
$self->_no_diag_on_only(defined $_[0] ? shift : 1);
}
sub delimiters() {
(my ($self), @_) = find_my_self(@_);
$self->check_late;
my ($block_delimiter, $data_delimiter) = @_;
$block_delimiter ||= $self->block_delim_default;
$data_delimiter ||= $self->data_delim_default;
$self->block_delim($block_delimiter);
$self->data_delim($data_delimiter);
return $self;
}
sub spec_file() {
(my ($self), @_) = find_my_self(@_);
$self->check_late;
$self->_spec_file(shift);
return $self;
}
sub spec_string() {
(my ($self), @_) = find_my_self(@_);
$self->check_late;
$self->_spec_string(shift);
return $self;
}
sub filters() {
(my ($self), @_) = find_my_self(@_);
if (ref($_[0]) eq 'HASH') {
$self->_filters_map(shift);
}
else {
inc/Test/Base.pm view on Meta::CPAN
push @$filters, @_;
}
return $self;
}
sub filter_arguments() {
$Test::Base::Filter::arguments;
}
sub have_text_diff {
eval { require Text::Diff; 1 } &&
$Text::Diff::VERSION >= 0.35 &&
$Algorithm::Diff::VERSION >= 1.15;
}
sub is($$;$) {
(my ($self), @_) = find_my_self(@_);
my ($actual, $expected, $name) = @_;
local $Test::Builder::Level = $Test::Builder::Level + 1;
if ($ENV{TEST_SHOW_NO_DIFFS} or
not defined $actual or
inc/Test/Base.pm view on Meta::CPAN
ok $actual eq $expected,
$name . "\n" . Text::Diff::diff(\$expected, \$actual);
}
}
sub run(&;$) {
(my ($self), @_) = find_my_self(@_);
my $callback = shift;
for my $block (@{$self->block_list}) {
$block->run_filters unless $block->is_filtered;
&{$callback}($block);
inc/Test/Base.pm view on Meta::CPAN
sub END {
run_compare() unless $Have_Plan or $DIED or not $import_called;
}
sub run_compare() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
local $Test::Builder::Level = $Test::Builder::Level + 1;
for my $block (@{$self->block_list}) {
inc/Test/Base.pm view on Meta::CPAN
is($block->$x, $block->$y, $block->name ? $block->name : ());
}
}
}
sub run_is() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
local $Test::Builder::Level = $Test::Builder::Level + 1;
for my $block (@{$self->block_list}) {
inc/Test/Base.pm view on Meta::CPAN
$block->name ? $block->name : ()
);
}
}
sub run_is_deeply() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and exists($block->{$y});
inc/Test/Base.pm view on Meta::CPAN
$block->name ? $block->name : ()
);
}
}
sub run_like() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and defined($y);
inc/Test/Base.pm view on Meta::CPAN
$block->name ? $block->name : ()
);
}
}
sub run_unlike() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and defined($y);
inc/Test/Base.pm view on Meta::CPAN
$block->name ? $block->name : ()
);
}
}
sub skip_all_unless_require() {
(my ($self), @_) = find_my_self(@_);
my $module = shift;
eval "require $module; 1"
or Test::More::plan(
skip_all => "$module failed to load"
);
}
sub is_deep() {
(my ($self), @_) = find_my_self(@_);
require Test::Deep;
Test::Deep::cmp_deeply(@_);
}
sub run_is_deep() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and exists($block->{$y});
inc/Test/Base.pm view on Meta::CPAN
};
}
return $spec;
}
sub _strict_warnings() {
require Filter::Util::Call;
my $done = 0;
Filter::Util::Call::filter_add(
sub {
return 0 if $done;
inc/Test/Base.pm view on Meta::CPAN
$done = 1;
}
);
}
sub tie_output() {
my $handle = shift;
die "No buffer to tie" unless @_;
tie $handle, 'Test::Base::Handle', $_[0];
}
inc/Test/Base.pm view on Meta::CPAN
$ENV{TEST_SHOW_NO_DIFFS} = 1;
}
package Test::Base::Handle;
sub TIEHANDLE() {
my $class = shift;
bless \ $_[0], $class;
}
sub PRINT {
inc/Test/Base.pm view on Meta::CPAN
sub AUTOLOAD {
return;
}
sub block_accessor() {
my $accessor = shift;
no strict 'refs';
return if defined &$accessor;
*$accessor = sub {
my $self = shift;
Cache-FastMmap-Tie
view release on metacpan or search on metacpan
inc/Test/More.pm view on Meta::CPAN
}
#line 425
sub cmp_ok($$$;$) {
my $tb = Test::More->builder;
$tb->cmp_ok(@_);
}
Cache-Keys-DSL
view release on metacpan or search on metacpan
lib/Cache/Keys/DSL.pm view on Meta::CPAN
*{"${caller}::with_version"} = \&_with_version;
@{"${caller}::EXPORT_OK"} = ();
%{"${caller}::EXPORT_TAGS"} = (all => \@{"${caller}::EXPORT_OK"});
}
sub _with_version($$) {## no critic
my $name = shift;
my $version = shift;
return [$name, $version];
}
Cache-Memcached-AnyEvent
view release on metacpan or search on metacpan
lib/Cache/Memcached/AnyEvent/Protocol/Text.pm view on Meta::CPAN
package Cache::Memcached::AnyEvent::Protocol::Text;
use strict;
use base 'Cache::Memcached::AnyEvent::Protocol';
sub _NOOP() {}
{
my $generator = sub {
my $cmd = shift;
return sub {
Cache-Memcached-libmemcached
view release on metacpan or search on metacpan
inc/Test/More.pm view on Meta::CPAN
return $tb->unlike(@_);
}
#line 471
sub cmp_ok($$$;$) {
my $tb = Test::More->builder;
return $tb->cmp_ok(@_);
}
inc/Test/More.pm view on Meta::CPAN
return $obj;
}
#line 719
sub subtest($&) {
my ($name, $subtests) = @_;
my $tb = Test::More->builder;
return $tb->subtest(@_);
}
Calendar-Schedule
view release on metacpan or search on metacpan
Schedule.pm view on Meta::CPAN
=pod
=cut
sub _getfile($) {
my $f = shift;
local *F;
open(F, "<$f") or die "getfile:cannot open $f:$!";
my @r = <F>;
close(F);
Call-Immediate
view release on metacpan or search on metacpan
t/TestImmediate.pm view on Meta::CPAN
use Exporter;
use base 'Exporter';
our @EXPORT = qw<begin xbegin>;
sub begin(&) {
my ($code) = @_;
$code->();
}
sub xbegin { }
Callerid
view release on metacpan or search on metacpan
lib/Callerid.pm view on Meta::CPAN
}
}
return $self;
}
sub parse_raw_cid_string(;$$) {
my($_arg) = shift;
my($self);
my($c);
if(ref $_arg) {
$self = $_arg;
lib/Callerid.pm view on Meta::CPAN
$self->{_raw_cid_string} = $c;
return $self;
}
sub format_phone_number(;$$) {
my($_arg) = shift;
my($self);
my($number);
if(ref $_arg) {
Canella
view release on metacpan or search on metacpan
lib/Canella/DSL.pm view on Meta::CPAN
delete CTX->stash->{sudo};
};
$_[0]->();
}
sub run(@) {
CTX->run_cmd(@_);
}
sub run_local(@) {
my $stash = CTX->stash;
local $stash->{current_remote};
CTX->run_cmd(@_);
}
lib/Canella/DSL.pm view on Meta::CPAN
));
$code->($host);
}
sub scp_get(@) {
my $remote = current_remote;
{
local $Log::Minimal::AUTODUMP = 1;
infof "[%s :: executing] scp_get %s", $remote->host, \@_;
}
$remote->connection->scp_get(@_);
}
sub scp_put(@) {
my $remote = current_remote;
{
local $Log::Minimal::AUTODUMP = 1;
infof "[%s :: executing] scp_put %s", $remote->host, \@_;
}
$remote->connection->scp_put(@_);
}
sub on_finish(&;$) {
my ($code, $name) = @_;
# on_finish always fires
my $guard = Canella::BlockGuard->new(
name => $name,
Captcha-Stateless-Text
view release on metacpan or search on metacpan
lib/Captcha/Stateless/Text.pm view on Meta::CPAN
}
#############################################################################
# Object parameter get/set functions ########################################
#############################################################################
sub get_ep_pre($self) { return $self->{ep_pre}; }
sub set_self_val($self, $k, $v) { $self->{$k} = $v; }
sub set_cipher($self, $v) { set_self_val($self, 'cipher', $v); }
sub set_iv($self, $v) { set_self_val($self, 'iv', $v); }
sub set_key($self, $v) { set_self_val($self, 'key', $v); }
#############################################################################
# Crypto functions ##########################################################
#############################################################################
sub encrypt_b64($self, $data) {
my $d = my_crypt_cbc($self, 'encrypt', $self->{cipher}, $self->{key}, $self->{iv}, $data);
return MIME::Base64::encode_base64url($d, ''); # '' for no line breaks
}
sub decrypt_b64($self, $data) {
my $d = MIME::Base64::decode_base64url($data);
return my_crypt_cbc($self, 'decrypt', $self->{cipher}, $self->{key}, $self->{iv}, $d);
}
# Helper function to centralize and reduce code duplication
sub my_crypt_cbc($self, $mode, $cipher, $key, $iv, $data) {
my $pkg = __PACKAGE__;
my $cbc = Crypt::Mode::CBC->new($cipher, 1);
if ($mode eq 'encrypt') {
my $payload = undef;
lib/Captcha/Stateless/Text.pm view on Meta::CPAN
sub getQA_math {
my $qa = $QAfuncs{math}(@_);
$_[0]->add_enc_payload($qa);
return $qa;
}
sub add_enc_payload($self, $qa) {
# Make and add the enc_payload
my $payload_json = to_json($qa);
my $enc_payload = $self->encrypt_b64($payload_json);
$qa->{enc_payload} = $self->{ep_pre} . $enc_payload;
}
sub validate($self, $answer, $enc_payload) {
my $ep_pre = $self->{ep_pre};
return 0 if (!(defined($enc_payload) && length($enc_payload)));
return 0 if ($enc_payload !~ m/^\Q$ep_pre\E/); # Invalid payload
$enc_payload =~ s/^\Q$ep_pre\E//; # Trim the prefix
my $payload = $self->decrypt_b64($enc_payload);
Carp-Assert-More
view release on metacpan or search on metacpan
Asserts that C<$condition> is a true value. This is the same as C<assert>
in C<Carp::Assert>, provided as a convenience.
=cut
sub assert($;$) {
my $condition = shift;
my $name = shift;
return if $condition;
C<undef> is not converted to an empty string. If both strings are
C<undef>, they match. If only one string is C<undef>, they don't match.
=cut
sub assert_is($$;$) {
my $string = shift;
my $match = shift;
my $name = shift;
if ( defined($string) ) {
C<undef> is not converted to an empty string.
=cut
sub assert_isnt($$;$) {
my $string = shift;
my $unmatch = shift;
my $name = shift;
# undef only matches undef
If the operator is numeric, and C<$x> or C<$y> are not numbers, the assertion will fail.
=cut
sub assert_cmp($$$;$) {
my $x = shift;
my $op = shift;
my $y = shift;
my $name = shift;
The assertion fails either the string or the regex are undef.
=cut
sub assert_like($$;$) {
my $string = shift;
my $regex = shift;
my $name = shift;
if ( defined($string) && !ref($string) ) {
The assertion fails if the regex is undef.
=cut
sub assert_unlike($$;$) {
my $string = shift;
my $regex = shift;
my $name = shift;
return if !defined($string);
Asserts that I<$this> is defined.
=cut
sub assert_defined($;$) {
return if defined( $_[0] );
require Carp;
&Carp::confess( _failure_msg($_[1]) );
}
Asserts that I<$this> is not defined.
=cut
sub assert_undefined($;$) {
return unless defined( $_[0] );
require Carp;
&Carp::confess( _failure_msg($_[1]) );
}
Asserts that I<$this> is not a reference and is not an empty string.
=cut
sub assert_nonblank($;$) {
my $this = shift;
my $name = shift;
my $why;
if ( !defined($this) ) {
Asserts that both C<$x> and C<$y> are true.
=cut
sub assert_and($$;$) {
my $x = shift;
my $y = shift;
my $name = shift;
return if $x && $y;
Asserts that at least one of C<$x> or C<$y> are true.
=cut
sub assert_or($$;$) {
my $x = shift;
my $y = shift;
my $name = shift;
return if $x || $y;
Asserts that C<$x> is true, or C<$y> is true, but not both.
=cut
sub assert_xor($$;$) {
my $x = shift;
my $y = shift;
my $name = shift;
return if $x && !$y;
assert_integer( -14 ); # pass
assert_integer( '14.' ); # FAIL
=cut
sub assert_integer($;$) {
my $this = shift;
my $name = shift;
if ( defined($this) ) {
return if $this =~ $INTEGER;
assert_nonzero( -14 ); # pass
assert_nonzero( '14.' ); # pass
=cut
sub assert_nonzero($;$) {
my $this = shift;
my $name = shift;
if ( Scalar::Util::looks_like_number($this) ) {
return if $this != 0;
assert_positive( -14 ); # FAIL
assert_positive( '14.' ); # pass
=cut
sub assert_positive($;$) {
my $this = shift;
my $name = shift;
if ( Scalar::Util::looks_like_number($this) ) {
return if ($this+0 > 0);
assert_nonnegative( '14.' ); # pass
assert_nonnegative( 'dog' ); # pass
=cut
sub assert_nonnegative($;$) {
my $this = shift;
my $name = shift;
if ( Scalar::Util::looks_like_number( $this ) ) {
return if $this >= 0;
assert_negative( -14 ); # pass
assert_negative( '14.' ); # FAIL
=cut
sub assert_negative($;$) {
my $this = shift;
my $name = shift;
no warnings;
return if defined($this) && ($this+0 < 0);
assert_nonzero_integer( -14 ); # pass
assert_nonzero_integer( '14.' ); # FAIL
=cut
sub assert_nonzero_integer($;$) {
my $this = shift;
my $name = shift;
if ( defined($this) && ($this =~ $INTEGER) ) {
return if $this != 0;
assert_positive_integer( '14.' ); # FAIL
assert_positive_integer( '14' ); # pass
=cut
sub assert_positive_integer($;$) {
my $this = shift;
my $name = shift;
if ( defined($this) && ($this =~ $INTEGER) ) {
return if $this > 0;
assert_nonnegative_integer( -14 ); # FAIL
assert_nonnegative_integer( '14.' ); # FAIL
=cut
sub assert_nonnegative_integer($;$) {
my $this = shift;
my $name = shift;
if ( defined($this) && ($this =~ $INTEGER) ) {
return if $this >= 0;
assert_negative_integer( -14 ); # pass
assert_negative_integer( '14.' ); # FAIL
=cut
sub assert_negative_integer($;$) {
my $this = shift;
my $name = shift;
if ( defined($this) && ($this =~ $INTEGER) ) {
return if $this < 0;
assert_numeric_between( 10, 15, 100 ); # FAIL
assert_numeric_between( 3.14, 1, 10 ); # pass
=cut
sub assert_numeric_between($$$;$) {
my $n = shift;
my $lo = shift;
my $hi = shift;
my $name = shift;
assert_integer_between( 10, 15, 100 ); # FAIL
assert_integer_between( 3.14, 1, 10 ); # FAIL
=cut
sub assert_integer_between($$$;$) {
my $n = shift;
my $lo = shift;
my $hi = shift;
my $name = shift;
Asserts that I<$this> is an object of type I<$type>.
=cut
sub assert_isa($$;$) {
my $this = shift;
my $type = shift;
my $name = shift;
# The assertion is true if
assert_isa_in( $obj, [ 'My::Foo', 'My::Bar' ], 'Must pass either a Foo or Bar object' );
=cut
sub assert_isa_in($$;$) {
my $obj = shift;
my $types = shift;
my $name = shift;
if ( Scalar::Util::blessed($obj) ) {
assert_empty( {foo=>1} );# FAIL
assert_empty( [1,2,3] ); # FAIL
=cut
sub assert_empty($;$) {
my $ref = shift;
my $name = shift;
my $underlying_type;
if ( Scalar::Util::blessed( $ref ) ) {
assert_nonempty( {foo=>1} );# pass
assert_nonempty( [1,2,3] ); # pass
=cut
sub assert_nonempty($;$) {
my $ref = shift;
my $name = shift;
my $underlying_type;
if ( Scalar::Util::blessed( $ref ) ) {
Asserts that I<$this> is not undef and not a reference.
=cut
sub assert_nonref($;$) {
my $this = shift;
my $name = shift;
assert_defined( $this, $name );
return unless ref( $this );
=back
=cut
sub assert_hashref($;$) {
my $ref = shift;
my $name = shift;
if ( ref($ref) eq 'HASH' || (Scalar::Util::blessed( $ref ) && $ref->isa( 'HASH' )) ) {
return;
Asserts that I<$ref> is defined and is a reference to a hash with at
least one key/value pair.
=cut
sub assert_hashref_nonempty($;$) {
my $ref = shift;
my $name = shift;
if ( ref($ref) eq 'HASH' || (Scalar::Util::blessed( $ref ) && $ref->isa( 'HASH' )) ) {
return if scalar keys %{$ref} > 0;
C<assert_listref> is an alias for C<assert_arrayref> and may go away in
the future. Use C<assert_arrayref> instead.
=cut
sub assert_arrayref($;$) {
my $ref = shift;
my $name = shift;
if ( ref($ref) eq 'ARRAY' || (Scalar::Util::blessed( $ref ) && $ref->isa( 'ARRAY' )) ) {
return;
Asserts that I<$ref> is reference to an array that has at least one element in it.
=cut
sub assert_arrayref_nonempty($;$) {
my $ref = shift;
my $name = shift;
if ( ref($ref) eq 'ARRAY' || (Scalar::Util::blessed( $ref ) && $ref->isa( 'ARRAY' )) ) {
return if scalar @{$ref} > 0;
my @users = get_users();
assert_arrayref_of( \@users, 'My::User' );
=cut
sub assert_arrayref_of($$;$) {
my $ref = shift;
my $type = shift;
my $name = shift;
my $ok;
This is the same function as C<assert_arrayref_of>, except that it also
requires at least one element.
=cut
sub assert_arrayref_nonempty_of($$;$) {
my $ref = shift;
my $type = shift;
my $name = shift;
my $ok;
Whatever is passed as I<$name>, a string saying "Element #N" will be
appended, where N is the zero-based index of the array.
=cut
sub assert_arrayref_all($$;$) {
my $aref = shift;
my $sub = shift;
my $name = shift;
my @why;
Asserts that I<$ref> is defined, and is a reference to a closure.
=cut
sub assert_coderef($;$) {
my $ref = shift;
my $name = shift;
if ( ref($ref) eq 'CODE' || (Scalar::Util::blessed( $ref ) && $ref->isa( 'CODE' )) ) {
return;
It is functionally the same as C<assert_isa( $ref, 'Regexp' )>.
=cut
sub assert_regex($;$) {
my $ref = shift;
my $name = shift;
if ( ref($ref) eq 'Regexp' ) {
return;
Asserts that C<$date> is a DateTime object.
=cut
sub assert_datetime($;$) {
my $ref = shift;
my $name = shift;
if ( ref($ref) eq 'DateTime' || (Scalar::Util::blessed( $ref ) && $ref->isa( 'DateTime' )) ) {
return;
I<\@inlist> must be an array reference of non-ref strings. If any
element is a reference, the assertion fails.
=cut
sub assert_in($$;$) {
my $needle = shift;
my $haystack = shift;
my $name = shift;
my $found = 0;
assert_exists( \%custinfo, [qw( name addr phone )],
'Customer has name, address and phone' );
=cut
sub assert_exists($$;$) {
my $hash = shift;
my $key = shift;
my $name = shift;
my $ok = 0;
assert_lacks( \%users, [qw( root admin nobody )], 'No bad usernames found' );
=cut
sub assert_lacks($$;$) {
my $hash = shift;
my $key = shift;
my $name = shift;
my $ok = 0;
You can pass an empty list of C<@names>.
=cut
sub assert_all_keys_in($$;$) {
my $hash = shift;
my $keys = shift;
my $name = shift;
my @why;
Asserts that the keys for C<%hash> are exactly C<@keys>, no more and no less.
=cut
sub assert_keys_are($$;$) {
my $hash = shift;
my $keys = shift;
my $name = shift;
my @why;
If the C<$name> argument is not passed, a default message of "<funcname>
must not be called in void context" is provided.
=cut
sub assert_context_nonvoid(;$) {
my (undef, undef, undef, $subroutine, undef, $wantarray) = caller(1);
return if defined($wantarray);
my $name = $_[0] // "$subroutine must not be called in void context";
If the C<$name> argument is not passed, a default message of "<funcname>
must be called in void context" is provided.
=cut
sub assert_context_void(;$) {
my (undef, undef, undef, $subroutine, undef, $wantarray) = caller(1);
return if not defined($wantarray);
my $name = $_[0] // "$subroutine must be called in void context";
If the C<$name> argument is not passed, a default message of "<funcname>
must be called in scalar context" is provided.
=cut
sub assert_context_scalar(;$) {
my (undef, undef, undef, $subroutine, undef, $wantarray) = caller(1);
return if defined($wantarray) && !$wantarray;
my $name = $_[0] // "$subroutine must be called in scalar context";
If the C<$name> argument is not passed, a default message of "<funcname>
must be called in list context" is provided.
=cut
sub assert_context_list(;$) {
my (undef, undef, undef, $subroutine, undef, $wantarray) = caller(1);
return if $wantarray;
my $name = shift // "$subroutine must be called in list context";
as calling C<assert(0,$msg)>, but it eliminates that case where you
accidentally use C<assert($msg)>, which of course never fires.
=cut
sub assert_fail(;$) {
require Carp;
&Carp::confess( _failure_msg($_[0]) );
}
Carp-Ensure
view release on metacpan or search on metacpan
@EXPORT = qw( ensure DEBUG );
@EXPORT_OK = qw( is_a );
$EXPORT_TAGS{NDEBUG} = $EXPORT_TAGS{DEBUG} = [ @EXPORT ];
sub REAL_DEBUG() { 1 }
sub NDEBUG() { 0 }
sub noop { undef }
# Export the proper DEBUG flag according to if :NDEBUG is set.
# Also export noop versions of our routines if NDEBUG
sub import($@) {
my( $cls, @syms ) = @_;
if(scalar(grep{ $_ eq ':NDEBUG' }(@syms)) ||
(exists($ENV{PERL_NDEBUG}) ? $ENV{PERL_NDEBUG} : $ENV{'NDEBUG'})) {
my $dst = caller();
*DEBUG = *REAL_DEBUG;
Carp::Ensure->export_to_level(1, $cls, @syms);
}
}
sub unimport($@) {
my( $cls, @syms ) = @_;
*DEBUG = *NDEBUG;
import($cls, ':NDEBUG', @syms);
}
works as expected. If you say C<no Carp::Ensure> then the whole call is
compiled away from the program and has no impact on efficiency.
=cut
sub ensure($@) {
# Call it with our arguments to save a copy
my $err = &_is_not;
confess("ensure: $err")
if $err;
return !undef;
If a false value is returned I<$@> is set to an error message. Otherwise I<$@>
is undefined.
=cut
sub is_a($@) {
# Call it with our arguments to save a copy
$@ = &_is_not;
return !$@;
}
my $ErrTpCall = 1;
my $ErrTpDscr = 2;
my $ErrTpType = 3;
# This does the real work. Returns an error message or undef.
sub _is_not($@) {
my $tp = shift();
my $err;
unless(defined($tp))
{ $err = "$ErrTpCall Undefined first argument"; }
I<hash> | I<array> | I<alternative>
=cut
sub _type($$$ ) {
my( $tp, $idx, $arr ) = @_;
if($tp =~ /^\@/)
{ return _array($tp, $idx, $arr); }
elsif($tp =~ /^\%/)
'C<%>' I<alternative> 'C<=>>' I<alternative>
=cut
sub _hash($$$ ) {
my( $tp, $idx, $arr ) = @_;
$tp =~ s/^\%//;
return "$ErrTpDscr Missing `=>' in hash type `\%$tp'"
unless $tp =~ /=>/;
'C<@>' I<alternative>
=cut
sub _array($$$ ) {
my( $tp, $idx, $arr ) = @_;
$tp =~ s/^\@//;
my $err;
I<simple> 'C<|>' I<alternative> | I<simple>
=cut
sub _alternative($$) {
my( $tp, $val ) = @_;
return _simple($tp, $val)
unless $tp =~ /\|/;
=cut
my @referenceSs = qw( HASH ARRAY CODE GLOB );
sub _reference($$) {
my( $tp, $val ) = @_;
if(grep{ $tp eq $_ }(@referenceSs))
{ return _is_a($tp, $val); }
elsif($tp =~ /^\^/)
I<user>
=cut
sub _dynamic($$) {
my( $tp, $val ) = @_;
return _user($tp, $val);
}
=cut
my @specialSs = qw( undefined defined anything );
sub _special($$) {
my( $tp, $val ) = @_;
return _is_a($tp, $val);
}
=cut
my @scalarSs = qw( string word empty integer float boolean regex );
sub _scalar($$) {
my( $tp, $val ) = @_;
return "$ErrTpDscr Unknown scalar type `$tp'"
unless grep{ $tp eq $_ }(@scalarSs);
Some::Class|^Some::Class
=cut
sub _class($$) {
my( $tp, $val ) = @_;
$tp =~ /^\^/;
my $cls = $';
return ref($val) eq "SCALAR" && eval { $$val->isa($cls) } ? undef :
=cut
my $objectRe = '[A-Z]\w*(::\w+)*';
sub _object($$) {
my( $tp, $val ) = @_;
return ref($val) eq "REF" && UNIVERSAL::isa($$val, $tp) ? undef :
"$ErrTpType `" . $$val . "' is not of type `$tp'";
}
=cut
my $userRe = '[a-z]\w*';
sub _user($$) {
my( $tp, $val ) = @_;
return _is_a($tp, $val);
}
###############################################################################
sub _simple($$) {
my( $tp, $val ) = @_;
if(grep{ $tp eq $_ }(@scalarSs))
{ return _scalar($tp, $val); }
elsif(grep{ $tp eq $_ }(@specialSs))
=cut
###############################################################################
# Calls the `is_a_$tp'(`$val') sub.
sub _is_a($$) {
my( $tp, $val ) = @_;
my $sub = "is_a_$tp";
no strict 'refs';
return "$ErrTpDscr No user defined test `Carp::Ensure::$sub'"
The value is a reference(!) to a hash with arbitrary keys and values. Use this
if you don't want to check the hash content.
=cut
sub is_a_HASH($ ) {
my( $r ) = @_;
return ref($r) eq "REF" && ref($$r) eq "HASH";
}
The value is a reference(!) to an array with arbitrary content. Use this if you
don't want to check the array content.
=cut
sub is_a_ARRAY($ ) {
my( $r ) = @_;
return ref($r) eq "REF" && ref($$r) eq "ARRAY";
}
The value is a reference to some code. This may be an anonymous or a named sub.
=cut
sub is_a_CODE($ ) {
my( $r ) = @_;
return ref($r) eq "REF" && ref($$r) eq "CODE";
}
The value is a GLOB.
=cut
sub is_a_GLOB($ ) {
my( $r ) = @_;
return ref($r) eq "GLOB";
}
Only the undefined value is permitted. Often used as one part of an
alternative. Missing optional arguments of a sub are undefined, also.
=cut
sub is_a_undefined($ ) {
my( $r ) = @_;
return ref($r) eq "SCALAR" && !defined($$r);
}
The value only needs to be defined.
=cut
sub is_a_defined($ ) {
my( $r ) = @_;
return defined($$r);
}
Actually not a test since anything is permitted.
=cut
sub is_a_anything($ ) {
return !undef;
}
###############################################################################
An arbitrary string.
=cut
sub is_a_string($ ) {
my( $r ) = @_;
return ref($r) eq "SCALAR";
}
A string matching C</w+/>.
=cut
sub is_a_word($ ) {
my( $r ) = @_;
return ref($r) eq "SCALAR" && $$r =~ /^\w+$/;
}
An empty string.
=cut
sub is_a_empty($ ) {
my( $r ) = @_;
return ref($r) eq "SCALAR" && defined($$r) && $$r eq "";
}
An integer.
=cut
sub is_a_integer($ ) {
my( $r ) = @_;
return ref($r) eq "SCALAR" && $$r =~/^[-+]?\d+$/;
}
An floating point number.
=cut
sub is_a_float($ ) {
my( $r ) = @_;
return ref($r) eq "SCALAR" && $$r =~ /^[-+]?(\d+(\.\d*)?|\.\d+)([Ee][-+]?\d+)?$/;
}
A boolean. Actually every scalar is a boolean in Perl, so this is more a
description of how a certain value is used.
=cut
sub is_a_boolean($ ) {
my( $r ) = @_;
return ref($r) eq "SCALAR";
}
Note, that nothing prevents the C<regex> from executing arbitrary code if you
manage to include this somehow. The results are completly undefined.
=cut
sub is_a_regex($ ) {
my( $r ) = @_;
return ref($r) eq "SCALAR" && defined($$r) && defined(eval { "" =~ /$$r/ });
}
Carp-Fix-1_25
view release on metacpan or search on metacpan
t/lib/Test/More.pm view on Meta::CPAN
cmp_ok( $some_value, '<=', $upper_limit );
=cut
sub cmp_ok($$$;$) {
my $tb = Test::More->builder;
return $tb->cmp_ok(@_);
}
Carrot
view release on metacpan or search on metacpan
lib/Carrot/Continuity/Coordination/Episode/Loop.pm view on Meta::CPAN
$expressiveness->declare_provider;
# =--------------------------------------------------------------------------= #
sub T_ETERNITY() { 2**31 -1; };
sub attribute_construction
# /type method
# /effect "Constructs the attribute(s) of a newly created instance."
# //parameters
Catalyst-Action-Firebug
view release on metacpan or search on metacpan
inc/Test/Base.pm view on Meta::CPAN
$default_object ||= $default_class->new;
return $default_object;
}
my $import_called = 0;
sub import() {
$import_called = 1;
my $class = (grep /^-base$/i, @_)
? scalar(caller)
: $_[0];
if (not defined $default_class) {
inc/Test/Base.pm view on Meta::CPAN
$caller =~ s/.*:://;
croak "Too late to call $caller()"
}
}
sub find_my_self() {
my $self = ref($_[0]) eq $default_class
? splice(@_, 0, 1)
: default_object();
return $self, @_;
}
sub blocks() {
(my ($self), @_) = find_my_self(@_);
croak "Invalid arguments passed to 'blocks'"
if @_ > 1;
croak sprintf("'%s' is invalid argument to blocks()", shift(@_))
inc/Test/Base.pm view on Meta::CPAN
}
return (@blocks);
}
sub next_block() {
(my ($self), @_) = find_my_self(@_);
my $list = $self->_next_list;
if (@$list == 0) {
$list = [@{$self->block_list}, undef];
$self->_next_list($list);
inc/Test/Base.pm view on Meta::CPAN
$block->run_filters;
}
return $block;
}
sub first_block() {
(my ($self), @_) = find_my_self(@_);
$self->_next_list([]);
$self->next_block;
}
sub filters_delay() {
(my ($self), @_) = find_my_self(@_);
$self->_filters_delay(defined $_[0] ? shift : 1);
}
sub no_diag_on_only() {
(my ($self), @_) = find_my_self(@_);
$self->_no_diag_on_only(defined $_[0] ? shift : 1);
}
sub delimiters() {
(my ($self), @_) = find_my_self(@_);
$self->check_late;
my ($block_delimiter, $data_delimiter) = @_;
$block_delimiter ||= $self->block_delim_default;
$data_delimiter ||= $self->data_delim_default;
$self->block_delim($block_delimiter);
$self->data_delim($data_delimiter);
return $self;
}
sub spec_file() {
(my ($self), @_) = find_my_self(@_);
$self->check_late;
$self->_spec_file(shift);
return $self;
}
sub spec_string() {
(my ($self), @_) = find_my_self(@_);
$self->check_late;
$self->_spec_string(shift);
return $self;
}
sub filters() {
(my ($self), @_) = find_my_self(@_);
if (ref($_[0]) eq 'HASH') {
$self->_filters_map(shift);
}
else {
inc/Test/Base.pm view on Meta::CPAN
push @$filters, @_;
}
return $self;
}
sub filter_arguments() {
$Test::Base::Filter::arguments;
}
sub have_text_diff {
eval { require Text::Diff; 1 } &&
$Text::Diff::VERSION >= 0.35 &&
$Algorithm::Diff::VERSION >= 1.15;
}
sub is($$;$) {
(my ($self), @_) = find_my_self(@_);
my ($actual, $expected, $name) = @_;
local $Test::Builder::Level = $Test::Builder::Level + 1;
if ($ENV{TEST_SHOW_NO_DIFFS} or
not defined $actual or
inc/Test/Base.pm view on Meta::CPAN
ok $actual eq $expected,
$name . "\n" . Text::Diff::diff(\$expected, \$actual);
}
}
sub run(&;$) {
(my ($self), @_) = find_my_self(@_);
my $callback = shift;
for my $block (@{$self->block_list}) {
$block->run_filters unless $block->is_filtered;
&{$callback}($block);
inc/Test/Base.pm view on Meta::CPAN
sub END {
run_compare() unless $Have_Plan or $DIED or not $import_called;
}
sub run_compare() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
local $Test::Builder::Level = $Test::Builder::Level + 1;
for my $block (@{$self->block_list}) {
inc/Test/Base.pm view on Meta::CPAN
is($block->$x, $block->$y, $block->name ? $block->name : ());
}
}
}
sub run_is() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
local $Test::Builder::Level = $Test::Builder::Level + 1;
for my $block (@{$self->block_list}) {
inc/Test/Base.pm view on Meta::CPAN
$block->name ? $block->name : ()
);
}
}
sub run_is_deeply() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and exists($block->{$y});
inc/Test/Base.pm view on Meta::CPAN
$block->name ? $block->name : ()
);
}
}
sub run_like() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and defined($y);
inc/Test/Base.pm view on Meta::CPAN
$block->name ? $block->name : ()
);
}
}
sub run_unlike() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and defined($y);
inc/Test/Base.pm view on Meta::CPAN
};
}
return $spec;
}
sub _strict_warnings() {
require Filter::Util::Call;
my $done = 0;
Filter::Util::Call::filter_add(
sub {
return 0 if $done;
inc/Test/Base.pm view on Meta::CPAN
$done = 1;
}
);
}
sub tie_output() {
my $handle = shift;
die "No buffer to tie" unless @_;
tie $handle, 'Test::Base::Handle', $_[0];
}
inc/Test/Base.pm view on Meta::CPAN
$ENV{TEST_SHOW_NO_DIFFS} = 1;
}
package Test::Base::Handle;
sub TIEHANDLE() {
my $class = shift;
bless \ $_[0], $class;
}
sub PRINT {
inc/Test/Base.pm view on Meta::CPAN
sub AUTOLOAD {
return;
}
sub block_accessor() {
my $accessor = shift;
no strict 'refs';
return if defined &$accessor;
*$accessor = sub {
my $self = shift;
Catalyst-Action-Wizard
view release on metacpan or search on metacpan
lib/Catalyst/Action/Wizard.pm view on Meta::CPAN
use base 'Catalyst::Action';
our $VERSION = '0.008';
sub refaddr($) {
sprintf "%x", Scalar::Util::refaddr(shift);
}
sub _current_wizard {
return Catalyst::Wizard::_current_wizard(@_);
Catalyst-Authentication-Credential-RPX
view release on metacpan or search on metacpan
t/05_token.t view on Meta::CPAN
use Test::MockObject;
use Test::More tests => 10;
use Test::Fatal;
sub RPX() {
'Catalyst::Authentication::Credential::RPX';
}
sub APIRPX() {
'Net::API::RPX';
}
# Order is important
Catalyst-Controller-Atompub
view release on metacpan or search on metacpan
inc/Test/More.pm view on Meta::CPAN
return $tb->unlike(@_);
}
#line 476
sub cmp_ok($$$;$) {
my $tb = Test::More->builder;
return $tb->cmp_ok(@_);
}
Catalyst-Controller-FlashRemoting
view release on metacpan or search on metacpan
inc/Test/Base.pm view on Meta::CPAN
$default_object ||= $default_class->new;
return $default_object;
}
my $import_called = 0;
sub import() {
$import_called = 1;
my $class = (grep /^-base$/i, @_)
? scalar(caller)
: $_[0];
if (not defined $default_class) {
inc/Test/Base.pm view on Meta::CPAN
$caller =~ s/.*:://;
croak "Too late to call $caller()"
}
}
sub find_my_self() {
my $self = ref($_[0]) eq $default_class
? splice(@_, 0, 1)
: default_object();
return $self, @_;
}
sub blocks() {
(my ($self), @_) = find_my_self(@_);
croak "Invalid arguments passed to 'blocks'"
if @_ > 1;
croak sprintf("'%s' is invalid argument to blocks()", shift(@_))
inc/Test/Base.pm view on Meta::CPAN
}
return (@blocks);
}
sub next_block() {
(my ($self), @_) = find_my_self(@_);
my $list = $self->_next_list;
if (@$list == 0) {
$list = [@{$self->block_list}, undef];
$self->_next_list($list);
inc/Test/Base.pm view on Meta::CPAN
$block->run_filters;
}
return $block;
}
sub first_block() {
(my ($self), @_) = find_my_self(@_);
$self->_next_list([]);
$self->next_block;
}
sub filters_delay() {
(my ($self), @_) = find_my_self(@_);
$self->_filters_delay(defined $_[0] ? shift : 1);
}
sub no_diag_on_only() {
(my ($self), @_) = find_my_self(@_);
$self->_no_diag_on_only(defined $_[0] ? shift : 1);
}
sub delimiters() {
(my ($self), @_) = find_my_self(@_);
$self->check_late;
my ($block_delimiter, $data_delimiter) = @_;
$block_delimiter ||= $self->block_delim_default;
$data_delimiter ||= $self->data_delim_default;
$self->block_delim($block_delimiter);
$self->data_delim($data_delimiter);
return $self;
}
sub spec_file() {
(my ($self), @_) = find_my_self(@_);
$self->check_late;
$self->_spec_file(shift);
return $self;
}
sub spec_string() {
(my ($self), @_) = find_my_self(@_);
$self->check_late;
$self->_spec_string(shift);
return $self;
}
sub filters() {
(my ($self), @_) = find_my_self(@_);
if (ref($_[0]) eq 'HASH') {
$self->_filters_map(shift);
}
else {
inc/Test/Base.pm view on Meta::CPAN
push @$filters, @_;
}
return $self;
}
sub filter_arguments() {
$Test::Base::Filter::arguments;
}
sub have_text_diff {
eval { require Text::Diff; 1 } &&
$Text::Diff::VERSION >= 0.35 &&
$Algorithm::Diff::VERSION >= 1.15;
}
sub is($$;$) {
(my ($self), @_) = find_my_self(@_);
my ($actual, $expected, $name) = @_;
local $Test::Builder::Level = $Test::Builder::Level + 1;
if ($ENV{TEST_SHOW_NO_DIFFS} or
not defined $actual or
inc/Test/Base.pm view on Meta::CPAN
ok $actual eq $expected,
$name . "\n" . Text::Diff::diff(\$expected, \$actual);
}
}
sub run(&;$) {
(my ($self), @_) = find_my_self(@_);
my $callback = shift;
for my $block (@{$self->block_list}) {
$block->run_filters unless $block->is_filtered;
&{$callback}($block);
inc/Test/Base.pm view on Meta::CPAN
sub END {
run_compare() unless $Have_Plan or $DIED or not $import_called;
}
sub run_compare() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
local $Test::Builder::Level = $Test::Builder::Level + 1;
for my $block (@{$self->block_list}) {
inc/Test/Base.pm view on Meta::CPAN
is($block->$x, $block->$y, $block->name ? $block->name : ());
}
}
}
sub run_is() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
local $Test::Builder::Level = $Test::Builder::Level + 1;
for my $block (@{$self->block_list}) {
inc/Test/Base.pm view on Meta::CPAN
$block->name ? $block->name : ()
);
}
}
sub run_is_deeply() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and exists($block->{$y});
inc/Test/Base.pm view on Meta::CPAN
$block->name ? $block->name : ()
);
}
}
sub run_like() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and defined($y);
inc/Test/Base.pm view on Meta::CPAN
$block->name ? $block->name : ()
);
}
}
sub run_unlike() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and defined($y);
inc/Test/Base.pm view on Meta::CPAN
};
}
return $spec;
}
sub _strict_warnings() {
require Filter::Util::Call;
my $done = 0;
Filter::Util::Call::filter_add(
sub {
return 0 if $done;
inc/Test/Base.pm view on Meta::CPAN
$done = 1;
}
);
}
sub tie_output() {
my $handle = shift;
die "No buffer to tie" unless @_;
tie $handle, 'Test::Base::Handle', $_[0];
}
inc/Test/Base.pm view on Meta::CPAN
$ENV{TEST_SHOW_NO_DIFFS} = 1;
}
package Test::Base::Handle;
sub TIEHANDLE() {
my $class = shift;
bless \ $_[0], $class;
}
sub PRINT {
inc/Test/Base.pm view on Meta::CPAN
sub AUTOLOAD {
return;
}
sub block_accessor() {
my $accessor = shift;
no strict 'refs';
return if defined &$accessor;
*$accessor = sub {
my $self = shift;
Catalyst-Controller-Mobile-JP
view release on metacpan or search on metacpan
inc/Test/Base.pm view on Meta::CPAN
$default_object ||= $default_class->new;
return $default_object;
}
my $import_called = 0;
sub import() {
$import_called = 1;
my $class = (grep /^-base$/i, @_)
? scalar(caller)
: $_[0];
if (not defined $default_class) {
inc/Test/Base.pm view on Meta::CPAN
$caller =~ s/.*:://;
croak "Too late to call $caller()"
}
}
sub find_my_self() {
my $self = ref($_[0]) eq $default_class
? splice(@_, 0, 1)
: default_object();
return $self, @_;
}
sub blocks() {
(my ($self), @_) = find_my_self(@_);
croak "Invalid arguments passed to 'blocks'"
if @_ > 1;
croak sprintf("'%s' is invalid argument to blocks()", shift(@_))
inc/Test/Base.pm view on Meta::CPAN
}
return (@blocks);
}
sub next_block() {
(my ($self), @_) = find_my_self(@_);
my $list = $self->_next_list;
if (@$list == 0) {
$list = [@{$self->block_list}, undef];
$self->_next_list($list);
inc/Test/Base.pm view on Meta::CPAN
$block->run_filters;
}
return $block;
}
sub first_block() {
(my ($self), @_) = find_my_self(@_);
$self->_next_list([]);
$self->next_block;
}
sub filters_delay() {
(my ($self), @_) = find_my_self(@_);
$self->_filters_delay(defined $_[0] ? shift : 1);
}
sub no_diag_on_only() {
(my ($self), @_) = find_my_self(@_);
$self->_no_diag_on_only(defined $_[0] ? shift : 1);
}
sub delimiters() {
(my ($self), @_) = find_my_self(@_);
$self->check_late;
my ($block_delimiter, $data_delimiter) = @_;
$block_delimiter ||= $self->block_delim_default;
$data_delimiter ||= $self->data_delim_default;
$self->block_delim($block_delimiter);
$self->data_delim($data_delimiter);
return $self;
}
sub spec_file() {
(my ($self), @_) = find_my_self(@_);
$self->check_late;
$self->_spec_file(shift);
return $self;
}
sub spec_string() {
(my ($self), @_) = find_my_self(@_);
$self->check_late;
$self->_spec_string(shift);
return $self;
}
sub filters() {
(my ($self), @_) = find_my_self(@_);
if (ref($_[0]) eq 'HASH') {
$self->_filters_map(shift);
}
else {
inc/Test/Base.pm view on Meta::CPAN
push @$filters, @_;
}
return $self;
}
sub filter_arguments() {
$Test::Base::Filter::arguments;
}
sub have_text_diff {
eval { require Text::Diff; 1 } &&
$Text::Diff::VERSION >= 0.35 &&
$Algorithm::Diff::VERSION >= 1.15;
}
sub is($$;$) {
(my ($self), @_) = find_my_self(@_);
my ($actual, $expected, $name) = @_;
local $Test::Builder::Level = $Test::Builder::Level + 1;
if ($ENV{TEST_SHOW_NO_DIFFS} or
not defined $actual or
inc/Test/Base.pm view on Meta::CPAN
ok $actual eq $expected,
$name . "\n" . Text::Diff::diff(\$expected, \$actual);
}
}
sub run(&;$) {
(my ($self), @_) = find_my_self(@_);
my $callback = shift;
for my $block (@{$self->block_list}) {
$block->run_filters unless $block->is_filtered;
&{$callback}($block);
inc/Test/Base.pm view on Meta::CPAN
sub END {
run_compare() unless $Have_Plan or $DIED or not $import_called;
}
sub run_compare() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
local $Test::Builder::Level = $Test::Builder::Level + 1;
for my $block (@{$self->block_list}) {
inc/Test/Base.pm view on Meta::CPAN
is($block->$x, $block->$y, $block->name ? $block->name : ());
}
}
}
sub run_is() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
local $Test::Builder::Level = $Test::Builder::Level + 1;
for my $block (@{$self->block_list}) {
inc/Test/Base.pm view on Meta::CPAN
$block->name ? $block->name : ()
);
}
}
sub run_is_deeply() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and exists($block->{$y});
inc/Test/Base.pm view on Meta::CPAN
$block->name ? $block->name : ()
);
}
}
sub run_like() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and defined($y);
inc/Test/Base.pm view on Meta::CPAN
$block->name ? $block->name : ()
);
}
}
sub run_unlike() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and defined($y);
inc/Test/Base.pm view on Meta::CPAN
};
}
return $spec;
}
sub _strict_warnings() {
require Filter::Util::Call;
my $done = 0;
Filter::Util::Call::filter_add(
sub {
return 0 if $done;
inc/Test/Base.pm view on Meta::CPAN
$done = 1;
}
);
}
sub tie_output() {
my $handle = shift;
die "No buffer to tie" unless @_;
tie $handle, 'Test::Base::Handle', $_[0];
}
inc/Test/Base.pm view on Meta::CPAN
$ENV{TEST_SHOW_NO_DIFFS} = 1;
}
package Test::Base::Handle;
sub TIEHANDLE() {
my $class = shift;
bless \ $_[0], $class;
}
sub PRINT {
inc/Test/Base.pm view on Meta::CPAN
sub AUTOLOAD {
return;
}
sub block_accessor() {
my $accessor = shift;
no strict 'refs';
return if defined &$accessor;
*$accessor = sub {
my $self = shift;
Catalyst-ControllerRole-At
view release on metacpan or search on metacpan
Under(root) At(a/b/c/{id}/...)
Under(root) At($action/{id}/{date}
/)
sub myaction($view, $model) :At($local/{id}) {
$view->ok($model->find($id));
}
NamedFields(id=>$args[0])
sub myaction :At($local/{u:User}?{page}&{order:Int}) {
$_->view->ok($_{u});
}
sub myaction($view, $model M::Schema::User::Result) :At($local/{id}) {
$view->ok($model->find($id));
}
Via(action)
At(/foo/{$:User.0}/{$:User.1}%{$:User.age}{$:User.name}
At(/user/{id:User}%{params*:User}
If a Type::Foo accepts context, then $c is part of any coercions
sub myaction(User $u) :At(/user/{id:User}) {
}
sub foo :Local Named(foo=>$arg[0],bar=>$query{id})
sub friend :Via(user) At({id:Friend[user:User.id
#######
sub myaction([$id1,$id2]->User $u) At(users/{id1:Int}/{id2:Int})
sub myaction([Arg,Arg]->User $u) At(users/{id1:Int}/{id2:Int})
# User isa Model::Type::User
sub myaction(User $u) Via(root) At(users/{User.0:id1}/{User.1:id2})
{
$_{User} isa Model::Schema::User::Result
}
OR
sub myaction([id1,id2]->User $u ==> UserResultSet)
Via(root) At(users/{id1:Int}/{id2:Int})
{
$_{User} isa Model::Schema::User::Result
}
Catalyst-Helper-FastCGI-ExternalServer
view release on metacpan or search on metacpan
inc/Test/Base.pm view on Meta::CPAN
$default_object ||= $default_class->new;
return $default_object;
}
my $import_called = 0;
sub import() {
$import_called = 1;
my $class = (grep /^-base$/i, @_)
? scalar(caller)
: $_[0];
if (not defined $default_class) {
inc/Test/Base.pm view on Meta::CPAN
$caller =~ s/.*:://;
croak "Too late to call $caller()"
}
}
sub find_my_self() {
my $self = ref($_[0]) eq $default_class
? splice(@_, 0, 1)
: default_object();
return $self, @_;
}
sub blocks() {
(my ($self), @_) = find_my_self(@_);
croak "Invalid arguments passed to 'blocks'"
if @_ > 1;
croak sprintf("'%s' is invalid argument to blocks()", shift(@_))
inc/Test/Base.pm view on Meta::CPAN
}
return (@blocks);
}
sub next_block() {
(my ($self), @_) = find_my_self(@_);
my $list = $self->_next_list;
if (@$list == 0) {
$list = [@{$self->block_list}, undef];
$self->_next_list($list);
inc/Test/Base.pm view on Meta::CPAN
$block->run_filters;
}
return $block;
}
sub first_block() {
(my ($self), @_) = find_my_self(@_);
$self->_next_list([]);
$self->next_block;
}
sub filters_delay() {
(my ($self), @_) = find_my_self(@_);
$self->_filters_delay(defined $_[0] ? shift : 1);
}
sub no_diag_on_only() {
(my ($self), @_) = find_my_self(@_);
$self->_no_diag_on_only(defined $_[0] ? shift : 1);
}
sub delimiters() {
(my ($self), @_) = find_my_self(@_);
$self->check_late;
my ($block_delimiter, $data_delimiter) = @_;
$block_delimiter ||= $self->block_delim_default;
$data_delimiter ||= $self->data_delim_default;
$self->block_delim($block_delimiter);
$self->data_delim($data_delimiter);
return $self;
}
sub spec_file() {
(my ($self), @_) = find_my_self(@_);
$self->check_late;
$self->_spec_file(shift);
return $self;
}
sub spec_string() {
(my ($self), @_) = find_my_self(@_);
$self->check_late;
$self->_spec_string(shift);
return $self;
}
sub filters() {
(my ($self), @_) = find_my_self(@_);
if (ref($_[0]) eq 'HASH') {
$self->_filters_map(shift);
}
else {
inc/Test/Base.pm view on Meta::CPAN
push @$filters, @_;
}
return $self;
}
sub filter_arguments() {
$Test::Base::Filter::arguments;
}
sub have_text_diff {
eval { require Text::Diff; 1 } &&
$Text::Diff::VERSION >= 0.35 &&
$Algorithm::Diff::VERSION >= 1.15;
}
sub is($$;$) {
(my ($self), @_) = find_my_self(@_);
my ($actual, $expected, $name) = @_;
local $Test::Builder::Level = $Test::Builder::Level + 1;
if ($ENV{TEST_SHOW_NO_DIFFS} or
not defined $actual or
inc/Test/Base.pm view on Meta::CPAN
ok $actual eq $expected,
$name . "\n" . Text::Diff::diff(\$expected, \$actual);
}
}
sub run(&;$) {
(my ($self), @_) = find_my_self(@_);
my $callback = shift;
for my $block (@{$self->block_list}) {
$block->run_filters unless $block->is_filtered;
&{$callback}($block);
inc/Test/Base.pm view on Meta::CPAN
sub END {
run_compare() unless $Have_Plan or $DIED or not $import_called;
}
sub run_compare() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
local $Test::Builder::Level = $Test::Builder::Level + 1;
for my $block (@{$self->block_list}) {
inc/Test/Base.pm view on Meta::CPAN
is($block->$x, $block->$y, $block->name ? $block->name : ());
}
}
}
sub run_is() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
local $Test::Builder::Level = $Test::Builder::Level + 1;
for my $block (@{$self->block_list}) {
inc/Test/Base.pm view on Meta::CPAN
$block->name ? $block->name : ()
);
}
}
sub run_is_deeply() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and exists($block->{$y});
inc/Test/Base.pm view on Meta::CPAN
$block->name ? $block->name : ()
);
}
}
sub run_like() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and defined($y);
inc/Test/Base.pm view on Meta::CPAN
$block->name ? $block->name : ()
);
}
}
sub run_unlike() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and defined($y);
inc/Test/Base.pm view on Meta::CPAN
};
}
return $spec;
}
sub _strict_warnings() {
require Filter::Util::Call;
my $done = 0;
Filter::Util::Call::filter_add(
sub {
return 0 if $done;
inc/Test/Base.pm view on Meta::CPAN
$done = 1;
}
);
}
sub tie_output() {
my $handle = shift;
die "No buffer to tie" unless @_;
tie $handle, 'Test::Base::Handle', $_[0];
}
inc/Test/Base.pm view on Meta::CPAN
$ENV{TEST_SHOW_NO_DIFFS} = 1;
}
package Test::Base::Handle;
sub TIEHANDLE() {
my $class = shift;
bless \ $_[0], $class;
}
sub PRINT {
inc/Test/Base.pm view on Meta::CPAN
sub AUTOLOAD {
return;
}
sub block_accessor() {
my $accessor = shift;
no strict 'refs';
return if defined &$accessor;
*$accessor = sub {
my $self = shift;
Catalyst-Log-Log4perl
view release on metacpan or search on metacpan
t/10-basic.t view on Meta::CPAN
# fetch the single appender so we can access log messages
my ($appender) = values %{ Log::Log4perl->appenders };
isa_ok( $appender, 'Log::Log4perl::Appender' );
sub log_ok($;$) {
my ( $check, $msg ) = @_;
is( $appender->string, $check, $msg );
$appender->string('');
}
sub log_like($;$) {
my ( $re, $msg ) = @_;
like( $appender->string, $re, $msg );
$appender->string('');
}
Catalyst-Model-MogileFS-Client
view release on metacpan or search on metacpan
inc/Test/Base.pm view on Meta::CPAN
$default_object ||= $default_class->new;
return $default_object;
}
my $import_called = 0;
sub import() {
$import_called = 1;
my $class = (grep /^-base$/i, @_)
? scalar(caller)
: $_[0];
if (not defined $default_class) {
inc/Test/Base.pm view on Meta::CPAN
$caller =~ s/.*:://;
croak "Too late to call $caller()"
}
}
sub find_my_self() {
my $self = ref($_[0]) eq $default_class
? splice(@_, 0, 1)
: default_object();
return $self, @_;
}
sub blocks() {
(my ($self), @_) = find_my_self(@_);
croak "Invalid arguments passed to 'blocks'"
if @_ > 1;
croak sprintf("'%s' is invalid argument to blocks()", shift(@_))
inc/Test/Base.pm view on Meta::CPAN
}
return (@blocks);
}
sub next_block() {
(my ($self), @_) = find_my_self(@_);
my $list = $self->_next_list;
if (@$list == 0) {
$list = [@{$self->block_list}, undef];
$self->_next_list($list);
inc/Test/Base.pm view on Meta::CPAN
$block->run_filters;
}
return $block;
}
sub first_block() {
(my ($self), @_) = find_my_self(@_);
$self->_next_list([]);
$self->next_block;
}
sub filters_delay() {
(my ($self), @_) = find_my_self(@_);
$self->_filters_delay(defined $_[0] ? shift : 1);
}
sub no_diag_on_only() {
(my ($self), @_) = find_my_self(@_);
$self->_no_diag_on_only(defined $_[0] ? shift : 1);
}
sub delimiters() {
(my ($self), @_) = find_my_self(@_);
$self->check_late;
my ($block_delimiter, $data_delimiter) = @_;
$block_delimiter ||= $self->block_delim_default;
$data_delimiter ||= $self->data_delim_default;
$self->block_delim($block_delimiter);
$self->data_delim($data_delimiter);
return $self;
}
sub spec_file() {
(my ($self), @_) = find_my_self(@_);
$self->check_late;
$self->_spec_file(shift);
return $self;
}
sub spec_string() {
(my ($self), @_) = find_my_self(@_);
$self->check_late;
$self->_spec_string(shift);
return $self;
}
sub filters() {
(my ($self), @_) = find_my_self(@_);
if (ref($_[0]) eq 'HASH') {
$self->_filters_map(shift);
}
else {
inc/Test/Base.pm view on Meta::CPAN
push @$filters, @_;
}
return $self;
}
sub filter_arguments() {
$Test::Base::Filter::arguments;
}
sub have_text_diff {
eval { require Text::Diff; 1 } &&
$Text::Diff::VERSION >= 0.35 &&
$Algorithm::Diff::VERSION >= 1.15;
}
sub is($$;$) {
(my ($self), @_) = find_my_self(@_);
my ($actual, $expected, $name) = @_;
local $Test::Builder::Level = $Test::Builder::Level + 1;
if ($ENV{TEST_SHOW_NO_DIFFS} or
not defined $actual or
inc/Test/Base.pm view on Meta::CPAN
ok $actual eq $expected,
$name . "\n" . Text::Diff::diff(\$expected, \$actual);
}
}
sub run(&;$) {
(my ($self), @_) = find_my_self(@_);
my $callback = shift;
for my $block (@{$self->block_list}) {
$block->run_filters unless $block->is_filtered;
&{$callback}($block);
inc/Test/Base.pm view on Meta::CPAN
sub END {
run_compare() unless $Have_Plan or $DIED or not $import_called;
}
sub run_compare() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
local $Test::Builder::Level = $Test::Builder::Level + 1;
for my $block (@{$self->block_list}) {
inc/Test/Base.pm view on Meta::CPAN
is($block->$x, $block->$y, $block->name ? $block->name : ());
}
}
}
sub run_is() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
local $Test::Builder::Level = $Test::Builder::Level + 1;
for my $block (@{$self->block_list}) {
inc/Test/Base.pm view on Meta::CPAN
$block->name ? $block->name : ()
);
}
}
sub run_is_deeply() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and exists($block->{$y});
inc/Test/Base.pm view on Meta::CPAN
$block->name ? $block->name : ()
);
}
}
sub run_like() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and defined($y);
inc/Test/Base.pm view on Meta::CPAN
$block->name ? $block->name : ()
);
}
}
sub run_unlike() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and defined($y);
inc/Test/Base.pm view on Meta::CPAN
};
}
return $spec;
}
sub _strict_warnings() {
require Filter::Util::Call;
my $done = 0;
Filter::Util::Call::filter_add(
sub {
return 0 if $done;
inc/Test/Base.pm view on Meta::CPAN
$done = 1;
}
);
}
sub tie_output() {
my $handle = shift;
die "No buffer to tie" unless @_;
tie $handle, 'Test::Base::Handle', $_[0];
}
inc/Test/Base.pm view on Meta::CPAN
$ENV{TEST_SHOW_NO_DIFFS} = 1;
}
package Test::Base::Handle;
sub TIEHANDLE() {
my $class = shift;
bless \ $_[0], $class;
}
sub PRINT {
inc/Test/Base.pm view on Meta::CPAN
sub AUTOLOAD {
return;
}
sub block_accessor() {
my $accessor = shift;
no strict 'refs';
return if defined &$accessor;
*$accessor = sub {
my $self = shift;
Catalyst-Model-MultiAdaptor
view release on metacpan or search on metacpan
inc/Test/Base.pm view on Meta::CPAN
$default_object ||= $default_class->new;
return $default_object;
}
my $import_called = 0;
sub import() {
$import_called = 1;
my $class = (grep /^-base$/i, @_)
? scalar(caller)
: $_[0];
if (not defined $default_class) {
inc/Test/Base.pm view on Meta::CPAN
$caller =~ s/.*:://;
croak "Too late to call $caller()"
}
}
sub find_my_self() {
my $self = ref($_[0]) eq $default_class
? splice(@_, 0, 1)
: default_object();
return $self, @_;
}
sub blocks() {
(my ($self), @_) = find_my_self(@_);
croak "Invalid arguments passed to 'blocks'"
if @_ > 1;
croak sprintf("'%s' is invalid argument to blocks()", shift(@_))
inc/Test/Base.pm view on Meta::CPAN
}
return (@blocks);
}
sub next_block() {
(my ($self), @_) = find_my_self(@_);
my $list = $self->_next_list;
if (@$list == 0) {
$list = [@{$self->block_list}, undef];
$self->_next_list($list);
inc/Test/Base.pm view on Meta::CPAN
$block->run_filters;
}
return $block;
}
sub first_block() {
(my ($self), @_) = find_my_self(@_);
$self->_next_list([]);
$self->next_block;
}
sub filters_delay() {
(my ($self), @_) = find_my_self(@_);
$self->_filters_delay(defined $_[0] ? shift : 1);
}
sub no_diag_on_only() {
(my ($self), @_) = find_my_self(@_);
$self->_no_diag_on_only(defined $_[0] ? shift : 1);
}
sub delimiters() {
(my ($self), @_) = find_my_self(@_);
$self->check_late;
my ($block_delimiter, $data_delimiter) = @_;
$block_delimiter ||= $self->block_delim_default;
$data_delimiter ||= $self->data_delim_default;
$self->block_delim($block_delimiter);
$self->data_delim($data_delimiter);
return $self;
}
sub spec_file() {
(my ($self), @_) = find_my_self(@_);
$self->check_late;
$self->_spec_file(shift);
return $self;
}
sub spec_string() {
(my ($self), @_) = find_my_self(@_);
$self->check_late;
$self->_spec_string(shift);
return $self;
}
sub filters() {
(my ($self), @_) = find_my_self(@_);
if (ref($_[0]) eq 'HASH') {
$self->_filters_map(shift);
}
else {
inc/Test/Base.pm view on Meta::CPAN
push @$filters, @_;
}
return $self;
}
sub filter_arguments() {
$Test::Base::Filter::arguments;
}
sub have_text_diff {
eval { require Text::Diff; 1 } &&
$Text::Diff::VERSION >= 0.35 &&
$Algorithm::Diff::VERSION >= 1.15;
}
sub is($$;$) {
(my ($self), @_) = find_my_self(@_);
my ($actual, $expected, $name) = @_;
local $Test::Builder::Level = $Test::Builder::Level + 1;
if ($ENV{TEST_SHOW_NO_DIFFS} or
not defined $actual or
inc/Test/Base.pm view on Meta::CPAN
ok $actual eq $expected,
$name . "\n" . Text::Diff::diff(\$expected, \$actual);
}
}
sub run(&;$) {
(my ($self), @_) = find_my_self(@_);
my $callback = shift;
for my $block (@{$self->block_list}) {
$block->run_filters unless $block->is_filtered;
&{$callback}($block);
inc/Test/Base.pm view on Meta::CPAN
sub END {
run_compare() unless $Have_Plan or $DIED or not $import_called;
}
sub run_compare() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
local $Test::Builder::Level = $Test::Builder::Level + 1;
for my $block (@{$self->block_list}) {
inc/Test/Base.pm view on Meta::CPAN
is($block->$x, $block->$y, $block->name ? $block->name : ());
}
}
}
sub run_is() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
local $Test::Builder::Level = $Test::Builder::Level + 1;
for my $block (@{$self->block_list}) {
inc/Test/Base.pm view on Meta::CPAN
$block->name ? $block->name : ()
);
}
}
sub run_is_deeply() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and exists($block->{$y});
inc/Test/Base.pm view on Meta::CPAN
$block->name ? $block->name : ()
);
}
}
sub run_like() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and defined($y);
inc/Test/Base.pm view on Meta::CPAN
$block->name ? $block->name : ()
);
}
}
sub run_unlike() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and defined($y);
inc/Test/Base.pm view on Meta::CPAN
$block->name ? $block->name : ()
);
}
}
sub skip_all_unless_require() {
(my ($self), @_) = find_my_self(@_);
my $module = shift;
eval "require $module; 1"
or Test::More::plan(
skip_all => "$module failed to load"
);
}
sub is_deep() {
(my ($self), @_) = find_my_self(@_);
require Test::Deep;
Test::Deep::cmp_deeply(@_);
}
sub run_is_deep() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and exists($block->{$y});
inc/Test/Base.pm view on Meta::CPAN
};
}
return $spec;
}
sub _strict_warnings() {
require Filter::Util::Call;
my $done = 0;
Filter::Util::Call::filter_add(
sub {
return 0 if $done;
inc/Test/Base.pm view on Meta::CPAN
$done = 1;
}
);
}
sub tie_output() {
my $handle = shift;
die "No buffer to tie" unless @_;
tie $handle, 'Test::Base::Handle', $_[0];
}
inc/Test/Base.pm view on Meta::CPAN
$ENV{TEST_SHOW_NO_DIFFS} = 1;
}
package Test::Base::Handle;
sub TIEHANDLE() {
my $class = shift;
bless \ $_[0], $class;
}
sub PRINT {
inc/Test/Base.pm view on Meta::CPAN
sub AUTOLOAD {
return;
}
sub block_accessor() {
my $accessor = shift;
no strict 'refs';
return if defined &$accessor;
*$accessor = sub {
my $self = shift;
Catalyst-Plugin-Authentication-Basic-Remote
view release on metacpan or search on metacpan
inc/Test/Base.pm view on Meta::CPAN
$default_object ||= $default_class->new;
return $default_object;
}
my $import_called = 0;
sub import() {
$import_called = 1;
my $class = (grep /^-base$/i, @_)
? scalar(caller)
: $_[0];
if (not defined $default_class) {
inc/Test/Base.pm view on Meta::CPAN
$caller =~ s/.*:://;
croak "Too late to call $caller()"
}
}
sub find_my_self() {
my $self = ref($_[0]) eq $default_class
? splice(@_, 0, 1)
: default_object();
return $self, @_;
}
sub blocks() {
(my ($self), @_) = find_my_self(@_);
croak "Invalid arguments passed to 'blocks'"
if @_ > 1;
croak sprintf("'%s' is invalid argument to blocks()", shift(@_))
inc/Test/Base.pm view on Meta::CPAN
}
return (@blocks);
}
sub next_block() {
(my ($self), @_) = find_my_self(@_);
my $list = $self->_next_list;
if (@$list == 0) {
$list = [@{$self->block_list}, undef];
$self->_next_list($list);
inc/Test/Base.pm view on Meta::CPAN
$block->run_filters;
}
return $block;
}
sub first_block() {
(my ($self), @_) = find_my_self(@_);
$self->_next_list([]);
$self->next_block;
}
sub filters_delay() {
(my ($self), @_) = find_my_self(@_);
$self->_filters_delay(defined $_[0] ? shift : 1);
}
sub no_diag_on_only() {
(my ($self), @_) = find_my_self(@_);
$self->_no_diag_on_only(defined $_[0] ? shift : 1);
}
sub delimiters() {
(my ($self), @_) = find_my_self(@_);
$self->check_late;
my ($block_delimiter, $data_delimiter) = @_;
$block_delimiter ||= $self->block_delim_default;
$data_delimiter ||= $self->data_delim_default;
$self->block_delim($block_delimiter);
$self->data_delim($data_delimiter);
return $self;
}
sub spec_file() {
(my ($self), @_) = find_my_self(@_);
$self->check_late;
$self->_spec_file(shift);
return $self;
}
sub spec_string() {
(my ($self), @_) = find_my_self(@_);
$self->check_late;
$self->_spec_string(shift);
return $self;
}
sub filters() {
(my ($self), @_) = find_my_self(@_);
if (ref($_[0]) eq 'HASH') {
$self->_filters_map(shift);
}
else {
inc/Test/Base.pm view on Meta::CPAN
push @$filters, @_;
}
return $self;
}
sub filter_arguments() {
$Test::Base::Filter::arguments;
}
sub have_text_diff {
eval { require Text::Diff; 1 } &&
$Text::Diff::VERSION >= 0.35 &&
$Algorithm::Diff::VERSION >= 1.15;
}
sub is($$;$) {
(my ($self), @_) = find_my_self(@_);
my ($actual, $expected, $name) = @_;
local $Test::Builder::Level = $Test::Builder::Level + 1;
if ($ENV{TEST_SHOW_NO_DIFFS} or
not defined $actual or
inc/Test/Base.pm view on Meta::CPAN
ok $actual eq $expected,
$name . "\n" . Text::Diff::diff(\$expected, \$actual);
}
}
sub run(&;$) {
(my ($self), @_) = find_my_self(@_);
my $callback = shift;
for my $block (@{$self->block_list}) {
$block->run_filters unless $block->is_filtered;
&{$callback}($block);
inc/Test/Base.pm view on Meta::CPAN
sub END {
run_compare() unless $Have_Plan or $DIED or not $import_called;
}
sub run_compare() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
local $Test::Builder::Level = $Test::Builder::Level + 1;
for my $block (@{$self->block_list}) {
inc/Test/Base.pm view on Meta::CPAN
is($block->$x, $block->$y, $block->name ? $block->name : ());
}
}
}
sub run_is() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
local $Test::Builder::Level = $Test::Builder::Level + 1;
for my $block (@{$self->block_list}) {
inc/Test/Base.pm view on Meta::CPAN
$block->name ? $block->name : ()
);
}
}
sub run_is_deeply() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and exists($block->{$y});
inc/Test/Base.pm view on Meta::CPAN
$block->name ? $block->name : ()
);
}
}
sub run_like() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and defined($y);
inc/Test/Base.pm view on Meta::CPAN
$block->name ? $block->name : ()
);
}
}
sub run_unlike() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and defined($y);
inc/Test/Base.pm view on Meta::CPAN
};
}
return $spec;
}
sub _strict_warnings() {
require Filter::Util::Call;
my $done = 0;
Filter::Util::Call::filter_add(
sub {
return 0 if $done;
inc/Test/Base.pm view on Meta::CPAN
$done = 1;
}
);
}
sub tie_output() {
my $handle = shift;
die "No buffer to tie" unless @_;
tie $handle, 'Test::Base::Handle', $_[0];
}
inc/Test/Base.pm view on Meta::CPAN
$ENV{TEST_SHOW_NO_DIFFS} = 1;
}
package Test::Base::Handle;
sub TIEHANDLE() {
my $class = shift;
bless \ $_[0], $class;
}
sub PRINT {
inc/Test/Base.pm view on Meta::CPAN
sub AUTOLOAD {
return;
}
sub block_accessor() {
my $accessor = shift;
no strict 'refs';
return if defined &$accessor;
*$accessor = sub {
my $self = shift;
Catalyst-Plugin-Authentication-Credential-AOL
view release on metacpan or search on metacpan
inc/Test/Base.pm view on Meta::CPAN
$default_object ||= $default_class->new;
return $default_object;
}
my $import_called = 0;
sub import() {
$import_called = 1;
my $class = (grep /^-base$/i, @_)
? scalar(caller)
: $_[0];
if (not defined $default_class) {
inc/Test/Base.pm view on Meta::CPAN
$caller =~ s/.*:://;
croak "Too late to call $caller()"
}
}
sub find_my_self() {
my $self = ref($_[0]) eq $default_class
? splice(@_, 0, 1)
: default_object();
return $self, @_;
}
sub blocks() {
(my ($self), @_) = find_my_self(@_);
croak "Invalid arguments passed to 'blocks'"
if @_ > 1;
croak sprintf("'%s' is invalid argument to blocks()", shift(@_))
inc/Test/Base.pm view on Meta::CPAN
}
return (@blocks);
}
sub next_block() {
(my ($self), @_) = find_my_self(@_);
my $list = $self->_next_list;
if (@$list == 0) {
$list = [@{$self->block_list}, undef];
$self->_next_list($list);
inc/Test/Base.pm view on Meta::CPAN
$block->run_filters;
}
return $block;
}
sub first_block() {
(my ($self), @_) = find_my_self(@_);
$self->_next_list([]);
$self->next_block;
}
sub filters_delay() {
(my ($self), @_) = find_my_self(@_);
$self->_filters_delay(defined $_[0] ? shift : 1);
}
sub delimiters() {
(my ($self), @_) = find_my_self(@_);
$self->check_late;
my ($block_delimiter, $data_delimiter) = @_;
$block_delimiter ||= $self->block_delim_default;
$data_delimiter ||= $self->data_delim_default;
$self->block_delim($block_delimiter);
$self->data_delim($data_delimiter);
return $self;
}
sub spec_file() {
(my ($self), @_) = find_my_self(@_);
$self->check_late;
$self->_spec_file(shift);
return $self;
}
sub spec_string() {
(my ($self), @_) = find_my_self(@_);
$self->check_late;
$self->_spec_string(shift);
return $self;
}
sub filters() {
(my ($self), @_) = find_my_self(@_);
if (ref($_[0]) eq 'HASH') {
$self->_filters_map(shift);
}
else {
inc/Test/Base.pm view on Meta::CPAN
push @$filters, @_;
}
return $self;
}
sub filter_arguments() {
$Test::Base::Filter::arguments;
}
sub have_text_diff {
eval { require Text::Diff; 1 } &&
$Text::Diff::VERSION >= 0.35 &&
$Algorithm::Diff::VERSION >= 1.15;
}
sub is($$;$) {
(my ($self), @_) = find_my_self(@_);
my ($actual, $expected, $name) = @_;
local $Test::Builder::Level = $Test::Builder::Level + 1;
if ($ENV{TEST_SHOW_NO_DIFFS} or
not defined $actual or
inc/Test/Base.pm view on Meta::CPAN
ok $actual eq $expected,
$name . "\n" . Text::Diff::diff(\$expected, \$actual);
}
}
sub run(&;$) {
(my ($self), @_) = find_my_self(@_);
my $callback = shift;
for my $block (@{$self->block_list}) {
$block->run_filters unless $block->is_filtered;
&{$callback}($block);
inc/Test/Base.pm view on Meta::CPAN
sub END {
run_compare() unless $Have_Plan or $DIED or not $import_called;
}
sub run_compare() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
local $Test::Builder::Level = $Test::Builder::Level + 1;
for my $block (@{$self->block_list}) {
inc/Test/Base.pm view on Meta::CPAN
is($block->$x, $block->$y, $block->name ? $block->name : ());
}
}
}
sub run_is() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
local $Test::Builder::Level = $Test::Builder::Level + 1;
for my $block (@{$self->block_list}) {
inc/Test/Base.pm view on Meta::CPAN
$block->name ? $block->name : ()
);
}
}
sub run_is_deeply() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and exists($block->{$y});
inc/Test/Base.pm view on Meta::CPAN
$block->name ? $block->name : ()
);
}
}
sub run_like() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and defined($y);
inc/Test/Base.pm view on Meta::CPAN
$block->name ? $block->name : ()
);
}
}
sub run_unlike() {
(my ($self), @_) = find_my_self(@_);
$self->_assert_plan;
my ($x, $y) = $self->_section_names(@_);
for my $block (@{$self->block_list}) {
next unless exists($block->{$x}) and defined($y);
inc/Test/Base.pm view on Meta::CPAN
};
}
return $spec;
}
sub _strict_warnings() {
require Filter::Util::Call;
my $done = 0;
Filter::Util::Call::filter_add(
sub {
return 0 if $done;
inc/Test/Base.pm view on Meta::CPAN
$done = 1;
}
);
}
sub tie_output() {
my $handle = shift;
die "No buffer to tie" unless @_;
tie $handle, 'Test::Base::Handle', $_[0];
}
inc/Test/Base.pm view on Meta::CPAN
$ENV{TEST_SHOW_NO_DIFFS} = 1;
}
package Test::Base::Handle;
sub TIEHANDLE() {
my $class = shift;
bless \ $_[0], $class;
}
sub PRINT {
inc/Test/Base.pm view on Meta::CPAN
sub AUTOLOAD {
return;
}
sub block_accessor() {
my $accessor = shift;
no strict 'refs';
return if defined &$accessor;
*$accessor = sub {
my $self = shift;
Catalyst-Plugin-Authentication-Credential-Livedoor
view release on metacpan or search on metacpan
inc/Test/More.pm view on Meta::CPAN
}
#line 425
sub cmp_ok($$$;$) {
my $tb = Test::More->builder;
$tb->cmp_ok(@_);
}
( run in 0.761 second using v1.01-cache-2.11-cpan-65fba6d93b7 )