# creates a C API file from proto.h
# takes one argument, the path to lib/CORE directory.
-# creates 2 files: "PerlCAPI.cpp" and "PerlCAPI.h".
+# creates 2 files: "perlCAPI.cpp" and "perlCAPI.h".
-my $hdrfile = "$ARGV[0]\\PerlCAPI.h";
+my $hdrfile = "$ARGV[0]\\perlCAPI.h";
my $infile = '..\\proto.h';
my $embedfile = '..\\embed.h';
my $separateObj = 0;
return 1;
}
-if (!open(OUTFILE, ">PerlCAPI.cpp")) {
- print "open of PerlCAPI.cpp failed: $!\n";
+if (!open(OUTFILE, ">perlCAPI.cpp")) {
+ print "open of perlCAPI.cpp failed: $!\n";
return 1;
}
@args = split(',', $args);
if ($args[$#args] =~ /\s*\.\.\.\s*/) {
if(($name eq "croak") or ($name eq "deb") or ($name eq "die")
- or ($name eq "form") or ($name eq "warn")) {
+ or ($name eq "form") or ($name eq "warn")
+ or ($name eq "warner")) {
print OUTFILE "\n#ifdef $name" . "_defined" unless ($separateObj == 0);
- $args[0] =~ /(\w+)\W*$/;
- $arg = $1;
+ for (@args) { $_ = $1 if /(\w+)\W*$/; }
+ $arg = $args[$#args-1];
+ my $start = '';
+ $start = join(', ',@args[0 .. ($#args - 2)]) if @args > 2;
+ $start .= ', ' if $start;
print OUTFILE <<ENDCODE;
#undef $name
pmsg = pPerl->Perl_mess($arg, &args);
New(0, pstr, strlen(pmsg)+1, char);
strcpy(pstr, pmsg);
-$return pPerl->Perl_$name(pstr);
+$return pPerl->Perl_$name($start pstr);
va_end(args);
}
ENDCODE
ENDCODE
print OUTFILE "#endif\n" unless ($separateObj == 0);
}
+ elsif($name eq "sv_catpvf_mg") {
+ print OUTFILE "\n#ifdef $name" . "_defined" unless ($separateObj == 0);
+ $args[0] =~ /(\w+)\W*$/;
+ $arg0 = $1;
+ $args[1] =~ /(\w+)\W*$/;
+ $arg1 = $1;
+ print OUTFILE <<ENDCODE;
+
+#undef $name
+#ifndef mg_set
+#define mg_set pPerl->Perl_mg_set
+#endif
+extern "C" $type $funcName ($args)
+{
+ va_list args;
+ va_start(args, $arg1);
+ pPerl->Perl_sv_vcatpvfn($arg0, $arg1, strlen($arg1), &args, NULL, 0, NULL);
+ va_end(args);
+ SvSETMAGIC(sv);
+}
+ENDCODE
+ print OUTFILE "#endif\n" unless ($separateObj == 0);
+ }
elsif($name eq "sv_setpvf") {
print OUTFILE "\n#ifdef $name" . "_defined" unless ($separateObj == 0);
$args[0] =~ /(\w+)\W*$/;
ENDCODE
print OUTFILE "#endif\n" unless ($separateObj == 0);
}
+ elsif($name eq "sv_setpvf_mg") {
+ print OUTFILE "\n#ifdef $name" . "_defined" unless ($separateObj == 0);
+ $args[0] =~ /(\w+)\W*$/;
+ $arg0 = $1;
+ $args[1] =~ /(\w+)\W*$/;
+ $arg1 = $1;
+ print OUTFILE <<ENDCODE;
+
+#undef $name
+#ifndef mg_set
+#define mg_set pPerl->Perl_mg_set
+#endif
+extern "C" $type $funcName ($args)
+{
+ va_list args;
+ va_start(args, $arg1);
+ pPerl->Perl_sv_vsetpvfn($arg0, $arg1, strlen($arg1), &args, NULL, 0, NULL);
+ va_end(args);
+ SvSETMAGIC(sv);
+}
+ENDCODE
+ print OUTFILE "#endif\n" unless ($separateObj == 0);
+ }
elsif($name eq "fprintf") {
print OUTFILE "\n#ifdef $name" . "_defined" unless ($separateObj == 0);
$args[0] =~ /(\w+)\W*$/;