view release on metacpan or search on metacpan
lib/DTL/Fast/Entity.pm view on Meta::CPAN
use strict;
use utf8;
use warnings FATAL => 'all';
# prototype for template entity. Handling current line and current template references
use Scalar::Util qw(weaken);
use Carp qw(confess);
sub new
{
my ( $proto, %kwargs ) = @_;
lib/DTL/Fast/Entity.pm view on Meta::CPAN
{
my ($self) = @_;
$self->{_template} = $DTL::Fast::Template::CURRENT_TEMPLATE;
$self->{_template_line} = $DTL::Fast::Template::CURRENT_TEMPLATE_LINE;
weaken $self->{_template};
return $self;
}
sub get_parse_error
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/DWH_File/Cache.pm view on Meta::CPAN
bless $self, $class;
return $self;
}
sub encache {
# weaken if available
$_[ 0 ]->{ $_[ 1 ]->cache_key } = $_[ 1 ];
$_[ 1 ]->cache_up;
}
sub decache {
view release on metacpan or search on metacpan
_Deparsed_XSubs.pm view on Meta::CPAN
package Class::MOP {
sub blessed($) ;
sub check_package_cache_flag($) ;
sub get_code_info($) ;
sub isweak($) ;
sub weaken($) ;
}
package Class::MOP::Attribute {
sub associated_class;
sub associated_methods;
sub blessed($) ;
sub weaken($) ;
}
package Class::MOP::Class {
sub all(&@) ;
sub blessed($) ;
sub constructor_class;
_Deparsed_XSubs.pm view on Meta::CPAN
sub associated_metaclass;
sub blessed($) ;
sub isweak($) ;
sub slot_hash;
sub slots;
sub weaken($) ;
}
package Class::MOP::Method {
sub blessed($) ;
sub body;
sub is_stub;
sub name;
sub package_name;
sub reftype($) ;
sub weaken($) ;
}
package Class::MOP::Method::Accessor {
sub blessed($) ;
sub weaken($) ;
}
package Class::MOP::Method::Constructor {
sub blessed($) ;
sub weaken($) ;
}
package Class::MOP::Method::Generated {
sub definition_context;
sub is_inline;
}
_Deparsed_XSubs.pm view on Meta::CPAN
sub _expected_method_class;
sub refaddr($) ;
}
package Class::MOP::Method::Meta {
sub blessed($) ;
sub weaken($) ;
}
package Class::MOP::Method::Wrapped {
sub blessed($) ;
sub set_subname;
}
_Deparsed_XSubs.pm view on Meta::CPAN
package Class::MOP::Object {
sub blessed($) ;
}
package Class::MOP::Overload {
sub blessed($) ;
sub weaken($) ;
}
package Class::MOP::Package {
sub blessed($) ;
sub name;
sub weaken($) ;
}
package Class::XSAccessor {
sub __entersub_optimized__() ;
sub _newxs_compat_accessor;
sub _newxs_compat_setter;
_Deparsed_XSubs.pm view on Meta::CPAN
package Devel::MAT::Cmd::_base {
sub max(@) ;
sub perlstring;
}
package Devel::MAT::Context {
sub weaken($) ;
}
package Devel::MAT::Dumper {
sub ARG_MAX() ;
sub CHILD_MAX() ;
sub CLK_TCK() ;
_Deparsed_XSubs.pm view on Meta::CPAN
sub df;
sub first(&@) ;
sub glob_at;
sub refcnt;
sub size;
sub weaken($) ;
}
package Devel::MAT::SV::ARRAY {
sub DESTROY;
sub _clear_elem;
sub _set_array_fields;
_Deparsed_XSubs.pm view on Meta::CPAN
}
package Future::PP {
sub blessed($) ;
sub gettimeofday() ;
sub reftype($) ;
sub weaken($) ;
}
package Future::_base {
sub blessed($) ;
sub svref_2object;
}
_Deparsed_XSubs.pm view on Meta::CPAN
}
package Moose::Meta::Class::Immutable::Trait {
sub blessed($) ;
}
package Moose::Meta::Method::Constructor {
sub weaken($) ;
}
package Moose::Meta::Method::Delegation {
sub blessed($) ;
sub weaken($) ;
}
package Moose::Meta::Method::Destructor {
sub blessed($) ;
sub weaken($) ;
}
package Moose::Meta::Object::Trait {
sub blessed($) ;
}
package Moose::Meta::Role {
_Deparsed_XSubs.pm view on Meta::CPAN
sub all(&@) ;
sub blessed($) ;
}
package Moose::Meta::Role::Application::ToClass {
sub first(&@) ;
sub weaken($) ;
}
package Moose::Meta::Role::Application::ToInstance {
sub _reset_amagic;
sub all(&@) ;
sub blessed($) ;
}
package Moose::Meta::Role::Attribute {
sub all(&@) ;
sub blessed($) ;
sub weaken($) ;
}
package Moose::Meta::Role::Composite {
sub blessed($) ;
}
package Moose::Meta::TypeCoercion::Union {
_Deparsed_XSubs.pm view on Meta::CPAN
sub openhandle($) ;
sub readonly($) ;
sub refaddr($) ;
sub reftype($) ;
sub tainted($) ;
sub unweaken($) ;
sub weaken($) ;
}
package Scalar::Util::LooksLikeNumber {
sub looks_like_number($) ;
}
package Scalar::Util::Numeric {
_Deparsed_XSubs.pm view on Meta::CPAN
}
package Specio::OO {
sub all(&@) ;
sub dclone($) ;
sub perlstring;
sub weaken($) ;
}
package Specio::PartialDump {
sub blessed($) ;
sub looks_like_number($) ;
sub reftype($) ;
_Deparsed_XSubs.pm view on Meta::CPAN
sub pixels;
}
package Test2::API {
sub blessed($) ;
sub time() ;
sub weaken($) ;
}
package Test2::API::Context {
sub blessed($) ;
sub weaken($) ;
}
package Test2::API::Instance {
sub reftype($) ;
}
package Test2::Event {
_Deparsed_XSubs.pm view on Meta::CPAN
package Test2::EventFacet::Trace {
sub time() ;
}
package Test2::Hub {
sub first(&@) ;
sub weaken($) ;
}
package Test2::Util::Facets2Legacy {
sub blessed($) ;
}
package Test2::Util::HashBase {
sub _isa($;$) ;
}
package Test::Builder {
sub blessed($) ;
sub reftype($) ;
sub weaken($) ;
}
package Test::LeakTrace {
sub CLONE;
sub _finish;
sub _runops_installed;
_Deparsed_XSubs.pm view on Meta::CPAN
sub refaddr($) ;
sub reftype($) ;
sub stringify($) ;
sub trim($) ;
sub true() ;
sub unweaken($) ;
sub weaken($) ;
}
package constant {
sub _make_const(\[$@]) ;
}
package indirect {
view release on metacpan or search on metacpan
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
lib/Dancer/Logger/File/PerRequest.pm view on Meta::CPAN
return $file . '-' . $$ . '-' . $request_id . '.log';
};
$self->{logfile_callback} = $logfile_callback;
# per request
Scalar::Util::weaken $self;
my $on_end = sub {
return unless $self->{fh};
Dancer::Factory::Hook->execute_hooks('before_file_per_request_close', $self->{fh}, $self->{logfile});
close($self->{fh}); # close
view release on metacpan or search on metacpan
lib/Mail/Email/IMAP.pm view on Meta::CPAN
package Mail::Email::IMAP;
use strict;
use MIME::WordDecoder;
use MIME::Base64;
use MIME::QuotedPrint;
use Scalar::Util qw(weaken);
use Encode qw(decode);
use Text::Markdown ();
use HTTP::Date qw( time2isoz );
use Time::Piece;
#use 5.016; # for fc
lib/Mail/Email/IMAP.pm view on Meta::CPAN
} => $class;
};
sub from_imap_client {
my ($package, $conn, $uid, %info) = @_;
#weaken $conn;
my $dt = $conn->date( $uid );
my $timestamp;
if( $dt ) {
view release on metacpan or search on metacpan
lib/Dancer2/Plugin/Auth/Extensible.pm view on Meta::CPAN
sub BUILD {
my $plugin = shift;
my $app = $plugin->app;
Scalar::Util::weaken( my $weak_plugin = $plugin );
warn "No Auth::Extensible realms configured with which to authenticate user"
unless $plugin->realm_count;
# Force all providers to load whilst we have access to the full dsl.
view release on metacpan or search on metacpan
lib/Dancer2/Plugin/BrowserDetect.pm view on Meta::CPAN
#ABSTRACT: Provides an easy to have info of the browser.
sub BUILD {
my $plugin = shift;
# Create a weakened plugin that we can close over to avoid leaking.
Scalar::Util::weaken( my $weak_plugin = $plugin );
$plugin->app->add_hook(
Dancer2::Core::Hook->new(
name => 'before_template',
code => sub {
my $tokens = shift;
view release on metacpan or search on metacpan
lib/Dancer2/Plugin/Interchange6.pm view on Meta::CPAN
use warnings;
use Dancer2::Plugin;
use Dancer2::Plugin::Interchange6::Business::OnlinePayment;
use Module::Runtime 'use_module';
use Scalar::Util 'weaken';
=head1 NAME
Dancer2::Plugin::Interchange6 - Interchange6 Shop Plugin for Dancer2
lib/Dancer2/Plugin/Interchange6.pm view on Meta::CPAN
'shop_state',
'shop_user';
sub BUILD {
my $plugin = shift;
weaken ( my $weak_plugin = $plugin );
$plugin->app->add_hook(
Dancer2::Core::Hook->new(
name => 'before',
code => sub {
# D2PAE::Provider::DBIC returns logged_in_user as hashref
view release on metacpan or search on metacpan
lib/Dancer2/Template/TTLogReport.pm view on Meta::CPAN
use Log::Report 'dancer2-plugin-logreport';
use Moo;
use Dancer2::Core::Types;
use Dancer2::FileUtils qw/path/;
use Scalar::Util qw/weaken/;
use Log::Report::Template ();
use Log::Report::Util qw/parse_locale/;
with 'Dancer2::Core::Role::Template';
lib/Dancer2/Template/TTLogReport.pm view on Meta::CPAN
my $charset = $self->charset;
my $templater = delete $config{templater} || 'Log::Report::Template';
$Template::Stash::PRIVATE = undef if delete $config{show_private_variables};
weaken(my $ttt = $self);
my $include_path = delete $config{include_path};
$templater->new(
ANYCASE => 1,
ABSOLUTE => 1,
view release on metacpan or search on metacpan
lib/Dancer2/Plugin/ParamTypes.pm view on Meta::CPAN
'builder' => '_build_type_actions',
);
sub _build_type_actions {
my $self = shift;
Scalar::Util::weaken( my $plugin = $self );
return {
'error' => sub {
my ( $self, $details ) = @_;
my ( $type, $name ) = @{$details}{qw<type name>};
lib/Dancer2/Plugin/ParamTypes.pm view on Meta::CPAN
'action' => $action,
};
}
# Couldn't prove yet that this is required, but it makes sense to me
Scalar::Util::weaken( my $plugin = $self );
return sub {
my @route_args = @_;
# Hash::MultiValue has "each" method which we could use to
view release on metacpan or search on metacpan
lib/Dancer2/Core/App.pm view on Meta::CPAN
or croak "Cannot load session engine '$value': illegal module name";
my $engine_options =
$self->_get_config_for_engine( session => $value, $config );
Scalar::Util::weaken( my $weak_self = $self );
# Note that engine options will replace the default session_dir (if provided).
return $self->_factory->create(
session => $value,
session_dir => $self->_appdir_path->child('sessions')->stringify,
lib/Dancer2/Core/App.pm view on Meta::CPAN
layout_dir => ( $config->{layout_dir} || 'layouts' ),
views => $config->{views},
charset => $config->{charset},
};
Scalar::Util::weaken( my $weak_self = $self );
return $self->_factory->create(
template => $value,
%{$engine_attrs},
postponed_hooks => $self->postponed_hooks,
lib/Dancer2/Core/App.pm view on Meta::CPAN
my $engine_options =
$self->_get_config_for_engine( serializer => $value, $config );
$engine_options->{strict_utf8} //= $config->{strict_utf8};
Scalar::Util::weaken( my $weak_self = $self );
return $self->_factory->create(
serializer => $value,
config => $engine_options,
postponed_hooks => $self->postponed_hooks,
lib/Dancer2/Core/App.pm view on Meta::CPAN
# typically this is passed in as an optimization within the
# dispatch loop but may be called elsewhere
$defined_engines ||= $self->defined_engines;
# populate request in app and all engines
$self->_set_request($request);
Scalar::Util::weaken( my $weak_request = $request );
$_->set_request( $weak_request ) for @{$defined_engines};
}
has response => (
is => 'ro',
lib/Dancer2/Core/App.pm view on Meta::CPAN
mime_type => $self->mime_type,
server_tokens => !$self->config->{'no_server_tokens'},
charset => $self->config->{charset},
strict_utf8 => $self->config->{strict_utf8},
do {
Scalar::Util::weaken( my $weak_self = $self );
log_cb => sub { $weak_self && $weak_self->log(@_) };
},
$self->has_serializer_engine
? ( serializer => $self->serializer_engine )
: (),
lib/Dancer2/Core/App.pm view on Meta::CPAN
my $self = shift;
# Hook to flush the session at the end of the request,
# this way, we're sure we flush only once per request
#
# Note: we create a weakened copy $self
# before closing over the weakened copy
# to avoid circular memory refs.
Scalar::Util::weaken(my $app = $self);
$self->add_hook(
Dancer2::Core::Hook->new(
name => 'core.app.after_request',
code => sub {
lib/Dancer2/Core/App.pm view on Meta::CPAN
# load any serializer engine config
my $engine_options =
$self->_get_config_for_engine( serializer => $type, $self->config ) || {};
$engine_options->{strict_utf8} //= $self->config->{strict_utf8};
Scalar::Util::weaken( my $weak_self = $self );
my $serializer = $self->_factory->create(
serializer => $type,
config => $engine_options,
postponed_hooks => $self->postponed_hooks,
log_cb => sub { $weak_self->log(@_) },
lib/Dancer2/Core/App.pm view on Meta::CPAN
return $responder->(
[ $res->status, $res->headers_to_array, $fh ]
);
};
Scalar::Util::weaken( my $weak_self = $self );
$response = Dancer2::Core::Response::Delayed->new(
error_cb => sub { $weak_self->logger_engine->log( warning => @_ ) },
cb => $cb,
request => $Dancer2::Core::Route::REQUEST,
lib/Dancer2/Core/App.pm view on Meta::CPAN
my ($self) = @_;
for my $position ( $self->supported_hooks ) {
my $compiled_hooks = [];
for my $hook ( @{ $self->hooks->{$position} } ) {
Scalar::Util::weaken( my $app = $self );
my $compiled = set_subname subname($hook) => sub {
# don't run the filter if halt has been used
$Dancer2::Core::Route::RESPONSE &&
$Dancer2::Core::Route::RESPONSE->is_halted
and return;
lib/Dancer2/Core/App.pm view on Meta::CPAN
1;
};
# Catch bad content causing deserialization to fail when building the request
if ( ! $request_built_successfully ) {
my $err = $@;
Scalar::Util::weaken(my $app = $self);
return Dancer2::Core::Error->new(
app => $app,
message => $err,
status => 400, # 400 Bad request (dont send again), rather than 500
charset => $self->config->{charset},
lib/Dancer2/Core/App.pm view on Meta::CPAN
return $response;
}
sub build_request {
my ( $self, $env ) = @_;
Scalar::Util::weaken( my $weak_self = $self );
# If we have an app, send the serialization engine
my $request = Dancer2::Core::Request->new(
env => $env,
is_behind_proxy => $self->settings->{'behind_proxy'} || 0,
view release on metacpan or search on metacpan
lib/DashProfiler/Core.pm view on Meta::CPAN
die @$ if $@ && $@ !~ /^Can't locate Hash\/Util/;
*lock_keys = sub { } if not defined &lock_keys;
}
# check for weaken support, used by ChildHandles
my $HAS_WEAKEN = eval {
require Scalar::Util;
# this will croak() if this Scalar::Util doesn't have a working weaken().
Scalar::Util::weaken( my $test = [] );
1;
};
*weaken = sub { croak "Can't weaken without Scalar::Util::weaken" }
unless $HAS_WEAKEN;
# On 2GHz OS X 10.5.2 laptop:
# sample_overhead_time = 0.000014s
lib/DashProfiler/Core.pm view on Meta::CPAN
$dbh->{Profile}->empty; # discard FETCH&STOREs etc due to connect()
for my $handles ($self->{dbi_handles_all}, $self->{dbi_handles_active}) {
# clean out any dead weakrefs
defined $handles->{$_} or delete $handles->{$_} for keys %$handles;
$handles->{$dbi_profile_name} = $dbh;
# weaken($handles->{$dbi_profile_name}) if $weakly; # not currently documented or used
}
return $dbh;
}
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/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
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/Data/Clone.xs view on Meta::CPAN
if(SvOBJECT(sv)){
sv_bless(cloned, SvSTASH(sv));
}
return SvWEAKREF(cloning) ? sv_rvweaken(cloned) : cloned;
}
/* as SV* sv_clone(SV* sv) */
SV*
Data_Clone_sv_clone(pTHX_ SV* const sv) {
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/Data/Decycle.pm view on Meta::CPAN
package Data::Decycle;
use 5.008001;
use warnings;
use strict;
use Carp;
use Scalar::Util qw/refaddr weaken isweak/;
our $VERSION = sprintf "%d.%02d", q$Revision: 0.2 $ =~ /(\d+)/g;
our $DEBUG = 0;
use base 'Exporter';
our @EXPORT = ();
our @EXPORT_OK = qw(recsub $CALLEE
may_leak has_cyclic_ref decycle_deeply weaken_deeply
);
our %EXPORT_TAGS = ( all => [ @EXPORT, @EXPORT_OK ], );
BEGIN {
require constant;
lib/Data/Decycle.pm view on Meta::CPAN
}
*_decycle_deeply = _mkwalker { undef $_[0] };
sub decycle_deeply($) { _decycle_deeply( $_[0], {} ) }
*_weaken_deeply = _mkwalker {
weaken $_[0] unless UNIVERSAL::isa( $_[0], 'CODE' )
};
sub weaken_deeply($) { _weaken_deeply( $_[0], {} ) }
1; # End of Data::Decycle
__END__
=head1 NAME
lib/Data/Decycle.pm view on Meta::CPAN
use Data::Decycle ':all';
my $obj = bless {}, 'Dummy';
$obj->{me} = $obj;
print may_leak($obj); # true
weaken_deeply($obj);
print may_leak($obj); # false
print has_cyclic_ref($obj); # true
decycle_deeply($obj);
print $obj->{me} == undef; # true
lib/Data/Decycle.pm view on Meta::CPAN
say "($son) may leak ? ", $son->may_leak? 'yes' : 'no';
$mom->{son} = $son;
$son->{mom} = $mom;
say "($mom) has cyclic ref ? ", $mom->has_cyclic_ref ? 'yes' : 'no';
say "($son) may leak ? ", $son->may_leak? 'yes' : 'no';
$mom->weaken_deeply;
$son->weaken_deeply;
say "($mom) has cyclic ref ? ", $mom->has_cyclic_ref ? 'yes' : 'no';
say "($son) may leak ? ", $son->may_leak? 'yes' : 'no';
}
lib/Data/Decycle.pm view on Meta::CPAN
Perl programmers love to hate cyclic References, or circular
references. It easly leaks out of perl's reference-counter based
garbage collection and stays there until perl exits.
Even with the introduction of weak references in Perl 5.8, you still
have to tell perl explicitly to weaken references and which reference
to weaken is tricky.
use Devel::Peek;
use Scalar::Util qw/weaken/;
my $obj = {you => $ENV{USER}};
$obj->{me} = $obj;
weaken($obj); # wrong
weaken($obj->{me}) # right;
In addition to that, weak references do not work with code references.
my $cref;
$cref = sub { $_[0] <= 1 ? 1 : $_[0] * $cref->( $_[0] - 1 ) };
print $cref->(10);
weaken($cref); # does undef($cref)
print $cref->(10); # goodbye
This module offers something easier than that.
=head2 HOW DOES IT WORK?
lib/Data/Decycle.pm view on Meta::CPAN
checks if cyclic reference exists in C<$obj>.
=head2 decycle_deeply($obj)
C<undef>s all duplicate references in C<$obj> thus breaks all cyclic
reference. Unlike C<weaken_deeply>, it decycles even code
references. You shouldn't call it yourself; let C<decycle> take care
of it.
=head2 weaken_deeply($obj)
weaken all duplicate references in C<$obj>. Unlike C<decycle_deeply>
it leaves code references intact. So you can safely call it but you
are at your own if C<$obj> contains a code reference that cycles.
=head2 recsub { }
view release on metacpan or search on metacpan
lib/Data/DublinCore.pm view on Meta::CPAN
use Log::Report 'data-dublincore', syntax => 'SHORT';
use XML::Compile::Util qw/type_of_node unpack_type pack_type SCHEMA2001/;
use XML::LibXML::Simple qw/XMLin/;
use Scalar::Util qw/weaken/;
use Data::DublinCore::Util;
use XML::Compile::Util qw/XMLNS/;
lib/Data/DublinCore.pm view on Meta::CPAN
my $r = $args->{opts_readers} ||= {};
$r = $args->{opts_readers} = +{ @$r } if ref $r eq 'ARRAY';
$r->{mixed_elements} = 'XML_NODE';
my $s = $self;
weaken $s; # avoid memory leak
# $r->{mixed_elements} = sub { $s->_handle_any_type(@_) };
$r->{any_type} = sub { $s->_handle_any_type(@_) };
$args->{any_element} ||= 'ATTEMPT';
$self->SUPER::init($args);
view release on metacpan or search on metacpan
lib/Data/Dump/Streamer.pm view on Meta::CPAN
lock_ref_keys_plus
lock_keys_plus
SvREADONLY_ref
SvREFCNT_ref
isweak
weaken
weak_refcount
readonly_set
Dumper
lib/Data/Dump/Streamer.pm view on Meta::CPAN
lock_keys
lock_ref_keys_plus
lock_keys_plus
alias_to
dualvar
weaken
usqz
)
],
special => [qw( readonly_set )],
all => [ @EXPORT, @EXPORT_OK ],
lib/Data/Dump/Streamer.pm view on Meta::CPAN
dualvar
blessed reftype refaddr refcount sv_refcount
readonly looks_like_number regex is_numeric
make_ro readonly_set reftype_or_glob
refaddr_or_glob globname
weak_refcount isweak weaken
)
],
);
lib/Data/Dump/Streamer.pm view on Meta::CPAN
\*$item{$t}, $depth + 1,
$type . "{$t}", refcount(\*$item{$t}) ];
}
}
#use Scalar::Util qw(weaken);
$self;
}
sub Data {
my $self= shift->_safe_self;
lib/Data/Dump/Streamer.pm view on Meta::CPAN
$self->_dump_rv($item, $depth + 1, $dumped, $name, $indent,
$is_ref && !$add_do);
}
$self->{fh}->print("$optspace}")
if $add_do;
$self->_add_fix('sub call', 'weaken', $name)
if $self->{svw}{$addr};
return;
}
sub _brace {
lib/Data/Dump/Streamer.pm view on Meta::CPAN
regex($var) # In list context returns the pattern and the modifiers,
# in scalar context returns the pattern in (?msix:) form.
# If not a regex returns false.
readonly($var) # returns whether the $var is readonly
weaken($var) # cause the reference contained in var to become weak.
make_ro($var) # causes $var to become readonly, returns the value of $var.
reftype_or_glob # returns the reftype of a reference, or if its not
# a reference but a glob then the globs name
refaddr_or_glob # similar to reftype_or_glob but returns an address
# in the case of a reference.
view release on metacpan or search on metacpan
lib/Data/Dumper/Interp.pm view on Meta::CPAN
use re qw/is_regexp regexp_pattern/;
use Data::Dumper ();
use Carp;
use POSIX qw(INT_MAX);
use Scalar::Util qw(blessed reftype refaddr looks_like_number weaken);
use List::Util 1.45 qw(min max first none all any sum0);
use Data::Structure::Util qw/circular_off/;
use Regexp::Common qw/RE_balanced RE_quoted/;
#use Term::ReadKey ();
use Term::Size 0.211 ();
lib/Data/Dumper/Interp.pm view on Meta::CPAN
tlen => 0, # incremented below
children => [],
C => undef,
parent => $context,
};
weaken( $child->{parent} );
push @{ $context->{children} }, $child;
$context = $child;
}
elsif ($mode eq "close") {
oops if defined($context->{C});
lib/Data/Dumper/Interp.pm view on Meta::CPAN
tlen => length($lhs),
children => [ $lhs ],
C => undef,
parent => $context,
};
weaken($newchild->{parent});
$context->{children}->[-1] = $newchild;
$context = $newchild;
atom($_[0]); # the " => "
oops unless $context == $newchild;
$context->{CLOSE_AFTER_NEXT} = 1;
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
lib/Data/Frame/Partial/Sugar.pm view on Meta::CPAN
use namespace::autoclean;
package Tie::Data::Frame {
$Tie::Data::Frame::VERSION = '0.006005';
use Scalar::Util qw(weaken);
use Types::PDL qw(Piddle);
use Types::Standard qw(ArrayRef Value);
use Type::Params;
sub new {
my ($class, $object) = @_;
my $self = bless( { _object => $object }, $class);
weaken( $self->{_object} );
return $self;
}
sub TIEHASH {
my $class = shift;
view release on metacpan or search on metacpan
t/020_common_exceptions.t view on Meta::CPAN
use strict;
use warnings;
use Data::Google::Visualization::DataTable;
use Test::More;
use Scalar::Util qw(weaken);
BEGIN {
eval "use Test::Exception";
plan skip_all => "Test::Exception needed for these tests" if $@;
}
t/020_common_exceptions.t view on Meta::CPAN
# Nonsense column p
{
my $datatable = Data::Google::Visualization::DataTable->new();
my $circular = [];
push(@$circular, $circular);
weaken $circular;
throws_ok
{ $datatable->add_columns( { type => 'string', p => $circular } ) }
qr/Serializing 'p' failed/,
"Unserializable p caught";
view release on metacpan or search on metacpan
lib/Data/Handle.pm view on Meta::CPAN
my %datastash;
use Symbol qw( gensym );
use Scalar::Util qw( weaken );
use parent qw( IO::File );
use Package::Stash 0.15; # has_symbol
use Carp ();
use Data::Handle::Exception;
use Data::Handle::IO;
lib/Data/Handle.pm view on Meta::CPAN
. "\n" );
}
my $sym = gensym();
my $xsym = $sym;
weaken($xsym);
## no critic( ProhibitTies )
tie *{$sym}, 'Data::Handle::IO', { self => $xsym };
${ *{$sym} }{stash} = {};
bless $sym, $class;
view release on metacpan or search on metacpan
lib/Data/Header/Fields.pm view on Meta::CPAN
1;
package Data::Header::Fields::Value;
use Scalar::Util 'weaken', 'isweak';
use overload
'""' => \&as_string,
'cmp' => \&cmp,
;
lib/Data/Header/Fields.pm view on Meta::CPAN
$value = { $value, @_ };
}
my $self = bless { 'parent' => $class->_default_parent, %{$value} }, $class;
weaken($self->{'parent'})
if (ref($self->{'parent'}) && !isweak($self->{'parent'}));
return $self;
}
lib/Data/Header/Fields.pm view on Meta::CPAN
}
1;
package Data::Header::Fields::Line;
use Scalar::Util 'blessed', 'weaken', 'isweak';
use overload
'""' => \&as_string,
'cmp' => \&cmp,
;
lib/Data/Header/Fields.pm view on Meta::CPAN
'parent' => $line,
);
}
}
weaken($line->{'parent'})
if (ref($line->{'parent'}) && !isweak($line->{'parent'}));
return bless $line, $class;
}