$xs .= ', &sv' if $params->{SV};
$xs .= ");\n";
+ # If anyone is insane enough to suggest a package name containing %
+ my $package_sprintf_safe = $package;
+ $package_sprintf_safe =~ s/%/%%/g;
+
$xs .= << "EOT";
/* Return 1 or 2 items. First is error message, or undef if no error.
Second, if present, is found value */
switch (type) {
case PERL_constant_NOTFOUND:
- sv = sv_2mortal(newSVpvf("%s is not a valid $package macro", s));
+ sv =
+ sv_2mortal(newSVpvf("%s is not a valid $package_sprintf_safe macro", s));
PUSHs(sv);
break;
case PERL_constant_NOTDEF:
sv = sv_2mortal(newSVpvf(
- "Your vendor has not defined $package macro %s, used", s));
+ "Your vendor has not defined $package_sprintf_safe macro %s, used",
+ s));
PUSHs(sv);
break;
EOT
$xs .= << "EOT";
default:
sv = sv_2mortal(newSVpvf(
- "Unexpected return type %d while processing $package macro %s, used",
+ "Unexpected return type %d while processing $package_sprintf_safe macro %s, used",
type, s));
PUSHs(sv);
}
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
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
croak "Module name not specified" unless length $ARGS{NAME};
- my ($c_fh, $xs_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();
- $xs_fh = FileHandle->new();
+ 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}: $!";
}
- open $c_fh, ">$ARGS{C_FILE}" or die "Can't open $ARGS{C_FILE}: $!";
- 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
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}});
+ $ARGS{C_FH} = $c_fh;
+ $ARGS{XS_FH} = $xs_fh;
+ ExtUtils::Constant::ProxySubs->WriteConstants(%ARGS);
} else {
my $types = {};
$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;