use strict;
use warnings;
use 5.008003;
use Module::Build;
use File::Find qw( find );
use Storable qw( store retrieve );
use File::Spec::Functions qw( catfile );
use Fcntl;
=for comment
Build.PL file generates a slew of files on the fly before writing the Build
script. See KinoSearch::Docs::DevGuide.
=cut
my $ks_xs_filepath = 'KinoSearch.xs';
# keep lists of which .c .h and .xs files need to be rewritten and cleaned up
my %needs_rewrite;
# retrieve a list of modification times from when Build.PL was last run
my $lastmod = -f 'lastmod' ? retrieve('lastmod') : {};
# If Build.PL was modified, force recompile of KinoSearch.xs
my $build_pl_lastmod = ( stat('Build.PL') )[9];
if ( !exists $lastmod->{'Build.PL'}
or $lastmod->{'Build.PL'} != $build_pl_lastmod )
{
$needs_rewrite{$ks_xs_filepath} = 1;
}
$lastmod->{'Build.PL'} = $build_pl_lastmod;
# hold filepath => content pairs for generated files
my %code = ( $ks_xs_filepath => '' );
my %source_pm = ();
# grab all .pm filepaths, making sure that KinoSearch.pm is first
my @pm_filepaths;
find(
{ wanted => sub {
if ( $File::Find::name =~ /KinoSearch\.pm$/ ) {
unshift @pm_filepaths, $File::Find::name;
}
elsif ( $File::Find::name =~ /\.pm$/ ) {
push @pm_filepaths, $File::Find::name;
}
},
no_chdir => 1,
},
'lib',
);
for my $pm_filepath (@pm_filepaths) {
open( my $module_fh, '<', $pm_filepath )
or die "couldn't open file '$pm_filepath': $!";
my $module_text = do { local $/; <$module_fh> };
my $outfilepath;
# grab code that's delimited by an xs, c, or h __TAG__
my $inside = '';
my $line_count = 0;
while ( $module_text =~ /(.*?(?:\n|\r\n|\r))/g ) {
$line_count++;
my $line = $1;
if ( $line =~ /^__(\w+)__/ ) { # the tag to begin a block
$inside = $1;
if ( $inside eq 'XS' ) {
# all XS code goes into one file: lib/KinoSearch.xs
$outfilepath = $ks_xs_filepath;
}
elsif ( $inside eq 'H' or $inside eq 'C' ) {
# each .c and .h code section becomes its own file
$outfilepath = $pm_filepath;
$outfilepath =~ s/lib//;
$outfilepath =~ s/\W//g;
$outfilepath =~ s/pm$//;
if ( $inside eq 'H' ) {
$outfilepath .= ".h";
# prepend an #include to KinoSearch.xs
$code{$ks_xs_filepath}
= qq|#include "$outfilepath"\n$code{$ks_xs_filepath}|;
}
else {
$outfilepath .= ".c";
}
$outfilepath = catfile( 'src', $outfilepath );
my $line_start = $line_count + 1;
$code{$outfilepath} = qq|#line $line_start "$pm_filepath"\n|;
}
if ( $inside =~ /^(?:XS|H|C)$/ ) {
# if the file has been modified, force a recompile
my $mod_time = ( stat($module_fh) )[9];
if ( !exists $lastmod->{$pm_filepath}{$inside}
or $lastmod->{$pm_filepath}{$inside} != $mod_time )
{
$needs_rewrite{$outfilepath} = 1;
}
$lastmod->{$pm_filepath}{$inside} = $mod_time;
$source_pm{$outfilepath} = $pm_filepath;
}
}
elsif ( $inside =~ /^(?:XS|H|C)$/ ) {
$code{$outfilepath} .= $line;
}
}
}
# write all the files that have been modified.
for my $outfilepath ( keys %needs_rewrite ) {
my $autogen_header = <<"END_AUTOGEN";
/***********************************************
!!!! DO NOT EDIT THIS FILE !!!!
This file was auto-generated by Build.PL from
$source_pm{$outfilepath}
See KinoSearch::Docs::DevGuide for details.
***********************************************/
END_AUTOGEN
print "Writing $outfilepath\n";
unlink $outfilepath;
sysopen( my $fh, $outfilepath, O_CREAT | O_EXCL | O_WRONLY )
or die "Couldn't open file '$outfilepath' for writing: $!";
print $fh "$autogen_header$code{$outfilepath}"
or die "Print to '$outfilepath' failed: $!";
close $fh or die "Couldn't close file '$outfilepath': $!";
}
=begin Rationale
All of KinoSearch's C-struct types share the same typemap profile, but can't
be mapped to a single type. Instead of tediously hand-editing the
typemap file, we autogenerate the file. Adding a new type is now as simple as
adding an item to the @struct_classes array (provided it follows the same
pattern as all the others).
=end Rationale
=cut
# write the typemap file.
if ( $needs_rewrite{$ks_xs_filepath} ) {
my @struct_classes = qw(
KinoSearch::Analysis::Stemmer::Stemmifier
KinoSearch::Analysis::Token
KinoSearch::Analysis::TokenBatch
KinoSearch::Index::SegTermEnum
KinoSearch::Index::TermBuffer
KinoSearch::Index::TermDocs
KinoSearch::Index::TermInfo
KinoSearch::Index::TermInfosWriter
KinoSearch::Search::HitCollector
KinoSearch::Search::MatchBatch
KinoSearch::Search::Scorer
KinoSearch::Search::Similarity
KinoSearch::Store::InStream
KinoSearch::Store::OutStream
KinoSearch::Util::BitVector
KinoSearch::Util::BoolSet
KinoSearch::Util::PriorityQueue
KinoSearch::Util::SortExternal
);
my $typemap_start = qq|\nTYPEMAP\n|;
my $typemap_input = qq|\n\nINPUT\n|;
my $typemap_output = qq|\n\nOUTPUT\n|;
for my $struct_class (@struct_classes) {
my ($ctype) = $struct_class =~ /([^:]+$)/;
my $uc_ctype = uc($ctype);
$ctype .= ' *';
$typemap_start .= "$ctype\t$uc_ctype\n";
my $input_frag = <<'END_INPUT';
#UC_CTYPE#
if (sv_derived_from($arg, \"#STRUCT_CLASS#\")) {
$var = INT2PTR($type,( SvIV((SV*)SvRV($arg)) ) );
}
else
Perl_croak(aTHX_ \"$var is not of type #STRUCT_CLASS#\")
END_INPUT
$input_frag =~ s/#UC_CTYPE#/$uc_ctype/gsm;
$input_frag =~ s/#STRUCT_CLASS#/$struct_class/gsm;
$typemap_input .= $input_frag;
my $output_frag .= <<'END_OUTPUT';
#UC_CTYPE#
sv_setref_pv($arg, \"#STRUCT_CLASS#\", (void*)$var);
END_OUTPUT
$output_frag =~ s/#UC_CTYPE#/$uc_ctype/gsm;
$output_frag =~ s/#STRUCT_CLASS#/$struct_class/gsm;
$typemap_output .= $output_frag;
}
# blast it out
print "Writing typemap\n";
unlink 'typemap';
sysopen( my $typemap_fh, 'typemap', O_CREAT | O_WRONLY | O_EXCL )
or die "Couldn't open 'typemap' for writing: $!";
print $typemap_fh
"# Auto-generated file. See KinoSearch::Docs::DevGuide.\n\n"
or die "Print to 'typemap' failed: $!";
print $typemap_fh "$typemap_start $typemap_input $typemap_output"
or die "Print to 'typemap' failed: $!";
}
# record mod times in anticipation of Build.PL's next run
store( $lastmod, 'lastmod' );
my $builder = Module::Build->new(
module_name => 'KinoSearch',
license => 'perl',
dist_author => 'Marvin Humphrey <marvin at rectangular dot com>',
dist_version_from => 'lib/KinoSearch.pm',
requires => {
'Compress::Zlib' => 0,
'Lingua::Stem::Snowball' => 0.94,
'Lingua::StopWords' => 0.02,
},
build_requires => {
'ExtUtils::CBuilder' => 0,
'ExtUtils::ParseXS' => 0,
},
create_makefile_pl => 'passthrough',
# extra_compiler_flags => [
# '-Wall', '-Wextra',
# '-pedantic', '-ansi',
# '-DPERL_GCC_PEDANTIC', '-std=c89',
# ],
xs_files => { $ks_xs_filepath => 'lib/KinoSearch.xs' },
c_source => 'src',
add_to_cleanup => [
keys %code, 'KinoSearch-*', 'typemap', 'MANIFEST.bak',
'lastmod', 'perltidy.ERR', '*.o',
],
);
$builder->create_build_script();