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
t/cdbi-t/02-Film.t view on Meta::CPAN
eval { $film = Film->retrieve('Goodbye Norma Jean') };
ok !$film, "It destroys itself";
}
SKIP: {
skip "Scalar::Util::weaken not available", 3
if !$Class::DBI::Weaken_Is_Available;
# my bad taste is your bad taste
my $btaste = Film->retrieve('Bad Taste');
my $btaste2 = Film->retrieve('Bad Taste');
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.
view release on metacpan or search on metacpan
lib/Class/EHierarchy.pm view on Meta::CPAN
use strict;
use warnings;
use vars qw($VERSION @EXPORT @EXPORT_OK %EXPORT_TAGS);
use base qw(Exporter);
use Carp;
use Scalar::Util qw(weaken);
($VERSION) = ( q$Revision: 2.01 $ =~ /(\d+(?:\.(\d+))+)/sm );
# Ordinal indexes for the @objects element records
use constant CEH_OREF => 0;
lib/Class/EHierarchy.pm view on Meta::CPAN
$objects[$id] = [];
$objects[$id][CEH_CREF] = [];
$objects[$id][CEH_CLASSES] = [];
$objects[$id][CEH_OREF] = $obj;
$objects[$id][CEH_PKG] = ref $obj;
weaken( $objects[$$obj][CEH_OREF] );
$id = '0 but true' if $id == 0;
# Build object class list
{
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
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/Field.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 {
lib/Class/Field.pm view on Meta::CPAN
local *paired_arguments = sub { (qw(-package -init)) };
Class::Field->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 )
lib/Class/Field.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
lib/Class/InsideOut.pm view on Meta::CPAN
use Carp;
use Exporter;
use Class::ISA;
use Scalar::Util 1.09 qw( refaddr reftype blessed );
# Check for XS Scalar::Util with weaken() or warn and fallback
# syntax of error changed in Scalar::Util so we check both versions
BEGIN {
eval { Scalar::Util->import( "weaken" ) };
if ( $@ =~ /\AWeak references|weaken is only available/ ) {
warn "Scalar::Util::weaken unavailable: "
. "Class::InsideOut will not be thread-safe and will leak memory\n";
*weaken = sub { return @_ };
}
}
#--------------------------------------------------------------------------#
# Class data
lib/Class/InsideOut.pm view on Meta::CPAN
# register( REFERENCE/OBJECT, CLASSNAME )
$obj = shift;
bless $obj, shift; # ok to rebless
}
weaken( $OBJECT_REGISTRY{ refaddr $obj } = $obj );
return $obj;
}
#--------------------------------------------------------------------------#
# private functions for implementation
lib/Class/InsideOut.pm view on Meta::CPAN
$prop->{ $new_id } = $prop->{ $old_id };
delete $prop->{ $old_id };
}
# update the registry to the new, cloned object
weaken ( $OBJECT_REGISTRY{ $new_id } = $object );
_deregister( $old_id );
}
}
sub _check_options{
lib/Class/InsideOut.pm view on Meta::CPAN
encouraged to explore L<Object::InsideOut>. Other implementations are also
noted in L<Class::InsideOut::Manual::About>.
=head1 KNOWN LIMITATIONS
Requires weak reference support (Perl E<gt>= 5.6) and Scalar::Util::weaken() to
avoid memory leaks and to provide thread-safety.
=head1 ROADMAP
Features slated for after the 1.0 release include:
view release on metacpan or search on metacpan
IntrospectionMethods.pm view on Meta::CPAN
@EXPORT_OK = qw(make_methods set_obsolete_behavior set_parent_method_name);
# Utility -----------------------------
# Necessary for parent feature
use Scalar::Util qw(isweak weaken) ;
use Class::IntrospectionMethods::Catalog
qw/set_global_catalog set_method_info set_method_in_catalog/;
use Class::IntrospectionMethods::Parent
qw/set_parent_method_name graft_parent_method/ ;
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
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
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
lib/Class/Monadic.pm view on Meta::CPAN
methods => undef,
modifiers => undef,
fields => undef,
field_map => undef,
}, $metaclass;
Scalar::Util::weaken( $meta->{object} );
&Internals::SvREADONLY($meta, 1); # lock_keys(%{$meta})
my $sclass = $class . '::' . $meta->{id};
my $sclass_isa = do{ no strict 'refs'; \@{$sclass . '::ISA'} };
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/Observable.pm view on Meta::CPAN
my $invocant = delete $registry{ $oldaddr };
my $observers = delete $O{ $oldaddr };
if ( defined $invocant ) {
my $addr = refaddr $invocant;
$O{ $addr } = $observers;
Scalar::Util::weaken( $registry{ $addr } = $invocant );
} else {
$have_warned++ or warn
"*** Inconsistent state ***\n",
"Observed instances have gone away " .
"without invoking Class::Observable::DESTROY\n";
lib/Class/Observable.pm view on Meta::CPAN
}
sub add_observer {
my $invocant = shift;
my $addr = refaddr $invocant;
Scalar::Util::weaken( $registry{ $addr } = $invocant ) if NEEDS_REGISTRY and $addr;
push @{ $O{ $addr || "::$invocant" } }, @_;
}
sub delete_observer {
my $invocant = shift;
view release on metacpan or search on metacpan
lib/Class/Plain/Document/Cookbook.pm view on Meta::CPAN
=head1 Weakening Field
Weaken a field.
use Scalar::Util 'weaken';
use Class::Plain;
class Foo {
field x;
method weaken_x {
weaken $self->{x};
}
}
=head1 Class Variable
view release on metacpan or search on metacpan
lib/Class/Property/RO/Lazy.pm view on Meta::CPAN
my( $self ) = @_;
if( not defined $self->{'flag_ref'}->{$self->{'object'}} )
{
$self->{'flag_ref'}->{$self->{'object'}} = $self->{'object'};
Scalar::Util::weaken($self->{'flag_ref'}->{$self->{'object'}});
$self->{'object'}->{$self->{'field'}} = $self->{'init'}->($self->{'object'});
}
return $self->{'object'}->{$self->{'field'}};
}
view release on metacpan or search on metacpan
lib/Class/Publisher.pm view on Meta::CPAN
# $Id: Publisher.pm,v 1.3 2005/03/25 13:20:21 simonflack Exp $
package Class::Publisher;
use strict;
use Carp;
use Class::ISA;
use Scalar::Util qw/blessed reftype weaken/;
use vars '$VERSION';
$VERSION = '0.2';
my (%S, %P) = ();
lib/Class/Publisher.pm view on Meta::CPAN
$event = '*' unless defined $event && length $event;
croak "Invalid subscriber - $subscriber, expected a coderef, object or class name"
unless _valid_subscriber($subscriber);
my $subscriber_list = $S {$item} {$event} ||= {};
weaken($subscriber) if blessed($subscriber);
my $new_subscriber;
if ($use_method && (!ref $subscriber || blessed($subscriber))) {
$new_subscriber = [ $subscriber, $use_method ];
} else {
$new_subscriber = $subscriber;
view release on metacpan or search on metacpan
lib/Class/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 {
lib/Class/Spiffy.pm view on Meta::CPAN
local *paired_arguments = sub { (qw(-package -init)) };
Class::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 )
lib/Class/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
lib/Class/StateMachine/Declarative/Builder.pm view on Meta::CPAN
on => {},
ignore => [],
delay => [] };
bless $state, $class;
push @{$parent->{substates}}, $state if $parent;
Scalar::Util::weaken($state->{parent});
$state;
}
1;
view release on metacpan or search on metacpan
lib/Class/Std/Slots.pm view on Meta::CPAN
package Class::Std::Slots;
use warnings;
use strict;
use Carp;
use Scalar::Util qw(blessed refaddr weaken);
our $VERSION = '0.31';
my %signal_map = (); # maps id -> signame -> array of connected slots
my %signal_busy = (); # maps id -> signame -> busy flag
lib/Class/Std/Slots.pm view on Meta::CPAN
my $caller = ref( $src_obj );
_check_signals_exist( $caller, $sig_names )
unless $options->{undeclared};
my $weaken = !( $options->{strong} || ref( $dst_obj ) eq 'CODE' );
for my $sig_name ( @{$sig_names} ) {
# Stash the object and method so we can call it later.
my $dst_data = [ $dst_obj, $dst_method, $options ];
weaken( $dst_data->[0] ) if $weaken;
push @{ $signal_map{$src_id}->{$sig_name} }, $dst_data;
}
# Now badness: we replace the DESTROY that Class::Std dropped into
# the caller's namespace with our own. See the note under BUGS AND
lib/Class/Std/Slots.pm view on Meta::CPAN
Modify slot arg list to include a hash that describes the source of the signal.
=item strong
Normally the reference to the object containing the slot method is weakened (by
calling C<Scalar::Util::weaken> on it). Set this option to make the reference
strong - which means that once an object has been connected to no other
references to it need be kept.
Anonymous subroutine slots are always strongly referred to - so there is no
need to specify the C<strong> option for them.
view release on metacpan or search on metacpan
lib/Class/Usul/IPC/Cmd.pm view on Meta::CPAN
use IO::Handle;
use IO::Select;
use IPC::Open3;
use Module::Load::Conditional qw( can_load );
use POSIX qw( _exit setsid sysconf WIFEXITED WNOHANG );
use Scalar::Util qw( blessed openhandle weaken );
use Socket qw( AF_UNIX SOCK_STREAM PF_UNSPEC );
use Sub::Install qw( install_sub );
use Try::Tiny;
use Unexpected::Functions qw( TimeOut Unspecified );
lib/Class/Usul/IPC/Cmd.pm view on Meta::CPAN
my ($self, $cmd_ref, @cmd_args) = @_;
if ($self->async) {
is_coderef $cmd_ref->[ 0 ] and $cmd_ref = $cmd_ref->[ 0 ];
my $pidfile = $self->pidfile; weaken( $pidfile );
my $h = IPC::Run::harness( $cmd_ref, @cmd_args, init => sub {
IPC::Run::close_terminal(); $pidfile->println( $PID ) }, '&' );
$h->start; return ( 0, $h );
}
view release on metacpan or search on metacpan
lib/Class/Variable.pm view on Meta::CPAN
package Class::Variable;
use 5.008;
use strict; use warnings FATAL => 'all';
use Exporter 'import';
use Carp;
use Scalar::Util 'weaken';
our $VERSION = '1.002'; # <== update version in pod
our @EXPORT;
lib/Class/Variable.pm view on Meta::CPAN
)
{
$NS->{$self} = {
' self' => $self
};
weaken $NS->{$self}->{' self'};
}
$NS->{$self}->{$name};
};
}
lib/Class/Variable.pm view on Meta::CPAN
)
{
$NS->{$self} = {
' self' => $self
};
weaken $NS->{$self}->{' self'};
}
croak sprintf(
"Access violation: protected variable %s of %s available only to class or subclasses, but not %s."
, $name || 'undefined'
lib/Class/Variable.pm view on Meta::CPAN
)
{
$NS->{$self} = {
' self' => $self
};
weaken $NS->{$self}->{' self'};
}
croak sprintf(
"Access violation: private variable %s of %s available only to class itself, not %s."
, $name || 'undefined'
view release on metacpan or search on metacpan
lib/Class/WeakSingleton.pm view on Meta::CPAN
returns an undefined value then the constructer is deemed to have
failed.
=cut
use Scalar::Util 'weaken';
sub instance {
# instance()
lib/Class/WeakSingleton.pm view on Meta::CPAN
return $$instance if defined $$instance;
my $new_instance = $$instance = $class->_new_instance(@_);
weaken $$instance;
return $new_instance;
}
=item $singleton = YourClass->_new_instance(...)
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
t/06inherit-from.t
t/07coercion.t
t/08defaults.t
t/09initarg.t
t/10triggers.t
t/11weaken.t
Copyright: This software is copyright (c) 2025 by Toby Inkster.
License: GPL-1.0+ or Artistic-1.0
Files: t/01basic.t
t/02types.t