initial import of Devel-Size 0.01 from CPAN
Dan Sugalski [Tue, 8 Oct 2002 06:23:43 +0000 (22:23 -0800)]
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

Changes [new file with mode: 0644]
MANIFEST [new file with mode: 0644]
Makefile.PL [new file with mode: 0644]
Size.pm [new file with mode: 0644]
Size.xs [new file with mode: 0644]
test.pl [new file with mode: 0644]

diff --git a/Changes b/Changes
new file mode 100644 (file)
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 (file)
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 (file)
index 0000000..6426fb2
--- /dev/null
@@ -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 (file)
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<not> 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 (file)
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 (file)
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):
+