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