#!/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 mro 'c3'; # XXX: Not fully compatible.
use parent qw/YATT::Lite::Object/;
use YATT::Lite::MFields qw/dispatcher
cf_dir
cf_linear
cf_from
/;
use YATT::Lite::Util qw/globref look_for_globref lexpand/;
use YATT::Lite::Util::CmdLine qw/run/;
use YATT::Lite;
use YATT::Lite::Factory;
use YATT::Lite::LRXML;
use YATT::Lite::Core;
use YATT::Lite::CGen::Perl;
use YATT::Lite::Walker;
{
my $disp = YATT::Lite::Factory->load_factory_offline
or die "Can't find YATT app script!\n";
my MY $cmd = MY->new;
$cmd->{dispatcher} = $disp;
$cmd->run(\@ARGV);
}
sub cmd_isa {
(my MY $self, my (@path)) = @_;
my $disp = $self->{dispatcher};
if (not @path) {
$self->show_isa(dispatcher => ref $disp);
} else {
foreach my $path (@path) {
my ($dir, $file) = do {
if (-d $path) {
($path)
} else {
(File::Basename::dirname($path), File::Basename::basename($path));
}
};
my $dh = $disp->get_dirhandler($dir);
if (defined $file) {
my ($part, $sub, $pkg) = $dh->open_trans->find_part_handler($file);
$self->show_isa(File => $pkg);
# my ($tmpl) = $dh->open_trans->find_file($file);
# $self->show_isa(File => $tmpl->cget('entns'));
} else {
$self->show_isa(DirApp => ref $dh);
}
}
}
}
sub show_isa {
(my MY $self, my ($title, $class)) = @_;
if ($self->{cf_linear}) {
print "$title=$class\n";
foreach my $super (@{mro::get_linear_isa($class)}) {
my $fn = $self->get_class_filename($super);
print " ", $super, "\t", $fn ? "[$fn]" : "", "\n";
}
} else {
print $class;
if (my $fn = $self->get_class_filename($class)) {
print "\t[$fn]";
}
print "\n";
$self->show_isa_tree(0, {}, *{globref($class, 'ISA')}{ARRAY});
}
}
sub show_isa_tree {
(my MY $self, my ($depth, $seen, $supers)) = @_;
$depth++;
foreach my $super (@$supers) {
my $cnt = $seen->{$super}++;
print " " x $depth, $cnt ? "*" : " ", $super;
if (my $fn = $self->get_class_filename($super)) {
print "\t[$fn]";
}
print "\n";
next if $cnt;
my $sym = look_for_globref($super, 'ISA')
or next;
my $isa = *{$sym}{ARRAY}
or next;
$self->show_isa_tree($depth, $seen, $isa);
}
}
sub get_class_filename {
(my MY $self, my ($cls, $default)) = @_;
my $fnsym = look_for_globref($cls, 'filename')
or return $default;
my $sub = *{$fnsym}{CODE}
or return $default;
$sub->() // $default;
}
sub is_in_template_dir {
(my MY $self, my $path) = @_;
foreach my $dir (lexpand($self->{dispatcher}->{tmpldirs})) {
if (length $dir <= length $path
and substr($dir, 0, length $path) eq $path) {
return 1;
}
}
return 0;
}
sub list_target_dirs {
(my MY $self, my $dirSpec) = @_;
if ($dirSpec) {
$self->rel2abs($dirSpec)
} else {
my $cwd = Cwd::getcwd;
if ($self->is_in_template_dir($cwd)) {
$cwd;
} else {
$self->{dispatcher}->cget('doc_root') // do {
if (my $dir = $self->{dispatcher}->cget('per_role_docroot')) {
[glob("$dir/[a-z]*")];
} else {
Carp::croak "doc_root is empty!"
}
}
}
}
}
sub cmd_list_widgets {
(my MY $self, my ($widgetNameGlob)) = @_;
my $cwdOrFileList = $self->list_target_dirs($self->{cf_from});
require Text::Glob;
walk(
factory => $self->{dispatcher},
from => $cwdOrFileList,
($widgetNameGlob ? (
(name_match => Text::Glob::glob_to_regex($widgetNameGlob))
) : ()),
widget => sub {
my ($args) = @_;
print ":$args->{name}\n";
},
item => sub {
my ($args) = @_;
print "# ", $args->{tree}->cget('path'), "\n";
},
);
# $yatt->get_trans->list_items
# $yatt->get_trans->find_file('index')
# $yatt->get_trans->find_file('index')->list_parts
}