Mailing List Archive

Yet another patch for xsubpp. Assumes you have xsubpp 1.926

This one adds the INCLUDE: keyword requested by a few people.

The format can take any of the following formas:

INCLUDE: filename
INCLUDE: "filename"
INCLUDE: 'filename'
INCLUDE: command |
INCLUDE: "command |"
INCLUDE: 'command |'



Paul

*** xsubpp-1.926 Wed Dec 20 21:09:12 1995
--- xsubpp Thu Dec 21 12:24:42 1995
***************
*** 76,84 ****
=cut

# Global Constants
! $XSUBPP_version = "1.926";
require 5.002;

$usage = "Usage: xsubpp [-v] [-C++] [-except] [-prototypes] [-noversioncheck] [-s pattern] [-typemap typemap]... file.xs\n";

$proto_re = "[" . quotemeta('\$%&*@;') . "]" ;
--- 76,89 ----
=cut

# Global Constants
! $XSUBPP_version = "1.927";
require 5.002;

+ sub Q ;
+
+ $FH_string = 'File0000' ;
+ *FH = $FH_string ;
+
$usage = "Usage: xsubpp [-v] [-C++] [-except] [-prototypes] [-noversioncheck] [-s pattern] [-typemap typemap]... file.xs\n";

$proto_re = "[" . quotemeta('\$%&*@;') . "]" ;
***************
*** 117,122 ****
--- 122,129 ----
or ($dir, $filename) = ('.', $ARGV[0]);
chdir($dir);

+ ++ $IncludedFiles{$ARGV[0]} ;
+
sub TrimWhitespace
{
$_[0] =~ s/^\s+|\s+$//go ;
***************
*** 203,209 ****
# Match an XS keyword
$BLOCK_re= '\s*(' . join('|', qw(
REQUIRE BOOT CASE PREINIT INPUT INIT CODE PPCODE OUTPUT
! CLEANUP ALIAS PROTOTYPES PROTOTYPE VERSIONCHECK
)) . "|$END)\\s*:";

# Input: ($_, @line) == unparsed input.
--- 210,216 ----
# Match an XS keyword
$BLOCK_re= '\s*(' . join('|', qw(
REQUIRE BOOT CASE PREINIT INPUT INIT CODE PPCODE OUTPUT
! CLEANUP ALIAS PROTOTYPES PROTOTYPE VERSIONCHECK INCLUDE
)) . "|$END)\\s*:";

# Input: ($_, @line) == unparsed input.
***************
*** 421,426 ****
--- 428,519 ----

}

+ sub INCLUDE_handler ()
+ {
+ # the rest of the current line should contain a valid filename
+
+ TrimWhitespace($_) ;
+
+ # If the filename is enclosed in quotes, remove them.
+ s/^'([^']*)'$/$1/ or s/^"([^"]*)"$/$1/ ;
+
+ death("INCLUDE: filename missing")
+ unless $_ ;
+
+ death("INCLUDE: output pipe is illegal")
+ if /^\s*\|/ ;
+
+ # simple minded recursion detector
+ death("INCLUDE loop detected")
+ if $IncludedFiles{$_} ;
+
+ ++ $IncludedFiles{$_} unless /\|\s*$/ ;
+
+ # Save the current file context.
+ push(@FileStack, {
+ LastLine => $lastline,
+ LastLineNo => $lastline_no,
+ Line => \@line,
+ LineNo => \@line_no,
+ Filename => $filename,
+ Handle => $FH_string,
+ }) ;
+
+ ++ $FH_string ;
+
+ # open the new file
+ open ($FH_string, "$_") or death("Cannot open '$_': $!") ;
+
+ print Q<<"EOF" ;
+ #
+ #/* INCLUDE: Including '$_' from '$filename' */
+ #
+ EOF
+
+ *FH = $FH_string ;
+ $filename = $_ ;
+
+ # Prime the pump by reading the first line
+ $lastline = <FH> ;
+ $lastline_no = $. ;
+
+ }
+
+ sub PopFile()
+ {
+ return 0 unless @FileStack ;
+
+ my $data = pop @FileStack ;
+ my $ThisFile = $filename ;
+ my $isPipe = ($filename =~ /\|\s*$/) ;
+
+ -- $IncludedFiles{$filename}
+ unless $isPipe ;
+
+ close FH ;
+
+ *FH = $data->{Handle} ;
+ $filename = $data->{Filename} ;
+ $lastline = $data->{LastLine} ;
+ $lastline_no = $data->{LastLineNo} ;
+ @line = @{ $data->{Line} } ;
+ @line_no = @{ $data->{LineNo} } ;
+
+ if ($isPipe and $? ) {
+ -- $lastline_no ;
+ print STDERR "Error reading from pipe '$ThisFile': $! in $filename, line $lastline_no\n" ;
+ exit 1 ;
+ }
+
+ print Q<<"EOF" ;
+ #
+ #/* INCLUDE: Returning to '$filename' from '$ThisFile' */
+ #
+ EOF
+
+ return 1 ;
+ }
+
sub ValidProtoString ($)
{
my($string) = @_ ;
***************
*** 474,480 ****
$text;
}

! open(F, $filename) or die "cannot open $filename: $!\n";

# Identify the version of xsubpp used
print <<EOM ;
--- 567,573 ----
$text;
}

! open(FH, $filename) or die "cannot open $filename: $!\n";

# Identify the version of xsubpp used
print <<EOM ;
***************
*** 489,495 ****
EOM


! while (<F>) {
last if ($Module, $Package, $Prefix) =
/^MODULE\s*=\s*([\w:]+)(?:\s+PACKAGE\s*=\s*([\w:]+))?(?:\s+PREFIX\s*=\s*(\S+))?\s*$/;
print $_;
--- 582,588 ----
EOM


! while (<FH>) {
last if ($Module, $Package, $Prefix) =
/^MODULE\s*=\s*([\w:]+)(?:\s+PACKAGE\s*=\s*([\w:]+))?(?:\s+PREFIX\s*=\s*(\S+))?\s*$/;
print $_;
***************
*** 504,509 ****
--- 597,603 ----
#define XS_VERSION VERSION
#endif
#endif
+
EOM

my $lastline = $_;
***************
*** 515,521 ****
# parse paragraph
@line = ();
@line_no = () ;
! return 0 unless defined $lastline;

if ($lastline =~
/^MODULE\s*=\s*([\w:]+)(?:\s+PACKAGE\s*=\s*([\w:]+))?(?:\s+PREFIX\s*=\s*(\S+))?\s*$/) {
--- 609,618 ----
# parse paragraph
@line = ();
@line_no = () ;
! if (! defined $lastline) {
! return 1 if PopFile() ;
! return 0 ;
! }

if ($lastline =~
/^MODULE\s*=\s*([\w:]+)(?:\s+PACKAGE\s*=\s*([\w:]+))?(?:\s+PREFIX\s*=\s*(\S+))?\s*$/) {
***************
*** 538,544 ****
}

# Read next line and continuation lines
! last unless defined($lastline = <F>);
$lastline_no = $.;
my $tmp_line;
$lastline .= $tmp_line
--- 635,641 ----
}

# Read next line and continuation lines
! last unless defined($lastline = <FH>);
$lastline_no = $.;
my $tmp_line;
$lastline .= $tmp_line
***************
*** 576,588 ****
$ProtoThisXSUB = $WantPrototypes ;

$_ = shift(@line);
! while ($kwd = check_keyword("REQUIRE|PROTOTYPES|VERSIONCHECK")) {
! if ($kwd eq 'REQUIRE')
! { REQUIRE_handler() }
! elsif ($pwd eq 'PROTOTYPES')
! { PROTOTYPES_handler() }
! else
! { VERSIONCHECK_handler() }
next PARAGRAPH unless @line ;
$_ = shift(@line);
}
--- 673,680 ----
$ProtoThisXSUB = $WantPrototypes ;

$_ = shift(@line);
! while ($kwd = check_keyword("REQUIRE|PROTOTYPES|VERSIONCHECK|INCLUDE")) {
! &{"${kwd}_handler"}() ;
next PARAGRAPH unless @line ;
$_ = shift(@line);
}