package C::Scan::Constants; use 5.008003; use strict; use warnings; use Carp; use ExtUtils::Constant; use ModPerl::CScan; use File::Temp qw( tempdir ); use File::Copy; use File::Spec; use File::Path; use Data::Dumper; use IO::File; require Exporter; our @ISA = qw(Exporter); # Our functions are pretty uniquely named, and intended for # calling from Makefile.PL, so we simply export them be default. our @EXPORT = qw( extract_constants_from write_constants_module ); our %EXPORT_TAGS = ( 'all' => [ @EXPORT ] ); our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); our $VERSION = do { my @r=(q$Revision: 1.17 $=~/\d+/g); sprintf "%d."."%03d"x$#r,@r }; my $g_use_blueprint_sections; BEGIN { # Initialize global variable(s) $g_use_blueprint_sections = 0; eval 'require Blueprint'; unless ($@) { $g_use_blueprint_sections = 1; } # Now blueprint comment block protection is quietly enabled. # This will almost never be turned on. } # _get_constant_data_blobs_from() # # Internal function. # # Returns a two blobs of data from the supplied file: # ($defines, <-- #define macros with no args # $typedefs) <-- #typedef enum constants sub _get_constant_data_blobs_from { my $file_to_relocate = shift; if ( ! -f $file_to_relocate ) { croak "$file_to_relocate does not appear to be accessible"; } # Create a temp directory here. my $temp_scan_dir = tempdir( 'c_scan_const_XXXXX', DIR => '/tmp', CLEANUP => 1 ) or die "Internal error: failed to create temp dir"; # copy the file into it my $scan_file_basename = ( File::Spec->splitpath($file_to_relocate) )[2]; my $relocated_file = File::Spec->catpath( '', $temp_scan_dir, $scan_file_basename ); copy($file_to_relocate, $relocated_file) or croak "Could not copy $file_to_relocate to $relocated_file"; # scan the file my $c_header_file = ModPerl::CScan->new( filename => $relocated_file ); if ( !defined( $c_header_file ) ) { croak "Could not create ModPerl::CScan obj for $relocated_file"; } # Swallow STDERR temporarily open my $OLDERR, ">&", STDERR; close(STDERR); # Redirect temporarily to the bit bucket, but keep it open # to avoid conflicting in a -w environment such as under test. # TBD: Make this friendlier for non-*n[u|i]x systems. open *STDERR, ">", "/dev/null"; # We only care about unadorned macros, i.e. "defines" my $defs = $c_header_file->get("defines_no_args"); ### These next lines represent possible future functionality #### # my $defs2 = $c_header_file->get("defines_maybe"); # my $defs3 = $c_header_file->get("defines_full"); # my $defs4 = $c_header_file->get("defines_args"); # my $defs5 = $c_header_file->get("defines_no_args_full"); # my $defs6 = $c_header_file->get("Defines"); ################################################################## my $typedefs = $c_header_file->get("typedef_texts"); ### For debugging only ###################################################### ### NOTE: need to send STDERR somewhere other than /dev/null for these to ### work as intended. ### # warn sprintf("[$file_to_relocate] defines_no_args = %s", Dumper($defs)); # warn sprintf("[$file_to_relocate] defines_maybe = %s", Dumper($defs2)); # warn sprintf("[$file_to_relocate] defines_full = %s", Dumper($defs3)); # warn sprintf("[$file_to_relocate] defines_args = %s", Dumper($defs4)); # warn sprintf("[$file_to_relocate] defines_no_args_full = %s", Dumper($defs5)); # warn sprintf("[$file_to_relocate] Defines = %s", Dumper($defs6)); # warn sprintf("[$file_to_relocate] enums = %s", Dumper($typedefs)); ############################################################################# # Restore STDERR and close the temp filehandle for neatness. close STDERR; open STDERR, ">&", $OLDERR; close $OLDERR; # Return the file object returned from ModPerl::CScan->new() # Note: these may be empty (hashref, arrayref) return ($defs, $typedefs); } # extract_constants_from() # # Exported function. # # This function takes a list of C header (.h) files and returns a list # of constants information suitable for supplying as the NAME parameter # to ExtUtils::Constant. sub extract_constants_from { my @c_header_paths = @_; # full paths to each .h file to scan my @all_constants; C_HEADER_FILE: foreach my $c_header_file ( @c_header_paths ) { my ($defs, $typedefs) = _get_constant_data_blobs_from( $c_header_file ); if ( ( !defined $defs || (defined $defs && scalar( keys %$defs ) == 0) ) || ( !defined $typedefs || (!defined $typedefs || scalar @$typedefs == 0) ) ) { warn "WARNING: Found no constants in $c_header_file."; next C_HEADER_FILE; } # Do the messy enum extraction my @enums = _extract_enum_constants_from( $typedefs ); # Consolidate all names found into a single list. # Note that we discard string constants. my @constant_names = ( @enums, grep { my $defn = $_; # Toss header file identifiers. $defn !~ /_H[_]?$/ and $defn !~ /_$/ # Toss string constants. and $defs->{$defn} !~ /^["]/ } keys %{$defs} ); # Add these to the output push @all_constants, @constant_names; } return @all_constants; } # _extract_enum_constants_from() # # Internal function. # # Does some heinous massaging on a "typedef blob" returned from the # ModPerl::CScan::get() macro, ultimately spitting out a hashref for each # enumerated constant of the following form: # # { name => $enumerated_constant_name, # macro => 1 } # # See C::Scan for more details on the "typedef blob". sub _extract_enum_constants_from { my $typedefs = shift; # enums will live in the @$typedefs array as follows: # ' enum # { # FOO_TYPE_A, FOO_TYPE_B, FOO_TYPE_C, # FOO_TYPE_D, FOO_TYPE_E, FOO_TYPE_F, # FOO_TYPE_INVALID # } foo_type_e' # We want to remove all the extraneous stuff and output the # following for each enum constant: # { name => $constant, macro => 1 } # This can then be fed into the NAMES parameter of WriteConstant # and have it do the right thing. my @enums = map { { name => "$_", macro => 1 } } # 7) assemble hashrefs # for # WriteConstants() map { s/[=][^\s]+//; $_ } # 6) discard explicit # val settings map { split ',' } # 5) split into consts map { s/^\s*enum.+[{]\s*//s; # 2) strip chars up # to 1st constant s/\s*[}].+_e$//s; # 3) strip chars after # last constant s/\s//sg; # 4) strip all other # whitespace $_ } grep { /enum/ } @{$typedefs}; # 1) find "enum" typedefs return @enums; } # _const_mod_header_text() # # Internal function. # # Return the block of code to be written to the top of the Symbols.pm # module. sub _const_mod_header_text { my $sub_pkg_name = shift; return <<"END_OF_MODULE_HEADER"; package $sub_pkg_name; use 5.008003; use strict; use warnings; use base 'Exporter'; our \@EXPORT = qw( \@ALL ); our \@ALL = qw( END_OF_MODULE_HEADER } # _const_mod_symbol_names() # # Internal function. # # Return symbol names found in a list such as that which is returned # from extract_constants_from(). This function is typically used # to get text for writing to the middle portion of the Symbols.pm # module. sub _const_mod_symbol_names { my $names_ref = shift; my $symbol_names_str = ""; for my $symbol (@$names_ref) { if (ref $symbol) { $symbol_names_str .= join q{}, ' 'x4, $symbol->{name}, "\n"; } else { $symbol_names_str .= join q{}, ' 'x4, $symbol, "\n"; } } return $symbol_names_str; } # _const_mod_trailer_text() # # Internal function. # # Return the block of code to be written to the bottom of the Symbols.pm # module. sub _const_mod_trailer_text { return <<"END_OF_MODULE_TRAILER"; ); 1; END_OF_MODULE_TRAILER } # write_constants_module() # # Exported function. # # This function writes a Constants/C/Symbols.pm submodule into the # invoking Makefile.PL module's namespace. sub write_constants_module { my $pkg_name = shift; my @c_constants = @_; # array of symbol name blobs # This is the canonical name of the submodule exporting the C symbols my $const_mod_base_name = 'Symbols.pm'; my $fwd_decl_base_name = 'ForwardDecls.pm'; my @const_mod_subdir_elems = qw(Constants C); # turn the current package name into a directory path, creating # subordinate paths if needed my $const_mod_dir_name = join "/", ( 'lib', split( "::", $pkg_name ), @const_mod_subdir_elems, ); my $const_mod_base_full_name = join '/', ( $const_mod_dir_name, $const_mod_base_name, ); my $fwd_decl_base_full_name = join '/', ( $const_mod_dir_name, $fwd_decl_base_name, ); # Create directory in which to place the module unless (-d "$const_mod_dir_name") { mkpath( $const_mod_dir_name, 0, 0755) or die "mkpath failed: $!"; } # Create the module file to house the list of constants, as # well as the forward declarations file. open my $const_mod_fh, ">", "$const_mod_base_full_name" or die "Could not open $const_mod_base_name for writing: $!"; open my $fwd_decl_fh, ">", "$fwd_decl_base_full_name" or die "Could not open $fwd_decl_base_full_name for writing: $!"; # Common arg list for the next threee functions (my $const_mod_name_prefix = $const_mod_base_name) =~ s/[.]pm$//; my $sub_pkg_name = join "::", ($pkg_name, @const_mod_subdir_elems, $const_mod_name_prefix); # Write file contents. print {$const_mod_fh} _const_mod_header_text( $sub_pkg_name ); print {$const_mod_fh} _const_mod_symbol_names( \@c_constants ); print {$const_mod_fh} _const_mod_trailer_text( ); # Close file. close $const_mod_fh; # Write forward declarations my @sym_names = split /\s+/, _const_mod_symbol_names( \@c_constants ); for my $sym (grep { ! /^\s*$/ } @sym_names) { print {$fwd_decl_fh} "sub $sym();\n"; } print {$fwd_decl_fh} "\n1;\n"; # Close file. close $fwd_decl_fh; # Now write the XS stuff. This is overly simplistic. For example, # string constants will not be handled correctly this way. ExtUtils::Constant::WriteConstants( NAME => $pkg_name, NAMES => \@c_constants, DEFAULT_TYPE => 'IV', C_FILE => 'const-c.inc', XS_FILE => 'const-xs.inc', ); # We've now written the file, but we need to modify handling of IVs # to avoid seg faults on C constant access. open CONST_XS_IN, "const-xs.inc" or die "Failed to open autogen'd const-xs.inc file for mods: $!"; my @in_code_lines = ; close CONST_XS_IN; # Make the modification. Basically we assure that returned IVs have # refcounts of 1 vs. leaving it up to Perl to decide. my @out_code_lines; for my $line (@in_code_lines) { if ($line =~ /PUSHi[(]iv[)]/) { $line = " PUSHs(sv_2mortal(newSViv(iv)));\n"; } push @out_code_lines, $line; } # Write out the modified file. Only one line should differ from # the original. open CONST_XS_OUT, ">const-xs.inc" or die "Failed to open const-xs.inc for writing, post mods: $!"; for my $line (@out_code_lines) { print CONST_XS_OUT $line; } close CONST_XS_OUT; # Help the user out. They will need to modify their code. print {*STDERR} _suggested_code_snippets($pkg_name); return; } # _suggested_code_snippets() # # Internal function. # # Returns a block of text that provides helpful direction to # someone who has just run C::Scan::Constants code, via "perl Makefile.PL" # so that the next time they do that they'll actually get all the # goodies wired into their code. sub _suggested_code_snippets { my $pkg_name = shift; # Set up for extra decoration if needed to help out a build system my ($header,$trailer); if ($g_use_blueprint_sections) { $header = "##### (BLUEPRINT: BEGIN EXPECTED OUTPUT) #####\n"; $trailer = "##### (BLUEPRINT: END EXPECTED OUTPUT) #####\n"; } else { # The most common situation $header = q{}; $trailer = q{}; } return <<"END_BEGIN_SNIPPET"; $header You will need to add some code to your YourPkgName.pm and YourPkgName.xs files in order to make use of the code that has just been autogenerated via C::Scan::Constants. If you've already added the code, just ignore this message. Otherwise, do some cut-and-paste of the following snippets, substituting "YourPkgName" with your actual module name everywhere you see it in the snippets. Then, simply "make" and test! It's that easy. #------------- start of .pm snippet ---------------------- # Do we have C symbols in a YourPkgName::Constants::C::Symbols module? my \$_symbols_present; # Check for (and note) the existence of the C constants module. BEGIN { eval "require YourPkgName::Constants::C::Symbols"; \$_symbols_present = 1 unless \$\@; eval "require YourPkgName::Constants::C::ForwardDecls"; } # (Later, in your exports definition section...) # Bring in the whole lot of C constants that are available. Your mileage # of course, may vary, e.g. alternatively do this via \@EXPORT_OK. our \@EXPORT = ( # any other symbols you are exporting, plus: \$_symbols_present ? \@YourPkgName::Constants::C::Symbols::ALL : (), ); # Make sure to have a $VERSION defined. # Then, prior to subroutine definitions, insert the following. Note # that if you left autoloading turned on when you created your module # skeleton with h2xs (i.e. you did *not* specify -A when you ran it), # you already have this code in place. use Carp; use AutoLoader; sub AUTOLOAD { # This AUTOLOAD is used to 'autoload' constants from the constant() # XS function. my \$constname; our \$AUTOLOAD; (\$constname = \$AUTOLOAD) =~ s/.*:://; croak "&YourPkgName::constant not defined" if \$constname eq 'constant' ; my (\$error, \$val) = constant(\$constname); if (\$error) { croak \$error; } { no strict 'refs'; *\$AUTOLOAD = sub { \$val }; } goto &\$AUTOLOAD; } require XSLoader; XSLoader::load('YourPkgName', \$VERSION); #------------- start of .pm snippet ---------------------- #------------- start of .xs snippet ---------------------- # In YourPkgName.xs, make sure to add the following lines. /* Before "MODULE =" line: */ /* Specific .h files to scan */ #include "header_file_a.h" #include "header_file_b.h" /* ... */ #include "header_file_c.h" /* * Note that if you left autoloading turned on when you created your module * skeleton with h2xs (i.e. you did *not* specify -A when you ran it), * you probably already have the code below in place and ready to use. */ /* Reference to autogenerated C-side binding file */ #include "const-c.inc" /* After "MODULE =" line: */ # Reference to autogenerated xs-side binding file. INCLUDE: const-xs.inc #------------- end of .xs snippet ------------------------ $trailer END_BEGIN_SNIPPET } 1; __END__ =head1 NAME C::Scan::Constants - Slurp constants from specified C header (.h) files =head1 VERSION This documentation refers to C::Scan::Constants version 1.017. =head1 SYNOPSIS ## Intended for use in your module's Makefile.PL file, to ## add DWIMery to use of C constants within your module. use C::Scan::Constants; my @hdr_files = ( "/path/to/first_header.h", "/path/to/second_header.h", ); ## Slurp a list of constant information from C headers my @constants = extract_constants_from( @hdr_files ); ## Create the C, XS, and pure-Perl machinery needed to ## provide automagical access to C constants at runtime. write_constants_module( "Your::Module", @constants ); =head1 DESCRIPTION This module provides an alternative to using the B command to generate Perl header (.ph) files that are then subsequently Cd by your module code. When you need access to C numeric and enumerated type constants, especially in a dynamic source tree environment, there are times when you'd like something a little more automagical and closely tailored to what you actually need. Now you have it, in this module. C::Scan::Constants was born out of a recognition that ModPerl::CScan and ExtUtils::Constant provide a wealth of capabilities in the area of C code parsing and autogenerated XS access to C constants, but that the actual mechanisms for harnessing them to do those things were really rather opaque. This module should help take (most of) the mystery out of those activities. Here's a brief overview of the module: =over 4 =item * Provides a function, L<"extract_constants_from()">, that extracts a list of information relating to L<#define> constants and L<#typedef enum> style constants found in a supplied list of C header (.h) files. =item * Provides a function, L<"write_constants_module()">, that generates three files: const-c.inc const-xs.inc lib/Your/ModuleName/Constants/C/Symbols.pm that are ready to be dropped into your module's build machinery to give your module runtime access to those constants. =item * Gives hints at C time about the code you need to add to files in your module's source tree to assure that all the tracks line up at module build time. =back =head1 SUBROUTINES The following two subroutines are exported by default. =head2 @blobs = extract_constants_from( @header_paths ) =over Takes a list of C header (.h) files and returns a list of constants information suitable for supplying as the NAME parameter to ExtUtils::Constant. Returns an array of constant name "blobs" suitable for feeding into ExtUtils::Constant::WriteConstants() as the value of the NAME parameter. =back =head2 write_constants_module( $pkg_name, @c_constants ) =over Writes a Constants/C/Symbols.pm submodule into the invoking Makefile.PL module's namespace. Really just a value-added wrapper around ExtUtils::Constant::WriteConstants(). No return value -- call for side-effects only. =back =head1 DIAGNOSTICS TBD. I owe you a list of error and warning messages you might see when invoking functions from C::Scan::Constants. =head1 CONFIGURATION AND ENVIRONMENT TBD. If/when populated, this section will describe in detail how/where to add the necessary extra code to wire in the autogenerated files to your module. It will also describe what you need in your Makefile.PL to assure that the autogenerated stuff goes away at C time. For the time being, write_constants_module() outputs to STDERR a number of hints that should provide the needed answers to these types of questions. =head1 DEPENDENCIES For the program proper: =over 4 Carp, Data::Flow, ExtUtils::Constants, ModPerl::CScan, C::Scan, File::Temp, File::Copy, File::Spec, File::Path, Exporter =back Additional modules needed for tests (over and above Test::More): =over 4 Scalar::Util, List::MoreUtils, Cwd =back =head1 COMPATIBILITY NOTES This version of C::Scan::Constants is known to work with version of ExtUtil::Constants versions 0.14 - 0.16. It may not work properly with earlier or later versions. I welcome your comments and patches to assure continued compatibility going forward. =head1 BUGS AND LIMITATIONS The amount of code you are currently required to add to your module to make use of the files C::Scan::Constants generates seems rather too much. It would be highly useful to provide a more streamlined usage, or to provide scripts that would assist you in inserting the needed code into your module. Also, the tests are incomplete. The runtime usability of constants generated by the module is not tested at all. I need to set up some tests that actually create a new module, invoke the C::Scan::Constants functionality, and then do a perl Makefile.PL make make test regimen on that module in order to accomplish this. That's pretty tricky, so I haven't tackled it yet. Finally (well probably not), it would be nice to be able to specify whether B should "follow" C<#include> statements in C header files. Sometimes, that's what you really want. This version of C::Scan::Constants suppresses all such "following" behavior. Other than that, there are no known bugs in this module. Please report problems to Philip Monsen (philip.monsen@gmail.com). Patches are especially welcome. =head1 AUTHOR Philip Monsen (philip.monsen@gmail.com) =head1 COPYRIGHT AND LICENSE I ModPerl::CScan is provided with this module for convenience for those users who do not wish to install mod_perl as a whole. This version is 0.75 from the mod_perl-2.0.1 distro. Copyright (C) 2005 by Doug MacEachern. Licensed under the Apache License, Version 2.0; you may not use this file except in compliance with the License. A current copy of the license is available at http://www.apache.org/licenses/LICENSE-2.0 See also contrib/LICENSE for a Jan. 2004 copy of the license text. Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. I Copyright (C) 2005-7 by Philip Monsen. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.3 or, at your option, any later version of Perl 5 you may have available. See L. This module is distributed in the hope that it will be useful, and is provided on an "AS-IS" basis, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied, including, without limitation, any warranties or conditions of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A PARTICULAR PURPOSE. =cut