Result:
found more than 877 distributions - search limited to the first 2001 files matching your query
( run in 0.592 )
AnyEvent-Gearman
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;
AnyEvent-Gmail-Feed
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;
AnyEvent-GnuPG
view release on metacpan or search on metacpan
lib/AnyEvent/GnuPG.pm view on Meta::CPAN
$cv1->croak($_)
};
}
}
sub _eq($_) { shift eq pop } ## no critic
sub _parse_status {
my ( $self, $cv, %actions ) = @_;
my $commands;
$self->{status_fd}->readlines_cb(
AnyEvent-Groonga
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(@_);
}
AnyEvent-HTTP-Socks
view release on metacpan or search on metacpan
lib/AnyEvent/HTTP/Socks.pm view on Meta::CPAN
use constant {
READ_WATCHER => 1,
WRITE_WATCHER => 2,
};
sub http_get($@) {
unshift @_, 'GET';
&http_request;
}
sub http_head($@) {
unshift @_, 'HEAD';
&http_request;
}
sub http_post($$@) {
my $url = shift;
unshift @_, 'POST', $url, 'body';
&http_request;
}
sub http_request($$@) {
my ($method, $url, $cb) = (shift, shift, pop);
my %opts = @_;
my $socks = delete $opts{socks};
if ($socks) {
AnyEvent-HTTP
view release on metacpan or search on metacpan
#############################################################################
# wait queue/slots
sub _slot_schedule;
sub _slot_schedule($) {
my $host = shift;
while ($CO_SLOT{$host}[0] < $MAX_PER_HOST) {
if (my $cb = shift @{ $CO_SLOT{$host}[1] }) {
# somebody wants that slot
}
}
}
# wait for a free slot on host, call callback
sub _get_slot($$) {
push @{ $CO_SLOT{$_[0]}[1] }, $_[1];
_slot_schedule $_[0];
}
#############################################################################
# cookie handling
# expire cookies
sub cookie_jar_expire($;$) {
my ($jar, $session_end) = @_;
%$jar = () if $jar->{version} != 2;
my $anow = AE::now;
unless %$paths;
}
}
# extract cookies from jar
sub cookie_jar_extract($$$$) {
my ($jar, $scheme, $host, $path) = @_;
%$jar = () if $jar->{version} != 2;
$host = AnyEvent::Util::idn_to_ascii $host
\@cookies
}
# parse set_cookie header into jar
sub cookie_jar_set_cookie($$$$) {
my ($jar, $set_cookie, $host, $date) = @_;
%$jar = () if $jar->{version} != 2;
my $anow = int AE::now;
#############################################################################
# keepalive/persistent connection cache
# fetch a connection from the keepalive cache
sub ka_fetch($) {
my $ka_key = shift;
my $hdl = pop @{ $KA_CACHE{$ka_key} }; # currently we reuse the MOST RECENTLY USED connection
delete $KA_CACHE{$ka_key}
unless @{ $KA_CACHE{$ka_key} };
$hdl
}
sub ka_store($$) {
my ($ka_key, $hdl) = @_;
my $kaa = $KA_CACHE{$ka_key} ||= [];
my $destroy = sub {
#############################################################################
# utilities
# continue to parse $_ for headers and place them into the arg
sub _parse_hdr() {
my %hdr;
# things seen, not parsed:
# p3pP="NON CUR OTPi OUR NOR UNI"
our $TLS_CTX_LOW = { cache => 1, sslv2 => 1 };
our $TLS_CTX_HIGH = { cache => 1, verify => 1, verify_peername => "https" };
# maybe it should just become a normal object :/
sub _destroy_state(\%) {
my ($state) = @_;
$state->{handle}->destroy if $state->{handle};
%$state = ();
}
sub _error(\%$$) {
my ($state, $cb, $hdr) = @_;
&_destroy_state ($state);
$cb->(undef, $hdr);
UPDATE => 1,
UPDATEREDIRECTREF => 1,
"VERSION-CONTROL" => 1,
);
sub http_request($$@) {
my $cb = pop;
my ($method, $url, %arg) = @_;
my %hdr;
};
defined wantarray && AnyEvent::Util::guard { _destroy_state %state }
}
sub http_get($@) {
unshift @_, "GET";
&http_request
}
sub http_head($@) {
unshift @_, "HEAD";
&http_request
}
sub http_post($$@) {
my $url = shift;
unshift @_, "POST", $url, "body";
&http_request
}
=cut
our @month = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
our @weekday = qw(Sun Mon Tue Wed Thu Fri Sat);
sub format_date($) {
my ($time) = @_;
# RFC 822/1123 format
my ($S, $M, $H, $mday, $mon, $year, $wday, $yday, undef) = gmtime $time;
sprintf "%s, %02d %s %04d %02d:%02d:%02d GMT",
$weekday[$wday], $mday, $month[$mon], $year + 1900,
$H, $M, $S;
}
sub parse_date($) {
my ($date) = @_;
my ($d, $m, $y, $H, $M, $S);
if ($date =~ /^[A-Z][a-z][a-z]+, ([0-9][0-9]?)[\- ]([A-Z][a-z][a-z])[\- ]([0-9][0-9][0-9][0-9]) ([0-9][0-9]?):([0-9][0-9]?):([0-9][0-9]?) GMT$/) {
}
undef
}
sub set_proxy($) {
if (length $_[0]) {
$_[0] =~ m%^(http):// ([^:/]+) (?: : (\d*) )?%ix
or Carp::croak "$_[0]: invalid proxy URL";
$PROXY = [$2, $3 || 3128, $1]
} else {
AnyEvent-Hiredis
view release on metacpan or search on metacpan
use File::Which qw(which);
use base qw(Exporter);
our @EXPORT = qw(test_redis);
sub test_redis(&;$) {
my $cb = shift;
my $args = shift;
my $redis_server = which 'redis-server';
unless ($redis_server && -e $redis_server && -x _) {
AnyEvent-IRC
view release on metacpan or search on metacpan
lib/AnyEvent/IRC/Util.pm view on Meta::CPAN
Unfortunately the mIRC color coding will destroy improper colored numbers. So this
function may destroy the message in some occasions a bit.
=cut
sub filter_colors($) {
my ($line) = @_;
$line =~ s/\x1B\[.*?[\x00-\x1F\x40-\x7E]//g; # see ECMA-48 + advice by urxvt author
$line =~ s/\x03\d\d?(?:,\d\d?)?//g; # see http://www.mirc.co.uk/help/color.txt
$line =~ s/[\x03\x16\x02\x1f\x0f]//g; # see some undefined place :-)
$line
AnyEvent-JSONRPC-Lite
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;
AnyEvent-JSONRPC
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;
AnyEvent-KVStore-Etcd
view release on metacpan or search on metacpan
lib/AnyEvent/KVStore/Etcd.pm view on Meta::CPAN
Reads a value from a key and returns a JSON document payload.
=cut
sub read($$) {
my ($self, $key) = @_;
my $value = $self->cnx->range({key => $key })->{response}->{content};
$value = decode_json($value)->{kvs}->[0]->{value};
return decode_base64($value);
}
lib/AnyEvent/KVStore/Etcd.pm view on Meta::CPAN
Checks to see if a key exists. Here this is no less costly than read.
=cut
sub exists($$) {
my ($self, $key) = @_;
my $value = $self->cnx->range({key => $key })->{response}->{content};
$value = decode_json($value)->{kvs}->[0]->{value};
return defined $value;;
}
lib/AnyEvent/KVStore/Etcd.pm view on Meta::CPAN
Returns a list of keys
=cut
# adds one to the binary representation of the string for prefix searches
sub _add_one($){
my ($str) = @_;
if ($str =~ /^\xff*$/){ # for empty string too
return "\x00";
}
my $inc = $str;
$inc =~ s/([^\xff])\xff*\z/ $1 =~ tr||\x01-\xff|cr /e;
return $inc;
}
sub list($$) {
my ($self, $pfx) = @_;
my $value = $self->cnx->range({key => $pfx, range_end => _add_one($pfx)})->{response}->{content};
return map { decode_base64($_->{key} ) } @{decode_json($value)->{kvs}};
}
lib/AnyEvent/KVStore/Etcd.pm view on Meta::CPAN
Writes the key to the database and returns 1 if successful, 0 if not.
=cut
sub write($$$) {
my ($self, $key, $value) = @_;
return $self->cnx->put({ key => $key, value => $value })->is_success;
}
=head2 watch($pfx, $callback)
lib/AnyEvent/KVStore/Etcd.pm view on Meta::CPAN
$e = $e->{kv};
&$sub(decode_base64($e->{key}), decode_base64($e->{value}));
}
}
sub watch($$$) {
my ($self, $pfx, $subroutine ) = @_;
return $self->cnx->watch({key => $pfx, range_end => _add_one($pfx)},
sub { my ($result) = @_; _portability_wrapper($subroutine, $result) })->create;
}
AnyEvent-KVStore
view release on metacpan or search on metacpan
lib/AnyEvent/KVStore.pm view on Meta::CPAN
);
has _proxy => ( is => 'lazy', isa => $kvs_module, builder => \&_connect,
handles => 'AnyEvent::KVStore::Driver');
sub _connect($){
my ($self) = @_;
local $@ = undef;
my $modname = "AnyEvent::KVStore::" . ucfirst($self->module);
eval "require $modname" or die $@;
return $modname->new($self->config);
AnyEvent-MP
view release on metacpan or search on metacpan
after
);
our $SELF;
sub _self_die() {
my $msg = $@;
$msg =~ s/\n+$// unless ref $msg;
kil $SELF, die => $msg;
}
kil $SELF;
};
=cut
sub rcv($@);
my $KILME = sub {
(my $tag = substr $_[0], 0, 30) =~ s/([^\x20-\x7e])/./g;
kil $SELF, unhandled_message => "no callback found for message '$tag'";
};
sub port(;&) {
my $id = $UNIQ . ++$ID;
my $port = "$NODE#$id";
rcv $port, shift || $KILME;
rcv $SELF, $otherport;
};
=cut
sub rcv($@) {
my $port = shift;
my ($nodeid, $portid) = split /#/, $port, 2;
$nodeid eq $NODE
or Carp::croak "$port: rcv can only be called on local ports, caught";
or die "unable to init";
};
=cut
sub peval($$) {
local $SELF = shift;
my $cb = shift;
if (wantarray) {
my @res = eval { &$cb };
};
};
=cut
sub psub(&) {
my $cb = shift;
my $port = $SELF
or Carp::croak "psub can only be called from within rcv or psub callbacks, not";
&{ load_func $init }
};
_self_die if $@;
}
sub spawn(@) {
my ($nodeid, undef) = split /#/, shift, 2;
my $id = $RUNIQ . ++$ID;
$_[0] =~ /::/
AnyEvent::MP author is not convinced of the wisdom of having it, though,
so it may go away in the future.
=cut
sub after($@) {
my ($timeout, @action) = @_;
my $t; $t = AE::timer $timeout, 0, sub {
undef $t;
ref $action[0]
might go in future versions unless you can make a convincing case that
this is indeed useful for something.
=cut
sub cal(@) {
my $timeout = ref $_[-1] ? undef : pop;
my $cb = pop;
my $port = port {
undef $timeout;
is just another name for a database family), and have it removed when the
port is gone. This works best when the port is a local port.
=cut
sub db_reg($$;$) {
my $family = shift;
my $port = @_ ? shift : $SELF;
my $clr = sub { db_del $family => $port };
mon $port, $clr;
AnyEvent-MPRPC
view release on metacpan or search on metacpan
lib/AnyEvent/MPRPC.pm view on Meta::CPAN
use base 'Exporter';
use 5.008;
our @EXPORT = qw/mprpc_client mprpc_server/;
sub mprpc_client($$) { ## no critic
my ($host, $port) = @_;
AnyEvent::MPRPC::Client->new(
host => $host,
port => $port,
);
}
sub mprpc_server($$) { ## no critic
my ($address, $port) = @_;
AnyEvent::MPRPC::Server->new(
address => $address,
port => $port,
AnyEvent-MPV
view release on metacpan or search on metacpan
use AnyEvent ();
use AnyEvent::Util ();
our $VERSION = '1.03';
sub OBSID() { 2**52 }
our $JSON = eval { require JSON::XS; JSON::XS:: }
|| do { require JSON::PP; JSON::PP:: };
our $JSON_ENCODER = $JSON->new->utf8;
AnyEvent-Memcached
view release on metacpan or search on metacpan
t/lib/Test/AE/MC.pm view on Meta::CPAN
*{caller().'::runtest'} = \&runtest;
@_ = 'Test::More';
goto &{ Test::More->can('import') };
}
sub runtest(&) {
my $cx = shift;
my $code = sub {
alarm 10;
eval {
$cx->(@_,noreply => 1, cas => 1);
AnyEvent-Pcap
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;
AnyEvent-Plurk
view release on metacpan or search on metacpan
lib/AnyEvent/Plurk.pm view on Meta::CPAN
use URI;
use Carp "croak";
use POSIX qw(strftime);
# Sub
sub current_time_offset() {
my @t = gmtime;
return strftime('%Y-%m-%dT%H:%M:%S', @t);
}
sub plurk_api_uri {
AnyEvent-Promises
view release on metacpan or search on metacpan
use AnyEvent;
use Test::More;
our @EXPORT = qw(run_event_loop el_subtest);
sub run_event_loop(&@) {
my ( $code, %args ) = @_;
my $timeout = defined $args{timeout}? $args{timeout}: 10;
my $cv = AE::cv;
my $tmer;
AnyEvent-Redis
view release on metacpan or search on metacpan
use FindBin;
use base qw(Exporter);
our @EXPORT = qw(test_redis);
sub test_redis(&;$) {
my $cb = shift;
my $args = shift;
chomp(my $redis_server = `which redis-server`);
unless ($redis_server && -e $redis_server && -x _) {
AnyEvent-ReverseHTTP
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;
AnyEvent-SCGI
view release on metacpan or search on metacpan
lib/AnyEvent/SCGI.pm view on Meta::CPAN
C<$error> parameters are passed in as subsequent arguments. On "EOF" from the
client, fatal is "0" and error is 'EOF'.
=cut
sub scgi_server($$$) {
my $host = shift;
my $port = shift;
my $cb = shift;
return tcp_server $host, $port, sub { handle_scgi(@_,$cb) };
}
AnyEvent-SMTP
view release on metacpan or search on metacpan
lib/AnyEvent/SMTP/Client.pm view on Meta::CPAN
our $ACTIVE = 0; # Currently active connections
our %ACTIVE;
my %CO_SLOT; # number of open connections, and wait queue, per host
sub _slot_schedule;
sub _slot_schedule($) {
my $host = shift;
my $mc = exists $MAXCON{$host} ? $MAXCON{$host} : $MAXCON;
while (!$mc or ( $mc > 0 and $CO_SLOT{$host}[0] < $mc )) {
if (my $cb = shift @{ $CO_SLOT{$host}[1] }) {
# somebody wants that slot
lib/AnyEvent/SMTP/Client.pm view on Meta::CPAN
}
}
}
# wait for a free slot on host, call callback
sub _get_slot($$) {
push @{ $CO_SLOT{$_[0]}[1] }, $_[1];
_slot_schedule $_[0];
}
sub _tcp_connect($$$;$) {
my ($host,$port,$cb,$pr) = @_;
#warn "Need slot $host (have $ACTIVE)";
_get_slot $host, sub {
my $sg = shift;
#warn "Have slot $host (have $ACTIVE)";
lib/AnyEvent/SMTP/Client.pm view on Meta::CPAN
require Carp; Carp::croak "$_ is not exported by $me";
}
}
}
sub sendmail(%) {
my %args = @_;
my @keys = keys %args;
@args{map lc, @keys} = delete @args{ @keys };
$args{data} ||= delete $args{message} || delete $args{body};
$args{helo} ||= hostname();
AnyEvent-SNMP
view release on metacpan or search on metacpan
}
$DONE and $DONE->() unless $BUSY;
}
sub send_pdu($$$) {
my (undef, $pdu, $delay) = @_;
# $delay is not very sensibly implemented by AnyEvent::SNMP,
# but apparently it is not a very sensible feature.
if ($delay > 0) {
kick_job;
1
}
sub loop($) {
while ($BUSY) {
$DONE = AE::cv;
$DONE->recv;
undef $DONE;
}
}
*activate = \&loop; # 5.x compatibility?
*listen = \&loop; # 5.x compatibility?
sub one_event($) {
# should not ever be used
AnyEvent->one_event; #d# todo
}
sub set_max_outstanding($) {
$MAX_OUTSTANDING = $_[0];
kick_job;
}
# not provided yet:
AnyEvent-Serialize
view release on metacpan or search on metacpan
lib/AnyEvent/Serialize.pm view on Meta::CPAN
return $class->export_to_level(1, $class, @arg);
}
sub serialize($&) {
require Data::StreamSerializer;
no warnings 'redefine';
no strict 'refs';
*{ __PACKAGE__ . '::serialize' } = sub ($&) {
lib/AnyEvent/Serialize.pm view on Meta::CPAN
};
goto &serialize;
}
sub deserialize($&) {
require Data::StreamDeserializer;
no warnings 'redefine';
no strict 'refs';
*{ __PACKAGE__ . '::deserialize' } = sub ($&) {
AnyEvent-Tools
view release on metacpan or search on metacpan
lib/AnyEvent/Tools.pm view on Meta::CPAN
our @EXPORT = qw();
our $VERSION = '0.12';
sub pool(@)
{
require AnyEvent::Tools::Pool;
no strict 'refs';
no warnings 'redefine';
lib/AnyEvent/Tools.pm view on Meta::CPAN
goto &pool;
}
sub buffer(@)
{
require AnyEvent::Tools::Buffer;
no warnings 'redefine';
no strict 'refs';
*{ __PACKAGE__ . "::buffer" } = sub (@) {
lib/AnyEvent/Tools.pm view on Meta::CPAN
};
goto &buffer;
}
sub mutex()
{
require AnyEvent::Tools::Mutex;
no strict 'refs';
no warnings 'redefine';
lib/AnyEvent/Tools.pm view on Meta::CPAN
};
goto &mutex;
}
sub rw_mutex()
{
require AnyEvent::Tools::RWMutex;
no strict 'refs';
no warnings 'redefine';
lib/AnyEvent/Tools.pm view on Meta::CPAN
};
goto &rw_mutex;
}
sub _async_repeati($$&;&);
sub async_repeat($&;&) {
my ($count, $cb, $cbe) = @_;
if (!$count) {
$cbe->() if $cbe;
return;
}
return &_async_repeati(0, $count, $cb, $cbe);
}
sub async_for($&;&) {
my ($obj, $cb, $cbe) = @_;
if ('ARRAY' eq ref $obj or "$obj" =~ /=ARRAY\(/) {
unless (@$obj) {
$cbe->() if $cbe;
return;
lib/AnyEvent/Tools.pm view on Meta::CPAN
croak "Usage: async_for ARRAYREF|HASHREF, callback [, end_callback ]";
}
sub async_foreach($&;&) { goto &async_for; }
sub async_rfor($&;&) {
my ($obj, $cb, $cbe) = @_;
if ('ARRAY' eq ref $obj or "$obj" =~ /=ARRAY\(/) {
unless (@$obj) {
$cbe->() if $cbe;
return;
lib/AnyEvent/Tools.pm view on Meta::CPAN
}
croak "Usage: async_for ARRAYREF|HASHREF, callback [, end_callback ]";
}
sub _async_repeati($$&;&) {
my ($start, $count, $cb, $cbe) = @_;
my $idle;
my $wantarray = wantarray;
$idle = aggressive_idle sub {
AnyEvent-Twitter
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(@_);
}
AnyEvent-UWSGI
view release on metacpan or search on metacpan
lib/AnyEvent/UWSGI.pm view on Meta::CPAN
#############################################################################
# wait queue/slots
sub _slot_schedule;
sub _slot_schedule($) {
my $host = shift;
while ($CO_SLOT{$host}[0] < $MAX_PER_HOST) {
if (my $cb = shift @{ $CO_SLOT{$host}[1] }) {
# somebody wants that slot
lib/AnyEvent/UWSGI.pm view on Meta::CPAN
}
}
}
# wait for a free slot on host, call callback
sub _get_slot($$) {
push @{ $CO_SLOT{$_[0]}[1] }, $_[1];
_slot_schedule $_[0];
}
#############################################################################
# cookie handling
# expire cookies
sub cookie_jar_expire($;$) {
my ($jar, $session_end) = @_;
%$jar = () if $jar->{version} != 1;
my $anow = AE::now;
lib/AnyEvent/UWSGI.pm view on Meta::CPAN
unless %$paths;
}
}
# extract cookies from jar
sub cookie_jar_extract($$$$) {
my ($jar, $scheme, $host, $path) = @_;
%$jar = () if $jar->{version} != 1;
my @cookies;
lib/AnyEvent/UWSGI.pm view on Meta::CPAN
\@cookies
}
# parse set_cookie header into jar
sub cookie_jar_set_cookie($$$$) {
my ($jar, $set_cookie, $host, $date) = @_;
my $anow = int AE::now;
my $snow; # server-now
lib/AnyEvent/UWSGI.pm view on Meta::CPAN
#############################################################################
# keepalive/persistent connection cache
# fetch a connection from the keepalive cache
sub ka_fetch($) {
my $ka_key = shift;
my $hdl = pop @{ $KA_CACHE{$ka_key} }; # currently we reuse the MOST RECENTLY USED connection
delete $KA_CACHE{$ka_key}
unless @{ $KA_CACHE{$ka_key} };
$hdl
}
sub ka_store($$) {
my ($ka_key, $hdl) = @_;
my $kaa = $KA_CACHE{$ka_key} ||= [];
my $destroy = sub {
lib/AnyEvent/UWSGI.pm view on Meta::CPAN
#############################################################################
# utilities
# continue to parse $_ for headers and place them into the arg
sub _parse_hdr() {
my %hdr;
# things seen, not parsed:
# p3pP="NON CUR OTPi OUR NOR UNI"
lib/AnyEvent/UWSGI.pm view on Meta::CPAN
#############################################################################
our $qr_nlnl = qr{(?<![^\012])\015?\012};
# maybe it should just become a normal object :/
sub _destroy_state(\%) {
my ($state) = @_;
$state->{handle}->destroy if $state->{handle};
%$state = ();
}
sub _error(\%$$) {
my ($state, $cb, $hdr) = @_;
&_destroy_state ($state);
$cb->(undef, $hdr);
lib/AnyEvent/UWSGI.pm view on Meta::CPAN
Like C<AnyEvent::HTTP::http_request>
Also accepts C<modifier1> and C<modifier2> in C<%args>
=cut
sub uwsgi_request($$@) {
my $cb = pop;
my ($method, $url, %arg) = @_;
my %hdr;
lib/AnyEvent/UWSGI.pm view on Meta::CPAN
=item uwsgi_get
Like C<AnyEvent::HTTP::http_get>
=cut
sub uwsgi_get($@) {
unshift @_, "GET";
&uwsgi_request
}
=item uwsgi_head
Like C<AnyEvent::HTTP::http_head>
=cut
sub uwsgi_head($@) {
unshift @_, "HEAD";
&uwsgi_request
}
=item uwsgi_post
Like C<AnyEvent::HTTP::http_post>
=cut
sub uwsgi_post($$@) {
my $url = shift;
unshift @_, "POST", $url, "body";
&uwsgi_request
}
our @month = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
our @weekday = qw(Sun Mon Tue Wed Thu Fri Sat);
sub format_date($) {
my ($time) = @_;
# RFC 822/1123 format
my ($S, $M, $H, $mday, $mon, $year, $wday, $yday, undef) = gmtime $time;
sprintf "%s, %02d %s %04d %02d:%02d:%02d GMT",
$weekday[$wday], $mday, $month[$mon], $year + 1900,
$H, $M, $S;
}
sub parse_date($) {
my ($date) = @_;
my ($d, $m, $y, $H, $M, $S);
if ($date =~ /^[A-Z][a-z][a-z]+, ([0-9][0-9]?)[\- ]([A-Z][a-z][a-z])[\- ]([0-9][0-9][0-9][0-9]) ([0-9][0-9]?):([0-9][0-9]?):([0-9][0-9]?) GMT$/) {
lib/AnyEvent/UWSGI.pm view on Meta::CPAN
}
undef
}
sub set_proxy($) {
if (length $_[0]) {
$_[0] =~ m%^(uwsgi):// ([^:/]+) (?: : (\d*) )?%ix
or Carp::croak "$_[0]: invalid proxy URL";
$PROXY = [$2, $3 || 3128, $1]
} else {
AnyEvent-Watchdog
view release on metacpan or search on metacpan
Watchdog.pm view on Meta::CPAN
our $PID; # child pid
our $ENABLED = 0; # also version
our $AUTORESTART; # actually exit
our ($P, $C);
sub poll($) {
(vec my $v, fileno $P, 1) = 1;
CORE::select $v, undef, undef, $_[0]
}
sub server {
AnyEvent-WebDriver
view release on metacpan or search on metacpan
WebDriver.pm view on Meta::CPAN
link => "link text",
substr => "partial link text",
tag => "tag name",
);
sub _using($) {
using => $USING{$_[0]} // "$_[0]"
}
=item $element = $wd->find_element ($locator_strategy, $selector)
WebDriver.pm view on Meta::CPAN
$al->source ("kbd1");
=cut
sub _default_source($) {
my ($source) = @_;
$source eq "keyboard" ? { actions => [], id => $source, type => "key" }
: $source eq "mouse" ? { actions => [], id => $source, type => "pointer", pointerType => "mouse" }
: $source eq "touch" ? { actions => [], id => $source, type => "pointer", pointerType => "touch" }
WebDriver.pm view on Meta::CPAN
"\uE053" "MetaRight"
EOF
our %SPECIAL_KEY;
sub _special_key($) {
# parse first time
%SPECIAL_KEY || do {
for (split /\n/, $SPECIAL_KEY) {
s/"//g or next;
my ($k, $s, $name) = split /\t/;
WebDriver.pm view on Meta::CPAN
exists $SPECIAL_KEY{$_[0]}
? chr $SPECIAL_KEY{$_[0]}
: Carp::croak "AnyEvent::WebDriver::Actions: special key '$1' not known"
}
sub _kv($) {
$_[0] =~ /^\{(.*)\}$/s
? _special_key $1
: $_[0]
}
( run in 0.592 second using v1.01-cache-2.11-cpan-65fba6d93b7 )