view release on metacpan or  search on metacpan

ZabbixSender.pm  view on Meta::CPAN

193
194
195
196
197
198
199
200
201
202
203
# start sending
sub _send {
   my ($self) = @_;
 
   if ($self->{delay}) {
      Scalar::Util::weaken $self;
      $self->{delay_w} ||= AE::timer $self->{delay}, 0, sub {
         delete $self->{delay_w};
         $self->{send_immediate} = 1;
         $self->_send2 unless $self->{sending}++;
      };

ZabbixSender.pm  view on Meta::CPAN

209
210
211
212
213
214
215
216
217
218
219
 
# actually do send
sub _send2 {
   my ($self) = @_;
 
   Scalar::Util::weaken $self;
   $self->{connect_w} = AnyEvent::Socket::tcp_connect $self->{zhost}, $self->{zport}, sub {
      my ($fh) = @_;
 
      $fh
         or return $self->_retry;

ZabbixSender.pm  view on Meta::CPAN

283
284
285
286
287
288
289
290
291
292
293
}
 
sub _retry {
   my ($self) = @_;
 
   Scalar::Util::weaken $self;
 
   delete $self->{hdl};
 
   my $expire = AE::now - $self->{queue_time};
   while (@{ $self->{queue} } && $self->{queue}[0][0] < $expire) {

 view release on metacpan or  search on metacpan

lib/AnyEvent/ZeroMQ/Handle.pm  view on Meta::CPAN

8
9
10
11
12
13
14
15
16
17
18
use AnyEvent::ZeroMQ;
use AnyEvent::ZeroMQ::Types qw(IdentityStr);
use ZeroMQ::Raw::Constants qw(ZMQ_NOBLOCK ZMQ_IDENTITY);
 
use Params::Util qw(_CODELIKE);
use Scalar::Util qw(weaken);
use Try::Tiny;
use POSIX qw(EAGAIN EWOULDBLOCK);
 
use true;
use namespace::autoclean;

lib/AnyEvent/ZeroMQ/Handle.pm  view on Meta::CPAN

88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
    default  => sub { [] },
);
 
sub _build_read_watcher {
    my $self = shift;
    weaken $self;
    return AnyEvent::ZeroMQ->io(
        poll   => 'r',
        socket => $self->socket,
        cb     => sub { $self->read },
    );
}
 
sub _build_write_watcher {
    my $self = shift;
    weaken $self;
    return AnyEvent::ZeroMQ->io(
        poll   => 'w',
        socket => $self->socket,
        cb     => sub { $self->write },
    );

 view release on metacpan or  search on metacpan

lib/AnyMQ/Queue.pm  view on Meta::CPAN

1
2
3
4
5
6
7
8
9
10
11
package AnyMQ::Queue;
use strict;
use Any::Moose;
use AnyEvent;
use Try::Tiny;
use Scalar::Util qw(weaken refaddr);
use Time::HiRes;
use constant DEBUG => 0;
 
has id => (is => 'rw', isa => 'Str');
has persistent => (is => "rw", isa => "Bool", default => sub { 0 });

lib/AnyMQ/Queue.pm  view on Meta::CPAN

74
75
76
77
78
79
80
81
82
83
84
my ($self, $timeout) = @_;
 
AnyEvent->timer(
    after => $timeout || $self->timeout,
    cb => sub {
        weaken $self;
        warn "Timing out $self long-poll" if DEBUG;
        if ($self->on_timeout) {
            $self->on_timeout->($self, "timeout")
        }
        else {

lib/AnyMQ/Queue.pm  view on Meta::CPAN

96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
 
    # reset garbage collection timeout with the long-poll timeout
    # $timeout = 0 is a valid timeout for interval-polling
    $timeout = 55 unless defined $timeout;
    $self->{timer} = AE::timer $timeout || 55, 0, sub {
        weaken $self;
        warn "long-poll timeout, flush and wait for client reconnect" if DEBUG;
        $self->_flush;
    };
    weaken $self->{timer};
 
    # flush buffer for a long-poll client
    $self->_flush( @{ $self->{buffer} })
        if @{ $self->{buffer} };
}

 view release on metacpan or  search on metacpan

ppport.h  view on Meta::CPAN

1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
sv_release_COW|||
sv_release_IVX|||
sv_replace|||
sv_report_used|||
sv_reset|||
sv_rvweaken||5.006000|
sv_setiv_mg|5.006000||p
sv_setiv|||
sv_setnv_mg|5.006000||p
sv_setnv|||
sv_setpv_mg|5.006000||p

 view release on metacpan or  search on metacpan

lib/Apache/Solr.pm  view on Meta::CPAN

17
18
19
20
21
22
23
24
25
26
use Apache::Solr::Tables;
use Log::Report    qw(solr);
 
use Scalar::Util   qw/blessed/;
use Encode         qw/encode/;
use Scalar::Util   qw/weaken/;
 
use URI            ();
use LWP::UserAgent ();
use MIME::Types    ();

lib/Apache/Solr.pm  view on Meta::CPAN

66
67
68
69
70
71
72
73
74
75
        $self->{AS_retry_max}  = $args->{retry_max}  // 60;
 
        $http_agent = $self->{AS_agent} =
                $args->{agent} || $http_agent || LWP::UserAgent->new(keep_alive=>1);
 
        weaken $http_agent;
        $self;
}
 
#---------------

 view release on metacpan or  search on metacpan

lib/Apache2/ASP/ASPDOM/Node.pm  view on Meta::CPAN

2
3
4
5
6
7
8
9
10
11
12
package Apache2::ASP::ASPDOM::Node;
 
use strict;
use warnings 'all';
use Carp 'confess';
use Scalar::Util 'weaken';
 
 
#==============================================================================
sub new
{

lib/Apache2/ASP/ASPDOM/Node.pm  view on Meta::CPAN

18
19
20
21
22
23
24
25
26
27
28
    events => {
      before_appendChild  => [ ],
      after_appendChild   => [ ],
    },
  }, $class;
  weaken($s->{parentNode}) if $s->{parentNode};
  return $s;
}# end new()
 
 
#==============================================================================

lib/Apache2/ASP/ASPDOM/Node.pm  view on Meta::CPAN

68
69
70
71
72
73
74
75
76
77
78
#==============================================================================
sub parentNode
{
  my $s = shift;
   
  @_ ? weaken($s->{parentNode} = shift) : $s->{parentNode};
}# end parentNode()
 
 
#==============================================================================
sub appendChild

 view release on metacpan or  search on metacpan

ppport.h  view on Meta::CPAN

2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
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

ppport.h  view on Meta::CPAN

2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
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

ppport.h  view on Meta::CPAN

2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
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/Apache2/SSI/URI.pm  view on Meta::CPAN

809
810
811
812
813
814
815
816
817
818
819
    _path_info_processed => 1,
    };
    $hash->{document_path} = $hash->{document_uri};
    $hash->{apache_request} = $self->apache_request if( $self->apache_request );
    my $root = bless( $hash => ref( $self ) );
    # Scalar::Util::weaken( $copy );
    $root->{base_dir} = $root;
    $root->{base_uri} = $root;
    $self->{root} = $root;
    return( $root );
}

 view release on metacpan or  search on metacpan

ppport.h  view on Meta::CPAN

2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
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

inc/Spiffy.pm  view on Meta::CPAN

184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
      "  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

207
208
209
210
211
212
213
214
215
216
217
    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

227
228
229
230
231
232
233
234
235
236
237
}
$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

184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
      "  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

207
208
209
210
211
212
213
214
215
216
217
    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

227
228
229
230
231
232
233
234
235
236
237
}
$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

184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
      "  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

207
208
209
210
211
212
213
214
215
216
217
    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

227
228
229
230
231
232
233
234
235
236
237
}
$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

184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
      "  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

207
208
209
210
211
212
213
214
215
216
217
    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

227
228
229
230
231
232
233
234
235
236
237
}
$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

184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
      "  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

207
208
209
210
211
212
213
214
215
216
217
    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

227
228
229
230
231
232
233
234
235
236
237
}
$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

184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
      "  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

207
208
209
210
211
212
213
214
215
216
217
    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

227
228
229
230
231
232
233
234
235
236
237
}
$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

devel/run-download-dialog.pl  view on Meta::CPAN

35
36
37
38
39
40
41
42
43
 
{
  my $dialog = App::Chart::Gtk2::DownloadDialog->new;
  $dialog->destroy;
  print Devel::FindRef::track ($dialog);
  Scalar::Util::weaken ($dialog);
  print defined $dialog ? "defined\n" : "not defined\n";
  exit 0;
}

 view release on metacpan or  search on metacpan

scripts/dex  view on Meta::CPAN

11041
11042
11043
11044
11045
11046
11047
11048
11049
11050
11051
package YAML::PP::Schema::Include;
 
our $VERSION = '0.027'; # VERSION
 
use Carp qw/ croak /;
use Scalar::Util qw/ weaken /;
use File::Basename qw/ dirname /;
 
sub new {
    my ($class, %args) = @_;

scripts/dex  view on Meta::CPAN

11081
11082
11083
11084
11085
11086
11087
11088
11089
11090
11091
sub allow_absolute { $_[0]->{allow_absolute} }
sub yp {
    my ($self, $yp) = @_;
    if (@_ == 2) {
        $self->{yp} = $yp;
        weaken $self->{yp};
        return $yp;
    }
    return $self->{yp};
}

scripts/dex  view on Meta::CPAN

14192
14193
14194
14195
14196
14197
14198
14199
14200
14201
14202
use warnings;
require Exporter;
 
our @ISA       = qw(Exporter);
our @EXPORT_OK = qw(
  blessed refaddr reftype weaken unweaken isweak
 
  dualvar isdual isvstring looks_like_number openhandle readonly set_prototype
  tainted
);
our $VERSION    = "1.59";

scripts/dex  view on Meta::CPAN

14231
14232
14233
14234
14235
14236
14237
14238
14239
14240
14241
Scalar::Util - A selection of general-utility scalar subroutines
 
=head1 SYNOPSIS
 
    use Scalar::Util qw(blessed dualvar isdual readonly refaddr reftype
                        tainted weaken isweak isvstring looks_like_number
                        set_prototype);
                        # and other useful utils appearing below
 
=head1 DESCRIPTION

scripts/dex  view on Meta::CPAN

14303
14304
14305
14306
14307
14308
14309
14310
14311
14312
14313
14314
14315
Note that for internal reasons, all precompiled regexps (C<qr/.../>) are
blessed references; thus C<ref()> returns the package name string C<"Regexp">
on these but C<reftype()> will return the underlying C structure type of
C<"REGEXP"> in all capitals.
 
=head2 weaken
 
    weaken( $ref );
 
The lvalue C<$ref> will be turned into a weak reference. This means that it
will not hold a reference count on the object it references. Also, when the
reference count on that object reaches zero, the reference will be set to
undef. This function mutates the lvalue passed as its argument and returns no

scripts/dex  view on Meta::CPAN

14319
14320
14321
14322
14323
14324
14325
14326
14327
14328
14329
14330
14331
14332
14333
14334
14335
14336
14337
14338
14339
14340
14341
14342
14343
14344
14345
14346
14347
14348
14349
14350
14351
14352
14353
14354
14355
14356
14357
14358
14359
14360
14361
14362
14363
14364
14365
14366
14367
14368
14369
14370
14371
14372
14373
14374
14375
14376
14377
14378
14379
14380
14381
the object being DESTROY-ed at its usual time.
 
    {
      my $var;
      $ref = \$var;
      weaken($ref);                     # Make $ref a weak reference
    }
    # $ref is now undef
 
Note that if you take a copy of a scalar with a weakened reference, the copy
will be a strong reference.
 
    my $var;
    my $foo = \$var;
    weaken($foo);                       # Make $foo a weak reference
    my $bar = $foo;                     # $bar is now a strong reference
 
This may be less obvious in other situations, such as C<grep()>, for instance
when grepping through a list of weakened references to objects that may have
been destroyed already:
 
    @object = grep { defined } @object;
 
This will indeed remove all references to destroyed objects, but the remaining
references to objects will be strong, causing the remaining objects to never be
destroyed because there is now always a strong reference to them in the @object
array.
 
=head2 unweaken
 
    unweaken( $ref );
 
I<Since version 1.36.>
 
The lvalue C<REF> will be turned from a weak reference back into a normal
(strong) reference again. This function mutates the lvalue passed as its
argument and returns no value. This undoes the action performed by
L</weaken>.
 
This function is slightly neater and more convenient than the
otherwise-equivalent code
 
    my $tmp = $REF;
    undef $REF;
    $REF = $tmp;
 
(because in particular, simply assigning a weak reference back to itself does
not work to unweaken it; C<$REF = $REF> does not work).
 
=head2 isweak
 
    my $weak = isweak( $ref );
 
Returns true if C<$ref> is a weak reference.
 
    $ref  = \$foo;
    $weak = isweak($ref);               # false
    weaken($ref);
    $weak = isweak($ref);               # true
 
B<NOTE>: Copying a weak reference creates a normal, strong, reference.
 
    $copy = $ref;

scripts/dex  view on Meta::CPAN

14510
14511
14512
14513
14514
14515
14516
14517
14518
14519
14520
 
Copyright (c) 1997-2007 Graham Barr <gbarr@pobox.com>. All rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
 
Additionally L</weaken> and L</isweak> which are
 
Copyright (c) 1999 Tuomas J. Lukka <lukka@iki.fi>. All rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as perl itself.

 view release on metacpan or  search on metacpan

lib/App/DubiousHTTP/TestServer.pm  view on Meta::CPAN

1
2
3
4
5
6
7
8
9
use strict;
use warnings;
package App::DubiousHTTP::TestServer;
use Scalar::Util 'weaken';
use Digest::MD5 'md5_base64';
use MIME::Base64 'decode_base64';
use App::DubiousHTTP::Tests::Common qw($TRACKHDR $CLIENTIP ungarble_url);
 
use IO::Socket::INET;

lib/App/DubiousHTTP/TestServer.pm  view on Meta::CPAN

69
70
71
72
73
74
75
76
77
78
79
my ($cl,$response,$sslctx) = @_;
my $addr = $cl->sockhost.':'.$cl->sockport;
$DEBUG && _debug("new client from $addr");
 
$clients{fileno($cl)}{time} = time();
weaken( my $wcl = $cl );
$clients{fileno($cl)}{fd} = $wcl;
$SELECT->timeout($cl,5,sub { delete_client($wcl) if $wcl });
 
return _install_check_https($cl,$response,$sslctx) if $sslctx;
return _install_http($cl,$response);

lib/App/DubiousHTTP/TestServer.pm  view on Meta::CPAN

367
368
369
370
371
372
373
374
375
376
377
    }
    return $close;
}
 
package App::DubiousHTTP::TestServer::Select;
use Scalar::Util 'weaken';
use Time::HiRes 'gettimeofday';
 
my $maxfn = 0;
my @handler;
my @didit;

lib/App/DubiousHTTP/TestServer.pm  view on Meta::CPAN

397
398
399
400
401
402
403
404
405
406
407
 
sub handler {
    my ($self,$cl,%sub) = @_;
    defined( my $fn = fileno($cl) ) or die "invalid fd";
    $maxfn = $fn if $fn>$maxfn;
    weaken(my $wcl = $cl);
    while (my ($rw,$sub) = each %sub) {
        $sub = [ $sub ] if ref($sub) eq 'CODE';
        splice(@$sub,1,0,$wcl);
        $handler[$fn][$rw] = $sub;
        $DEBUG && _debug("add handler($fn,$rw)");

 view release on metacpan or  search on metacpan

lib/App/Easer/V2.pm  view on Meta::CPAN

78
79
80
81
82
83
84
85
86
87
88
 
package App::Easer::V2::Command;
use Scalar::Util 'blessed';
use List::Util 'any';
use English '-no_match_vars';
use Scalar::Util qw< weaken >;
 
# some stuff can be managed via a hash reference kept in a "slot",
# allowing for overriding should be easy either with re-defining the
# "slot" method, or overriding the sub-method relying on it. The name of
# the slot is the same as the name of the actual package that $self is

lib/App/Easer/V2.pm  view on Meta::CPAN

174
175
176
177
178
179
180
181
182
183
184
 
sub child ($self, @newval) {
   my $slot = $self->slot;
   if (@newval) {
      $slot->{child} = $newval[0];
      weaken($slot->{child});
   }
   return $slot->{child};
}
sub is_leaf ($self) { ! defined($self->child) }
sub leaf ($self) {

lib/App/Easer/V2.pm  view on Meta::CPAN

187
188
189
190
191
192
193
194
195
      my $retval = $self;
      while (defined(my $parent = $retval->child)) {
         $retval = $parent;
      }
      $slot->{leaf} = $retval;
      weaken($slot->{leaf});
   }
   return $slot->{leaf};
}

 view release on metacpan or  search on metacpan

lib/App/Glacier/Command/Get.pm  view on Meta::CPAN

276
277
278
279
280
281
282
283
284
285
286
my $part_idx = $job_idx * $job_parts;
# Offset in file
my $off = $part_idx * $part_size;
# Number of retries in case of failure
my $retries = $self->cf_transfer_param(qw(download retries));
Scalar::Util::weaken($p);
for (my $j = 0; $j < $job_parts;
     $j++, $part_idx++, $off += $part_size) {
    last if $off >= $archive_size;
    if ($part_size > $archive_size - $off) {
        $part_size = $archive_size - $off;

 view release on metacpan or  search on metacpan

examples/DelayRequest.pm  view on Meta::CPAN

6
7
8
9
10
11
12
13
14
15
16
use fields qw(delayed);
 
use Net::IMP;
use Net::IMP::HTTP;
use Net::IMP::Debug;
use Scalar::Util 'weaken';
 
sub RTYPES { ( IMP_PASS ) }
 
sub new_analyzer {
    my ($class,%args) = @_;

examples/DelayRequest.pm  view on Meta::CPAN

44
45
46
47
48
49
50
51
52
53
54
        $self->run_callback([ IMP_PASS,0,IMP_MAXOFFSET ]);
        return;
    }
}
 
weaken(my $wself = $self);
$self->{delayed} = $self->{factory_args}{eventlib}->timer(
    $self->{factory_args}{delay} || 0.5,
    sub {
        # pass thru everything 
        $wself or return;

 view release on metacpan or  search on metacpan

inc/Spiffy.pm  view on Meta::CPAN

184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
      "  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

207
208
209
210
211
212
213
214
215
216
217
    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

227
228
229
230
231
232
233
234
235
236
237
}
$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

kritika.fatpack  view on Meta::CPAN

1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
$fatpacked{"Test/Deep/Cache.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TEST_DEEP_CACHE';
  use strict;use warnings;package Test::Deep::Cache;use Test::Deep::Cache::Simple;sub new {my$pkg=shift;my$self=bless {},$pkg;$self->{expects}=[Test::Deep::Cache::Simple->new];$self->{normal}=[Test::Deep::Cache::Simple->new];$self->local;return$self}...
TEST_DEEP_CACHE
 
$fatpacked{"Test/Deep/Cache/Simple.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TEST_DEEP_CACHE_SIMPLE';
  use strict;use warnings;package Test::Deep::Cache::Simple;use Carp qw(confess);use Scalar::Util qw(refaddr);BEGIN {if (grep /^weaken$/,@Scalar::Util::EXPORT_FAIL){*weaken=sub {}}else {Scalar::Util->import('weaken')}}sub new {my$pkg=shift;my$self=bl...
TEST_DEEP_CACHE_SIMPLE
 
$fatpacked{"Test/Deep/Class.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TEST_DEEP_CLASS';
  use strict;use warnings;package Test::Deep::Class;use Test::Deep::Cmp;sub init {my$self=shift;my$snobby=shift;my$val=shift;$self->{snobby}=$snobby;$self->{val}=$val}sub descend {my$self=shift;my$got=shift;local$Test::Deep::Snobby=$self->{snobby};Te...
TEST_DEEP_CLASS

 view release on metacpan or  search on metacpan

lib/App/MHFS.pm  view on Meta::CPAN

381
382
383
384
385
386
387
388
389
390
391
use strict; use warnings;
use feature 'say';
use IO::Socket::INET;
use Socket qw(IPPROTO_TCP TCP_KEEPALIVE TCP_NODELAY);
use IO::Poll qw(POLLIN POLLOUT POLLHUP);
use Scalar::Util qw(weaken);
use File::Path qw(make_path);
use Data::Dumper;
use Config;
 
MHFS::Util->import();

lib/App/MHFS.pm  view on Meta::CPAN

1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
use Cwd qw(abs_path getcwd);
use File::Basename;
use File::stat;
use IO::Poll qw(POLLIN POLLOUT POLLHUP);
use Data::Dumper;
use Scalar::Util qw(weaken);
use List::Util qw[min max];
use Symbol 'gensym';
use Devel::Peek;
use Encode qw(decode encode);
use constant {

lib/App/MHFS.pm  view on Meta::CPAN

1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
sub new {
    my ($class, $client) = @_;
    my %self = ( 'client' => $client);
    bless \%self, $class;
    weaken($self{'client'}); #don't allow Request to keep client alive
    $self{'on_read_ready'} = \&want_request_line;
    $self{'outheaders'}{'X-MHFS-CONN-ID'} = $client->{'outheaders'}{'X-MHFS-CONN-ID'};
    $self{'rl'} = 0;
    # we want the request
    $client->SetEvents(POLLIN | MHFS::EventLoop::Poll->ALWAYSMASK );

lib/App/MHFS.pm  view on Meta::CPAN

2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
use IO::Socket::INET;
use Errno qw(EINTR EIO :POSIX);
use Fcntl qw(:seek :mode);
use File::stat;
use IO::Poll qw(POLLIN POLLOUT POLLHUP);
use Scalar::Util qw(looks_like_number weaken);
use Data::Dumper;
use Carp;
$SIG{ __DIE__ } = sub { Carp::confess( @_ ) };
 
sub new {

lib/App/MHFS.pm  view on Meta::CPAN

2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
}
 
# add a connection timeout timer
sub AddClientCloseTimer {
    my ($self, $timelength, $id, $is_requesttimeout) = @_;
    weaken($self); #don't allow this timer to keep the client object alive
    my $server = $self->{'server'};
    say "CCT | add timer: $id";
    $server->{'evp'}->add_timer($timelength, 0, sub {
        if(! defined $self) {
            say "CCT | $id self undef";

lib/App/MHFS.pm  view on Meta::CPAN

2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
package MHFS::FD::Reader {
    use strict; use warnings;
    use feature 'say';
    use Time::HiRes qw( usleep clock_gettime CLOCK_MONOTONIC);
    use IO::Poll qw(POLLIN POLLOUT POLLHUP);
    use Scalar::Util qw(looks_like_number weaken);
    sub new {
        my ($class, $process, $fd, $func) = @_;
        my %self = ('time' => clock_gettime(CLOCK_MONOTONIC), 'process' => $process, 'fd' => $fd, 'onReadReady' => $func);
        say "PID " . $self{'process'}{'pid'} . 'FD ' . $self{'fd'};
        weaken($self{'process'});
        return bless \%self, $class;
    }
 
    sub onReadReady {
        my ($self) = @_;

lib/App/MHFS.pm  view on Meta::CPAN

2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
package MHFS::FD::Writer {
   use strict; use warnings;
   use feature 'say';
   use Time::HiRes qw( usleep clock_gettime CLOCK_MONOTONIC);
   use IO::Poll qw(POLLIN POLLOUT POLLHUP);
   use Scalar::Util qw(looks_like_number weaken);
   sub new {
       my ($class, $process, $fd, $func) = @_;
       my %self = ('time' => clock_gettime(CLOCK_MONOTONIC), 'process' => $process, 'fd' => $fd, 'onWriteReady' => $func);
       say "PID " . $self{'process'}{'pid'} . 'FD ' . $self{'fd'};
       weaken($self{'process'});
       return bless \%self, $class;
   }
 
   sub onWriteReady {
       my ($self) = @_;

lib/App/MHFS.pm  view on Meta::CPAN

2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
use IO::Poll qw(POLLIN POLLOUT POLLHUP);
use Errno qw(EINTR EIO :POSIX);
use Fcntl qw(:seek :mode);
use File::stat;
use IPC::Open3;
use Scalar::Util qw(looks_like_number weaken);
use Data::Dumper;
use Devel::Peek;
 
use Carp;
$SIG{ __DIE__ } = sub { Carp::confess( @_ ) };

lib/App/MHFS.pm  view on Meta::CPAN

3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
3735
use Encode qw(decode encode);
use URI::Escape;
use Storable qw(dclone);
use Fcntl ':mode';
use Time::HiRes qw( usleep clock_gettime CLOCK_REALTIME CLOCK_MONOTONIC);
use Scalar::Util qw(looks_like_number weaken);
use POSIX qw/ceil/;
use Storable qw( freeze thaw);
#use ExtUtils::testlib;
use FindBin;
use File::Spec;

lib/App/MHFS.pm  view on Meta::CPAN

4496
4497
4498
4499
4500
4501
4502
4503
4504
4505
4506
use feature 'say';
use Data::Dumper;
use feature 'state';
use Encode;
use URI::Escape;
use Scalar::Util qw(looks_like_number weaken);
use File::stat;
MHFS::Util->import();
BEGIN {
    if( ! (eval "use JSON; 1")) {
        eval "use JSON::PP; 1" or die "No implementation of JSON available";

lib/App/MHFS.pm  view on Meta::CPAN

4630
4631
4632
4633
4634
4635
4636
4637
4638
4639
4640
    return -1;
}
 
sub downloadAndServe {
    my ($self, $request, $video) = @_;
    weaken($request);
 
 
    my $filename = $video->{'out_filepath'};
    my $sendit = sub {
        # we can send the file

lib/App/MHFS.pm  view on Meta::CPAN

5489
5490
5491
5492
5493
5494
5495
5496
5497
5498
5499
use Cwd qw(abs_path getcwd);
use URI::Escape qw(uri_escape);
use Encode qw(decode encode);
use File::Path qw(make_path);
use Data::Dumper qw(Dumper);
use Scalar::Util qw(weaken);
use MIME::Base64 qw(encode_base64url decode_base64url);
use Devel::Peek qw(Dump);
MHFS::Util->import(qw(decode_UTF_8 encode_UTF_8 base64url_to_str str_to_base64url uri_escape_path_utf8));
BEGIN {
    if( ! (eval "use JSON; 1")) {

lib/App/MHFS.pm  view on Meta::CPAN

6240
6241
6242
6243
6244
6245
6246
6247
6248
6249
6250
# slow path, download it
$request->{client}{server}{settings}{TMDB} or last;
my $searchname = $medianame;
$searchname =~ s/\s\(\d\d\d\d\)// if($mediatype eq 'movies');
say "searchname $searchname";
weaken($request);
_TMDB_api_promise($request->{client}{server}, 'search/'.$params->{search}, {'query' => $searchname})->then( sub {
    if($metadatatype eq 'plot' || ! -f "$metadir/plot.txt") {
        make_path($metadir);
        MHFS::Util::write_file("$metadir/plot.txt", $_[0]->{results}[0]{overview});
    }

lib/App/MHFS.pm  view on Meta::CPAN

6324
6325
6326
6327
6328
6329
6330
6331
6332
6333
package MHFS::Plugin::GetVideo {
    use strict; use warnings;
    use feature 'say';
    use Data::Dumper qw (Dumper);
    use Fcntl qw(:seek);
    use Scalar::Util qw(weaken);
    use URI::Escape qw (uri_escape);
    use Devel::Peek qw(Dump);
    no warnings "portable";
    use Config;

lib/App/MHFS.pm  view on Meta::CPAN

6477
6478
6479
6480
6481
6482
6483
6484
6485
6486
6487
# deprecated
$video{'pid'} = ASYNC(\&shellcmd_unlock, \@cmd, $video{'out_filepath'});
 
# our file isn't ready yet, so create a timer to check the progress and act
weaken($request); # the only one who should be keeping $request alive is the client
$request->{'client'}{'server'}{'evp'}->add_timer(0, 0, sub {
    if(! defined $request) {
        say "\$request undef, ignoring CB";
        return undef;
    }

 view release on metacpan or  search on metacpan

lib/App/MechaCPAN.pm  view on Meta::CPAN

661
662
663
664
665
666
667
668
669
670
671
}
 
package MechaCPAN::DestGuard
{
  use Cwd qw/cwd/;
  use Scalar::Util qw/refaddr weaken/;
  use overload '""' => sub { my $s = shift; return $$s }, fallback => 1;
  my $dest_dir;
 
  sub get
  {

lib/App/MechaCPAN.pm  view on Meta::CPAN

674
675
676
677
678
679
680
681
682
683
{
  my $pwd = App::MechaCPAN::get_project_dir;
  $dest_dir = \"$pwd/local";
  bless $dest_dir;
  $result = $dest_dir;
  weaken $dest_dir;
}
 
mkdir $dest_dir
  unless -d $dest_dir;

 view release on metacpan or  search on metacpan

t/unit/glacier/inventory_csv.t  view on Meta::CPAN

24
25
26
27
28
29
30
31
32
use warnings;
use Test::More tests => 805;
use Test::Deep;
use Carp;
use FindBin;
use Scalar::Util qw/weaken/;
use lib map { "$FindBin::RealBin/../$_" } qw{../lib ../../lib};
use TestUtils 'w_fatal';
use App::MtAws::Glacier::Inventory::CSV;

 view release on metacpan or  search on metacpan

lib/App/Netdisco/AnyEvent/Nbtstat.pm  view on Meta::CPAN

23
24
25
26
27
28
29
30
31
32
33
$timeout = 0.5 unless defined $timeout;
 
my $self = bless { interval => $interval, timeout => $timeout, %args },
    $class;
 
Scalar::Util::weaken( my $wself = $self );
 
socket my $fh4, AF_INET, Socket::SOCK_DGRAM(), 0
    or Carp::croak "Unable to create socket : $!";
 
AnyEvent::Util::fh_nonblocking $fh4, 1;

 view release on metacpan or  search on metacpan

t/files/moby11.txt  view on Meta::CPAN

10440
10441
10442
10443
10444
10445
10446
10447
10448
10449
10450
10451
10452
10453
10454
10455
10456
10457
10458
10459
10460
upon the Islanders to assist him in the laborious business of heaving
 
down the ship to stop the leak.  But to such unresting vigilance over
 
their dangerous allies was this small band of whites necessitated,
 
both by night and by day, and so extreme was the hard work they underwent,
 
that upon the vessel being ready again for sea, they were in such
 
a weakened condition that the captain durst not put off with them
 
in so heavy a vessel.  After taking counsel with his officers,
 
he anchored the ship as far off shore as possible; loaded and ran
 
out his two cannon from the bows; stacked his muskets on the poop;
 
and warning the Islanders not to approach the ship at their peril,
 
took one man with him, and setting the sail of his best whale-boat,

t/files/moby11.txt  view on Meta::CPAN

19147
19148
19149
19150
19151
19152
19153
19154
19155
19156
19157
19158
19159
19160
19161
19162
19163
19164
19165
19166
19167
But as all else in him thinned, and his cheek-bones grew sharper,
 
his eyes, nevertheless, seemed growing fuller and fuller;
 
they became of a strange softness of lustre; and mildly but
 
deeply looked out at you there from his sickness, a wondrous
 
testimony to that immortal health in him which could not die,
 
or be weakened.  And like circles on the water, which, as they
 
grow fainter, expand; so his eyes seemed rounding and rounding,
 
like the rings of Eternity.  An awe that cannot be named would
 
steal over you as you sat by the side of this waning savage,
 
and saw as strange things in his face, as any beheld who were
 
bystanders when Zoroaster died.  For whatever is truly wondrous