1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246
|
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();
|