#!/usr/bin/env perl
#----------------------------------------
use strict;
use warnings FATAL => qw(all);
use FindBin; BEGIN {do "$FindBin::RealBin/libdir.pl"}
#----------------------------------------

use YATT::Lite qw/*SYS/;
use YATT::Lite::Factory;
use YATT::Lite::Breakpoint;
use YATT::Lite::Util qw(default rootname catch);
use YATT::Lite::Error;
use YATT::Lite::CGen::Perl; # Just for debugging aid.

use YATT::Lite::Util::CmdLine qw/parse_opts/;
use YATT::Lite::Types
  ([Opts => -fields => [qw/cf_tap cf_all/]]);

my Opts $opts = Opts->new(MY->parse_opts(\@ARGV));

# XXX: 各ディレクトリに .htyattcf.xhf が有ったら？ rc が有ったら?
# XXX: それらが無い状態で、 Web::* 環境での動作検証をしたいときは？

# library の追加は？ <= .htyattrc で？違うよね?

$SYS = my $dispatcher = YATT::Lite::Factory->load_factory_offline || do {
  require YATT::Lite::WebMVC0::SiteApp;
  YATT::Lite::WebMVC0::SiteApp->new
      (app_ns => 'MyApp'
       , namespace => ['yatt', 'perl', 'js']
       , header_charset => 'utf-8'
       , debug_cgen => $ENV{DEBUG}
       , debug_cgi  => $ENV{DEBUG_CGI}
       # , is_gateway => $ENV{GATEWAY_INTERFACE} # Too early for FastCGI.
       # , tmpl_encoding => 'utf-8'
      );
};

my $nerror = 0;

my $i = 1;
if ($opts->{cf_tap}) {
  $opts->{cf_all} //= 1;
  print "$i..".@ARGV, "\n";
}

foreach my $fn (@ARGV) {
  my $dir = dirname($fn);
  my $dirhandler = $dispatcher->get_dirhandler($dispatcher->rel2abs($dir));
  $dirhandler->fconfigure_encoding(\*STDOUT, \*STDERR);

  my $error_handler = do {
    if ($opts->{cf_tap}) {
      sub {
	print "not ok $i - $fn\n";
	my $msg = format_error(@_);
	$msg =~ s/^/\# /mg;
	print $msg;
	exit 1 unless $opts->{cf_all};
      };
    } else {
      sub {
	print STDERR format_error(@_);
	exit 1 unless $opts->{cf_all};;
      };
    }
  };

  $dirhandler->configure(error_handler => $error_handler);

  my $trans = $dirhandler->open_trans;
  my $tmpl = $trans->find_file(basename($fn)) or do {
    warn "No such file: $fn\n";
    $nerror++;
    next;
  };
  unless (my $err = catch {my $pkg = $trans->find_product(perl => $tmpl)}) {
    print "ok $i - $fn\n" if $opts->{cf_tap};
  } else {
    if ($opts->{cf_tap}) {
      warn "# $err\n";
    } else {
      print $err;
    }
    $nerror++;
  }
} continue {
  $i++;
}

exit 1 if $nerror;

sub format_error {
  (my $type, my YATT::Lite::Error $err) = splice @_, 0, 2;
  my @lineinfo = ("[file] ".default($err->{cf_tmpl_file}, '-')
		  , "[line] ".default($err->{cf_tmpl_line}, '-'));
  my $msg = $type . " [@lineinfo]\n "
    .sprintf($err->{cf_format}, @{$err->{cf_args}});
  $msg .= "\n" unless $msg =~ m{\n\Z};
  $msg;
};