1
2# The original notice of B::Size:
3# B::TerseSize.pm
4# Copyright (c) 1999-2000 Doug MacEachern. All rights reserved.
5# This module is free software; you can redistribute and/or modify
6# it under the same terms as Perl itself.
7
8package B::Size2;
9
10use strict;
11use warnings;
12use XSLoader ();
13use B ();
14
15BEGIN {
16    our $VERSION = '2.07';
17
18    XSLoader::load(__PACKAGE__, $VERSION);
19}
20
21{
22    no warnings qw (redefine prototype);
23    *B::OP::size   = \&B::Sizeof::OP;
24    *B::UNOP::size = \&B::Sizeof::UNOP;
25}
26
27use constant _CHECK_SVPAD_OUR_FOR_MAGIC => $] < 5.016;
28
29use constant _SVpad_NAME => 0x40000000; # sv.h
30use constant _SVpad_OUR  => 0x00040000; # sv.h
31
32sub _SvPAD_OUR { # see SvPAD_OUR()@sv.h
33    my($sv) = @_;
34    return ($sv->FLAGS() & _SVpad_NAME|_SVpad_OUR) == (_SVpad_NAME|_SVpad_OUR);
35}
36
37sub B::SVOP::size {
38    my($op) = @_;
39    if ($op->desc eq 'constant array element') { # aelemfast
40        return B::Sizeof::SVOP;
41    }
42    else {
43        return B::Sizeof::SVOP + $op->sv->size;
44    }
45}
46
47sub B::GVOP::size {
48    my $op = shift;
49    B::Sizeof::GVOP; #XXX more to measure?
50}
51
52sub B::PVOP::size {
53    B::Sizeof::PVOP + length(shift->pv);
54}
55
56*B::BINOP::size  = \&B::Sizeof::BINOP;
57*B::LOGOP::size  = \&B::Sizeof::LOGOP;
58*B::LISTOP::size = \&B::Sizeof::LISTOP;
59
60sub B::PMOP::size {
61    my $op = shift;
62    my $size = B::Sizeof::PMOP + B::Sizeof::REGEXP;
63    $size += $op->REGEXP_size;
64}
65
66sub B::PV::size {
67    my $sv = shift;
68    B::Sizeof::SV + B::Sizeof::XPV + $sv->LEN;
69}
70
71sub B::IV::size {
72    B::Sizeof::SV + B::Sizeof::XPVIV;
73}
74
75sub B::NV::size {
76    B::Sizeof::SV + B::Sizeof::XPVNV;
77}
78
79sub B::PVIV::size {
80    my $sv = shift;
81    B::IV::size + $sv->LEN;
82}
83
84sub B::PVNV::size {
85    my $sv = shift;
86    B::NV::size + $sv->LEN;
87}
88
89sub B::PVLV::size {
90    my $sv = shift;
91    B::Sizeof::SV + B::Sizeof::XPVLV +
92    B::Sizeof::MAGIC + $sv->LEN;
93}
94
95sub B::PVMG::size {
96    my $sv = shift;
97    my $size = B::Sizeof::SV + B::Sizeof::XPVMG;
98
99    if (_CHECK_SVPAD_OUR_FOR_MAGIC && !_SvPAD_OUR($sv)){
100        my(@chain) = $sv->MAGIC;
101        for my $mg (@chain) {
102            $size += B::Sizeof::MAGIC + $mg->LENGTH;
103        }
104    }
105    if (defined(my $tied = tied(${ $sv->object_2svref }))) {
106        return $size + B::svref_2object($tied)->size;
107    }
108    $size;
109}
110
111sub B::AV::size {
112    my $sv = shift;
113    my $size = B::Sizeof::AV + B::Sizeof::XPVAV;
114    if (defined(my $tied = tied(@{ $sv->object_2svref }))) {
115        return $size + B::svref_2object($tied)->size;
116    }
117    my @vals = $sv->ARRAY;
118    for (my $i = 0; $i <= $sv->MAX; $i++) {
119        my $sizecv = $vals[$i]->can('size') if $vals[$i];
120        $size += $sizecv ? $sizecv->($vals[$i]) : B::Sizeof::SV;
121    }
122    $size;
123}
124
125sub B::HV::size {
126    my $sv = shift;
127    my $size = B::Sizeof::HV + B::Sizeof::XPVHV;
128    #$size += length($sv->NAME);
129
130    if (defined(my $tied = tied(%{ $sv->object_2svref }))) {
131        return $size + B::svref_2object($tied)->size;
132    }
133
134    $size += ($sv->MAX * (B::Sizeof::HE + B::Sizeof::HEK));
135
136    my %vals = $sv->ARRAY;
137    while (my($k,$v) = each %vals) {
138        $size += length($k) + $v->size;
139    }
140
141    $size;
142}
143
144sub B::RV::size {
145    B::Sizeof::SV + B::Sizeof::XRV();
146}
147
148sub B::CV::size {
149    B::Sizeof::SV + B::Sizeof::XPVCV + 0000; #__ANON__
150}
151
152sub B::BM::size {
153    my $sv = shift;
154    B::Sizeof::SV + B::Sizeof::XPVBM() + $sv->LEN;
155}
156
157sub B::FM::size {
158    B::Sizeof::SV + B::Sizeof::XPVFM;
159}
160
161sub B::IO::size {
162    B::Sizeof::SV + B::Sizeof::XPVIO;
163}
164
165sub B::SPECIAL::size {
166    B::Sizeof::SV + 0; #?
167}
168
169sub B::NULL::size {
170    B::Sizeof::SV + 0; #?
171}
172
173sub B::SPECIAL::PV {
174    my $sv = shift;
175    $B::specialsv_name[$$sv];
176}
177
178sub B::RV::sizeval {
179    my $sv = shift;
180    sprintf "0x%lx", $$sv;
181}
182
183sub B::PV::sizeval {
184    my $sv = shift;
185    my $pv = $sv->PV;
186    escape_html(\$pv) if $ENV{MOD_PERL};
187    $pv;
188}
189
190sub B::AV::sizeval {
191    "MAX => " . shift->MAX;
192}
193
194sub B::HV::sizeval {
195    "MAX => " . shift->MAX;
196}
197
198sub B::IV::sizeval {
199    my($sv) = @_;
200    return $sv->FLAGS & (B::SVf_IOK|B::SVp_IOK)
201        ? $sv->IV
202        : B::NULL::sizeval($sv);
203}
204
205sub B::NV::sizeval {
206    my($sv) = @_;
207    return $sv->FLAGS & (B::SVf_NOK|B::SVp_NOK)
208        ? $sv->NV
209        : B::NULL::sizeval($sv);
210}
211
212sub B::NULL::sizeval {
213    my $sv = shift;
214    sprintf "0x%lx", $$sv;
215}
216
217sub B::SPECIAL::sizeval {
218    my $sv = shift;
219    sprintf "0x%lx", $$sv;
220}
221
222sub B::SPECIAL::FLAGS {
223    0;
224}
225
226sub B::NULL::FLAGS {
227    0;
228}
229
230sub B::CV::is_alias {
231    my($cv, $package) = @_;
232    my $stash  = $cv->GV->STASH->NAME;
233    if($package ne $stash) {
234    my $name = $cv->GV->NAME;
235    #print "$package\::$name aliased to $stash\::$name\n";
236    return $stash;
237    }
238    0;
239}
240
241sub B::Size::SV_size {
242    B::svref_2object(shift)->size;
243}
244
245#bleh
246my %esc = (
247   '&' => 'amp',
248   '>' => 'gt',
249   '<' => 'lt',
250   '"' => 'quot',
251);
252
253my $esc = join '', keys %esc;
254
255sub escape_html {
256    my $str = shift;
257    $$str =~ s/([$esc])/&$esc{$1};/g if $$str;
258}
259
2601;
261__END__
262
263=head1 NAME
264
265B::Size2 - Measure size of Perl OPs and SVs
266
267=head1 SYNOPSIS
268
269  use B ();
270  use B::Size2 ();
271
272  say B::svref_2object($value)->size;
273
274=head1 DESCRIPTION
275
276I<< B::Size2 is a fork of B::Size 0.09 for maintainance >>.
277
278=head1 SEE ALSO
279
280L<B::Size2::Terse>
281
282L<B::Size> - the original version but no longer maintained
283
284=head1 AUTHORS
285
286Fuji, Goro (gfx) E<lt>gfuji@cpan.orgE<gt>
287
288=head1 ORIGINAL AUTHORS
289
290Doug MacEachern
291
292=cut
293