package App::sigfix;

use strictures 2;
use Babble::Plugin::CoreSignatures;
use Babble::Match;
use Getopt::Long;

our $VERSION = '0.001001';

sub stripspace {
  my ($text) = @_;
  $text =~ /^(\s+)/ && $text =~ s/^$1//mg;
  $text;
}

sub usage {
  print <<'USAGE';
sigfix [OPTIONS] [FILES]

  sigfix -t signatures perl526file >perl528file
  sigfix -t oldsignatures perl528file >perl526file
  sigfix -t plain perlfile >perl58file

  sigfix -i -t signatures upgradethisfile

  sigfix -t signatures --pmc lib/My/Module.pm >lib/My/Module.pmc
  sigfix -i -t signatures --pmc lib/My/Module.pm

  sigfix -i --pmc eval $(find lib -name '*.pm') # multi-target fat pmc

Options:

  -t, --target     Target: 'signatures', 'oldsignatures', 'plain'
  -i, --inplace    Modify target file(s) in place
  --pmc            Generate .pmc (without -t, triple target pmc)
  -h               This usage message
USAGE

  exit(255);
}

{
  my $cs = Babble::Plugin::CoreSignatures->new;

  my @target_selectors = (
    [ 'signatures', '($] >= 5.020 and $] < 5.022) or $] >= 5.028' ],
    [ 'oldsignatures', '$] >= 5.022 and $] < 5.028' ],
    [ 'plain' ],
  );

  sub process_source {
    my ($source, $opt) = @_;

    if (my $target = $opt->{target}) {

      my $top = Babble::Match->new(
        top_rule => 'Document',
        text => $source,
      );

      my $transform = "transform_to_${target}";

      unless ($cs->can($transform)) {
        print STDERR "Invalid transform target ${target}";
        usage;
      }
      $cs->$transform($top);

      return $top->text;
    }

    # must be in pmc mode without target
    my $preamble = stripspace <<'    PREAMBLE';
      # This code generated by App::sigfix
      BEGIN {
        my %options;
    PREAMBLE

    my @segments;

    foreach my $target (map $_->[0], @target_selectors) {

      my $top = Babble::Match->new(
        top_rule => 'Document',
        text => $source,
      );

      $cs->${\"transform_to_${target}"}($top);

      my $data = $top->text;

      # indent for heredoc and ensure trailing newline
      s/^/    /mg, s/(?<!\n)\z/\n/ for $data;

      my $doc_name = uc join '_', 'CODE_FOR', $target;

      push @segments, join '',
        qq{  \$options{'${target}'} = '#line '.(1+__LINE__).' "'.__FILE__."\\"\\n".<<'$doc_name';\n},
        $data, $doc_name, "\n";
    }

    my $select = join "\n",
      '  my $chosen =',
      (map {
        my ($choice, $cond) = @$_;
        if ($cond) {
          "    $cond ? '$choice' :"
        } else {
          "    '$choice';"
        }
      } @target_selectors),
      '';
    my $postamble = stripspace <<'    POSTAMBLE';
      require Filter::Util::Call;
      Filter::Util::Call::filter_add(sub {
        Filter::Util::Call::filter_del();
        1 while Filter::Util::Call::filter_read();
        $_ = $options{$chosen};
      });
    POSTAMBLE
    $postamble =~ s/^/  /mg;
    return join '',
      $preamble,
      @segments,
      $select,
      $postamble,
      "}\n0; # should never get here\n";
  }
}

sub process_file {
  my ($file, $opt) = @_;

  my $source = do {
    open my $in, '<', $file or die "Couldn't open ${file} for read: $!\n";
    local $/; <$in>;
  };

  # Process first so if that fails, we didn't eat the original file
  my $processed = process_source $source, $opt;

  # ... or overwrite the old .pmc
  my $out_file = $file.($opt->{pmc} ? 'c' : '');

  open my $out, '>', $out_file
    or die "Couldn't open ${out_file} for write: $!\n";

  print $out $processed;

  return;
}

sub options {
  my %opt;

  GetOptions(
    't|target=s', \$opt{target},
    'i|inplace', \$opt{inplace},
    'pmc', \$opt{pmc},
    'help', \$opt{help}
  );

  if ($opt{help}) {
    usage;
  }
  if (not $opt{target} and not $opt{pmc}) {
    print STDERR "Must supply at least one of -t/--target or --pmc\n";
    usage;
  }
  if ($opt{inplace} and not @ARGV) {
    print STDERR "In-place operation requires a list of files\n";
    usage;
  }
  if ($opt{inplace} and $opt{pmc} and grep !/\.pm$/, @ARGV) {
    print STDERR "In-place pmc generation requires a list of .pm files\n";
    usage;
  }
  return \%opt;
}

sub main {
  my $opt = options;

  if ($opt->{inplace}) {
    foreach my $file (@ARGV) {
      process_file $file, $opt;
    }
    return;
  }

  (my $source = do { local $/; <> }) ||= '';
  print process_source $source, $opt;

  return;
}

1;

__END__

=head1 NAME

App::sigfix - transform files between signature syntax versions

=head1 USAGE

    sigfix [OPTIONS] [FILES]
    
      sigfix -t signatures perl526file >perl528file
      sigfix -t oldsignatures perl528file >perl526file
      sigfix -t plain perlfile >perl58file
    
      sigfix -i -t signatures upgradethisfile
    
      sigfix -t signatures --pmc lib/My/Module.pm >lib/My/Module.pmc
      sigfix -i -t signatures --pmc lib/My/Module.pm
    
      sigfix -i --pmc eval $(find lib -name '*.pm') # multi-target fat pmc
    
    Options:
    
      -t, --target     Target: 'signatures', 'oldsignatures', 'plain'
      -i, --inplace    Modify target file(s) in place
      --pmc            Generate .pmc (without -t, triple target pmc)
      -h               This usage message

=cut
