#!/usr/bin/env perl

use strict;
use FindBin;
use lib "$FindBin::Bin/../lib";
use lib "$FindBin::Bin/../../pegex-pm/lib";
use Pegex::Parser;
use Swim::Grammar;
use Getopt::Long;

use Getopt::Long;

sub usage {
  print <<'...';
Usage:

  swim --to=<format> [<option>...] <file.swim>
  swim -h|--help

Formats:

  html          # HTML
  txt           # Plain text
  md | markdown # Markdown
  pod           # Pod

  man           # nroff / manpage
  pdf           # PDF
  dvi           # DVI

  byte          # Swim Bytecode

Options:

  --meta=<file> # YAML or JSON file containing metadata
  --wrap=1      # Attempt to wrap output to 80 cols
  --complete=1  # Add header and footer output as appropriate
  --pod-upper-head=1  # Convert header1 titles to uppercase

...
  exit 0
}

my $to = "html";
my $debug = $ENV{PERL_PEGEX_DEBUG} || 0;
my %opts = (
  'meta' => [],
  'wrap' => 0,
  'complete' => 0,
  'pod-upper-head' => 0,
);
my %opt_spec = (
  "h|help" => \&usage,
  "to=s" => \$to,
  "debug" => \$debug,
  "complete=s" => \&opt,
  "meta=s" => \&meta_opt,
  "wrap=s" => \&opt,
  "pod-upper-head=s" => \&opt,
  "pod-cpan" => \&pod_cpan_opts,
);
my $meta = {};

sub main {
  binmode(STDOUT, ':utf8');
  GetOptions(%opt_spec) or die "Error in command line arguments";

  my $format_mapping = {
    html => 'Swim::HTML',
    md => 'Swim::Markdown',
    markdown => 'Swim::Markdown',
    pod => 'Swim::Pod',
    byte => 'Swim::Byte',

    txt => \&to_txt,
    man => \&to_man,
    pdf => \&to_pdf,
    dvi => \&to_dvi,
  };

  my $format = $format_mapping->{$to}
    or die "Unknown output format '$to'";

  my $swim = slurp(@ARGV);
  if (ref $format) {
    $format->($swim);
    return;
  }
  my $receiver_class = $format;
  eval "require $receiver_class; 1"
    or die "$@";

  my $parser = Pegex::Parser->new(
    grammar => 'Swim::Grammar'->new,
    receiver => $receiver_class->new(
      meta => $meta,
      option => \%opts,
    ),
    debug => $debug,
  );
  print $parser->parse($swim);
}

sub to_txt {
  require IPC::Run;
  my ($in) = @_;
  my ($out, $err);

  my @cmd1 = ($0, '--to=pod', '--complete=1');
  my @cmd2 = ('pod2text');
  IPC::Run::run(\@cmd1, \$in, '|', \@cmd2, \$out, \$err, IPC::Run::timeout(10))
    or die "$0: $?";
  die "$err" if $err;

  print $out;
}

sub to_man {
  my ($swim) = @_;
  print get_man($swim);
}

sub to_pdf {
  my ($swim) = @_;
  my ($in, $out, $err) = get_man($swim);
  my @cmd = ('groffer', '--pdf');
  IPC::Run::run(\@cmd, \$in, \$out, \$err, IPC::Run::timeout(10))
    or die "$cmd[0]: $?";
  die "$err" if $err;
  print $out;
}

sub to_dvi {
  my ($swim) = @_;
  my ($in, $out, $err) = get_man($swim);
  my @cmd = ('groffer', '--dvi');
  IPC::Run::run(\@cmd, \$in, \$out, \$err, IPC::Run::timeout(10))
    or die "$cmd[0]: $?";
  die "$err" if $err;
  print $out;
}

sub get_man {
  require IPC::Run;
  my ($in) = @_;
  my ($out, $err);

  my @cmd1 = ($0, '--to=pod', '--complete=1', '--wrap=1');
  my @cmd2 = ('pod2man', '--utf8');
  IPC::Run::run(\@cmd1, \$in, '|', \@cmd2, \$out, \$err, IPC::Run::timeout(10))
    or die "$0: $?";
  die "$err" if $err;

  $out;
}

sub opt {
  my ($option, $value) = @_;
  $opts{$option} =
    $value =~ /^(true|1)$/ ? 1 :
    $value =~ /^(false|0)$/ ? 0 :
    0;
}

sub pod_cpan_opts {
  $to = 'pod';
  $opts{complete} = 1;
  $opts{wrap} = 1;
  $opts{'pod-upper-head'} = 1;
}

sub meta_opt {
  my ($option, $value) = @_;
  require Swim::Util;
  for my $file (split /,/, $value) {
    my $yaml = Swim::Util->slurp($file);
    $meta = Swim::Util->merge_meta($meta, $yaml);
  }
}

sub slurp {
  my ($file) = @_;
  local $/;
  my $swim;
  if (defined $file) {
    open IN, $file
      or die "Can't open '$file' for input";
    binmode(IN, ':encoding(UTF-8)');
    $swim = <IN>;
    close IN;
  }
  else {
    binmode(STDIN, ':encoding(UTF-8)');
    $swim = <STDIN>;
  }
  return $swim;
}

main();

# vim: set sw=2:
