DDumper.xs

   1 /*  Copyright (c) 2007-2008 H.Merijn Brand.  All rights reserved.
   2  *  This program is free software; you can redistribute it and/or
   3  *  modify it under the same terms as Perl itself.
   4  */
   5
   6 #include <EXTERN.h>
   7 #include <perl.h>
   8 #include <XSUB.h>
   9 #include "ppport.h"
  10
  11 SV *_DDump (SV *sv)
  12 {
  13     int   err[3], n;
  14     char  buf[128];
  15     SV   *dd;
  16     dTHX;
  17
  18     if (pipe (err)) return (NULL);
  19
  20     dd = sv_newmortal ();
  21     err[2] = dup (2);
  22     close (2);
  23     if (dup (err[1]) == 2)
  24         Perl_sv_dump (aTHX_ sv);
  25     close (err[1]);
  26     close (2);
  27     err[1] = dup (err[2]);
  28     close (err[2]);
  29
  30     Perl_sv_setpvn (aTHX_ dd, "", 0);
  31     while ((n = read (err[0], buf, 128)) > 0)
  32 #if PERL_VERSION >= 8
  33         /* perl 5.8.0 did not export Perl_sv_catpvn */
  34         Perl_sv_catpvn_flags (aTHX_ dd, buf, n, SV_GMAGIC);
  35 #else
  36         Perl_sv_catpvn       (aTHX_ dd, buf, n);
  37 #endif
  38     return (dd);
  39     } /* _DDump */
  40
  41 MODULE = DDumper                PACKAGE = DDumper
  42
  43 PROTOTYPES: DISABLE
  44
  45 void
  46 DPeek (sv)
  47     SV   *sv
  48
  49   PPCODE:
  50     ST (0) = newSVpv (Perl_sv_peek (aTHX_ sv), 0);
  51     XSRETURN (1);
  52     /* XS DPeek */
  53
  54 void
  55 DDump_XS (sv)
  56     SV   *sv
  57
  58   PPCODE:
  59     SV   *dd = _DDump (sv);
  60
  61     if (dd) {
  62         ST (0) = dd;
  63         XSRETURN (1);
  64         }
  65
  66     XSRETURN (0);
  67     /* XS DDump */
  68
  69 #if PERL_VERSION >= 8
  70
  71 void
  72 DDump_IO (io, sv, level)
  73     PerlIO *io
  74     SV     *sv
  75     IV      level
  76
  77   PPCODE:
  78     Perl_do_sv_dump (aTHX_ 0, io, sv, 1, level, 1, 0);
  79     XSRETURN (1);
  80     /* XS DDump */
  81
  82 #endif