#!/usr/bin/env perl
# -*- coding: utf-8 -*-
#----------------------------------------
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 CGI;
use Hash::MultiValue;
use YATT::Lite::Factory;
use YATT::Lite::Entities qw(*YATT *CON *SYS);
use YATT::Lite::Util::CmdLine qw(parse_opts parse_params);
use YATT::Lite::Util qw(rootname
catch try_invoke);
use YATT::Lite::CGen::Perl; # Just for debugging aid.
use YATT::Lite::Breakpoint;
use YATT::Lite::Util::FindMethods; # For debugging aid.
# Try x FindMethods($this, qr/^entity_/)
MY->parse_opts(\@ARGV, \ my %opts);
MY->parse_params(\@ARGV, \ my %common);
my $direct_mode = delete $opts{direct};
$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'
);
};
$dispatcher->prepare_app;
# [1] Compile all.
my @command;
{
while (@ARGV) {
my $file = shift @ARGV;
my %params = %common;
MY->parse_params(\@ARGV, \%params);
my $parameters = Hash::MultiValue->new(%params);
my $dir = File::Basename::dirname($dispatcher->rel2abs($file));
$dir =~ s,/*$,/,;
my $dirhandler = $dispatcher->get_dirhandler($dir)
or die "Can't find dirhandler for $dir";
push @command, [$dirhandler, $file, $parameters];
}
}
# [2] Execute all.
my $nerror;
foreach my $cmd (@command) {
my ($dirhandler, $file, $parameters) = @$cmd;
# XXX: そもそも、ここでの DONE に疑問が.
local $dirhandler->{cf_at_done} = sub {
# ここで at_done が呼ばれるのは error_handler からだけ。
exit;
};
local $YATT = $dirhandler;
local $dirhandler->{cf_at_done} = sub {};
# $dirhandler->fconfigure_encoding(\*STDOUT, \*STDERR);
local $ENV{REQUEST_URI} = $ENV{REQUEST_URI} // $file;
local $ENV{SCRIPT_NAME} = $ENV{SCRIPT_NAME} // $file;
local $ENV{PATH_INFO} = $ENV{PATH_INFO} // '/';
my $env = +{%ENV};
local $CON = $dispatcher->make_connection
(\*STDOUT
, parameters => $parameters
, file => $file, noheader => 1
, env => $env
, system => $SYS, yatt => $YATT);
$dispatcher->set_yatt_script_name($env);
my ($part, $sub, $this, $args)
= $dirhandler->prepare_part_handler($CON, File::Basename::basename($file));
my $err = catch {
$sub->($this, $CON, @$args);
};
try_invoke($CON, 'flush_headers');
if (not $err or YATT::Lite::WebMVC0::SiteApp::is_done($err)) {
} elsif (ref $err eq 'ARRAY') {
my ($status, $header, $body) = @$err;
if ($status == 200) {
print $body
} else {
print STDERR join(" ", $status, @$body), "\n";
$nerror++;
}
} else {
die $err;
}
}
exit 1 if $nerror;