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
Algorithm/TrunkClassifier/ppport.h view on Meta::CPAN
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
examples/sudoku/SudokuFormat.pm view on Meta::CPAN
use strict;
use warnings;
use Carp qw(croak);
use List::Util qw(first);
use Scalar::Util qw(weaken);
sub new {
my ($class, $type_or_format, $input) = @_;
my $self = {};
examples/sudoku/SudokuFormat.pm view on Meta::CPAN
for (my $y = 0; $y < $type->n(); ++$y) {
$result .= $line;
}
my $self = { type => $type, template => $result, labels => choose_labels($result) };
weaken($self->{type});
return bless $self, $class;
}
sub oneline {
my ($class, $type) = @_;
my $result = '.' x $type->size() . "\n";
my $self = { type => $type, template => $result, labels => choose_labels($result) };
weaken($self->{type});
return bless $self, $class;
}
sub with_labels {
view release on metacpan or search on metacpan
lib/Alice/HTTP/WebSocket.pm view on Meta::CPAN
return $self->app->($env);
}
package Alice::HTTP::WebSocket::Impl;
use Plack::Util::Accessor qw(env error_code version);
use Scalar::Util qw(weaken);
use IO::Handle;
use Protocol::WebSocket::Handshake::Server;
sub new {
my ($class, $env) = @_;
my $self = bless { env => $env }, $class;
weaken $self->{env};
return $self;
}
sub handshake {
my $self = shift;
view release on metacpan or search on metacpan
t/lib/MyTest/System.pm view on Meta::CPAN
use strict;
use warnings;
use Exporter qw( import );
use Scalar::Util qw( refaddr );
use Text::ParseWords qw( shellwords );
use Scalar::Util qw( weaken );
use File::Which ();
our @EXPORT = qw( system_fake system_add );
sub system_fake
t/lib/MyTest/System.pm view on Meta::CPAN
sub new
{
my($class, %cmds) = @_;
my $self = bless { %cmds }, $class;
push @stack, $self;
weaken $stack[-1];
$self;
}
sub add
{
view release on metacpan or search on metacpan
src/tccgen.c view on Meta::CPAN
s = ss;
}
*ptop = b;
}
static void weaken_symbol(Sym *sym)
{
sym->type.t |= VT_WEAK;
if (sym->c > 0) {
int esym_type;
ElfW(Sym) *esym;
src/tccgen.c view on Meta::CPAN
vsetc(type, VT_CONST | VT_SYM, &cval);
vtop->sym = sym;
}
/* patch symbol weakness */
if (type->t & VT_WEAK)
weaken_symbol(sym);
#ifdef CONFIG_TCC_BCHECK
/* handles bounds now because the symbol must be defined
before for the relocation */
if (tcc_state->do_bounds_check) {
unsigned long *bounds_ptr;
src/tccgen.c view on Meta::CPAN
/* patch symbol size */
((ElfW(Sym) *)symtab_section->data)[sym->c].st_size =
ind - func_ind;
/* patch symbol weakness (this definition overrules any prototype) */
if (sym->type.t & VT_WEAK)
weaken_symbol(sym);
if (tcc_state->do_debug) {
put_stabn(N_FUN, 0, 0, ind - func_ind);
}
/* It's better to crash than to generate wrong code */
cur_text_section = NULL;
src/tccgen.c view on Meta::CPAN
arrays of null size are considered as
extern */
sym = external_sym(v, &type, r, asm_label);
if (type.t & VT_WEAK)
weaken_symbol(sym);
if (ad.alias_target) {
Section tsec;
Elf32_Sym *esym;
Sym *alias_target;
view release on metacpan or search on metacpan
src/tccgen.c view on Meta::CPAN
s = ss;
}
*ptop = b;
}
static void weaken_symbol(Sym *sym)
{
sym->type.t |= VT_WEAK;
if (sym->c > 0) {
int esym_type;
ElfW(Sym) *esym;
src/tccgen.c view on Meta::CPAN
tcc_error("incompatible types for redefinition of '%s'",
get_tok_str(v, NULL));
}
/* Merge some storage attributes. */
if (type->t & VT_WEAK)
weaken_symbol(s);
if (type->t & VT_VIS_MASK)
apply_visibility(s, type);
return s;
src/tccgen.c view on Meta::CPAN
sym = get_sym_ref(type, sec, addr, size);
vpushsym(type, sym);
}
/* patch symbol weakness */
if (type->t & VT_WEAK)
weaken_symbol(sym);
apply_visibility(sym, type);
#ifdef CONFIG_TCC_BCHECK
/* handles bounds now because the symbol must be defined
before for the relocation */
if (tcc_state->do_bounds_check) {
src/tccgen.c view on Meta::CPAN
/* patch symbol size */
((ElfW(Sym) *)symtab_section->data)[sym->c].st_size =
ind - func_ind;
/* patch symbol weakness (this definition overrules any prototype) */
if (sym->type.t & VT_WEAK)
weaken_symbol(sym);
apply_visibility(sym, &sym->type);
if (tcc_state->do_debug) {
put_stabn(N_FUN, 0, 0, ind - func_ind);
}
/* It's better to crash than to generate wrong code */
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
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
inc/Pegex/Parser.pm view on Meta::CPAN
receiver => $self->{receiver},
);
$optimizer->optimize_grammar($start_rule_ref);
# Add circular ref and weaken it.
$self->{receiver}{parser} = $self;
Scalar::Util::weaken($self->{receiver}{parser});
if ($self->{receiver}->can("initial")) {
$self->{rule} = $start_rule_ref;
$self->{parent} = {};
$self->{receiver}->initial();
view release on metacpan or search on metacpan
t/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);
B<NOTE>: using no_plan requires a Test::Harness upgrade else it will
think everything has failed. See L<CAVEATS and NOTES>).
view release on metacpan or search on metacpan
lib/Tickit/Widget.pm view on Meta::CPAN
use warnings;
our $VERSION = '0.53';
use Carp;
use Scalar::Util qw( weaken );
use List::Util 1.33 qw( all );
use Tickit::Pen;
use Tickit::Style;
use Tickit::Utils qw( textwidth );
lib/Tickit/Widget.pm view on Meta::CPAN
{
my $self = shift;
my $window = $self->window;
weaken $self;
my $event_ids = $self->{event_ids} //= {};
$event_ids->{geomchange} = $window->bind_event( geomchange => sub {
$self->reshape;
lib/Tickit/Widget.pm view on Meta::CPAN
my $self = shift;
my ( $parent ) = @_;
!$parent or $parent->isa( "Tickit::ContainerWidget" ) or croak "Parent must be a ContainerWidget";
weaken( $self->{parent} = $parent );
}
=head2 parent
$parent = $widget->parent
view release on metacpan or search on metacpan
lib/Alter/AlterXS_in_perl.pm view on Meta::CPAN
package Alter;
use strict; use warnings;
### basic functions corona(), alter() and ego()
use Scalar::Util qw( readonly reftype weaken);
no warnings 'redefine'; # in case we're called after the XS version was loaded
my %corona_tab;
my %ob_reg;
lib/Alter/AlterXS_in_perl.pm view on Meta::CPAN
ref $obj or croak "Alter: Can't use a non-reference";
reftype $obj eq 'SCALAR' and readonly( $$obj) and
croak "Alter: Can't modify a read-only value";
my $id = $obj + 0;
$corona_tab{ $id} ||= do {
weaken( $ob_reg{ $id} = $obj);
{};
};
}
sub alter ($$) {
lib/Alter/AlterXS_in_perl.pm view on Meta::CPAN
sub CLONE {
return unless shift eq __PACKAGE__;
for my $old_id ( keys %ob_reg ) {
my $new_obj = delete $ob_reg{ $old_id};
my $new_id = $new_obj + 0;
weaken( $ob_reg{ $new_id} = $new_obj);
$corona_tab{ $new_id} = delete $corona_tab{ $old_id};
}
}
1;
view release on metacpan or search on metacpan
lib/Alzabo/Runtime/Table.pm view on Meta::CPAN
# replace our copy of this column with a clone
$col = $col->alias_clone( table => $self );
my $index = $self->{columns}->Indices($name);
$self->{columns}->Replace( $index, $col, $name );
Scalar::Util::weaken( $col->{table} );
delete $self->{pk_array} if $col->is_primary_key;
}
return $col;
view release on metacpan or search on metacpan
lib/Amon2/DBI.pm view on Meta::CPAN
sub _txn_manager {
my $self = shift;
if (not defined $self->{private_txn_manager}) {
$self->{private_txn_manager} = DBIx::TransactionManager->new($self);
Scalar::Util::weaken($self->{private_txn_manager}->{dbh});
}
return $self->{private_txn_manager};
}
sub txn_scope { $_[0]->_txn_manager->txn_scope(caller => [caller(0)]) }
view release on metacpan or search on metacpan
lib/Driver/Compiler/Check.pm view on Meta::CPAN
confess "XXX No type in " . $self->dump unless $type;
return $self if $type->equals($newtype);
$self->debug_tc(DBG_TC_PROMOTE, "Promoting ([" . $type->dump . "] ".
$self->opcode . ") into " . $newtype->dump);
# Anything can become 'unknown' - this allows weakening
return $self if $type->compatible($newtype);
# This should really be done by 'compatible'?
return $self if $newtype->equals(T_BOOL);
view release on metacpan or search on metacpan
lib/Aniki/Schema/Relationship/Fetcher.pm view on Meta::CPAN
required => 1,
);
use List::MoreUtils qw/pairwise notall/;
use List::UtilsBy qw/partition_by/;
use Scalar::Util qw/weaken/;
use SQL::QueryMaker;
sub execute {
my ($self, $handler, $rows, $prefetch) = @_;
return unless @$rows;
lib/Aniki/Schema/Relationship/Fetcher.pm view on Meta::CPAN
my %dest_rows_map = partition_by { $dest_keygen->($_) } @$dest_rows;
for my $src_row (@$src_rows) {
next if notall { defined $src_row->get_column($_) } @src_columns;
my $dest_rows = $dest_rows_map{$src_keygen->($src_row)};
$src_row->relay_data->{$name} = $has_many ? $dest_rows : $dest_rows->[0];
weaken($src_row->relay_data->{$name});
}
}
}
__PACKAGE__->meta->make_immutable();
view release on metacpan or search on metacpan
lib/Ansible.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/Ansible.pm view on Meta::CPAN
my ($indent, $seq, $parent, $dcon) = @_;
my $config = bless { $bloc => 1 }, __PACKAGE__;
$config->{$debg} = "BLOCK:$dseq:$dcon" if $ddata;
$config->{$cntx} = $parent;
weaken $config->{$cntx};
$dseq ++;
my ($last, $prev, $ciscobug);
for ( ; $line; $prev = $line, $line = <$fh> ) {
$_ = $line;
lib/Ansible.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/Ansible.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
src/ppport.h view on Meta::CPAN
sv_release_COW|||
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
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/AnyEvent/BitTorrent.pm view on Meta::CPAN
if ($m eq 'r') {
AE::log trace => 'Opening %s to read', $s->files->[$i]->{path};
sysopen($s->files->[$i]->{fh}, $s->files->[$i]->{path}, O_RDONLY)
|| return;
flock($s->files->[$i]->{fh}, LOCK_SH) || return;
weaken $s unless isweak $s;
my $x = $i;
$s->files->[$x]->{timeout}
= AE::timer(500, 0, sub { $s // return; $s->_open($x, 'c') });
}
elsif ($m eq 'w') {
lib/AnyEvent/BitTorrent.pm view on Meta::CPAN
|| return;
flock $s->files->[$i]->{fh}, LOCK_EX;
truncate $s->files->[$i]->{fh}, $s->files->[$i]->{length}
if -s $s->files->[$i]->{fh}
!= $s->files->[$i]->{length}; # XXX - pre-allocate files
weaken $s unless isweak $s;
my $x = $i;
$s->files->[$x]->{timeout}
= AE::timer(60, 0, sub { $s // return; $s->_open($x, 'c') });
}
elsif ($m eq 'c') { $s->files->[$i]->{timeout} = () }
lib/AnyEvent/BitTorrent.pm view on Meta::CPAN
$data .= $_data if $_data;
AE::log
trace =>
'Read %d bytes of data from file (%d bytes collected so far)',
length $_data, length $data;
weaken $s unless isweak $s;
my $x = $file_index;
$s->files->[$x]->{timeout}
= AE::timer(500, 0, sub { $s // return; $s->_open($x, 'c') });
}
$file_index++;
lib/AnyEvent/BitTorrent.pm view on Meta::CPAN
my $w = syswrite $s->files->[$file_index]->{fh}, substr $data, 0,
$this_write, '';
AE::log
trace => 'Wrote %d bytes of data to file (%d bytes left)',
$w, length $data;
weaken $s unless isweak $s;
my $x = $file_index;
$s->files->[$x]->{timeout}
= AE::timer(120, 0, sub { $s // return; $s->_open($x, 'c') });
}
$file_index++;
lib/AnyEvent/BitTorrent.pm view on Meta::CPAN
}
sub _request_pieces {
my ($s, $p) = @_;
return if $s->state ne 'active';
weaken $p unless isweak $p;
$p // return;
$p->{handle} // return;
my @indexes;
if (scalar keys %{$s->working_pieces} < 10) { # XXX - Max working pieces
for my $findex (0 .. $#{$s->files}) {
lib/AnyEvent/BitTorrent.pm view on Meta::CPAN
#$s->_request_pieces( $p) # XXX - Ask a different peer
}
)
];
weaken($s->working_pieces->{$index}{$offset}[3])
unless isweak($s->working_pieces->{$index}{$offset}[3]);
push @{$p->{local_requests}}, [$index, $offset, $_block_size];
}
}
view release on metacpan or search on metacpan
lib/AnyEvent/Callback.pm view on Meta::CPAN
delete $self->{ecb};
}
package AnyEvent::Callback::Stack;
use Scalar::Util 'weaken';
use Carp;
sub new {
my ($class) = @_;
return bless { stack => [], done => 0 } => ref($class) || $class;
lib/AnyEvent/Callback.pm view on Meta::CPAN
$self->{done}++;
$self->_check_if_done;
}
;
push @{ $self->{stack} } => $cb;
weaken $self->{stack}[$idx];
return $self->{stack}[$idx];
}
sub _check_if_done {
view release on metacpan or search on metacpan
lib/AnyEvent/Connection.pm view on Meta::CPAN
use AnyEvent 5;
use AnyEvent::Socket;
use Carp;
use Scalar::Util qw(weaken);
use AnyEvent::Connection::Raw;
use AnyEvent::Connection::Util;
# @rewrite s/^# //; # Development hacks, see L<Devel::Rewrite>
# use Devel::Leak::Cb;
lib/AnyEvent/Connection.pm view on Meta::CPAN
sub connect {
my $self = shift;
$self->{connecting} and return;
$self->{connecting} = 1;
weaken $self;
croak "Only client can connect but have $self->{type}" if $self->{type} and $self->{type} ne 'client';
$self->{type} = 'client';
warn "Connecting to $self->{host}:$self->{port}..." if $self->{debug};
# @rewrite s/sub {/cb connect {/;
lib/AnyEvent/Connection.pm view on Meta::CPAN
croak "Not implemented yet";
}
sub _reconnect_after {
weaken( my $self = shift );
$self->{reconnect} or return $self->{connecting} = 0;
$self->{timers}{reconnect} = AnyEvent->timer(
after => $self->{reconnect},
cb => sub {
$self or return;
lib/AnyEvent/Connection.pm view on Meta::CPAN
);
}
sub periodic_stop;
sub periodic {
weaken( my $self = shift );
my $interval = shift;
my $cb = shift;
#warn "Create periodic $interval";
$self->{timers}{int $cb} = AnyEvent->timer(
after => $interval,
lib/AnyEvent/Connection.pm view on Meta::CPAN
});
return;
}
sub after {
weaken( my $self = shift );
my $interval = shift;
my $cb = shift;
#warn "Create after $interval";
$self->{timers}{int $cb} = AnyEvent->timer(
after => $interval,
view release on metacpan or search on metacpan
lib/AnyEvent/CouchDB/Stream.pm view on Meta::CPAN
}
my $self = bless {}, $class;
{
Scalar::Util::weaken( my $self = $self );
my $set_timeout = $timeout
? sub {
$self->{timeout}
= AE::timer( $timeout, 0, sub { $on_error->('timeout') } );
}
view release on metacpan or search on metacpan
lib/AnyEvent/DBD/Pg.pm view on Meta::CPAN
use 5.008008; # don't use old crap without utf8
use common::sense 3;m{
use strict;
use warnings;
}x;
use Scalar::Util 'weaken';
use Carp;
use DBI;
use DBD::Pg ':async';
use AE 5;
use Time::HiRes 'time';
lib/AnyEvent/DBD/Pg.pm view on Meta::CPAN
my $counter = ++$self->{querynum};
warn "prepare call <$query>( @_ ), async status = ".$self->{db}->{pg_async_status} if $self->{debug} > 2;
$self->{current} = [$query,@_];
$self->{current_start} = time();
weaken $self;
$self or return;
my ($st,$w,$t,$check);
my @watchers;
push @watchers, sub {
$self and $st or warn("no self"), @watchers = (), return 1;
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/AnyEvent/DBI/MySQL.pm view on Meta::CPAN
## no critic(ProhibitMultiplePackages Capitalization ProhibitNoWarnings)
use base qw( DBI );
use AnyEvent;
use Scalar::Util qw( weaken );
my @DATA;
my @NEXT_ID = ();
my $NEXT_ID = 0;
my $PRIVATE = 'private_' . __PACKAGE__;
lib/AnyEvent/DBI/MySQL.pm view on Meta::CPAN
$attr->{RootClass} = $class;
$attr->{$PRIVATE} = $id;
my $dbh = DBI->connect_cached($dsn, $user, $pass, $attr);
return if !$dbh;
# weaken cached $dbh to have DESTROY called when user stop using it
my $cache = $dbh->{Driver}{CachedKids};
for (grep {$cache->{$_} && $cache->{$_} == $dbh} keys %{$cache}) {
weaken($cache->{$_});
}
weaken(my $weakdbh = $dbh);
my $io_cb; $io_cb = sub {
local $SIG{__WARN__} = sub { (my $msg=shift)=~s/ at .*//ms; warn "$msg\n" };
my $data = $DATA[$id];
my $cb = delete $data->{cb};
my $h = delete $data->{h};
lib/AnyEvent/DBI/MySQL.pm view on Meta::CPAN
package AnyEvent::DBI::MySQL::db;
use base qw( DBI::db );
use Carp;
use Scalar::Util qw( weaken );
my $GLOBAL_DESTRUCT = 0;
END { $GLOBAL_DESTRUCT = 1; }
sub DESTROY {
lib/AnyEvent/DBI/MySQL.pm view on Meta::CPAN
push @NEXT_ID, $dbh->{$PRIVATE};
if (!$dbh->{Active}) {
$dbh->SUPER::DESTROY();
}
else {
# un-weaken cached $dbh to keep it for next connect_cached()
my $cache = $dbh->{Driver}{CachedKids};
for (grep {$cache->{$_} && $cache->{$_} == $dbh} keys %{$cache}) {
$cache->{$_} = $dbh;
}
}
lib/AnyEvent/DBI/MySQL.pm view on Meta::CPAN
if ($data->{cb}) {
croak q{can't make more than one asynchronous query simultaneously};
}
$data->{cb} = pop @args;
$data->{h} = $dbh;
weaken($data->{h});
$args[1] //= {};
$args[1]->{async} //= 1;
if (!$args[1]->{async}) {
my $cb = delete $data->{cb};
my $h = delete $data->{h};
lib/AnyEvent/DBI/MySQL.pm view on Meta::CPAN
my $cb = $args[-1];
# The select*() functions should be called twice:
# - first time they'll do only prepare() and execute()
# * we should return false from execute() to interrupt them
# after execute(), before they'll start fetching data
# * we shouldn't weaken {h} because their $sth will be
# destroyed when they will be interrupted
# - second time they'll do only data fetching:
# * they should get ready $sth instead of query param,
# so they'll skip prepare()
# * this $sth should be AnyEvent::DBI::MySQL::st::ready,
# so they'll skip execute()
$data->{call_again} = [@args[1 .. $#args-1]];
weaken($dbh);
$args[-1] = sub {
my (undef, $sth, $args) = @_;
return if !$dbh;
if ($dbh->err) {
$cb->();
lib/AnyEvent/DBI/MySQL.pm view on Meta::CPAN
package AnyEvent::DBI::MySQL::st;
use base qw( DBI::st );
use Carp;
use Scalar::Util qw( weaken );
sub execute {
my ($sth, @args) = @_;
local $SIG{__WARN__} = sub { (my $msg=shift)=~s/ at .*//ms; carp $msg };
my $data = $DATA[ $sth->{$PRIVATE} ];
view release on metacpan or search on metacpan
# we don't rely on the callback, because we use our own
# socketpair, for better or worse.
$fork->run ("AnyEvent::DBI::Slave::serve", sub { });
{
Convert::Scalar::weaken (my $self = $self);
my $cbor = new CBOR::XS;
$self->{rw} = AE::io $client, 0, sub {
my $len = Convert::Scalar::extend_read $client, $rbuf, 65536;
Executes the given SQL statement with placeholders replaced by
C<@args>. The statement will be prepared and cached on the server side, so
using placeholders is extremely important.
The callback will be called with a weakened AnyEvent::DBI object as the
first argument and the result of C<fetchall_arrayref> as (or C<undef>
if the statement wasn't a select statement) as the second argument.
Third argument is the return value from the C<< DBI->execute >> method
call.
view release on metacpan or search on metacpan
lib/AnyEvent/DNS.pm view on Meta::CPAN
# try to create an ipv4 and an ipv6 socket
# only fail when we cannot create either
my $got_socket;
Scalar::Util::weaken (my $wself = $self);
if (socket my $fh4, AF_INET , Socket::SOCK_DGRAM(), 0) {
++$got_socket;
AnyEvent::fh_unblock $fh4;