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 );

=for comment

Build.PL file generates a slew of files on the fly before writing the Build
script.  See KinoSearch::Docs::DevGuide.

=cut

my $autogen_header = <<'END_AUTOGEN';
/***********************************************
 * This file was auto-generated by Build.PL.   *  
 * See KinoSearch::Docs::DevGuide for details. *
 ***********************************************/
END_AUTOGEN

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 => '' );

# 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__
    while ($module_text =~ /
            ^(__XS__|__C__|__H__)   # the tag to begin a block
            (.*?)                   # code block
            (?=(?:^__[A-Z_]+__|\z)) # either a new tag or the EOF
            /gxsm
        )
    {
        my $tag = $1;
        my $fragment = $2;

        # record the code, transform the filepath into an outfilepath
        if ($tag eq '__XS__') {
            # all XS code goes into one file: lib/KinoSearch.xs
            $outfilepath = $ks_xs_filepath;
            $code{$outfilepath} .= $fragment;
        }
        else {
            # each .c and .h code section becomes its own file
            $outfilepath = $pm_filepath;
            $outfilepath =~ s/lib//;
            $outfilepath =~ s/\W//g;
            $outfilepath =~ s/pm$//;
            if ($tag 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);
            $code{$outfilepath} = $fragment;
        }

        # if the file has been modified, force a recompile
        my $mod_time = (stat($module_fh))[9];
        if (    !exists $lastmod->{$pm_filepath}{$tag} 
            or   $lastmod->{$pm_filepath}{$tag} != $mod_time ) {
            $needs_rewrite{$outfilepath} = 1;
        }
        $lastmod->{$pm_filepath}{$tag} = $mod_time;
    }
}

# write all the files that have been modified.
for my $outfilepath (keys %needs_rewrite) {
    print "Writing $outfilepath\n";
    open( my $fh, '>', $outfilepath ) 
        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::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";
    open(my $typemap_fh, '>', 'typemap') 
        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,
        'Clone'                  => 0.18,
    },
    create_makefile_pl => 'passthrough',
    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();

