Initial Commit

database/perl/lib/ExtUtils/ParseXS/Constants.pm

@@ -0,0 +1,44 @@
+package ExtUtils::ParseXS::Constants;
+use strict;
+use warnings;
+use Symbol;
+
+our $VERSION = '3.40';
+
+=head1 NAME
+
+ExtUtils::ParseXS::Constants - Initialization values for some globals
+
+=head1 SYNOPSIS
+
+  use ExtUtils::ParseXS::Constants ();
+
+  $PrototypeRegexp = $ExtUtils::ParseXS::Constants::PrototypeRegexp;
+
+=head1 DESCRIPTION
+
+Initialization of certain non-subroutine variables in ExtUtils::ParseXS and some of its
+supporting packages has been moved into this package so that those values can
+be defined exactly once and then re-used in any package.
+
+Nothing is exported.  Use fully qualified variable names.
+
+=cut
+
+# FIXME: THESE ARE NOT CONSTANTS!
+our @InitFileCode;
+
+# Note that to reduce maintenance, $PrototypeRegexp is used
+# by ExtUtils::Typemaps, too!
+our $PrototypeRegexp = "[" . quotemeta('\$%&*@;[]_') . "]";
+our @XSKeywords      = qw( 
+  REQUIRE BOOT CASE PREINIT INPUT INIT CODE PPCODE
+  OUTPUT CLEANUP ALIAS ATTRS PROTOTYPES PROTOTYPE
+  VERSIONCHECK INCLUDE INCLUDE_COMMAND SCOPE INTERFACE
+  INTERFACE_MACRO C_ARGS POSTCALL OVERLOAD FALLBACK
+  EXPORT_XSUB_SYMBOLS
+);
+
+our $XSKeywordsAlternation = join('|', @XSKeywords);
+
+1;

database/perl/lib/ExtUtils/ParseXS/CountLines.pm

@@ -0,0 +1,54 @@
+package ExtUtils::ParseXS::CountLines;
+use strict;
+
+our $VERSION = '3.40';
+
+our $SECTION_END_MARKER;
+
+sub TIEHANDLE {
+  my ($class, $cfile, $fh) = @_;
+  $cfile =~ s/\\/\\\\/g;
+  $cfile =~ s/"/\\"/g;
+  $SECTION_END_MARKER = qq{#line --- "$cfile"};
+
+  return bless {
+    buffer => '',
+    fh => $fh,
+    line_no => 1,
+  }, $class;
+}
+
+sub PRINT {
+  my $self = shift;
+  for (@_) {
+    $self->{buffer} .= $_;
+    while ($self->{buffer} =~ s/^([^\n]*\n)//) {
+      my $line = $1;
+      ++$self->{line_no};
+      $line =~ s|^\#line\s+---(?=\s)|#line $self->{line_no}|;
+      print {$self->{fh}} $line;
+    }
+  }
+}
+
+sub PRINTF {
+  my $self = shift;
+  my $fmt = shift;
+  $self->PRINT(sprintf($fmt, @_));
+}
+
+sub DESTROY {
+  # Not necessary if we're careful to end with a "\n"
+  my $self = shift;
+  print {$self->{fh}} $self->{buffer};
+}
+
+sub UNTIE {
+  # This sub does nothing, but is necessary for references to be released.
+}
+
+sub end_marker {
+  return $SECTION_END_MARKER;
+}
+
+1;

database/perl/lib/ExtUtils/ParseXS/Eval.pm

@@ -0,0 +1,97 @@
+package ExtUtils::ParseXS::Eval;
+use strict;
+use warnings;
+
+our $VERSION = '3.40';
+
+=head1 NAME
+
+ExtUtils::ParseXS::Eval - Clean package to evaluate code in
+
+=head1 SYNOPSIS
+
+  use ExtUtils::ParseXS::Eval;
+  my $rv = ExtUtils::ParseXS::Eval::eval_typemap_code(
+    $parsexs_obj, "some Perl code"
+  );
+
+=head1 SUBROUTINES
+
+=head2 $pxs->eval_output_typemap_code($typemapcode, $other_hashref)
+
+Sets up various bits of previously global state
+(formerly ExtUtils::ParseXS package variables)
+for eval'ing output typemap code that may refer to these
+variables.
+
+Warns the contents of C<$@> if any.
+
+Not all these variables are necessarily considered "public" wrt. use in
+typemaps, so beware. Variables set up from the ExtUtils::ParseXS object:
+
+  $Package $ALIAS $func_name $Full_func_name $pname
+
+Variables set up from C<$other_hashref>:
+
+  $var $type $ntype $subtype $arg
+
+=cut
+
+sub eval_output_typemap_code {
+  my ($_pxs, $_code, $_other) = @_;
+
+  my ($Package, $ALIAS, $func_name, $Full_func_name, $pname)
+    = @{$_pxs}{qw(Package ALIAS func_name Full_func_name pname)};
+
+  my ($var, $type, $ntype, $subtype, $arg)
+    = @{$_other}{qw(var type ntype subtype arg)};
+
+  my $rv = eval $_code;
+  warn $@ if $@;
+  return $rv;
+}
+
+=head2 $pxs->eval_input_typemap_code($typemapcode, $other_hashref)
+
+Sets up various bits of previously global state
+(formerly ExtUtils::ParseXS package variables)
+for eval'ing output typemap code that may refer to these
+variables.
+
+Warns the contents of C<$@> if any.
+
+Not all these variables are necessarily considered "public" wrt. use in
+typemaps, so beware. Variables set up from the ExtUtils::ParseXS object:
+
+  $Package $ALIAS $func_name $Full_func_name $pname
+
+Variables set up from C<$other_hashref>:
+
+  $var $type $ntype $subtype $num $init $printed_name $arg $argoff
+
+=cut
+
+sub eval_input_typemap_code {
+  my ($_pxs, $_code, $_other) = @_;
+
+  my ($Package, $ALIAS, $func_name, $Full_func_name, $pname)
+    = @{$_pxs}{qw(Package ALIAS func_name Full_func_name pname)};
+
+  my ($var, $type, $num, $init, $printed_name, $arg, $ntype, $argoff, $subtype)
+    = @{$_other}{qw(var type num init printed_name arg ntype argoff subtype)};
+
+  my $rv = eval $_code;
+  warn $@ if $@;
+  return $rv;
+}
+
+=head1 TODO
+
+Eventually, with better documentation and possible some cleanup,
+this could be part of C<ExtUtils::Typemaps>.
+
+=cut
+
+1;
+
+# vim: ts=2 sw=2 et:

database/perl/lib/ExtUtils/ParseXS/Utilities.pm

@@ -0,0 +1,821 @@
+package ExtUtils::ParseXS::Utilities;
+use strict;
+use warnings;
+use Exporter;
+use File::Spec;
+use ExtUtils::ParseXS::Constants ();
+
+our $VERSION = '3.40';
+
+our (@ISA, @EXPORT_OK);
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(
+  standard_typemap_locations
+  trim_whitespace
+  C_string
+  valid_proto_string
+  process_typemaps
+  map_type
+  standard_XS_defs
+  assign_func_args
+  analyze_preprocessor_statements
+  set_cond
+  Warn
+  current_line_number
+  blurt
+  death
+  check_conditional_preprocessor_statements
+  escape_file_for_line_directive
+  report_typemap_failure
+);
+
+=head1 NAME
+
+ExtUtils::ParseXS::Utilities - Subroutines used with ExtUtils::ParseXS
+
+=head1 SYNOPSIS
+
+  use ExtUtils::ParseXS::Utilities qw(
+    standard_typemap_locations
+    trim_whitespace
+    C_string
+    valid_proto_string
+    process_typemaps
+    map_type
+    standard_XS_defs
+    assign_func_args
+    analyze_preprocessor_statements
+    set_cond
+    Warn
+    blurt
+    death
+    check_conditional_preprocessor_statements
+    escape_file_for_line_directive
+    report_typemap_failure
+  );
+
+=head1 SUBROUTINES
+
+The following functions are not considered to be part of the public interface.
+They are documented here for the benefit of future maintainers of this module.
+
+=head2 C<standard_typemap_locations()>
+
+=over 4
+
+=item * Purpose
+
+Provide a list of filepaths where F<typemap> files may be found.  The
+filepaths -- relative paths to files (not just directory paths) -- appear in this list in lowest-to-highest priority.
+
+The highest priority is to look in the current directory.  
+
+  'typemap'
+
+The second and third highest priorities are to look in the parent of the
+current directory and a directory called F<lib/ExtUtils> underneath the parent
+directory.
+
+  '../typemap',
+  '../lib/ExtUtils/typemap',
+
+The fourth through ninth highest priorities are to look in the corresponding
+grandparent, great-grandparent and great-great-grandparent directories.
+
+  '../../typemap',
+  '../../lib/ExtUtils/typemap',
+  '../../../typemap',
+  '../../../lib/ExtUtils/typemap',
+  '../../../../typemap',
+  '../../../../lib/ExtUtils/typemap',
+
+The tenth and subsequent priorities are to look in directories named
+F<ExtUtils> which are subdirectories of directories found in C<@INC> --
+I<provided> a file named F<typemap> actually exists in such a directory.
+Example:
+
+  '/usr/local/lib/perl5/5.10.1/ExtUtils/typemap',
+
+However, these filepaths appear in the list returned by
+C<standard_typemap_locations()> in reverse order, I<i.e.>, lowest-to-highest.
+
+  '/usr/local/lib/perl5/5.10.1/ExtUtils/typemap',
+  '../../../../lib/ExtUtils/typemap',
+  '../../../../typemap',
+  '../../../lib/ExtUtils/typemap',
+  '../../../typemap',
+  '../../lib/ExtUtils/typemap',
+  '../../typemap',
+  '../lib/ExtUtils/typemap',
+  '../typemap',
+  'typemap'
+
+=item * Arguments
+
+  my @stl = standard_typemap_locations( \@INC );
+
+Reference to C<@INC>.
+
+=item * Return Value
+
+Array holding list of directories to be searched for F<typemap> files.
+
+=back
+
+=cut
+
+SCOPE: {
+  my @tm_template;
+
+  sub standard_typemap_locations {
+    my $include_ref = shift;
+
+    if (not @tm_template) {
+      @tm_template = qw(typemap);
+
+      my $updir = File::Spec->updir();
+      foreach my $dir (
+          File::Spec->catdir(($updir) x 1),
+          File::Spec->catdir(($updir) x 2),
+          File::Spec->catdir(($updir) x 3),
+          File::Spec->catdir(($updir) x 4),
+      ) {
+        unshift @tm_template, File::Spec->catfile($dir, 'typemap');
+        unshift @tm_template, File::Spec->catfile($dir, lib => ExtUtils => 'typemap');
+      }
+    }
+
+    my @tm = @tm_template;
+    foreach my $dir (@{ $include_ref}) {
+      my $file = File::Spec->catfile($dir, ExtUtils => 'typemap');
+      unshift @tm, $file if -e $file;
+    }
+    return @tm;
+  }
+} # end SCOPE
+
+=head2 C<trim_whitespace()>
+
+=over 4
+
+=item * Purpose
+
+Perform an in-place trimming of leading and trailing whitespace from the
+first argument provided to the function.
+
+=item * Argument
+
+  trim_whitespace($arg);
+
+=item * Return Value
+
+None.  Remember:  this is an I<in-place> modification of the argument.
+
+=back
+
+=cut
+
+sub trim_whitespace {
+  $_[0] =~ s/^\s+|\s+$//go;
+}
+
+=head2 C<C_string()>
+
+=over 4
+
+=item * Purpose
+
+Escape backslashes (C<\>) in prototype strings.
+
+=item * Arguments
+
+      $ProtoThisXSUB = C_string($_);
+
+String needing escaping.
+
+=item * Return Value
+
+Properly escaped string.
+
+=back
+
+=cut
+
+sub C_string {
+  my($string) = @_;
+
+  $string =~ s[\\][\\\\]g;
+  $string;
+}
+
+=head2 C<valid_proto_string()>
+
+=over 4
+
+=item * Purpose
+
+Validate prototype string.
+
+=item * Arguments
+
+String needing checking.
+
+=item * Return Value
+
+Upon success, returns the same string passed as argument.
+
+Upon failure, returns C<0>.
+
+=back
+
+=cut
+
+sub valid_proto_string {
+  my ($string) = @_;
+
+  if ( $string =~ /^$ExtUtils::ParseXS::Constants::PrototypeRegexp+$/ ) {
+    return $string;
+  }
+
+  return 0;
+}
+
+=head2 C<process_typemaps()>
+
+=over 4
+
+=item * Purpose
+
+Process all typemap files.
+
+=item * Arguments
+
+  my $typemaps_object = process_typemaps( $args{typemap}, $pwd );
+
+List of two elements:  C<typemap> element from C<%args>; current working
+directory.
+
+=item * Return Value
+
+Upon success, returns an L<ExtUtils::Typemaps> object.
+
+=back
+
+=cut
+
+sub process_typemaps {
+  my ($tmap, $pwd) = @_;
+
+  my @tm = ref $tmap ? @{$tmap} : ($tmap);
+
+  foreach my $typemap (@tm) {
+    die "Can't find $typemap in $pwd\n" unless -r $typemap;
+  }
+
+  push @tm, standard_typemap_locations( \@INC );
+
+  require ExtUtils::Typemaps;
+  my $typemap = ExtUtils::Typemaps->new;
+  foreach my $typemap_loc (@tm) {
+    next unless -f $typemap_loc;
+    # skip directories, binary files etc.
+    warn("Warning: ignoring non-text typemap file '$typemap_loc'\n"), next
+      unless -T $typemap_loc;
+
+    $typemap->merge(file => $typemap_loc, replace => 1);
+  }
+
+  return $typemap;
+}
+
+=head2 C<map_type()>
+
+=over 4
+
+=item * Purpose
+
+Performs a mapping at several places inside C<PARAGRAPH> loop.
+
+=item * Arguments
+
+  $type = map_type($self, $type, $varname);
+
+List of three arguments.
+
+=item * Return Value
+
+String holding augmented version of second argument.
+
+=back
+
+=cut
+
+sub map_type {
+  my ($self, $type, $varname) = @_;
+
+  # C++ has :: in types too so skip this
+  $type =~ tr/:/_/ unless $self->{RetainCplusplusHierarchicalTypes};
+  $type =~ s/^array\(([^,]*),(.*)\).*/$1 */s;
+  if ($varname) {
+    if ($type =~ / \( \s* \* (?= \s* \) ) /xg) {
+      (substr $type, pos $type, 0) = " $varname ";
+    }
+    else {
+      $type .= "\t$varname";
+    }
+  }
+  return $type;
+}
+
+=head2 C<standard_XS_defs()>
+
+=over 4
+
+=item * Purpose
+
+Writes to the C<.c> output file certain preprocessor directives and function
+headers needed in all such files.
+
+=item * Arguments
+
+None.
+
+=item * Return Value
+
+Returns true.
+
+=back
+
+=cut
+
+sub standard_XS_defs {
+  print <<"EOF";
+#ifndef PERL_UNUSED_VAR
+#  define PERL_UNUSED_VAR(var) if (0) var = var
+#endif
+
+#ifndef dVAR
+#  define dVAR		dNOOP
+#endif
+
+
+/* This stuff is not part of the API! You have been warned. */
+#ifndef PERL_VERSION_DECIMAL
+#  define PERL_VERSION_DECIMAL(r,v,s) (r*1000000 + v*1000 + s)
+#endif
+#ifndef PERL_DECIMAL_VERSION
+#  define PERL_DECIMAL_VERSION \\
+	  PERL_VERSION_DECIMAL(PERL_REVISION,PERL_VERSION,PERL_SUBVERSION)
+#endif
+#ifndef PERL_VERSION_GE
+#  define PERL_VERSION_GE(r,v,s) \\
+	  (PERL_DECIMAL_VERSION >= PERL_VERSION_DECIMAL(r,v,s))
+#endif
+#ifndef PERL_VERSION_LE
+#  define PERL_VERSION_LE(r,v,s) \\
+	  (PERL_DECIMAL_VERSION <= PERL_VERSION_DECIMAL(r,v,s))
+#endif
+
+/* XS_INTERNAL is the explicit static-linkage variant of the default
+ * XS macro.
+ *
+ * XS_EXTERNAL is the same as XS_INTERNAL except it does not include
+ * "STATIC", ie. it exports XSUB symbols. You probably don't want that
+ * for anything but the BOOT XSUB.
+ *
+ * See XSUB.h in core!
+ */
+
+
+/* TODO: This might be compatible further back than 5.10.0. */
+#if PERL_VERSION_GE(5, 10, 0) && PERL_VERSION_LE(5, 15, 1)
+#  undef XS_EXTERNAL
+#  undef XS_INTERNAL
+#  if defined(__CYGWIN__) && defined(USE_DYNAMIC_LOADING)
+#    define XS_EXTERNAL(name) __declspec(dllexport) XSPROTO(name)
+#    define XS_INTERNAL(name) STATIC XSPROTO(name)
+#  endif
+#  if defined(__SYMBIAN32__)
+#    define XS_EXTERNAL(name) EXPORT_C XSPROTO(name)
+#    define XS_INTERNAL(name) EXPORT_C STATIC XSPROTO(name)
+#  endif
+#  ifndef XS_EXTERNAL
+#    if defined(HASATTRIBUTE_UNUSED) && !defined(__cplusplus)
+#      define XS_EXTERNAL(name) void name(pTHX_ CV* cv __attribute__unused__)
+#      define XS_INTERNAL(name) STATIC void name(pTHX_ CV* cv __attribute__unused__)
+#    else
+#      ifdef __cplusplus
+#        define XS_EXTERNAL(name) extern "C" XSPROTO(name)
+#        define XS_INTERNAL(name) static XSPROTO(name)
+#      else
+#        define XS_EXTERNAL(name) XSPROTO(name)
+#        define XS_INTERNAL(name) STATIC XSPROTO(name)
+#      endif
+#    endif
+#  endif
+#endif
+
+/* perl >= 5.10.0 && perl <= 5.15.1 */
+
+
+/* The XS_EXTERNAL macro is used for functions that must not be static
+ * like the boot XSUB of a module. If perl didn't have an XS_EXTERNAL
+ * macro defined, the best we can do is assume XS is the same.
+ * Dito for XS_INTERNAL.
+ */
+#ifndef XS_EXTERNAL
+#  define XS_EXTERNAL(name) XS(name)
+#endif
+#ifndef XS_INTERNAL
+#  define XS_INTERNAL(name) XS(name)
+#endif
+
+/* Now, finally, after all this mess, we want an ExtUtils::ParseXS
+ * internal macro that we're free to redefine for varying linkage due
+ * to the EXPORT_XSUB_SYMBOLS XS keyword. This is internal, use
+ * XS_EXTERNAL(name) or XS_INTERNAL(name) in your code if you need to!
+ */
+
+#undef XS_EUPXS
+#if defined(PERL_EUPXS_ALWAYS_EXPORT)
+#  define XS_EUPXS(name) XS_EXTERNAL(name)
+#else
+   /* default to internal */
+#  define XS_EUPXS(name) XS_INTERNAL(name)
+#endif
+
+EOF
+
+  print <<"EOF";
+#ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE
+#define PERL_ARGS_ASSERT_CROAK_XS_USAGE assert(cv); assert(params)
+
+/* prototype to pass -Wmissing-prototypes */
+STATIC void
+S_croak_xs_usage(const CV *const cv, const char *const params);
+
+STATIC void
+S_croak_xs_usage(const CV *const cv, const char *const params)
+{
+    const GV *const gv = CvGV(cv);
+
+    PERL_ARGS_ASSERT_CROAK_XS_USAGE;
+
+    if (gv) {
+        const char *const gvname = GvNAME(gv);
+        const HV *const stash = GvSTASH(gv);
+        const char *const hvname = stash ? HvNAME(stash) : NULL;
+
+        if (hvname)
+	    Perl_croak_nocontext("Usage: %s::%s(%s)", hvname, gvname, params);
+        else
+	    Perl_croak_nocontext("Usage: %s(%s)", gvname, params);
+    } else {
+        /* Pants. I don't think that it should be possible to get here. */
+	Perl_croak_nocontext("Usage: CODE(0x%" UVxf ")(%s)", PTR2UV(cv), params);
+    }
+}
+#undef  PERL_ARGS_ASSERT_CROAK_XS_USAGE
+
+#define croak_xs_usage        S_croak_xs_usage
+
+#endif
+
+/* NOTE: the prototype of newXSproto() is different in versions of perls,
+ * so we define a portable version of newXSproto()
+ */
+#ifdef newXS_flags
+#define newXSproto_portable(name, c_impl, file, proto) newXS_flags(name, c_impl, file, proto, 0)
+#else
+#define newXSproto_portable(name, c_impl, file, proto) (PL_Sv=(SV*)newXS(name, c_impl, file), sv_setpv(PL_Sv, proto), (CV*)PL_Sv)
+#endif /* !defined(newXS_flags) */
+
+#if PERL_VERSION_LE(5, 21, 5)
+#  define newXS_deffile(a,b) Perl_newXS(aTHX_ a,b,file)
+#else
+#  define newXS_deffile(a,b) Perl_newXS_deffile(aTHX_ a,b)
+#endif
+
+EOF
+  return 1;
+}
+
+=head2 C<assign_func_args()>
+
+=over 4
+
+=item * Purpose
+
+Perform assignment to the C<func_args> attribute.
+
+=item * Arguments
+
+  $string = assign_func_args($self, $argsref, $class);
+
+List of three elements.  Second is an array reference; third is a string.
+
+=item * Return Value
+
+String.
+
+=back
+
+=cut
+
+sub assign_func_args {
+  my ($self, $argsref, $class) = @_;
+  my @func_args = @{$argsref};
+  shift @func_args if defined($class);
+
+  for my $arg (@func_args) {
+    $arg =~ s/^/&/ if $self->{in_out}->{$arg};
+  }
+  return join(", ", @func_args);
+}
+
+=head2 C<analyze_preprocessor_statements()>
+
+=over 4
+
+=item * Purpose
+
+Within each function inside each Xsub, print to the F<.c> output file certain
+preprocessor statements.
+
+=item * Arguments
+
+      ( $self, $XSS_work_idx, $BootCode_ref ) =
+        analyze_preprocessor_statements(
+          $self, $statement, $XSS_work_idx, $BootCode_ref
+        );
+
+List of four elements.
+
+=item * Return Value
+
+Modifed values of three of the arguments passed to the function.  In
+particular, the C<XSStack> and C<InitFileCode> attributes are modified.
+
+=back
+
+=cut
+
+sub analyze_preprocessor_statements {
+  my ($self, $statement, $XSS_work_idx, $BootCode_ref) = @_;
+
+  if ($statement eq 'if') {
+    $XSS_work_idx = @{ $self->{XSStack} };
+    push(@{ $self->{XSStack} }, {type => 'if'});
+  }
+  else {
+    $self->death("Error: '$statement' with no matching 'if'")
+      if $self->{XSStack}->[-1]{type} ne 'if';
+    if ($self->{XSStack}->[-1]{varname}) {
+      push(@{ $self->{InitFileCode} }, "#endif\n");
+      push(@{ $BootCode_ref },     "#endif");
+    }
+
+    my(@fns) = keys %{$self->{XSStack}->[-1]{functions}};
+    if ($statement ne 'endif') {
+      # Hide the functions defined in other #if branches, and reset.
+      @{$self->{XSStack}->[-1]{other_functions}}{@fns} = (1) x @fns;
+      @{$self->{XSStack}->[-1]}{qw(varname functions)} = ('', {});
+    }
+    else {
+      my($tmp) = pop(@{ $self->{XSStack} });
+      0 while (--$XSS_work_idx
+           && $self->{XSStack}->[$XSS_work_idx]{type} ne 'if');
+      # Keep all new defined functions
+      push(@fns, keys %{$tmp->{other_functions}});
+      @{$self->{XSStack}->[$XSS_work_idx]{functions}}{@fns} = (1) x @fns;
+    }
+  }
+  return ($self, $XSS_work_idx, $BootCode_ref);
+}
+
+=head2 C<set_cond()>
+
+=over 4
+
+=item * Purpose
+
+=item * Arguments
+
+=item * Return Value
+
+=back
+
+=cut
+
+sub set_cond {
+  my ($ellipsis, $min_args, $num_args) = @_;
+  my $cond;
+  if ($ellipsis) {
+    $cond = ($min_args ? qq(items < $min_args) : 0);
+  }
+  elsif ($min_args == $num_args) {
+    $cond = qq(items != $min_args);
+  }
+  else {
+    $cond = qq(items < $min_args || items > $num_args);
+  }
+  return $cond;
+}
+
+=head2 C<current_line_number()>
+
+=over 4
+
+=item * Purpose
+
+Figures out the current line number in the XS file.
+
+=item * Arguments
+
+C<$self>
+
+=item * Return Value
+
+The current line number.
+
+=back
+
+=cut
+
+sub current_line_number {
+  my $self = shift;
+  my $line_number = $self->{line_no}->[@{ $self->{line_no} } - @{ $self->{line} } -1];
+  return $line_number;
+}
+
+=head2 C<Warn()>
+
+=over 4
+
+=item * Purpose
+
+=item * Arguments
+
+=item * Return Value
+
+=back
+
+=cut
+
+sub Warn {
+  my $self = shift;
+  my $warn_line_number = $self->current_line_number();
+  print STDERR "@_ in $self->{filename}, line $warn_line_number\n";
+}
+
+=head2 C<blurt()>
+
+=over 4
+
+=item * Purpose
+
+=item * Arguments
+
+=item * Return Value
+
+=back
+
+=cut
+
+sub blurt {
+  my $self = shift;
+  $self->Warn(@_);
+  $self->{errors}++
+}
+
+=head2 C<death()>
+
+=over 4
+
+=item * Purpose
+
+=item * Arguments
+
+=item * Return Value
+
+=back
+
+=cut
+
+sub death {
+  my $self = shift;
+  $self->Warn(@_);
+  exit 1;
+}
+
+=head2 C<check_conditional_preprocessor_statements()>
+
+=over 4
+
+=item * Purpose
+
+=item * Arguments
+
+=item * Return Value
+
+=back
+
+=cut
+
+sub check_conditional_preprocessor_statements {
+  my ($self) = @_;
+  my @cpp = grep(/^\#\s*(?:if|e\w+)/, @{ $self->{line} });
+  if (@cpp) {
+    my $cpplevel;
+    for my $cpp (@cpp) {
+      if ($cpp =~ /^\#\s*if/) {
+        $cpplevel++;
+      }
+      elsif (!$cpplevel) {
+        $self->Warn("Warning: #else/elif/endif without #if in this function");
+        print STDERR "    (precede it with a blank line if the matching #if is outside the function)\n"
+          if $self->{XSStack}->[-1]{type} eq 'if';
+        return;
+      }
+      elsif ($cpp =~ /^\#\s*endif/) {
+        $cpplevel--;
+      }
+    }
+    $self->Warn("Warning: #if without #endif in this function") if $cpplevel;
+  }
+}
+
+=head2 C<escape_file_for_line_directive()>
+
+=over 4
+
+=item * Purpose
+
+Escapes a given code source name (typically a file name but can also
+be a command that was read from) so that double-quotes and backslashes are escaped.
+
+=item * Arguments
+
+A string.
+
+=item * Return Value
+
+A string with escapes for double-quotes and backslashes.
+
+=back
+
+=cut
+
+sub escape_file_for_line_directive {
+  my $string = shift;
+  $string =~ s/\\/\\\\/g;
+  $string =~ s/"/\\"/g;
+  return $string;
+}
+
+=head2 C<report_typemap_failure>
+
+=over 4
+
+=item * Purpose
+
+Do error reporting for missing typemaps.
+
+=item * Arguments
+
+The C<ExtUtils::ParseXS> object.
+
+An C<ExtUtils::Typemaps> object.
+
+The string that represents the C type that was not found in the typemap.
+
+Optionally, the string C<death> or C<blurt> to choose
+whether the error is immediately fatal or not. Default: C<blurt>
+
+=item * Return Value
+
+Returns nothing. Depending on the arguments, this
+may call C<death> or C<blurt>, the former of which is
+fatal.
+
+=back
+
+=cut
+
+sub report_typemap_failure {
+  my ($self, $tm, $ctype, $error_method) = @_;
+  $error_method ||= 'blurt';
+
+  my @avail_ctypes = $tm->list_mapped_ctypes;
+
+  my $err = "Could not find a typemap for C type '$ctype'.\n"
+            . "The following C types are mapped by the current typemap:\n'"
+            . join("', '", @avail_ctypes) . "'\n";
+
+  $self->$error_method($err);
+  return();
+}
+
+1;
+
+# vim: ts=2 sw=2 et: