App-SimpleBackuper

 view release on metacpan or  search on metacpan

local/lib/perl5/Package/Stash/PP.pm  view on Meta::CPAN

package Package::Stash::PP;
use strict;
use warnings;
# ABSTRACT: Pure perl implementation of the Package::Stash API

our $VERSION = '0.40';

use B;
use Carp qw(confess);
use Scalar::Util qw(blessed reftype weaken);
use Symbol;
# before 5.12, assigning to the ISA glob would make it lose its magical ->isa
# powers
use constant BROKEN_ISA_ASSIGNMENT => ($] < 5.012);
# before 5.10, stashes don't ever seem to drop to a refcount of zero, so
# weakening them isn't helpful
use constant BROKEN_WEAK_STASH     => ($] < 5.010);
# before 5.10, the scalar slot was always treated as existing if the
# glob existed
use constant BROKEN_SCALAR_INITIALIZATION => ($] < 5.010);
# add_method on anon stashes triggers rt.perl #1804 otherwise
# fixed in perl commit v5.13.3-70-g0fe688f
use constant BROKEN_GLOB_ASSIGNMENT => ($] < 5.013004);
# pre-5.10, ->isa lookups were cached in the ::ISA::CACHE:: slot
use constant HAS_ISA_CACHE => ($] < 5.010);

local/lib/perl5/Package/Stash/PP.pm  view on Meta::CPAN

        return \%{$_[0]->name . '::'};
    }
    else {
        return $_[0]->{namespace} if defined $_[0]->{namespace};

        {
            no strict 'refs';
            $_[0]->{namespace} = \%{$_[0]->name . '::'};
        }

        weaken($_[0]->{namespace});

        return $_[0]->{namespace};
    }
}

{
    my %SIGIL_MAP = (
        '$' => 'SCALAR',
        '@' => 'ARRAY',
        '%' => 'HASH',

local/lib/perl5/Test/Deep/Cache/Simple.pm  view on Meta::CPAN

use warnings;

package Test::Deep::Cache::Simple 1.204;

use Carp qw( confess );

use Scalar::Util qw( refaddr );

BEGIN
{
  if (grep /^weaken$/, @Scalar::Util::EXPORT_FAIL)
  {
    # we're running on a version of perl that has no weak refs, so we
    # just install a no-op sub for weaken instead of importing it
    *weaken = sub {};
  }
  else
  {
    Scalar::Util->import('weaken');
  }
}

sub new
{
  my $pkg = shift;

  my $self = bless {}, $pkg;

  return $self;

local/lib/perl5/Test/Deep/Cache/Simple.pm  view on Meta::CPAN

sub add
{
  my $self = shift;

  my ($d1, $d2) = @_;
  {
    local $SIG{__DIE__};

    local $@;

    # cannot weaken read only refs, no harm if we can't as they never
    # disappear
    eval{weaken($d1)};
    eval{weaken($d2)};
  }

  $self->{fn_get_key(@_)} = [$d1, $d2];
}

sub cmp
{
  my $self = shift;

  my $key = fn_get_key(@_);
  my $pair = $self->{$key};

  # are both weakened refs still valid, if not delete this entry
  if (ref($pair->[0]) and ref($pair->[1]))
  {
    return 1;
  }
  else
  {
    delete $self->{$key};
    return 0;
  }
}

local/lib/perl5/Test/Spec/Context.pm  view on Meta::CPAN

    my $args = shift;
    if (@_ || ref($args) ne 'HASH') {
      Carp::croak "usage: $class->new(\\%args)";
    }
    while (my ($name,$val) = each (%$args)) {
      $self->$name($val);
    }
  }

  my $this = $self;
  Scalar::Util::weaken($this);
  $self->on_enter(sub {
    $this && $this->_debug(sub {
      printf STDERR "%s[%s]\n", '  ' x $_StackDepth, $this->_debug_name;
      $_StackDepth++;
    });
  });

  $self->on_leave(sub {
    $this && $this->_debug(sub {
      $_StackDepth--;

local/lib/perl5/Test/Spec/Context.pm  view on Meta::CPAN

  $self->{_name} = shift if @_;
  return exists($self->{_name})
    ? $self->{_name}
    : ($self->{_name} = '');
}

sub parent {
  my $self = shift;
  if (@_) {
    $self->{_parent} = shift;
    Scalar::Util::weaken($self->{_parent}) if ref($self->{_parent});
  }
  return $self->{_parent};
}

sub class {
  my $self = shift;
  $self->{_class} = shift if @_;
  if ($self->{_class}) {
    return $self->{_class};
  }

local/lib/perl5/Test/Spec/Context.pm  view on Meta::CPAN

    $code = $self->wrap_code_with_around_block($code,$_,$example);
  }
  return $code;
}

# Wraps $code within a context with around block.
sub wrap_code_with_around_block {
  my ($self,$inner_code,$block,$example) = @_;

  my $this = $self;
  Scalar::Util::weaken($this);

  return sub {
    my $yield_ok = 0;
    local $Test::Spec::Yield = sub {
      $yield_ok = 1;
      $inner_code->($example);
    };
    $this && $this->_debug(sub {
      printf STDERR "%s[around CODE %s] %s {\n", '__' x $_AroundStackDepth, $self->_debug_name, "$block";
      $_AroundStackDepth++;

local/lib/perl5/Test/Spec/Example.pm  view on Meta::CPAN

  if (!$args || ref($args) ne 'HASH') {
    Carp::croak "usage: $class->new(\\%args)";
  }

  my $self = bless {}, $class;
  foreach my $attr ( qw/name description code builder context/ ) {
    $self->{$attr} = $args->{$attr} || Carp::croak "$attr missing";
  }

  Scalar::Util::weaken($self->{context});

  return $self;
}

sub name        { shift->{name} }
sub description { shift->{description} }
sub code        { shift->{code} }
sub builder     { shift->{builder} }
sub context     { shift->{context} }