view release on metacpan or search on metacpan
inc/Test/Base.pm view on Meta::CPAN
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
view release on metacpan or search on metacpan
inc/Test/Base.pm view on Meta::CPAN
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
view release on metacpan or search on metacpan
inc/Test/Base.pm view on Meta::CPAN
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
view release on metacpan or search on metacpan
inc/Test/Base.pm view on Meta::CPAN
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
view release on metacpan or search on metacpan
lib/Evo/Class/Syntax.pm view on Meta::CPAN
_check_settled('no_method');
SYNTAX_STATE()->{no_method}++;
SYNTAX_STATE;
}
sub ro() : prototype() : Export {
_check_settled('ro');
SYNTAX_STATE()->{ro}++;
SYNTAX_STATE;
}
sub rw() : prototype() : Export {
Carp::carp "rw is deprecated, all attributes are rw by default";
SYNTAX_STATE;
}
sub optional() : prototype() : Export {
view release on metacpan or search on metacpan
inc/Test/Base.pm view on Meta::CPAN
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
view release on metacpan or search on metacpan
t/ffi_probe.t view on Meta::CPAN
use Capture::Tiny qw( capture_merged );
use FFI::Temp;
use File::Basename qw( basename );
use Config;
sub n (&)
{
my($code) = @_;
my($out, @ret) = capture_merged {
$code->();
};
note $out;
@ret;
}
sub f (@)
{
foreach my $filename (@_)
{
note "==@{[ basename $filename ]}==";
my $fh;
view release on metacpan or search on metacpan
lib/FSM/Basic.pm view on Meta::CPAN
caseinsensitive
alternation
);
sub qp(&){
my $s;
open local *STDOUT, '>', \$s or die "open in-memory file: $!";
&{$_[0]};
die $@ if $@;
$s;
view release on metacpan or search on metacpan
}
our $REQ = {}; # Internal request-local data
our $fu = bless {}, 'FU::obj'; # App request-local data
sub fu() { $fu }
FU::Log::capture_warn(1);
FU::Log::set_fmt(sub($msg) {
FU::Log::default_fmt($msg,
fu->path && fu->method ? fu->method.' '.fu->path.(fu->query?'?'.fu->query:'') : '[global]',
package FU::obj;
use v5.36;
use Carp 'confess';
sub fu() { $FU::fu }
sub debug { FU::debug }
sub db_conn { $FU::DB || FU::_connect_db }
sub db {
view release on metacpan or search on metacpan
inc/Test/Base.pm view on Meta::CPAN
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
view release on metacpan or search on metacpan
lib/File/NCopy.pm view on Meta::CPAN
}
@copies;
}
sub cp(@) {
return copy @_;
}
# instantiate our object
sub new(@)
view release on metacpan or search on metacpan
my $caller = caller;
# execute 'do $file;' in calling package
&{eval "package $caller; sub { my \$file = shift; do \$file;};";}($file);
}
sub DO($;$) {
my($file,$nowarnings) = @_;
my $caller = caller;
@_ = ($file,$nowarnings,$caller,0);
goto &_doFILE;
}
view release on metacpan or search on metacpan
inc/Test/Base.pm view on Meta::CPAN
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
view release on metacpan or search on metacpan
inc/Test/Base.pm view on Meta::CPAN
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
view release on metacpan or search on metacpan
DiskFree.pm view on Meta::CPAN
sub command () {
my $self=shift;
return $Df{"\L".$self->{'FORMAT'}."\E"}{$self->{'MODE'}};
}
sub df(){
my $self=shift;
my $cmd="df";
$cmd=$self->command() or
croak "No df command known for format ".$self->{'FORMAT'};
view release on metacpan or search on metacpan
t/03-compilation-output.t view on Meta::CPAN
}
RESULT
$_ = <<'SUB';
sub f ($a,@) {
...
}
SUB
Filter::signatures::transform_arguments();
is $_, <<'RESULT', "Slurpy discard argument works";
t/03-compilation-output.t view on Meta::CPAN
sub { my ($self,$foo)=@_;$foo = $#args if @_ <= 1;();
}
RESULT
$_ = <<'SUB';
sub f ($a = /\w/ ) {
...
}
SUB
Filter::signatures::transform_arguments();
is $_, <<'RESULT', "Argument lists containing regular expressions work";
t/03-compilation-output.t view on Meta::CPAN
...
}
RESULT
$_ = <<'SUB';
sub f ($a = \$b, $c=\@d, $e=\%f, $g=\&h, $i=\*j ) {
...
}
SUB
Filter::signatures::transform_arguments();
is $_, <<'RESULT', "Argument lists containing scalar references";
t/03-compilation-output.t view on Meta::CPAN
...
}
RESULT
$_ = <<'SUB';
sub f ($a = /\(/ ) {
...
}
SUB
Filter::signatures::transform_arguments();
is $_, <<'RESULT', "Argument lists containing unmatched parentheses work";
t/03-compilation-output.t view on Meta::CPAN
...
}
RESULT
$_ = <<'SUB';
sub f ($a = /[\(]/ ) {
...
}
SUB
Filter::signatures::transform_arguments();
is $_, <<'RESULT', "Characterclasses with unmatched quoted parentheses work";
t/03-compilation-output.t view on Meta::CPAN
{ local $TODO = "Recursive parentheses don't work on $]"
if( $] < 5.010 );
$_ = <<'SUB';
sub f ($a = /[\)]/ ) {
...
}
SUB
Filter::signatures::transform_arguments();
is $_, <<'RESULT', "Characterclasses with unmatched quoted parentheses work";
t/03-compilation-output.t view on Meta::CPAN
RESULT
}
{ local $TODO = 'More robust regexp parsing needed';
$_ = <<'SUB';
sub f ($a = /[(]/ ) {
...
}
SUB
Filter::signatures::transform_arguments();
is $_, <<'RESULT', "Regular expressions containing characterclasses with unmatched parentheses work";
t/03-compilation-output.t view on Meta::CPAN
...
}
RESULT
$_ = <<'SUB';
sub f ($a = /[)]/ ) {
...
}
SUB
Filter::signatures::transform_arguments();
is $_, <<'RESULT', "Regular expressions containing characterclasses with unmatched parentheses work";
t/03-compilation-output.t view on Meta::CPAN
{ local $TODO = "Recursive parentheses don't work on $]"
if( $] < 5.010 );
$_ = <<'SUB';
sub f ($a = qr(\() ) {
...
}
SUB
Filter::signatures::transform_arguments();
is $_, <<'RESULT', "Argument lists containing unmatched parentheses within qr-strings work";
t/03-compilation-output.t view on Meta::CPAN
}
RESULT
}
$_ = <<'SUB';
sub f ($a = do { }) {
...
}
SUB
Filter::signatures::transform_arguments();
is $_, <<'RESULT', "do-blocks work";
t/03-compilation-output.t view on Meta::CPAN
{ local $TODO = "Recursive parentheses don't work on $]"
if( $] < 5.010 );
$_ = <<'SUB';
sub f ($a = substr("abc",0,1)) {
...
}
SUB
Filter::signatures::transform_arguments();
is $_, <<'RESULT', "Commas within subroutine calls don't split the argument lists";
t/03-compilation-output.t view on Meta::CPAN
}
RESULT
}
$_ = <<'SUB';
sub f ($a = /\,/, $b=1) {
...
}
SUB
Filter::signatures::transform_arguments();
is $_, <<'RESULT', "Commas within regular expression matches don't split the argument lists";
t/03-compilation-output.t view on Meta::CPAN
...
}
RESULT
$_ = <<'SUB';
sub f ($a = /\,/, $b=1) {
...
}
SUB
Filter::signatures::transform_arguments();
is $_, <<'RESULT', "Commas within regular expression matches don't split the argument lists";
t/03-compilation-output.t view on Meta::CPAN
...
}
RESULT
$_ = <<'SUB';
sub f ($a = do { $x = "abc"; return substr $x,0,1}) {
...
}
SUB
Filter::signatures::transform_arguments();
is $_, <<'RESULT', "Commas within do-blocks don't split the argument lists";
t/03-compilation-output.t view on Meta::CPAN
{ local $TODO = "Recursive parentheses don't work on $]"
if( $] < 5.010 );
$_ = <<'SUB';
sub f ($a = do { $x = "abc"; return substr($x,0,1)}) {
...
}
SUB
Filter::signatures::transform_arguments();
is $_, <<'RESULT', "do-blocks with parentheses work";
t/03-compilation-output.t view on Meta::CPAN
# This is a test for the placeholders that Filter::Simple supplies - if you
# have enough of them, "interesting" characters pop up within these placeholders
# We have an interesting dependency on the format of these placeholders.
$_ = <<'SUB';
sub f ($a = "...(") {
...
}
SUB
Filter::signatures::transform_arguments();
is $_, <<'RESULT', "Parentheses in (replaced) string arguments work";
view release on metacpan or search on metacpan
inc/Test/Base.pm view on Meta::CPAN
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
view release on metacpan or search on metacpan
inc/Test/Base.pm view on Meta::CPAN
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
view release on metacpan or search on metacpan
inc/Test/Base.pm view on Meta::CPAN
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
view release on metacpan or search on metacpan
lib/FP/Trampoline.pm view on Meta::CPAN
our @EXPORT_OK = qw();
our %EXPORT_TAGS = (all => [@EXPORT, @EXPORT_OK]);
use FP::Carp;
sub T (&) {
bless $_[0], "FP::Trampoline::Continuation"
}
sub TC {
bless [@_], "FP::Trampoline::Call"
view release on metacpan or search on metacpan
inc/Test/Base.pm view on Meta::CPAN
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
view release on metacpan or search on metacpan
inc/Test/Base.pm view on Meta::CPAN
$Text::Diff::VERSION >= 0.35 &&
$Algorithm::Diff::VERSION >= 1.15;
}
provides 'is';
sub is($$;$) {
(my ($self), @_) = find_my_self(@_);
my ($actual, $expected, $name) = @_;
local $Test::Builder::Level = $Test::Builder::Level + 1 unless $HAS_PROVIDER;
if ($ENV{TEST_SHOW_NO_DIFFS} or
not defined $actual or
view release on metacpan or search on metacpan
lib/Geo/Line.pm view on Meta::CPAN
sub isFilled() { shift->{GL_fill} }
#----------------
sub in($)
{ my ($self, $projnew) = @_;
return $self if ! defined $projnew || $projnew eq $self->proj;
# projnew can be 'utm'
my ($realproj, @points) = $self->projectOn($projnew, $self->points);
view release on metacpan or search on metacpan
inc/Test/Base.pm view on Meta::CPAN
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
view release on metacpan or search on metacpan
# arbitrary Getopt::Long option name
# (parsing depends on the params passed to GetModule, not the option name)
use constant OPTION_NAME => 'module';
sub pp($) { Getopt::Module::_pp($_[0]) }
sub _qw_to_split($) {
my $evals = shift;
my $ref = ref($evals);
view release on metacpan or search on metacpan
lib/Gimp.pm view on Meta::CPAN
*{"$up\::$_"} = \&$_;
}
}
# the monadic identity function
sub N_($) { shift }
my $gtk_init = 1;
sub gtk_init() {
if ($gtk_init) {
view release on metacpan or search on metacpan
lib/GitHub/Crud.pm view on Meta::CPAN
sub deleteSha($) #P Delete a L<sha> that is no longer valid
{my ($gitHub) = @_; # Github
$shas{$gitHub->shaKey} = undef # Mark the L<sha> as deleted
}
sub qm($) #P Quotemeta extended to include undef
{my ($s) = @_; # String to quote
return '' unless $s;
$s =~ s((\'|\"|\\)) (\\$1)gs;
$s =~ s(\s) (%20)gsr; # Url encode blanks
}
view release on metacpan or search on metacpan
lib/Github/Hooks/Receiver/Declare.pm view on Meta::CPAN
sub secret($) {
die 'not in receiver block' unless $_RECEIVER;
$_RECEIVER->{secret} = $_[0];
}
sub on($;$) {
die 'not in receiver block' unless $_RECEIVER;
$_RECEIVER->on(@_);
}
1;
view release on metacpan or search on metacpan
use warnings;
use Glib qw(:constants);
# From 7.t. Do we need a test helper class?
sub ok($$;$) {
my($test, $num, $name) = @_;
my $out = $test ? "ok" : "not ok";
$out .= " $num" if $num;
$out .= " - $name" if defined $name;
view release on metacpan or search on metacpan
lib/Graph/TransitiveClosure/Matrix.pm view on Meta::CPAN
use Graph::AdjacencyMatrix;
use Graph::Matrix;
use Scalar::Util qw(weaken);
use List::Util qw(min);
sub _A() { 0 } # adjacency
sub _D() { 1 } # distance
sub _S() { 2 } # successors
sub _V() { 3 } # vertices
sub _G() { 4 } # the original graph (OG)
sub _new {
my ($g, $class, $am_opt, $want_transitive, $want_reflexive, $want_path, $want_path_vertices, $want_path_count) = @_;
my $m = Graph::AdjacencyMatrix->new($g, %$am_opt);
my @V = $g->vertices;