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/DBD/SQLite/VirtualTable.pm view on Meta::CPAN
#======================================================================
package DBD::SQLite::VirtualTable;
#======================================================================
use strict;
use warnings;
use Scalar::Util qw/weaken/;
our $VERSION = '1.78';
our @ISA;
lib/DBD/SQLite/VirtualTable.pm view on Meta::CPAN
db_name => $db_name,
vtab_name => $vtab_name,
columns => \@columns,
options => \%options,
};
weaken $self->{dbh_ref};
return $self;
}
sub NEW {
view release on metacpan or search on metacpan
lib/DBD/Sys.pm view on Meta::CPAN
use strict;
use warnings;
use vars qw(@ISA);
use Scalar::Util qw(weaken);
@ISA = qw(DBI::DBD::SqlEngine::Statement);
sub open_table($$$$$)
{
lib/DBD/Sys.pm view on Meta::CPAN
$meta->{$1} = $dbh->{$attr};
}
$attrs->{meta} = $meta;
$attrs->{database} = $dbh;
$attrs->{owner} = $self;
weaken( $attrs->{owner} );
weaken( $attrs->{database} );
my $tbl = $dbh->{sys_pluginmgr}->get_table( $table, $attrs );
return $tbl;
}
view release on metacpan or search on metacpan
lib/DBD/Teradata.pm view on Meta::CPAN
$debug = $ENV{TDAT_DBD_DEBUG} || 0;
$use_arm = ($Config{archname}=~/^arm-linux/i);
our $HAS_WEAKEN = eval {
require Scalar::Util;
Scalar::Util::weaken(my $test = \"foo");
1;
};
};
our %td_type_code2str = (
lib/DBD/Teradata.pm view on Meta::CPAN
$sth->STORE('NUM_OF_FIELDS', delete $args->{NUM_OF_FIELDS});
my ($key, $val);
$sth->{$key} = $val
while (($key, $val) = each %$args);
$dbh->{_stmts}{$sth->{CursorName}} = $sth;
Scalar::Util::weaken($dbh->{_stmts}{$sth->{CursorName}})
if $DBD::Teradata::HAS_WEAKEN;
$dbh->{_cursors}{$sth->{CursorName}} = $sth,
$sth->{tdat_keepresp} = 1,
$sthp[16] = 1
if ($#$stmtinfo == 1) &&
view release on metacpan or search on metacpan
SvROK_off|5.003007|5.003007|
SvROK_on|5.003007|5.003007|
SvRV|5.003007|5.003007|
SvRV_const|5.010001||Viu
SvRV_set|5.009003|5.003007|p
sv_rvunweaken|5.027004|5.027004|
sv_rvweaken|5.006000|5.006000|
SvRVx|5.003007||Viu
SvRX|5.009005|5.003007|p
SvRXOK|5.009005|5.003007|p
SV_SAVED_COPY|5.009005||Viu
SvSCREAM|5.003007||Viu
view release on metacpan or search on metacpan
lib/DBGp/Client/AnyEvent/Connection.pm view on Meta::CPAN
use strict;
use warnings;
use AnyEvent::Handle;
use DBGp::Client::AsyncConnection;
use Scalar::Util qw(weaken blessed);
sub new {
my ($class, %args) = @_;
my $self = bless {
handle => undef,
on_stream => undef,
on_notify => undef,
connection => DBGp::Client::AsyncConnection->new(socket => $args{socket}),
}, $class;
my $weak_self = $self;
weaken($weak_self);
my $handle = AnyEvent::Handle->new(
fh => $args{socket},
on_error => sub {
my ($handle, $fatal, $message) = @_;
view release on metacpan or search on metacpan
lib/DBGp/Client/AsyncConnection.pm view on Meta::CPAN
init => undef,
commands => {},
on_stream => undef,
on_notification => undef,
}, $class;
Scalar::Util::weaken($weak_self);
$stream->on_line(sub { $weak_self->_receive_line(@_) });
return $self;
}
view release on metacpan or search on metacpan
lib/DBI/Changes.pm view on Meta::CPAN
Fixed cases where ShowErrorStatement might show incorrect Statement RT#97434
Fixed DBD::Gofer for UTF-8-enabled STDIN/STDOUT
thanks to mauke PR#32
Fixed fetchall_arrayref({}) behavior with no columns
thanks to Dan McGee PR#31
Fixed tied CachedKids ref leak in attribute cache by weakening
thanks to Michael Conrad RT#113852
Fixed "panic: attempt to copy freed scalar" upon commit() or rollback()
thanks to fbriere for detailed bug report RT#102791
Ceased to ignore DESTROY of outer handle in DBI::PurePerl
Treat undef in DBI::Profile Path as string "undef"
lib/DBI/Changes.pm view on Meta::CPAN
=head2 Changes in DBI 1.59 (svn rev 9874) - 23 Aug 2007
Fixed DBI::ProfileData to unescape headers lines read from data file.
Fixed DBI::ProfileData to not clobber $_, thanks to Alexey Tourbin.
Fixed DBI::SQL::Nano to not clobber $_, thanks to Alexey Tourbin.
Fixed DBI::PurePerl to return undef for ChildHandles if weaken not available.
Fixed DBD::Proxy disconnect error thanks to Philip Dye.
Fixed DBD::Gofer::Transport::Base bug (typo) in timeout code.
Fixed DBD::Proxy rows method thanks to Philip Dye.
Fixed dbiprof compile errors, thanks to Alexey Tourbin.
Fixed t/03handle.t to skip some tests if ChildHandles not available.
lib/DBI/Changes.pm view on Meta::CPAN
Added SQL_BIGINT type code (resolved to the ODBC/JDBC value (-5))
Added $h->private_attribute_info method.
=head2 Changes in DBI 1.53 (svn rev 7995) - 31 Oct 2006
Fixed checks for weaken to work with early 5.8.x versions
Fixed DBD::Proxy handling of some methods, including commit and rollback.
Fixed t/40profile.t to be more insensitive to long double precision.
Fixed t/40profile.t to be insensitive to small negative shifts in time
thanks to Jamie McCarthy.
Fixed t/40profile.t to skip tests for perl < 5.8.0.
lib/DBI/Changes.pm view on Meta::CPAN
=head2 Changes in DBI 1.51 (svn rev 6475) - 06 Jun 2006
Fixed $dbh->clone method 'signature' thanks to Jeffrey Klein.
Fixed default ping() method to return false if !$dbh->{Active}.
Fixed t/40profile.t to be insensitive to long double precision.
Fixed for perl 5.8.0's more limited weaken() function.
Fixed DBD::Proxy to not alter $@ in disconnect or AUTOLOADd methods.
Fixed bind_columns() to use return set_err(...) instead of die()
to report incorrect number of parameters, thanks to Ben Thul.
Fixed bind_col() to ignore undef as bind location, thanks to David Wheeler.
Fixed for perl 5.9.x for non-threaded builds thanks to Nicholas Clark.
view release on metacpan or search on metacpan
lib/DBICx/Modeler.pm view on Meta::CPAN
use DBICx::Modeler::Carp;
use constant TRACE => DBICx::Modeler::Carp::TRACE;
use Class::Inspector();
use Scalar::Util qw/weaken/;
use DBICx::Modeler::Model::Source;
#########
# Class #
lib/DBICx/Modeler.pm view on Meta::CPAN
$self->_setup_schema_modeler_accessor unless $self->skip_schema_modeler_accessor;
$self->_setup_base_model_sources;
{
$self->schema->modeler( $self );
weaken $self->schema->{modeler};
}
return 1;
}
view release on metacpan or search on metacpan
lib/DBIx/Abstract.pm view on Meta::CPAN
# ABSTRACT: DBI SQL abstraction
package DBIx::Abstract;
$DBIx::Abstract::VERSION = '1.04';
use DBI;
use Scalar::Util 'weaken';
use Check::ISA qw( obj_does );
use strict;
use warnings;
our $AUTOLOAD;
lib/DBIx/Abstract.pm view on Meta::CPAN
$newself->{'ORIG'} = $self;
}
else {
$newself->{'ORIG'} = $self->{'ORIG'};
}
weaken( $newself->{'ORIG'} );
push( @{ $newself->{'ORIG'}->{'CLONES'} }, $newself );
weaken(
$newself->{'ORIG'}->{'CLONES'}[ $#{ $newself->{'ORIG'}->{'CLONES'} } ]
);
$self->__logwrite( 5, 'Cloned' );
return $newself;
view release on metacpan or search on metacpan
lib/DBIx/Async.pm view on Meta::CPAN
use DBIx::Async::Handle;
# temporary pending next release of curry
our $_curry_weak = sub {
my ($invocant, $code) = splice @_, 0, 2;
Scalar::Util::weaken($invocant) if Scalar::Util::blessed($invocant);
my @args = @_;
sub {
return unless $invocant;
$invocant->$code(@args => @_)
}
view release on metacpan or search on metacpan
lib/DBIx/BatchChunker.pm view on Meta::CPAN
use List::Util 1.33 (qw( min max sum any first )); # has any/all/etc.
use Math::BigInt upgrade => 'Math::BigFloat';
use Math::BigFloat;
use POSIX qw( ceil );
use Scalar::Util qw( blessed weaken );
use Term::ProgressBar 2.14; # with silent option
use Time::HiRes qw( time sleep );
use DBIx::BatchChunker::LoopState;
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
lib/DBIx/Class/Async/Storage.pm view on Meta::CPAN
$DBIx::Class::Async::Storage::VERSION = '0.65';
$DBIx::Class::Async::Storage::AUTHORITY = 'cpan:MANWAR';
use strict;
use warnings;
use Scalar::Util qw(weaken);
=head1 NAME
DBIx::Class::Async::Storage - Storage Layer for DBIx::Class::Async
lib/DBIx/Class/Async/Storage.pm view on Meta::CPAN
);
B<async_db> is the internal engine (the 'bridge') that handles
communication with the worker processes.
This constructor automatically weakens the reference to the parent L<schema>
to prevent circular reference leaks, ensuring that worker processes are
correctly reaped when the schema object goes out of scope.
=cut
lib/DBIx/Class/Async/Storage.pm view on Meta::CPAN
_async_db => $args{async_db}, # The worker pool engine
}, $class;
# WEAKEN the schema reference to prevent circular memory leaks
# that caused your "5 vs 2 processes" test failure.
weaken($self->{_schema}) if $self->{_schema};
return $self;
}
=head1 METHODS
lib/DBIx/Class/Async/Storage.pm view on Meta::CPAN
This provides a back-reference from the storage to its parent schema,
allowing storage components to access schema-level information and other
ResultSources when needed.
Note: The schema reference is weakened internally to prevent circular
reference memory leaks between the schema and storage objects.
my $storage = $schema->storage;
my $parent_schema = $storage->schema;
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
lib/DBIx/Class/Graph/Role/ResultSet.pm view on Meta::CPAN
use strict;
use warnings;
use Moose::Role;
use DBIx::Class::Graph::Wrapper;
use Scalar::Util qw(weaken);
has _graph => (
is => 'rw',
isa => 'DBIx::Class::Graph::Wrapper',
lazy_build => 1,
lib/DBIx/Class/Graph/Role/ResultSet.pm view on Meta::CPAN
my $g = DBIx::Class::Graph::Wrapper->new( refvertexed => 1 );
for (@obj) {
$g->add_vertex($_);
$_->_graph($g);
weaken( $_->{_graph} );
}
$g->[99] = 1;
foreach my $row (@obj) {
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
t_dbic/lib/DBICTest/Util.pm view on Meta::CPAN
use warnings;
use strict;
use Carp;
use Scalar::Util qw/isweak weaken blessed reftype refaddr/;
use Config;
use base 'Exporter';
our @EXPORT_OK = qw/local_umask stacktrace populate_weakregistry assert_empty_weakregistry/;
t_dbic/lib/DBICTest/Util.pm view on Meta::CPAN
exit 255;
}
}
else {
$refs_traced++;
weaken( $reg->{$slot}{weakref} = $target );
$reg->{$slot}{stacktrace} = stacktrace(1);
}
$target;
}
view release on metacpan or search on metacpan
t/lib/dbixcsl_test_dir.pm view on Meta::CPAN
use strict;
use warnings;
use File::Path 'rmtree';
use File::Temp 'tempdir';
use Scalar::Util 'weaken';
use namespace::clean;
use DBI ();
use base qw/Exporter/;
our @EXPORT_OK = '$tdir';
t/lib/dbixcsl_test_dir.pm view on Meta::CPAN
my @handles;
*DBI::connect = sub {
my $dbh = $connect->(@_);
push @handles, $dbh;
weaken $handles[-1];
return $dbh;
};
END {
if (not $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP}) {
view release on metacpan or search on metacpan
t/lib/dbixcsl_test_dir.pm view on Meta::CPAN
use strict;
use warnings;
use File::Path 'rmtree';
use File::Temp 'tempdir';
use Scalar::Util 'weaken';
use namespace::clean;
use DBI ();
use base qw/Exporter/;
our @EXPORT_OK = '$tdir';
t/lib/dbixcsl_test_dir.pm view on Meta::CPAN
my @handles;
*DBI::connect = sub {
my $dbh = $connect->(@_);
push @handles, $dbh;
weaken $handles[-1];
return $dbh;
};
END {
if (not $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP}) {
view release on metacpan or search on metacpan
lib/DBIx/Class/Schema/Loader.pm view on Meta::CPAN
use warnings;
use base qw/DBIx::Class::Schema Class::Accessor::Grouped/;
use MRO::Compat;
use mro 'c3';
use Carp::Clan qw/^DBIx::Class/;
use Scalar::Util 'weaken';
use Sub::Util 'set_subname';
use DBIx::Class::Schema::Loader::Utils qw/array_eq sigwarn_silencer/;
use Try::Tiny;
use curry;
use namespace::clean;
lib/DBIx/Class/Schema/Loader.pm view on Meta::CPAN
my $clone = $self->next::method(@_);
if($clone->_loader_args) {
$clone->_loader_args->{schema} = $clone;
weaken($clone->_loader_args->{schema});
}
$clone;
}
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
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
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
t/01-operations.t view on Meta::CPAN
use Test::More;
use Test::Exception;
use Test::Warn;
use Scalar::Util qw/weaken/;
use lib qw(t/lib);
use MyApp::Schema;
my ( $dsn, $user, $pass ) =
t/01-operations.t view on Meta::CPAN
);
my $schema_autorecon = MyApp::Schema->connect( $dsn, $user, $pass,
{ mariadb_auto_reconnect => 1 } );
my $orig_dbh = $schema_autorecon->storage->_get_dbh;
weaken $orig_dbh;
ok( $orig_dbh, 'Got weak $dbh ref' );
ok( $orig_dbh->{mariadb_auto_reconnect},
'mariadb_auto_reconnect is properly set if explicitly requested' );
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
lib/DBIx/Class/AccessorGroup.pm view on Meta::CPAN
use strict;
use warnings;
use base qw/Class::Accessor::Grouped/;
use Scalar::Util qw/weaken blessed/;
use namespace::clean;
my $successfully_loaded_components;
sub get_component_class {
lib/DBIx/Class/AccessorGroup.pm view on Meta::CPAN
no strict 'refs';
$successfully_loaded_components->{$class}
= ${"${class}::__LOADED__BY__DBIC__CAG__COMPONENT_CLASS__"}
= do { \(my $anon = 'loaded') };
weaken($successfully_loaded_components->{$class});
}
$class;
};
view release on metacpan or search on metacpan
lib/DBIx/Connector/Retry/MySQL.pm view on Meta::CPAN
use Moo;
extends 'DBIx::Connector::Retry';
use Scalar::Util qw( weaken );
use Storable qw( dclone );
use Types::Standard qw( Bool HashRef InstanceOf ClassName );
use Types::Common::Numeric qw( PositiveOrZeroNum PositiveOrZeroInt );
use Time::HiRes qw( sleep );
view release on metacpan or search on metacpan
lib/DBIx/Connector/Retry.pm view on Meta::CPAN
use Moo;
extends 'DBIx::Connector', 'Moo::Object';
use Scalar::Util qw( weaken );
use Types::Standard qw( Str Bool HashRef CodeRef Dict Tuple Optional Maybe );
use Types::Common::Numeric qw( PositiveInt );
use namespace::clean; # don't export the above
lib/DBIx/Connector/Retry.pm view on Meta::CPAN
# DBIx::Connector stores connection details in a coderef (for some reason). Instead
# of just dumping the same arguments as another copy, we'll tie it directly to the
# attr. If connect_info ever changes, it will grab the latest version.
$self->{_args} = sub { @{ $self->connect_info } };
weaken $self; # circular closure ref
}
#pod =head1 MODIFIED METHODS
#pod
#pod =head2 run / txn
view release on metacpan or search on metacpan
lib/DBIx/Custom.pm view on Meta::CPAN
use DBIx::Custom::NotExists;
use DBIx::Custom::Query;
use DBIx::Connector;
use Encode qw/encode encode_utf8 decode_utf8/;
use Scalar::Util qw/weaken/;
has [qw/dsn password quote user exclude_table user_table_info
user_column_info safety_character/];
has connector => 1;
has option => sub { {} };
lib/DBIx/Custom.pm view on Meta::CPAN
$model_name ||= $model_table;
my $column_name_lc = delete $opt->{column_name_lc};
# Create model
my $model = $model_class->new($opt);
weaken $model->{dbi};
$model->table($model_table) unless $model->table;
$model->name($model_name);
if (!$model->columns || !@{$model->columns}) {
$model->columns($self->get_columns_from_db($model->table, {column_name_lc => $column_name_lc}));