Data-Dump-Streamer
view release on metacpan or search on metacpan
lib/Data/Dump/Streamer.pm view on Meta::CPAN
all_keys
legal_keys
hidden_keys
lock_ref_keys
lock_keys
lock_ref_keys_plus
lock_keys_plus
SvREADONLY_ref
SvREFCNT_ref
isweak
weaken
weak_refcount
readonly_set
Dumper
DDumper
alias
sqz
usqz
lib/Data/Dump/Streamer.pm view on Meta::CPAN
%EXPORT_TAGS= (
undump => [
qw( alias_av alias_hv alias_ref make_ro
lock_ref_keys
lock_keys
lock_ref_keys_plus
lock_keys_plus
alias_to
dualvar
weaken
usqz
)
],
special => [qw( readonly_set )],
all => [ @EXPORT, @EXPORT_OK ],
alias => [qw( alias_av alias_hv alias_ref push_alias )],
bin => [@EXPORT_OK],
Dumper => [qw( Dumper DDumper )],
util => [ qw (
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
)
],
);
sub alias_to { return shift }
#warn $VERSION;
Data::Dump::Streamer->bootstrap($XS_VERSION);
if ($] >= 5.013010) {
lib/Data/Dump/Streamer.pm view on Meta::CPAN
my $v= *$item{$t};
next unless defined $v;
next if $t eq 'SCALAR' and !defined($$v);
push @$queue, [
\*$item{$t}, $depth + 1,
$type . "{$t}", refcount(\*$item{$t}) ];
}
}
#use Scalar::Util qw(weaken);
$self;
}
sub Data {
my $self= shift->_safe_self;
my $args;
print "Data(" . scalar(@_) . " vars)\n"
if $DEBUG;
if (@_) {
$self->_reset;
lib/Data/Dump/Streamer.pm view on Meta::CPAN
}
$self->{do_nl}= 0;
}
else {
$self->{do_nl}= 1;
$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 {
my ($self, $name, $type, $cond, $indent, $child)= @_;
my $open= $type =~ /[\{\[\(]/;
my $brace=
$name !~ /^[%@]/ ? $type
lib/Data/Dump/Streamer.pm view on Meta::CPAN
sv_refcount($var) #the number of times a scalar is referenced.
weak_refcount($var) #the number of weakrefs to an object.
#sv_refcount($var)-weak_refcount($var) is the true
#SvREFCOUNT() of the var.
looks_like_number($var) #if perl will think this is a number.
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.
globname # returns an evalable string to represent a glob, or
# the empty string if not a glob.
:all # (Dump() and Stream() and Dumper() and DDumper()
# and all of the XS)
:bin # (not Dump() but all of the rest of the XS)
lib/Data/Dump/Streamer.xs view on Meta::CPAN
RETVAL = 0;
} else {
RETVAL = PTR2UV(SvRV(sv));
}
}
OUTPUT:
RETVAL
void
weaken(sv)
SV *sv
PROTOTYPE: $
CODE:
#ifdef SvWEAKREF
sv_rvweaken(sv);
XSRETURN_YES;
#else
croak("weak references are not implemented in this release of perl");
#endif
void
isweak(sv)
SV *sv
PROTOTYPE: $
CODE:
lib/Data/Dump/ppport.h view on Meta::CPAN
sv_pvutf8n_force||5.006000|
sv_pvutf8n||5.006000|
sv_pvutf8||5.006000|
sv_pv||5.006000|
sv_recode_to_utf8||5.007003|
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
sv_setpvf_mg_nocontext|||pvn
sv_setpvf_mg|5.006000|5.004000|pv
sv_setpvf_nocontext|||vn
sv_setpvf||5.004000|v
sv_setpviv_mg||5.008001|
t/madness_w.t view on Meta::CPAN
use Test::More tests => 6;
BEGIN { use_ok('Data::Dump::Streamer', qw(:undump weaken)); }
use strict;
use warnings;
use Data::Dumper;
SKIP: {
my ($_item, $_ref);
$_ref= \$_item;
skip("No Weak Refs", 5)
unless eval { weaken($_ref) };
# imports same()
require "./t/test_helper.pl";
# use this one for simple, non evalable tests. (GLOB)
# same ( $got,$expected,$name,$obj )
#
# use this one for eval checks and dumper checks but NOT for GLOB's
# same ( $name,$obj,$expected,@args )
t/madness_w.t view on Meta::CPAN
return [
$btree->($d + 1, $m, $p . '0'),
$btree->($d + 1, $m, $p . '1') ];
};
my $t= $btree->(0, 1, '');
my ($x, $y, $qr);
$x= \$y;
$y= \$x;
$qr= bless qr/this is a test/m, 'foo_bar';
weaken($y);
my $array= [];
my $hash= bless {
A => \$array,
'B-B' => ['$array'],
'CCCD' => [ 'foo', 'bar' ],
'E' => \\1,
'F' => \\undef,
'Q' => sub { \@_ }
->($icky),
},
t/madness_w.t view on Meta::CPAN
$ARRAY1 = [
'R: $ARRAY1->[1]',
'R: $ARRAY1->[0]',
'A: $foo_bar1',
'A: $ARRAY1->[0]',
'A: $ARRAY1->[1]',
'A: $foo_bar1'
];
$ARRAY1->[0] = \$ARRAY1->[1];
$ARRAY1->[1] = \$ARRAY1->[0];
weaken($ARRAY1->[1]);
alias_av(@$ARRAY1, 3, $ARRAY1->[0]);
alias_av(@$ARRAY1, 4, $ARRAY1->[1]);
$ARRAY2 = [
\$ThisIsATest1,
'V: $ARRAY2->[0]',
'V: $ARRAY2->[0]',
\$foo_bar1,
'V: $ARRAY2->[3]',
\'foo',
\$VAR1
t/madness_w.t view on Meta::CPAN
}
{
my ($x, $y);
$x= \$y;
$y= \$x;
my $a= [ 1, 2 ];
$a->[0]= \$a->[1];
$a->[1]= \$a->[0];
weaken($a->[1]);
weaken($x);
#$cap->[-1]=5;
my $s;
$s= \$s;
my $bar= 'bar';
my $foo= 'foo';
my $halias= { foo => 1, bar => 2 };
alias_hv(%$halias, 'foo', $foo);
alias_hv(%$halias, 'bar', $bar);
alias_hv(%$halias, 'foo2', $foo);
t/madness_w.t view on Meta::CPAN
same(
"More Madness",
$o,
<<'EXPECT', ($a, $q1, $q2, $q3, [ $x, $y ], [ $s, $x, $y ], $t, $u, $v, $t, [ 1, 2, 3 ], { 1 .. 4 }, $cap, $cap, $t, $u, $v, $halias));
$ARRAY1 = [
'R: $ARRAY1->[1]',
'R: $ARRAY1->[0]'
];
$ARRAY1->[0] = \$ARRAY1->[1];
$ARRAY1->[1] = \$ARRAY1->[0];
weaken($ARRAY1->[1]);
$Regexp1 = qr/foo/;
$bar1 = bless( qr/bar/, 'bar' );
$REF1 = \bless( qr/baz/, 'baz' );
$ARRAY2 = [
'R: $ARRAY5->[1]',
'R: $ARRAY5->[0]'
];
$ARRAY3 = [
\do { my $v = 'V: $ARRAY3->[0]' },
'V: $ARRAY2->[0]',
t/madness_w.t view on Meta::CPAN
};
$ARRAY5 = [
'V: $ARRAY2->[0]',
'V: $ARRAY2->[1]'
];
$ARRAY2->[0] = \$ARRAY5->[1];
$ARRAY2->[1] = \$ARRAY5->[0];
$ARRAY3->[1] = $ARRAY2->[0];
$ARRAY3->[2] = $ARRAY2->[1];
$ARRAY5->[0] = $ARRAY2->[0];
weaken($ARRAY5->[0]);
$ARRAY5->[1] = $ARRAY2->[1];
alias_ref(\$ARRAY6,\$ARRAY5);
alias_ref(\$VAR5,\$VAR1);
alias_ref(\$VAR6,\$VAR2);
alias_ref(\$VAR7,\$VAR3);
$HASH2 = {
bar => 'bar',
foo => 'foo',
foo2 => 'A: $HASH2->{foo}'
};
t/madness_w.t view on Meta::CPAN
}
{
skip("Causes error at global destruction on 5.8.0", 1)
if $] == 5.008;
#local $Data::Dump::Streamer::DEBUG = 1;
my $x;
$x= sub { \@_ }
->($x, $x);
my $y= $x; #keep it alive
weaken($x);
push @$x, $x;
same("Tye Alias Array", $o, <<'EXPECT', ($x));
$ARRAY1 = [
'A: $ARRAY1',
'A: $ARRAY1',
'V: $ARRAY1'
];
alias_av(@$ARRAY1, 0, $ARRAY1);
alias_av(@$ARRAY1, 1, $ARRAY1);
$ARRAY1->[2] = $ARRAY1;
weaken($ARRAY1);
EXPECT
}
undef $o;
}
__END__
# with eval testing
{
same( "", $o, <<'EXPECT', ( ) );
t/refcount.t view on Meta::CPAN
use Test::More tests => 18;
use Devel::Peek;
BEGIN {
use_ok('Data::Dump::Streamer',
qw(refcount sv_refcount is_numeric looks_like_number weak_refcount weaken isweak)
);
}
my $sv= "Foo";
my $rav= [];
my $rhv= {};
is sv_refcount($sv), 1, "sv_refcount";
is refcount($rav), 1, "refcount av";
is refcount($rhv), 1, "refcount hv";
is refcount(\$sv), 2, 'refcount \\$foo';
my $ref= \$sv;
is sv_refcount($sv), 2, 'sv_refcount after';
is refcount(\$sv), 3, 'refcount after';
SKIP: {
skip("No Weak Refs", 3)
unless eval { weaken($ref) };
is isweak($ref), 1, "is weakened";
is sv_refcount($sv), 2, "weakened sv_refcount";
is weak_refcount($sv), 1, "weak_refcount";
is refcount(\$sv), 3, "weakened refcount";
}
{
use strict;
my $sv= "Foo";
my $iv= 100;
my $nv= 1.234;
my $dbl= 1e40;
my %hash= (100 => 1, 1.234 => 1, 1e40 => 1);
( run in 0.757 second using v1.01-cache-2.11-cpan-65fba6d93b7 )