Add method macro_from_item to encapsulate the entire logic for getting
[p5sagit/p5-mst-13.2.git] / lib / ExtUtils / Constant.pm
index 00f5b42..46021b0 100644 (file)
@@ -1,6 +1,6 @@
 package ExtUtils::Constant;
 use vars qw (@ISA $VERSION @EXPORT_OK %EXPORT_TAGS);
-$VERSION = 0.16;
+$VERSION = 0.20;
 
 =head1 NAME
 
@@ -432,6 +432,11 @@ for each group with this number or more names in.
 An array of constants' names, either scalars containing names, or hashrefs
 as detailed in L<"C_constant">.
 
+=item C_FH
+
+A filehandle to write the C code to.  If not given, then I<C_FILE> is opened
+for writing.
+
 =item C_FILE
 
 The name of the file to write containing the C code.  The default is
@@ -440,6 +445,11 @@ mistaken for anything related to a legitimate perl package name, and
 not naming the file C<.c> avoids having to override Makefile.PL's
 C<.xs> to C<.c> rules.
 
+=item XS_FH
+
+A filehandle to write the XS code to.  If not given, then I<XS_FILE> is opened
+for writing.
+
 =item XS_FILE
 
 The name of the file to write containing the XS code.  The default is
@@ -474,32 +484,69 @@ sub WriteConstants {
 
   croak "Module name not specified" unless length $ARGS{NAME};
 
-  open my $c_fh, ">$ARGS{C_FILE}" or die "Can't open $ARGS{C_FILE}: $!";
-  open my $xs_fh, ">$ARGS{XS_FILE}" or die "Can't open $ARGS{XS_FILE}: $!";
+  my $c_fh = $ARGS{C_FH};
+  if (!$c_fh) {
+      if ($] <= 5.008) {
+         # We need these little games, rather than doing things
+         # unconditionally, because we're used in core Makefile.PLs before
+         # IO is available (needed by filehandle), but also we want to work on
+         # older perls where undefined scalars do not automatically turn into
+         # anonymous file handles.
+         require FileHandle;
+         $c_fh = FileHandle->new();
+      }
+      open $c_fh, ">$ARGS{C_FILE}" or die "Can't open $ARGS{C_FILE}: $!";
+  }
+
+  my $xs_fh = $ARGS{XS_FH};
+  if (!$xs_fh) {
+      if ($] <= 5.008) {
+         require FileHandle;
+         $xs_fh = FileHandle->new();
+      }
+      open $xs_fh, ">$ARGS{XS_FILE}" or die "Can't open $ARGS{XS_FILE}: $!";
+  }
 
   # As this subroutine is intended to make code that isn't edited, there's no
   # need for the user to specify any types that aren't found in the list of
   # names.
-  my $types = {};
-
-  print $c_fh constant_types(); # macro defs
-  print $c_fh "\n";
-
-  # indent is still undef. Until anyone implements indent style rules with it.
-  foreach (ExtUtils::Constant::XS->C_constant({package => $ARGS{NAME},
-                                              subname => $ARGS{C_SUBNAME},
-                                              default_type =>
-                                              $ARGS{DEFAULT_TYPE},
-                                              types => $types,
-                                              breakout => $ARGS{BREAKOUT_AT}},
-                                              @{$ARGS{NAMES}})) {
-    print $c_fh $_, "\n"; # C constant subs
+  
+  if ($ARGS{PROXYSUBS}) {
+      require ExtUtils::Constant::ProxySubs;
+      ExtUtils::Constant::ProxySubs->WriteConstants({c_fh => $c_fh,
+                                                    xs_fh => $xs_fh,
+                                                    package => $ARGS{NAME},
+                                                    c_subname
+                                                    => $ARGS{C_SUBNAME},
+                                                    xs_subname
+                                                    => $ARGS{XS_SUBNAME},
+                                                    default_type
+                                                    => $ARGS{DEFAULT_TYPE},
+                                                   }, @{$ARGS{NAMES}});
+  } else {
+      my $types = {};
+
+      print $c_fh constant_types(); # macro defs
+      print $c_fh "\n";
+
+      # indent is still undef. Until anyone implements indent style rules with
+      # it.
+      foreach (ExtUtils::Constant::XS->C_constant({package => $ARGS{NAME},
+                                                  subname => $ARGS{C_SUBNAME},
+                                                  default_type =>
+                                                      $ARGS{DEFAULT_TYPE},
+                                                      types => $types,
+                                                      breakout =>
+                                                      $ARGS{BREAKOUT_AT}},
+                                                 @{$ARGS{NAMES}})) {
+         print $c_fh $_, "\n"; # C constant subs
+      }
+      print $xs_fh XS_constant ($ARGS{NAME}, $types, $ARGS{XS_SUBNAME},
+                               $ARGS{C_SUBNAME});
   }
-  print $xs_fh XS_constant ($ARGS{NAME}, $types, $ARGS{XS_SUBNAME},
-                            $ARGS{C_SUBNAME});
 
-  close $c_fh or warn "Error closing $ARGS{C_FILE}: $!";
-  close $xs_fh or warn "Error closing $ARGS{XS_FILE}: $!";
+  close $c_fh or warn "Error closing $ARGS{C_FILE}: $!" unless $ARGS{C_FH};
+  close $xs_fh or warn "Error closing $ARGS{XS_FILE}: $!" unless $ARGS{XS_FH};
 }
 
 1;