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/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
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;
view release on metacpan or search on metacpan
t/lib/Test/More.pm view on Meta::CPAN
use Test::More tests => $Num_Tests;
There are rare cases when you will not know beforehand how many tests
your script is going to run. In this case, you can declare that you
have no plan. (Try to avoid using this as it weakens your test.)
use Test::More qw(no_plan);
In some cases, you'll want to completely skip an entire testing script.
view release on metacpan or search on metacpan
lib/Class/Container.pm view on Meta::CPAN
my $HAVE_WEAKEN;
BEGIN {
eval {
require Scalar::Util;
Scalar::Util->import('weaken');
$HAVE_WEAKEN = 1;
};
*weaken = sub {} unless defined &weaken;
}
use Carp;
# The create_contained_objects() method lets one object
lib/Class/Container.pm view on Meta::CPAN
if ($HAVE_WEAKEN) {
my $c = $self->get_contained_object_spec;
foreach my $name (keys %$c) {
next if $c->{$name}{delayed};
$self->{$name}{container}{container} = $self;
weaken $self->{$name}{container}{container};
}
}
return $self;
}
lib/Class/Container.pm view on Meta::CPAN
my ($self, $name) = (shift, shift);
croak "Unknown delayed item '$name'" unless $self->{container}{contained}{$name}{delayed};
if ($HAVE_WEAKEN) {
push @_, container => {container => $self};
weaken $_[-1]->{container};
}
return $self->call_method($name, 'new', @_);
}
sub delayed_object_class
view release on metacpan or search on metacpan
self(self->next) instead of $_[0] = $_[0]->next.
- refactored all condition checking to use <C>generic_check</C> function
- revisted _inheritence and generic_check. Think I've finally got
weakening pre-conditional checks working correctly. There is a good
test covering this in t/method.t
1.04 Wed Jan 31 15:45:42 2001
1.00 Sun Aug 6 07:11:35 2000
- Changed semantics of preconditions.
Now only inherited if not defined in same class
(this conforms with the notion of derived classes
being allowed to weaken, but not strengthen preconditions).
- Added postconditions on SCALAR, ARRAY, and HASH attributes
- Added &value for attr conditions
view release on metacpan or search on metacpan
lib/Class/DBI/Frozen/301.pm view on Meta::CPAN
BEGIN {
$Weaken_Is_Available = 1;
eval {
require Scalar::Util;
import Scalar::Util qw(weaken);
};
if ($@) {
$Weaken_Is_Available = 0;
}
}
lib/Class/DBI/Frozen/301.pm view on Meta::CPAN
$obj = bless {}, $class;
$obj->_attribute_store(%$data);
# don't store it unless all keys are present
if ($obj_key && $Weaken_Is_Available) {
weaken($Live_Objects{$obj_key} = $obj);
# time to clean up your room?
$class->purge_dead_from_object_index
if ++$Init_Count % $class->purge_object_index_every == 0;
}
view release on metacpan or search on metacpan
lib/Class/DBI/Lite.pm view on Meta::CPAN
use vars qw( $Weaken_Is_Available %Live_Objects );
$Weaken_Is_Available = 1;
eval {
require Scalar::Util;
import Scalar::Util qw(weaken isweak);
};
$Weaken_Is_Available = 0 if $@;
}# end BEGIN:
lib/Class/DBI/Lite.pm view on Meta::CPAN
my $obj = bless $data, $class;
if( $Weaken_Is_Available && ! $is_void_context )
{
$Live_Objects{$key} = $obj;
weaken( $Live_Objects{$key} );
return $Live_Objects{$key};
}
else
{
return $obj;
view release on metacpan or search on metacpan
lib/Class/DBI.pm view on Meta::CPAN
BEGIN {
$Weaken_Is_Available = 1;
eval {
require Scalar::Util;
import Scalar::Util qw(weaken);
};
if ($@) {
$Weaken_Is_Available = 0;
}
}
lib/Class/DBI.pm view on Meta::CPAN
my $obj = bless {}, $class;
$obj->_attribute_store(%$data);
# don't store it unless all keys are present
if ($key && $Weaken_Is_Available) {
weaken($Live_Objects{$key} = $obj);
# time to clean up your room?
$class->purge_dead_from_object_index
if ++$Init_Count % $class->purge_object_index_every == 0;
}
lib/Class/DBI.pm view on Meta::CPAN
objects in memory. It is not a traditional cache - when your objects
go out of scope, they will be destroyed normally, and a future retrieve
will instantiate an entirely new object.
The ability to perform this magic for you replies on your perl having
access to the Scalar::Util::weaken function. Although this is part of
the core perl distribution, some vendors do not compile support for it.
To find out if your perl has support for it, you can run this on the
command line:
perl -e 'use Scalar::Util qw(weaken)'
If you get an error message about weak references not being implemented,
Class::DBI will not maintain this lookup index, but give you a separate
instances for each retrieve.