From: Nicholas Clark <nick@ccl4.org>
Date: Fri, 23 Dec 2005 12:21:19 +0000 (+0000)
Subject: Add support for PV to ExtUtils::Constant::ProxySubs, and enable its
X-Git-Tag: perl-5.9.3~353
X-Git-Url: https://perl5.git.perl.org/perl5.git/commitdiff_plain/49657794b700c5b56b92eaf38a24c952564ee7db

Add support for PV to ExtUtils::Constant::ProxySubs, and enable its
use in Sys::Syslog

p4raw-id: //depot/perl@26472
---

diff --git a/ext/Sys/Syslog/Makefile.PL b/ext/Sys/Syslog/Makefile.PL
index 82f649d..3a25d3f 100644
--- a/ext/Sys/Syslog/Makefile.PL
+++ b/ext/Sys/Syslog/Makefile.PL
@@ -45,6 +45,7 @@ if(eval {require ExtUtils::Constant; 1}) {
     );
 
     ExtUtils::Constant::WriteConstants(
+        ($] > 5.0090002 ? (PROXYSUBS => 1) : ()),
         NAME => 'Sys::Syslog',
         NAMES => \@names,
     );
diff --git a/lib/ExtUtils/Constant/ProxySubs.pm b/lib/ExtUtils/Constant/ProxySubs.pm
index b69c14e..06712b9 100644
--- a/lib/ExtUtils/Constant/ProxySubs.pm
+++ b/lib/ExtUtils/Constant/ProxySubs.pm
@@ -17,6 +17,7 @@ $VERSION = '0.01';
      IV => '{const char *name; I32 namelen; IV value;}',
      NV => '{const char *name; I32 namelen; NV value;}',
      UV => '{const char *name; I32 namelen; UV value;}',
+     PV => '{const char *name; I32 namelen; const char *value;}',
      YES => '{const char *name; I32 namelen;}',
      NO => '{const char *name; I32 namelen;}',
      '' => '{const char *name; I32 namelen;} ',
@@ -27,6 +28,7 @@ $VERSION = '0.01';
      IV => sub { $_[0] . '->value' },
      NV => sub { $_[0] . '->value' },
      UV => sub { $_[0] . '->value' },
+     PV => sub { $_[0] . '->value' },
      YES => sub {},
      NO => sub {},
      '' => sub {},
@@ -37,6 +39,7 @@ $VERSION = '0.01';
      IV => sub { "newSViv($_[0])" },
      NV => sub { "newSVnv($_[0])" },
      UV => sub { "newSVuv($_[0])" },
+     PV => sub { "newSVpv($_[0], 0)" },
      YES => sub { '&PL_sv_yes' },
      NO => sub { '&PL_sv_no' },
      '' => sub { '&PL_sv_yes' },
@@ -55,13 +58,20 @@ sub type_to_C_value {
     return $type_to_C_value{$type} || sub {return map {ref $_ ? @$_ : $_} @_};
 }
 
+# TODO - figure out if there is a clean way for the type_to_sv code to
+# attempt s/sv_2mortal// and if it succeeds tell type_to_sv not to add
+# SvREFCNT_inc
 %type_is_a_problem =
     (
      # The documentation says *mortal SV*, but we now need a non-mortal copy.
      SV => 1,
      );
 
-$type_temporary{SV} = 'SV *';
+%type_temporary =
+    (
+     SV => 'SV *',
+     PV => 'const char *',
+     );
 $type_temporary{$_} = $_ foreach qw(IV UV NV);
      
 while (my ($type, $value) = each %XS_TypeSet) {