#!/usr/bin/env perl
#----------------------------------------
use strict;
use warnings qw(FATAL all NONFATAL misc);
use constant DEBUG_LIB => $ENV{DEBUG_YATT_CLI_LIB};
use FindBin; BEGIN {
if (-r (my $libFn = "$FindBin::RealBin/libdir.pl")) {
print STDERR "# using $libFn\n" if DEBUG_LIB;
do $libFn
}
elsif ($FindBin::RealBin =~ m{/local/bin$ }x) {
print STDERR "# using local/lib/perl5\n" if DEBUG_LIB;
require lib;
lib->import($FindBin::RealBin . "/../lib/perl5");
}
else {
print STDERR "# No special libdir\n" if DEBUG_LIB;
}
}
sub MY () {__PACKAGE__}
#----------------------------------------
use mro 'c3';
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::LRXML;
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 => 'MyYATT'
, 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 = File::Basename::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(File::Basename::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 {
use YATT::Lite::Util::AllowRedundantSprintf;
(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 "
. ($err->{cf_reason} // sprintf($err->{cf_format}, @{$err->{cf_args}}));
$msg .= "\n" unless $msg =~ m{\n\Z};
$msg;
};