view release on metacpan or search on metacpan
lib/CatalystX/CRUD/ModelAdapter/DBIC.pm view on Meta::CPAN
CatalystX::CRUD::ModelAdapter
CatalystX::CRUD::Model::Utils
);
use MRO::Compat;
use mro 'c3';
use Scalar::Util qw( weaken );
use Carp;
use Data::Dump qw( dump );
use Sort::SQL;
__PACKAGE__->mk_ro_accessors(qw( treat_like_int ));
lib/CatalystX/CRUD/ModelAdapter/DBIC.pm view on Meta::CPAN
my $c = shift;
my $field_names = shift;
# Model::Utils (make_sql_query) assumes ACCEPT_CONTEXT accessor
$self->{context} = $c;
weaken( $self->{context} );
my $q = $self->next::method($field_names);
#carp "make_sql_query : " . dump $q;
view release on metacpan or search on metacpan
lib/CatalystX/Crudite/Util/Random.pm view on Meta::CPAN
ways
wayside
wayward
we
weak
weaken
weakened
weakening
weakens
weaker
weakest
weakly
weakness
weaknesses
view release on metacpan or search on metacpan
lib/CatalystX/Controller/ExtJS/REST.pm view on Meta::CPAN
$form->populate($config);
}
# To allow your form validation packages, etc, access to the catalyst
# context, a weakened reference of the context is copied into the form's
# stash.
my $context_stash = $self->_extjs_config->{context_stash};
$form->stash->{$context_stash} = $c;
Scalar::Util::weaken( $form->stash->{$context_stash} );
return $form;
}
sub load_config_file {
my ($self, $file) = @_;
lib/CatalystX/Controller/ExtJS/REST.pm view on Meta::CPAN
Defaults to C<data>.
=head2 context_stash
To allow your form validation packages, etc, access to the catalyst context,
a weakened reference of the context is copied into the form's stash.
$form->stash->{context};
This setting allows you to change the key name used in the form stash.
view release on metacpan or search on metacpan
lib/CatalystX/I18N/Model/Maketext.pm view on Meta::CPAN
use Moose;
extends 'CatalystX::I18N::Model::Base';
use CatalystX::I18N::TypeConstraints;
use Path::Class;
use Scalar::Util qw(weaken);
has 'gettext_style' => (
is => 'rw',
isa => 'Bool',
default => 1,
lib/CatalystX/I18N/Model/Maketext.pm view on Meta::CPAN
# Catch error
Catalyst::Exception->throw(sprintf("Could not fetch lanuage handle for locale '%s'",$c->locale))
unless ( scalar $handle );
if ($self->can('fail_with')) {
weaken($c);
$handle->fail_with( sub {
$self->fail_with($c,@_);
} );
} else {
$handle->fail_with( sub { } );
view release on metacpan or search on metacpan
lib/CatalystX/LeakChecker.pm view on Meta::CPAN
# ABSTRACT: Debug memory leaks in Catalyst applications
use Moose::Role;
use B::Deparse;
use Text::SimpleTable;
use Scalar::Util 'weaken';
use Devel::Cycle 'find_cycle';
sub deparse {
my ($code) = @_;
return q{sub } . B::Deparse->new->coderef2text($code) . q{;};
lib/CatalystX/LeakChecker.pm view on Meta::CPAN
after finalize => sub {
my ($ctx) = @_;
my @leaks;
my $weak_ctx = $ctx;
weaken $weak_ctx;
find_cycle($ctx, sub {
my ($path) = @_;
push @leaks, $path
if $path->[0]->[2] == $weak_ctx;
view release on metacpan or search on metacpan
lib/CellBIS/Random.pm view on Meta::CPAN
use strict;
use warnings;
use utf8;
use Carp ();
use Scalar::Util qw(blessed weaken);
use List::SomeUtils qw(part);
# ABSTRACT: Tool for Randomize characters in strings.
our $VERSION = '0.3';
view release on metacpan or search on metacpan
sv_ref||5.015004|
sv_replace|||
sv_report_used|||
sv_resetpvn|||
sv_reset|||
sv_rvweaken||5.006000|
sv_sethek|||
sv_setiv_mg|5.004050||p
sv_setiv|||
sv_setnv_mg|5.006000||p
sv_setnv|||
view release on metacpan or search on metacpan
sv_reftype|||
sv_release_COW|||
sv_replace|||
sv_report_used|||
sv_reset|||
sv_rvweaken||5.006000|
sv_setiv_mg|5.004050||p
sv_setiv|||
sv_setnv_mg|5.006000||p
sv_setnv|||
sv_setpv_mg|5.004050||p
view release on metacpan or search on metacpan
xs/contextmenu.xs view on Meta::CPAN
SV **app_svp = hv_fetchs(hv, "app", 0);
if (app_svp && SvOK(*app_svp)) {
SV *cm_self_ref = newSVsv(self);
CV *wrapper_cv;
sv_rvweaken(cm_self_ref);
wrapper_cv = newXS(NULL, XS_Chandra__ContextMenu__dispatch_trampoline, __FILE__);
CvXSUBANY(wrapper_cv).any_ptr = (void *)cm_self_ref;
{
dSP;
ENTER; SAVETMPS;
view release on metacpan or search on metacpan
lib/Cheat/Sheet/Util.agi view on Meta::CPAN
#-# # #2345678901234567890123456789012345678901234
#-#
#=head2 Scalar::Util
use Scalar::Util; # General-utility scalar subroutines
use Scalar::Util qw(
weaken isweak reftype refaddr blessed isvstring readonly tainted
dualvar looks_like_number openhandle set_prototype
);
weaken $ref; # $ref will not keep @$ref, %$ref, etc. from GC
# note: copies of weak refs are not weak
$bool = isweak $ref; # true if $ref is a weak reference
$type = reftype $ref; # 'SCALAR', 'ARRAY', 'HASH', or undef
$addr = refaddr $ref; # machine address of $ref or undef
$got = blessed $ref; # class of blessed ref or undef
view release on metacpan or search on metacpan
inc/Spiffy.pm view on Meta::CPAN
" return \$_[0]->{%s} = do { my \$self = \$_[0]; %s }\n" .
" unless \$#_ > 0 or defined \$_[0]->{%s};\n",
weak_init =>
" return do {\n" .
" \$_[0]->{%s} = do { my \$self = \$_[0]; %s };\n" .
" Scalar::Util::weaken(\$_[0]->{%s}) if ref \$_[0]->{%s};\n" .
" \$_[0]->{%s};\n" .
" } unless \$#_ > 0 or defined \$_[0]->{%s};\n",
return_if_get =>
" return \$_[0]->{%s} unless \$#_ > 0;\n",
set =>
" \$_[0]->{%s} = \$_[1];\n",
weaken =>
" Scalar::Util::weaken(\$_[0]->{%s}) if ref \$_[0]->{%s};\n",
sub_end =>
" return \$_[0]->{%s};\n}\n",
);
sub field {
inc/Spiffy.pm view on Meta::CPAN
local *paired_arguments = sub { (qw(-package -init)) };
Spiffy->parse_arguments(@_);
};
my ($field, $default) = @values;
$package = $args->{-package} if defined $args->{-package};
die "Cannot have a default for a weakened field ($field)"
if defined $default && $args->{-weak};
return if defined &{"${package}::$field"};
require Scalar::Util if $args->{-weak};
my $default_string =
( ref($default) eq 'ARRAY' and not @$default )
inc/Spiffy.pm view on Meta::CPAN
}
$code .= sprintf $code{set_default}, $field, $default_string, $field
if defined $default;
$code .= sprintf $code{return_if_get}, $field;
$code .= sprintf $code{set}, $field;
$code .= sprintf $code{weaken}, $field, $field
if $args->{-weak};
$code .= sprintf $code{sub_end}, $field;
my $sub = eval $code;
die $@ if $@;
view release on metacpan or search on metacpan
# $Id: PDB.pm,v 1.13 2009/05/10 21:57:32 itubert Exp $
use base qw(Chemistry::File);
use Chemistry::MacroMol;
use Chemistry::Domain;
use Scalar::Util qw(weaken);
use Carp;
use strict;
use warnings;
=head1 NAME
if ($is_macro) {
$domain = Chemistry::Domain->new(
parent => $mol, name => "$res_name$seq_n",
type => $res_name);
$mol->add_domain($domain);
weaken $domain;
$domain->attr('pdb/sequence_number', $seq_n);
$domain->attr('pdb/chain_id', $chain_id);
$domain->attr('pdb/insertion_code', $ins_code);
}
$curr_residue = $seq_n;
view release on metacpan or search on metacpan
InternalCoords.pm view on Meta::CPAN
use strict;
use warnings;
use Math::VectorReal qw(:all);
use Carp;
use overload '""' => "stringify", fallback => 1;
use Scalar::Util 'weaken';
use Math::Trig 'deg2rad';
=head1 NAME
InternalCoords.pm view on Meta::CPAN
len_ref => shift, len_val => shift,
ang_ref => shift, ang_val => shift,
dih_ref => shift, dih_val => shift,
}, ref $class || $class;
weaken($self->{atom}); # to avoid memory leaks
for (@$self{qw(len_ref ang_ref dih_ref)}) {
if ($_ and not ref) {
$_ = $atom->parent->atoms($_);
}
view release on metacpan or search on metacpan
use 5.006;
use strict;
use warnings;
use base qw(Chemistry::Mol);
use Carp;
use Scalar::Util 'weaken';
=head1 NAME
Chemistry::Domain - Class for domains in macromolecules
sub parent {
my $self = shift;
if (@_) {
$self->{parent} = shift;
weaken($self->{parent});
return $self;
} else {
return $self->{parent};
}
}
view release on metacpan or search on metacpan
lib/Chemistry/Atom.pm view on Meta::CPAN
# mass_number (A)
use 5.006;
use strict;
use warnings;
use Scalar::Util 'weaken';
use Math::VectorReal qw(O vector);
use Math::Trig;
use Carp;
use base qw(Chemistry::Obj Exporter);
use List::Util qw(first);
lib/Chemistry/Atom.pm view on Meta::CPAN
#return if first { $_ eq $bond } @{$self->{bonds}};
for my $atom (@{$bond->{atoms}}){ #for each atom...
if ($atom ne $self) {
my $b = {to=>$atom, bond=>$bond};
weaken($b->{to});
weaken($b->{bond});
push @{$self->{bonds}}, $b;
}
}
}
# make sure the atom doesn't cause circular references
sub _weaken {
my $self = shift;
for my $b (@{$self->{bonds}}) {
weaken($b->{to});
weaken($b->{bond});
}
weaken($self->{parent});
}
# This method is private. Bonds should be deleted from the
# mol object. These methods should only be called by
# $bond->delete_atoms, which is called by $mol->delete_bond
lib/Chemistry/Atom.pm view on Meta::CPAN
sub parent {
my $self = shift;
if (@_) {
($self->{parent}) = @_;
weaken($self->{parent});
$self;
} else {
$self->{parent};
}
}
view release on metacpan or search on metacpan
lib/Chemistry/Ring.pm view on Meta::CPAN
use warnings;
use Math::VectorReal qw(:axis vector);
use Statistics::Regression;
use Chemistry::Mol;
use base 'Chemistry::Mol', 'Exporter';
use Scalar::Util 'weaken';
our @EXPORT_OK = qw(aromatize_mol);
our %EXPORT_TAGS = ( all => \@EXPORT_OK );
our $N = 0;
lib/Chemistry/Ring.pm view on Meta::CPAN
$_->aromatic(1) for ($ring->atoms, $ring->bonds);
}
for ($ring->atoms, $ring->bonds) {
my $ringlist = $_->attr("ring/rings") || [];
push @$ringlist, $ring;
weaken($ringlist->[-1]);
$_->attr("ring/rings", $ringlist);
}
}
@rings;
}
view release on metacpan or search on metacpan
lib/Chorus/Frame.pm view on Meta::CPAN
}
use strict;
use Carp; # warn of errors (from perspective of caller)
use Digest::MD5;
use Scalar::Util qw(weaken);
use Data::Dumper;
use constant DEBUG_MEMORY => 0;
lib/Chorus/Frame.pm view on Meta::CPAN
sub _addInstance {
my ($this, $instance) = @_;
my $k = $instance->{_KEY};
$INSTANCES{$this->{_KEY}}->{$k} = $instance;
weaken($INSTANCES{$this->{_KEY}}->{$k}); #Â will not increase garbage ref counter to $instance !!
}
=head2 _inherits
add inherited new frame(s) outside constructor
lib/Chorus/Frame.pm view on Meta::CPAN
$REPOSITORY{$slot}->{$k} = 'Y';
}
$this->{_KEY} = $k;
$FMAP{$k} = $this;
weaken($FMAP{$k}); #Â will not increase garbage ref counter to $this !!
return $this;
}
sub blessToFrameRec {
view release on metacpan or search on metacpan
lib/Chorus/Frame.pm view on Meta::CPAN
}
use strict;
use Carp; # warn of errors (from perspective of caller)
use Digest::MD5;
use Scalar::Util qw(weaken);
use Data::Dumper;
use constant DEBUG_MEMORY => 0;
lib/Chorus/Frame.pm view on Meta::CPAN
sub _addInstance {
my ($this, $instance) = @_;
my $k = $instance->{_KEY};
$INSTANCES{$this->{_KEY}}->{$k} = $instance;
weaken($INSTANCES{$this->{_KEY}}->{$k}); #Â will not increase garbage ref counter to $instance !!
}
=head2 _inherits
add inherited new frame(s) outside constructor
lib/Chorus/Frame.pm view on Meta::CPAN
$REPOSITORY{$slot}->{$k} = 'Y';
}
$this->{_KEY} = $k;
$FMAP{$k} = $this;
weaken($FMAP{$k}); #Â will not increase garbage ref counter to $this !!
return $this;
}
sub blessToFrameRec {
view release on metacpan or search on metacpan
lib/Chorus/Frame.pm view on Meta::CPAN
use strict;
use warnings;
use Carp; # warn of errors (from perspective of caller)
use Digest::MD5;
use Scalar::Util qw(weaken);
use constant DEBUG_MEMORY => 0;
use vars qw($AUTOLOAD);
lib/Chorus/Frame.pm view on Meta::CPAN
my ($this, $instance) = @_;
my $k = $instance->{_KEY};
$INSTANCES{$this->{_KEY}}->{$k} = $instance;
# weaken($INSTANCES{$instance); # TOCHECK - does the SAME !!??
#
weaken($INSTANCES{$this->{_KEY}}->{$k}); # Will not increase garbage ref counter to $instance !!
}
=head2 _inherits
Adds one or more parent frames to the inheritance chain outside the constructor.
lib/Chorus/Frame.pm view on Meta::CPAN
sub _inherits {
my ($this, @inherited) = @_;
my $k = $this->{_KEY};
for (grep { ! $INSTANCES{$_->{_KEY}}->{$k} } @inherited) { #Â clean list
$_->_addInstance($this); # will use weaken on
$this->_push('_ISA', $_);
}
return $this;
}
lib/Chorus/Frame.pm view on Meta::CPAN
}
$this->{_KEY} = $k; # _KEY SET HERE !!
$FMAP{$k} = $this;
weaken($FMAP{$k}); # will not increase garbage ref counter to $this !!
return $this;
}
sub _blessToFrameRec {
local $_ = shift;
view release on metacpan or search on metacpan
lib/Circle/Net/Matrix.pm view on Meta::CPAN
use Circle::Widget::Box;
use Circle::Widget::Label;
use Data::Dump qw( pp );
use Scalar::Util qw( weaken );
=head1 NAME
C<Circle::Net::Matrix> - use C<Circle> as a I<Matrix> client
lib/Circle/Net/Matrix.pm view on Meta::CPAN
sub WEAKSELF_EVAL
{
my ( $self, $method ) = @_;
my $code = $self->can( $method ) or return sub {};
weaken( $self );
return sub {
my @args = @_;
eval { $self->$code( @args ); 1 } or
warn $@;
};
lib/Circle/Net/Matrix.pm view on Meta::CPAN
my $loop = $self->{loop} = $args{loop};
# For WindowItem
$self->set_prop_tag( $args{tag} );
weaken( my $weakself = $self );
my $matrix = $self->{matrix} = Net::Async::Matrix->new(
on_log => sub { }, # TODO
on_presence => $self->WEAKSELF_EVAL( 'on_presence' ),
on_room_new => $self->WEAKSELF_EVAL( 'on_room_new' ),
on_room_del => $self->WEAKSELF_EVAL( 'on_room_del' ),
view release on metacpan or search on metacpan
lib/Cisco/Reconfig.pm view on Meta::CPAN
use strict;
use Text::Tabs;
use Carp;
use Carp qw(verbose confess);
use IO::File;
use Scalar::Util qw(weaken);
my $iostrings;
our $allow_minus_one_indent = qr/class /;
our $allow_plus_one_indent = qr/service-policy |quit$/;
our $bad_indent_policy = 'DIE';
lib/Cisco/Reconfig.pm view on Meta::CPAN
my $config = bless { $bloc => 1 }, __PACKAGE__;
$config->{$debg} = "BLOCK:$dseq:$dcon" if $ddata;
$config->{$cntx} = $parent;
weaken $config->{$cntx};
$dseq++;
my $prev;
my $ciscobug;
for(;$line;$prev = $line, $line = <$fh>) {
lib/Cisco/Reconfig.pm view on Meta::CPAN
$context->{$seqn} = $seq++;
$context->{$text} = $line;
confess if $context->{$cntx};
$context->{$cntx} = $config;
weaken $context->{$cntx};
unless ($nonext) {
if ($last) {
$last->{$next} = $context;
weaken $last->{$next};
} else {
$config->{$next} = $context;
weaken $config->{$next};
}
}
$last = $context;
lib/Cisco/Reconfig.pm view on Meta::CPAN
#
die unless defined $1;
my $sep = qr/\Q$1\E/;
my $sub = $last->{$subs} = bless { $bloc => 1 }, __PACKAGE__;
$sub->{$cntx} = $last;
weaken $sub->{$cntx};
my $subnull = $sub->{''} = bless { $bloc => 1, $dupl => [] }, __PACKAGE__;
$subnull->{$cntx} = $sub;
weaken $subnull->{$cntx};
for(;;) {
$line = <$fh>;
last unless $line;
my $l = bless {
$ddata ? ( $debg => "$dseq:DUP:$line" ) : (),
}, __PACKAGE__;
$dseq++;
$l->{$seqn} = $seq++;
$l->{$text} = $line;
$l->{$cntx} = $subnull;
weaken($l->{$cntx});
push(@{$subnull->{$dupl}}, $l);
last if $line =~ /$sep[\r]?$/;
}
warn "parse probably failed"
unless $line && $line =~ /$sep[\r]?$/;
view release on metacpan or search on metacpan
lib/Cisco/UCS/Blade.pm view on Meta::CPAN
use warnings;
use strict;
use Carp qw(croak);
use Scalar::Util qw(weaken);
use Cisco::UCS::Blade::Adaptor;
use Cisco::UCS::Blade::CPU;
use Cisco::UCS::Blade::PowerBudget;
use Cisco::UCS::Common::PowerStats;
lib/Cisco/UCS/Blade.pm view on Meta::CPAN
defined $args{dn}
? $self->{dn} = $args{dn}
: croak 'dn not defined';
defined $args{ucs}
? weaken($self->{ucs} = $args{ucs})
: croak 'dn not defined';
my %attr = %{ $self->{ucs}->resolve_dn(
dn => $self->{dn})->{outConfig}->{computeBlade}
};
view release on metacpan or search on metacpan
share/icd10.json view on Meta::CPAN
"N814": "Uterovaginal prolapse, unspecified",
"N815": "Vaginal enterocele",
"N816": "Rectocele",
"N818": "Other female genital prolapse",
"N8181": "Perineocele",
"N8182": "Incompetence or weakening of pubocervical tissue",
"N8183": "Incompetence or weakening of rectovaginal tissue",
"N8184": "Pelvic muscle wasting",
"N8185": "Cervical stump prolapse",
"N8189": "Other female genital prolapse",
"N819": "Female genital prolapse, unspecified",
"N82": "Fistulae involving female genital tract",
view release on metacpan or search on metacpan
t/edge_cases.t view on Meta::CPAN
use strict;
use warnings;
use Readonly;
use Scalar::Util qw(blessed reftype weaken);
use Test::Most;
use Test::Mockingbird;
use Test::Returns;
use Class::Abstract;
t/edge_cases.t view on Meta::CPAN
};
# ===========================================================================
# SECTION 15: Weakened reference as invocant
#
# Scalar::Util::weaken() removes the strong reference count. Once all
# strong references are gone the object is destroyed and the weak ref becomes
# undef. A live (still-referenced) weakened blessed ref must pass new().
# A dead (garbage-collected) weakened ref becomes undef and must croak.
# ===========================================================================
# Purpose: live weakened blessed ref works; dead weakened ref croaks
subtest 'weakened references as invocants' => sub {
plan tests => 3;
# Live weak ref: a strong ref also exists, so the object survives
my $strong = EC::Concrete->new();
my $weak = $strong;
weaken($weak);
diag 'weak ref: ' . (defined($weak) ? ref($weak) : 'undef') if $ENV{TEST_VERBOSE};
# $weak is still alive because $strong holds a strong reference
ok defined($weak) && blessed($weak),
'precondition: weakened ref is still alive (strong ref holds it)';
# A live weakened blessed ref must be accepted by new()
lives_ok { $strong->new() }
'live weakened blessed ref: new() succeeds via strong ref';
# Dead weak ref: no strong references, object is garbage-collected immediately
my $dead_weak = do { my $obj = EC::Concrete->new(); weaken($obj); $obj };
# The dead weak ref is undef; ref(undef) = "", so it hits the undef guard
throws_ok { Class::Abstract::new($dead_weak) }
$config{err_new_undef},
'dead weakened ref (undef) causes new() to croak with defined-class-name error';
};
# ===========================================================================
# SECTION 16: $_ is never clobbered by any public method
#
view release on metacpan or search on metacpan
lib/Class/Accessor/Grouped.pm view on Meta::CPAN
# now things are installed - one ref less to carry
delete $resolved_methods->{$current_class}{$methname};
# but need to record it in the expectation registry *in case* it
# was cached via ->can for some moronic reason
Scalar::Util::weaken( $cag_produced_crefs->{$resolved_implementation} = $resolved_implementation );
# older perls segfault if the cref behind the goto throws
# http://rt.perl.org/rt3/Public/Bug/Display.html?id=35878
return $resolved_implementation->(@_) if __CAG_ENV__::BROKEN_GOTO;
goto $resolved_implementation;
};
Scalar::Util::weaken($cag_produced_crefs->{$ret} = $ret);
$ret; # returning shim
}
# no Sub::Name - just install the coderefs directly (compiling every time)
view release on metacpan or search on metacpan
xs/accessors.h view on Meta::CPAN
PUSHs(slot); \
PUTBACK; \
} \
#define CALL_WRITE_WEAKEN(slot) \
if (opts & IsWeak) sv_rvweaken(slot)
#define READONLY_TYPE_ASSERT \
assert(type == Inherited || type == PrivateClass || type == ObjectOnly || type == LazyClass)
#define READONLY_CROAK_CHECK \
view release on metacpan or search on metacpan
lib/Class/Accessor/Lvalue.pm view on Meta::CPAN
use strict;
package Class::Accessor::Lvalue;
use base qw( Class::Accessor );
use Scalar::Util qw(weaken);
use Want qw( want );
our $VERSION = '0.11';
sub make_accessor {
my ($class, $field) = @_;
view release on metacpan or search on metacpan
lib/Class/AutoDB.pm view on Meta::CPAN
deletion: it is now possible for a variable to contain a reference
pointing to an object that has been deleted; likewise, an object can
contain a reference (technically an Oid) pointing to a deleted object.
The closest Perl analog is L<weak
references|Scalar::Util/"weaken_REF">. The standard Perl rule stated
above -- "an object exists until all references to the object cease to
exist" -- does not apply to weak references. A weak reference can go
stale (in other words, point to an object that no longer exists). When
this happens, Perl sets the reference to undef, and any attempt to
access the object via the stale reference generates an error.
view release on metacpan or search on metacpan
lib/Class/Builtin/Array.pm view on Meta::CPAN
sub shuffle {
__PACKAGE__->new( [ List::Util::shuffle @{ $_[0] } ] );
}
# Scalar::Util related
for my $meth (qw/blessed isweak refaddr reftype weaken/){
eval qq{
sub Class::Builtin::Array::$meth
{
my \$self = CORE::shift;
my \$ret = Scalar::Util::$meth(\$self);
view release on metacpan or search on metacpan
lib/Class/Cloneable.pm view on Meta::CPAN
use strict;
use warnings;
use overload ();
use Carp qw(confess);
use Scalar::Util qw(blessed reftype weaken isweak);
our $VERSION = '0.03';
sub clone {
(UNIVERSAL::isa((caller)[0], 'Class::Cloneable') ||
lib/Class/Cloneable.pm view on Meta::CPAN
|| confess "Illegal Operation : This method can only be called by a subclass of Class::Cloneable";
my ($to_clone, $cache, $ref_type) = @_;
(ref($to_clone) && (ref($cache) && ref($cache) eq 'HASH'))
|| confess "Insufficient Arguments : Must specify the object to clone and a valid cache";
$ref_type = ref($to_clone) unless defined $ref_type;
# check if it is weakened
my $is_weak;
$is_weak = 1 if isweak($to_clone);
my ($clone, $tied);
if ($ref_type eq 'HASH') {
$clone = {};
lib/Class/Cloneable.pm view on Meta::CPAN
# shallow copy reference to code, glob, regex
$clone = $to_clone;
}
# store it in our cache
$cache->{$to_clone} = $clone;
# and weaken it if appropriate
weaken($clone) if $is_weak;
# and return the clone
return $clone;
}
1;