view release on metacpan or search on metacpan
lib/Catalyst/Plugin/MapComponentDependencies/Utils.pm view on Meta::CPAN
sub FromModel($) { my $v = shift; return bless \$v, model_ns }
sub FromView($) { my $v = shift; return bless \$v, view_ns }
sub FromController($) { my $v = shift; return bless \$v, controller_ns }
sub FromComponent($) { my $v = shift; return bless \$v, component_ns }
sub FromCode(&) { my $v = shift; return bless \$v, code_ns }
sub FromContext {
return FromCode {
my ($c, $name, $config) = @_;
return blessed $c ? $c : undef;
view release on metacpan or search on metacpan
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);
view release on metacpan or search on metacpan
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);
view release on metacpan or search on metacpan
lib/Catalyst/View/ByCode/Renderer.pm view on Meta::CPAN
######################################## EXPORTED FUNCTIONS
#
# a template definition instead of sub RUN {}
#
sub template(&) {
my $package = caller;
my $code = shift;
no strict 'refs';
*{"$package\::RUN"} = sub {
view release on metacpan or search on metacpan
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);
view release on metacpan or search on metacpan
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);
view release on metacpan or search on metacpan
lib/CatalystX/ActionBuilders.pm view on Meta::CPAN
simple_login => [ qw{ needs_login } ],
},
};
sub index_parts() { (path_name(q{}), args(0)) }
sub action(&) { return shift }
# experimental - beore/after wrappers for our action method
sub before_action(&) { ( _before => $_[0] ) }
sub after_action(&) { ( _after => $_[0] ) }
#sub template($) { my $t = shift; (_before => sub { $_[1]->stash-> { template} = $t }) }
sub tweak_stash($$) { my ($k, $v) = @_; (_before => sub { $_[1]->stash-> { $k} = $v }) }
sub template($) { tweak_stash(template => $_[0]) }
view release on metacpan or search on metacpan
lib/CfgTie/TieAliases.pm view on Meta::CPAN
{eval $Rules;}
if (defined $@ && length $@) {die "rewrite rules compilation failed: $@";}
return $Sub;
}
sub ImpGroups(&$)
{
my ($CodeRef,$Ref)=@_;
#Create a list of group names that pass the selection criteria
#The code ref is passed a reference to the group information
my %groups;
view release on metacpan or search on metacpan
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);
view release on metacpan or search on metacpan
lib/Child.pm view on Meta::CPAN
our @PROCS;
our @EXPORT_OK = qw/child/;
add_accessors qw/code/;
sub child(&;@) {
my ( $code, @params ) = @_;
my $caller = caller;
return __PACKAGE__->new( $code, @params )->start;
}
view release on metacpan or search on metacpan
lib/Class/AutoGenerate/Declare.pm view on Meta::CPAN
A class would be generated named C<My::Flipper> that uses C<My::Base::Flipper> as its only base class, imports the C<looks_like_number> function from L<Scalar::Util>, defines a scalar package variable C<$scalar> set to 14, an array package variable, ...
=cut
sub generates(&) { shift }
=head2 declare { ... };
A declare block may be used to wrap your class loader code, but is not required. The block will be passed a single argument, C<$self>, which is the initialized class loader object. It is helpful if you need a reference to your C<$self>.
lib/Class/AutoGenerate/Declare.pm view on Meta::CPAN
It is important to note that the C<declare> block modifies the semantics of how the class loader is built. Normally, the C<requiring> rules are all generated and associated with the class loader package immediately. A C<declare> block causes all rule...
=cut
sub declare(&) {
my $code = shift;
# Wrap that code in a little more code that sets things up
my $declaration = sub {
my $self = shift;
view release on metacpan or search on metacpan
lib/Class/Closure.pm view on Meta::CPAN
return;
}
sub extends($) { &$EXTENDS }
sub destroy(&) { _install DESTROY => \Class::Closure::DestroyDelegate->new( $_[0] ) }
package Class::Closure::DestroyDelegate;
our $VERSION = '0.304';
sub new { bless $_[1] }
view release on metacpan or search on metacpan
t/Class-CompiledC.t view on Meta::CPAN
local $_ = 'foobar';
is (Class::CompiledC::__include(), "\n#include foobar\n",
'test __include');
}
sub dies_with(&$$)
{
my $sub = shift;
my $die = shift;
my $text = shift;
my $tmp;
t/Class-CompiledC.t view on Meta::CPAN
warn "is $tmp\nresult is $res\n" unless $tmp =~ $die;
ok ($tmp =~ $die, $text);
}
sub no_die(&$)
{
my $sub = shift;
my $text = shift;
local $@;
view release on metacpan or search on metacpan
lib/Class/Contract.pm view on Meta::CPAN
my $class = shift;
my $caller = caller;
$contract{$caller}{use_old} = 0 if grep /^old$/, @_;
}
sub contract(&) { $_[0]->(); _build_class(caller) }
sub check(\%;$) {
# NOT IN PRODUCTION...
my $state = !$#_ ? 0 : $_[1] ? 1 : 0;
defined $_
lib/Class/Contract.pm view on Meta::CPAN
sub failmsg {
croak "Unattached failmsg" unless $msg_target;
$msg_target->{'msg'} = shift;
}
sub pre(&) { _current('pre' => @_) }
sub post(&) { _current('post' => @_) }
sub impl(&) { _current('impl' => @_) }
sub optional { # my (@descriptors) = @_;
$_->{'opt'} = 1 foreach(@_); @_ # NOT IN PRODUCTION
}
sub invar(&) {
my ($code) = @_;
my $descriptor = {
'code' => $code,
'opt' => 0, # NOT IN PRODUCTION
view release on metacpan or search on metacpan
t/01-artist.t view on Meta::CPAN
$ENV{REMOTE_USER} = 'jennifer_lopez123';
$ENV{REQUEST_URI} = '/register';
$ENV{REMOTE_ADDR} = '000.000.000';
sub do_transaction(&) {
my $sub = shift;
Artist->db_Main->begin_work;
$sub->();
Artist->db_Main->commit;
}
view release on metacpan or search on metacpan
t/Test_Framework.pm view on Meta::CPAN
@ISA = qw(Exporter);
@EXPORT = qw(&Test &Test_Failure &Report_Results &Arrays_Equal);
my $test_no = 1;
my @results;
sub Test(&)
{
my $code = $_[0];
push @results, test_succeeds($code);
if ( !$results[$#results] )
{
print STDERR $@, "\n" if $@;
}
}
sub Test_Failure(&)
{
my $code = $_[0];
push @results, !test_succeeds($code);
}
view release on metacpan or search on metacpan
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);
view release on metacpan or search on metacpan
}
return undef;
};
sub walk_width(&$;@) {
&$walk_raw( 1, @_ );
}
sub walk_depth(&$;@) {
&$walk_raw( 0, @_ );
}
sub walk(&$;@) {
confess( "Class::Multi::walk is deprecated. Use walk_width or walk_depth instead.\n" );
&$walk_raw( 0, @_ );
}
sub walk_width_up(&$;@) {
my ( $callout, $derived, @avoid ) = @_;
my @classes;
walk_width { push @classes, $_; 0 } $derived, @avoid;
view release on metacpan or search on metacpan
t/lib/TestUtils.pm view on Meta::CPAN
# If we have Test::FailWarnings, use it
BEGIN {
eval { require Test::FailWarnings; 1 } and do { Test::FailWarnings->import };
}
sub exception(&) {
my $code = shift;
my $success = eval { $code->(); 1 };
my $err = $@;
return '' if $success;
croak "Execution died, but the error was lost" unless $@;
view release on metacpan or search on metacpan
lib/Clone/Util.pm view on Meta::CPAN
use Function::Fallback::CoreOrPP qw(clone);
use Exporter qw(import);
our @EXPORT_OK = qw(clone modclone sclone);
sub modclone(&$;@) {
my $code = shift;
my $data = shift;
my $clone = clone($data);
local $_ = $clone;
$code->($clone);
view release on metacpan or search on metacpan
lib/Closure/Explicit.pm view on Meta::CPAN
shift->method(++$x);
} weaken => [qw($self)], allowed => [qw($x)];
=cut
sub callback(&;@) {
if(CLOSURE_CHECKS) {
my $code = shift;
my %spec = (@_ > 1) ? (@_) : (allowed => shift);
# warn "Have " . join ',', keys %spec;
if(my @err = lint( $code => %spec )) {
view release on metacpan or search on metacpan
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);
view release on metacpan or search on metacpan
lib/Compiler/Parser/AST.pm view on Meta::CPAN
$parent->{$branch} = $node->next;
}
}
}
sub walk(&$) {
my ($ast, $callback);
if (ref $_[0] eq 'Compiler::Parser::AST') {
($ast, $callback) = @_;
} elsif (ref $_[1] eq 'Compiler::Parser::AST') {
($callback, $ast) = @_;
view release on metacpan or search on metacpan
t/checker.t view on Meta::CPAN
eval validate_config(clone($good_config), $prototype_config);
is($@, '', 'good config');
my $config;
sub mangle_and_test(&@)
{
my ($mangle, $message, $name) = @_;
$config = clone($good_config);
&$mangle;
eval { validate_config($config, $prototype_config) };
view release on metacpan or search on metacpan
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);
view release on metacpan or search on metacpan
t/10-basics.t view on Meta::CPAN
use Test::More 0.88;
use Test::Fatal qw(exception lives_ok);
use Const::Fast;
sub throws_readonly(&@) {
my ($sub, $desc) = @_;
my ($file, $line) = (caller)[1,2];
my $error = qr/\AModification of a read-only value attempted at \Q$file\E line $line\.\Z/;
local $Test::Builder::Level = $Test::Builder::Level + 1;
like(exception { $sub->() }, $error, $desc);
}
sub throws_reassign(&@) {
my ($sub, $desc) = @_;
my ($file, $line) = (caller)[1,2];
my $error = qr/\AAttempt to reassign a readonly \w+ at \Q$file\E line $line\.?\Z/;
local $Test::Builder::Level = $Test::Builder::Level + 1;
like(exception { $sub->() }, $error, $desc);
}
sub throws_ok(&@) {
my ($sub, $error, $desc) = @_;
local $Test::Builder::Level = $Test::Builder::Level + 1;
like(exception { $sub->() }, $error, $desc);
}
view release on metacpan or search on metacpan
lib/Context/Preserve.pm view on Meta::CPAN
use base 'Exporter';
our @EXPORT = qw(preserve_context);
our $VERSION = '0.03';
sub preserve_context(&@) {
my $orig = shift;
my %args = @_;
my $replace = $args{replace};
my $after = $args{after};
view release on metacpan or search on metacpan
lib/Contextual/Return.pm view on Meta::CPAN
;
return;
}
sub RVALUE(&;@) :lvalue;
sub LVALUE(&;@) :lvalue;
sub NVALUE(&;@) :lvalue;
my %opposite_of = (
'RVALUE' => 'LVALUE or NVALUE',
'LVALUE' => 'RVALUE or NVALUE',
'NVALUE' => 'LVALUE or RVALUE',
view release on metacpan or search on metacpan
schedule; # sleep well
}
};
$unblock_scheduler->{desc} = "[unblock_sub scheduler]";
sub unblock_sub(&) {
my $cb = shift;
sub {
unshift @unblock_queue, [$cb, @_];
$unblock_scheduler->ready;
view release on metacpan or search on metacpan
t/transaction.t view on Meta::CPAN
}
}
my $stub_dbh = stub::db->new;
sub my_try(&) {
my $code = shift;
my $error = do {
local $@;
eval {
$code->();