view release on metacpan or search on metacpan
$self->SUPER::DESTROY if $self->can("SUPER::DESTROY");
}
}
sub ts(;$) {
my $ts = DBG::ts->now;
$ts->text(shift);
return $ts;
}
sub rt($$) {
return unless $ON;
for (@_) {
die 'DBG::ts expected'
unless blessed($_) && $_->isa('DBG::ts');
}
_tee( $gv->STASH->NAME );
}
}
sub sz($;$) {
state $ts = eval { require Devel::Size };
if ($ts) {
my $msg = Devel::Size::total_size( pop @_ );
$msg = pop(@_) . ' ' . $msg if @_;
_tee($msg);
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
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
my $value = shift;
$value =~ s/\./_/g;
return $value;
}
sub u2($) {
my $value = shift;
$value =~ s/\./__/g;
return $value;
}
sub hy($) {
my $value = shift;
$value =~ s/\./-/g;
return $value;
}
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/DBIx/Perlish/Parse.pm view on Meta::CPAN
use B;
use Carp;
use Devel::Caller qw(caller_cv);
sub _o($) { ref($_[0]) . sprintf (" (0x%x)", ${$_[0]}) . ( $_[0]->can('name') ? (" " . $_[0]->name) : '' ) }
sub bailout
{
my ($S, @rest) = @_;
if ($DEVEL) {
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
Database.pm view on Meta::CPAN
## or
## \@bind_valus= values to bind (optional)
## \@bind_types = data types of bind_values
##
sub do($$;$$$)
{
my($self, $statement, $attribs, @params) = @_;
$self -> {'*LastSQLStatement'} = $statement ;
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
st/stress.pl view on Meta::CPAN
}
return $cache{$path} = $o;
}
sub df($;@) {
return unless $verbose;
my ($fmt, @args) = @_;
$fmt =~ s/\s*$/\n/;
unshift @args => $$;
view release on metacpan or search on metacpan
_Deparsed_XSubs.pm view on Meta::CPAN
sub _login;
sub _pg_type_info;
sub _ping;
sub commit;
sub disconnect;
sub do($$;$@) ;
sub endcopy;
sub getfd;
sub getline;
sub lo_close;
sub lo_creat;
_Deparsed_XSubs.pm view on Meta::CPAN
sub DROP_VIEW() ;
sub DROP_VTABLE() ;
sub FUNCTION() ;
sub IGNORE() ;
sub INSERT() ;
sub OK() ;
sub OPEN_CREATE() ;
sub OPEN_EXRESCODE() ;
sub OPEN_FULLMUTEX() ;
sub OPEN_MEMORY() ;
sub OPEN_NOFOLLOW() ;
_Deparsed_XSubs.pm view on Meta::CPAN
sub _active_fields;
sub _fieldhash($$) ;
sub _test_uvar_get;
sub _test_uvar_same;
sub _test_uvar_set;
sub id($) ;
sub id_2obj($) ;
sub register($@) ;
}
package I18N::Langinfo {
sub AUTOLOAD;
view release on metacpan or search on metacpan
lib/Dash/Leak.pm view on Meta::CPAN
=cut
use Devel::Declare ();
use Guard;
sub sz();
BEGIN {
if ($^O eq 'freebsd') {
require BSD::Process;
*sz = sub () { BSD::Process->new->{size} };
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/json/upstream/03_types.t view on Meta::CPAN
use utf8;
use Data::AnyXfer::JSON;
our $test;
sub ok($) {
print $_[0] ? "" : "not ", "ok ", ++$test, "\n";
}
ok( !defined Data::AnyXfer::JSON->new->allow_nonref(1)->decode('null') );
ok( Data::AnyXfer::JSON->new->allow_nonref(1)->decode('true') == 1 );
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/Data/Difflet.pm view on Meta::CPAN
%color,
indent => 2,
}, $class;
}
sub _f($) { die "Do not call directly"; }
sub ddf {
my $self = shift;
@_==1 or die;
view release on metacpan or search on metacpan
}
}
use Test qw( plan ok skip );
sub Ok($;$$) {
@_= @_ < 3 ? reverse @_ : @_[1,0,2];
goto &ok;
}
sub Skip($$;$$) {
view release on metacpan or search on metacpan
lib/Data/Edit/Xml/Lint.pm view on Meta::CPAN
} # singleOrIdDefinitionsReport
#D1 Report # Methods for L<reporting|Data::Edit::Xml::Lint/report> the results of L<linting|/lint> several L<files|/file>
sub p4($$) #PS Format a fraction as a percentage to 4 decimal places
{my ($p, $f) = @_; # Pass, fail
my $n = $p + $f;
return 0 if $n == 0;
$n > 0 or confess "Division by zero";
my $r = sprintf("%3.4f", 100 * $p / $n);
view release on metacpan or search on metacpan
lib/Data/Edit/Xml.pm view on Meta::CPAN
$node
}
# Doubles performance of by! IT is tempting to think that removing all the parameters would speed things up a lot - it does not as most parse trees are not very deep.
sub by($$) #I Post-order traversal of a L<parse|/parse> tree or sub tree calling the specified B<sub> at each node and returning the specified starting node. The B<sub> is passed re...
{my ($node, $sub) = @_; # Starting node, sub to call for each sub node
my $by; $by = sub # Recurse to process sub nodes in deeper context
{$_ = $_[0]; # Save active node in $_
if (my $c = $_->{content}) # Contents reference
lib/Data/Edit/Xml.pm view on Meta::CPAN
return grep {$m{$_->tag}} @c;
}
@c # Elements in the specified range
}
sub to($@) # Return a list of the sibling nodes preceding the specified node optionally including only those nodes that match one of the tags in the specified list.
{my ($end, @match) = @_; # End node, optional list of tags to match
my $q = $end->parent; # Parent node
confess "No parent" unless $q; # Not possible on a root node
my @c = $q->contents; # Content
pop @c while @c and $c[-1] != $end; # Position on end
lib/Data/Edit/Xml.pm view on Meta::CPAN
return $m{$tag}
}
confess "Unknown match type"; # Do not know how to match
}
sub at($@) #CIYU Confirm that the specified B<$node> has the specified L<ancestry|/ancestry>. Ancestry is specified by providing the expected tags that the B<$node>'s parent, the pa...
{my ($node, @context) = @_; # Node, ancestry.
for(my $x = shift @_; $x; $x = $x->parent) # Up through parents
{return $node unless @_; # OK if no more required context
next if atPositionMatch(-t $x, shift @_); # Match tag against context
return undef # Error if required does not match actual
lib/Data/Edit/Xml.pm view on Meta::CPAN
join ' ', path($node) # String representation
}
#D2 Match # Locate adjacent nodes that match horizontally and vertically
sub an($$@) #CU Return the next node if the specified B<$node> has the tag specified by B<$current> and the next node is in the specified B<@context>.
{my ($node, $current, @context) = @_; # Node, tag node must match, optional context of the next node.
return undef unless $node->at($current); # Check node has the right tag
$node->next(@context) # Next node if it matches the context else B<undef>
}
sub ap($$@) #CU Return the previous node if the specified B<$node> has the tag specified by B<$current> and the previous node is in the specified B<@context>.
{my ($node, $current, @context) = @_; # Node, tag node must match, optional context of the previous node.
return undef unless $node->at($current); # Check node has the right tag
$node->prev(@context) # Previous node if it matches the context else B<undef>
}
lib/Data/Edit/Xml.pm view on Meta::CPAN
$child->before($sibling); # Check child occurs after prior sibling
}
#D1 Navigation # Move around in the L<parse|/parse> tree.
sub go($@) #IYU Return the node reached from the specified B<$node> via the specified L<path|/path>: (index positionB<?>)B<*> where index is the tag of the next node to be chosen an...
{my ($node, @path) = @_; # Node, search specification.
my $p = $node; # Current node
while(@path) # Position specification
{my $i = shift @path; # Index name
return undef unless $p; # There is no node of the named type under this node
lib/Data/Edit/Xml.pm view on Meta::CPAN
#b <b><c/></b>
#c top
#c set id top
#d Go to the top of the parse tree.
sub up($@) #CYU Return the parent of the current node optionally checking the parent node's context or return B<undef> if the specified B<$node> is the root of the L<parse|/parse> t...
{my ($node, @context) = @_; # Start node, optional context of parent.
return $node->parent unless @context; # Parent with no context check
my $p = $node->parent;
$p->at(@context) ? $p : undef; # Check context of parent
}
lib/Data/Edit/Xml.pm view on Meta::CPAN
else {$p = $q->[0]} # Step into first sub node by default on last step
}
[@p] # Success!
}
sub nn($) #P Replace new lines in a string with N to make testing easier.
{my ($s) = @_; # String.
$s =~ s/\n/N/gsr
}
#D1 Validation # Validate Xml