From: Dan Sugalski Date: Tue, 8 Oct 2002 06:23:43 +0000 (-0800) Subject: initial import of Devel-Size 0.01 from CPAN X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit%2FDevel-Size.git;a=commitdiff_plain;h=e98cedbf047eed9826efbdbd3a723bb1391ee3fb initial import of Devel-Size 0.01 from CPAN git-cpan-module: Devel-Size git-cpan-version: 0.01 git-cpan-authorid: DSUGAL git-cpan-file: authors/id/D/DS/DSUGAL/Devel-Size-0.01.tar.gz --- e98cedbf047eed9826efbdbd3a723bb1391ee3fb diff --git a/Changes b/Changes new file mode 100644 index 0000000..ff4837b --- /dev/null +++ b/Changes @@ -0,0 +1,6 @@ +Revision history for Perl extension Devel::Size. + +0.01 Mon Oct 7 01:05:32 2002 + - original version; created by h2xs 1.2 with options + -A -n Devel::Size + diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..3bca5f4 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,6 @@ +Changes +MANIFEST +Makefile.PL +Size.pm +Size.xs +test.pl diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..6426fb2 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,11 @@ +use ExtUtils::MakeMaker; +# See lib/ExtUtils/MakeMaker.pm for details of how to influence +# the contents of the Makefile that is written. +WriteMakefile( + 'NAME' => 'Devel::Size', + 'VERSION_FROM' => 'Size.pm', # finds $VERSION + 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1 + 'LIBS' => [''], # e.g., '-lm' + 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING' + 'INC' => '', # e.g., '-I/usr/include/other' +); diff --git a/Size.pm b/Size.pm new file mode 100644 index 0000000..7cc20db --- /dev/null +++ b/Size.pm @@ -0,0 +1,76 @@ +package Devel::Size; + +require 5.005_62; +use strict; +use warnings; + +require Exporter; +require DynaLoader; + +our @ISA = qw(Exporter DynaLoader); + +# Items to export into callers namespace by default. Note: do not export +# names by default without a very good reason. Use EXPORT_OK instead. +# Do not simply export all your public functions/methods/constants. + +# This allows declaration use Devel::Size ':all'; +# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK +# will save memory. +our %EXPORT_TAGS = ( 'all' => [ qw( + size +) ] ); + +our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); + +our @EXPORT = qw( + +); +our $VERSION = '0.01'; + +bootstrap Devel::Size $VERSION; + +# Preloaded methods go here. + +1; +__END__ +# Below is stub documentation for your module. You better edit it! + +=head1 NAME + +Devel::Size - Perl extension for finding the memory usage of perl variables + +=head1 SYNOPSIS + + use Devel::Size qw(size); + $size = size("abcde"); + $other_size = size(\@foo); + +=head1 DESCRIPTION + +This module figures out the real sizes of perl variables. Call it with +a reference to the variable you want the size of. If you pass in a +plain scalar it returns the size of that scalar. (Just be careful if +you're asking for the size of a reference, as it'll follow the +reference if you don't reference it first) + +=head2 EXPORT + +None by default. + +=head1 BUGS + +Only does plain scalars and arrays. No sizes for hashes, globs, code refs, or magic scalars. Yet. + +Also, this module currently only returns the size used by the variable +itself, E the contents of arrays or hashes, nor does it follow +references past one level. That's for later. + +=head1 AUTHOR + +Dan Sugalski dan@sidhe.org + +=head1 SEE ALSO + +perl(1). + +=cut diff --git a/Size.xs b/Size.xs new file mode 100644 index 0000000..d0e1f1e --- /dev/null +++ b/Size.xs @@ -0,0 +1,111 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +UV thing_size(SV *orig_thing) { + SV *thing = orig_thing; + UV total_size = sizeof(SV); + + /* If they passed us a reference then dereference it. This is the + only way we can check the sizes of arrays and hashes */ + if (SvOK(thing) && SvROK(thing)) { + thing = SvRV(thing); + } + + switch (SvTYPE(thing)) { + /* Is it undef? */ + case SVt_NULL: + break; + /* Just a plain integer. This will be differently sized depending + on whether purify's been compiled in */ + case SVt_IV: +#ifdef PURIFY + total_size += sizeof(sizeof(XPVIV)); +#else + total_size += sizeof(IV); +#endif + break; + /* Is it a float? Like the int, it depends on purify */ + case SVt_NV: +#ifdef PURIFY + total_size += sizeof(sizeof(XPVNV)); +#else + total_size += sizeof(NV); +#endif + break; + /* Is it a reference? */ + case SVt_RV: + total_size += sizeof(XRV); + break; + /* How about a plain string? In which case we need to add in how + much has been allocated */ + case SVt_PV: + total_size += sizeof(XPV); + total_size += SvLEN(thing); + break; + /* A string with an integer part? */ + case SVt_PVIV: + total_size += sizeof(XPVIV); + total_size += SvLEN(thing); + break; + /* A string with a float part? */ + case SVt_PVNV: + total_size += sizeof(XPVNV); + total_size += SvLEN(thing); + break; + case SVt_PVMG: + croak("Not yet"); + break; + case SVt_PVBM: + croak("Not yet"); + break; + case SVt_PVLV: + croak("Not yet"); + break; + /* How much space is dedicated to the array? Not counting the + elements in the array, mind, just the array itself */ + case SVt_PVAV: + total_size += sizeof(XPVAV); + /* Is there anything in the array? */ + if (AvMAX(thing) != -1) { + total_size += sizeof(SV *) * AvMAX(thing); + } + /* Add in the bits on the other side of the beginning */ + total_size += (sizeof(SV *) * (AvARRAY(thing) - AvALLOC(thing))); + /* Is there something hanging off the arylen element? */ + if (AvARYLEN(thing)) { + total_size += thing_size(AvARYLEN(thing)); + } + break; + case SVt_PVHV: + croak("Not yet"); + break; + case SVt_PVCV: + croak("Not yet"); + break; + case SVt_PVGV: + croak("Not yet"); + break; + case SVt_PVFM: + croak("Not yet"); + break; + case SVt_PVIO: + croak("Not yet"); + break; + default: + croak("Unknown variable type"); + } + return total_size; +} + + +MODULE = Devel::Size PACKAGE = Devel::Size + +UV +size(SV *orig_thing) +CODE: +{ + RETVAL = thing_size(orig_thing); +} +OUTPUT: + RETVAL diff --git a/test.pl b/test.pl new file mode 100644 index 0000000..b096f73 --- /dev/null +++ b/test.pl @@ -0,0 +1,20 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.pl' + +######################### We start with some black magic to print on failure. + +# Change 1..1 below to 1..last_test_to_print . +# (It may become useful if the test is moved to ./t subdirectory.) + +BEGIN { $| = 1; print "1..1\n"; } +END {print "not ok 1\n" unless $loaded;} +use Devel::Size; +$loaded = 1; +print "ok 1\n"; + +######################### End of black magic. + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): +