sub
sorted_sub_command_classes {
no
warnings;
my
@c
=
shift
->sub_command_classes;
my
@commands_with_position
=
map
{ [
$_
->sub_command_sort_position,
$_
] }
@c
;
return
map
{
$_
->[1] }
sort
{ (
$a
->[0] <=>
$b
->[0])
||
(
$a
->[0] cmp
$b
->[0])
}
@commands_with_position
;
}
sub
sorted_sub_command_names {
my
$class
=
shift
;
my
@sub_command_classes
=
$class
->sorted_sub_command_classes;
my
@sub_command_names
=
map
{
$_
->command_name_brief }
@sub_command_classes
;
return
@sub_command_names
;
}
sub
sub_commands_table {
my
$class
=
shift
;
my
@sub_command_names
=
$class
->sorted_sub_command_names;
my
$max_length
= 0;
for
(
@sub_command_names
) {
$max_length
=
length
(
$_
)
if
(
$max_length
<
length
(
$_
));
}
$max_length
||= 79;
my
$col_spacer
=
'_'
x
$max_length
;
my
$n_cols
= floor(80/
$max_length
);
my
$n_rows
= ceil(
@sub_command_names
/
$n_cols
);
my
@tb_rows
;
for
(
my
$i
= 0;
$i
<
@sub_command_names
;
$i
+=
$n_cols
) {
my
$end
=
$i
+
$n_cols
- 1;
$end
=
$#sub_command_names
if
(
$end
>
$#sub_command_names
);
push
@tb_rows
, [
@sub_command_names
[
$i
..
$end
]];
}
my
@col_alignment
;
for
(
my
$i
= 0;
$i
<
$n_cols
;
$i
++) {
push
@col_alignment
, {
sample
=>
"&$col_spacer"
};
}
my
$tb
= Text::Table->new(
@col_alignment
);
$tb
->load(
@tb_rows
);
return
$tb
;
}
sub
help_sub_commands {
my
$class
=
shift
;
my
%params
=
@_
;
my
$command_name_method
=
'command_name_brief'
;
my
@sub_command_classes
=
$class
->sorted_sub_command_classes;
my
%categories
;
my
@categories
;
for
my
$sub_command_class
(
@sub_command_classes
) {
my
$category
=
$sub_command_class
->sub_command_category;
$category
=
''
if
not
defined
$category
;
next
if
$sub_command_class
->_is_hidden_in_docs();
my
$sub_commands_within_category
=
$categories
{
$category
};
unless
(
$sub_commands_within_category
) {
if
(
defined
$category
and
length
$category
) {
push
@categories
,
$category
;
}
else
{
unshift
@categories
,
''
;
}
$sub_commands_within_category
=
$categories
{
$category
} = [];
}
push
@$sub_commands_within_category
,
$sub_command_class
;
}
no
warnings;
local
$Text::Wrap::columns
= 60;
my
$full_text
=
''
;
my
@full_data
;
for
my
$category
(
@categories
) {
my
$sub_commands_within_this_category
=
$categories
{
$category
};
my
@data
=
map
{
my
@rows
=
split
(
"\n"
,Text::Wrap::wrap(
''
,
' '
,
$_
->help_brief));
chomp
@rows
;
(
[
$_
->
$command_name_method
,
$_
->_shell_args_usage_string_abbreviated,
$rows
[0],
],
map
{
[
''
,
' '
,
$rows
[
$_
],
]
} (1..
$#rows
)
);
}
@$sub_commands_within_this_category
;
if
(
$category
) {
push
@full_data
, [
''
,
''
,
''
]
if
@full_data
;
if
(
$category
=~ /\D/) {
$category
.=
':'
if
$category
=~ /\S/;
push
@full_data
,
[
Term::ANSIColor::colored(
uc
(
$category
),
'blue'
),
''
,
''
];
}
else
{
}
}
push
@full_data
,
@data
;
}
my
@max_width_found
= (0,0,0);
for
(
@full_data
) {
for
my
$c
(0..2) {
$max_width_found
[
$c
] =
length
(
$_
->[
$c
])
if
$max_width_found
[
$c
] <
length
(
$_
->[
$c
]);
}
}
my
@colors
= (
qw/ red bold /
);
my
$text
=
''
;
for
my
$row
(
@full_data
) {
for
my
$c
(0..2) {
$text
.=
' '
;
$text
.= Term::ANSIColor::colored(
$row
->[
$c
],
$colors
[
$c
]),
$text
.=
' '
;
$text
.=
' '
x (
$max_width_found
[
$c
]-
length
(
$row
->[
$c
]));
}
$text
.=
"\n"
;
}
return
$text
;
}
sub
sub_command_dirs {
my
$class
=
shift
;
my
$subdir
=
ref
(
$class
) ||
$class
;
$subdir
=~ s|::|\/|g;
my
@dirs
=
grep
{ -d
$_
}
map
{
$_
.
'/'
.
$subdir
}
@INC
;
return
@dirs
;
}
sub
sub_command_classes {
my
$class
=
shift
;
my
$mapping
=
$class
->_build_sub_command_mapping;
return
values
%$mapping
;
}
sub
_build_sub_command_mapping {
my
$class
=
shift
;
$class
=
ref
(
$class
) ||
$class
;
my
$mapping
;
do
{
no
strict
'refs'
;
$mapping
= ${
$class
.
'::SUB_COMMAND_MAPPING'
};
};
unless
(
defined
$mapping
) {
my
$subdir
=
$class
;
$subdir
=~ s|::|\/|g;
for
my
$lib
(
@INC
) {
my
$subdir_full_path
=
$lib
.
'/'
.
$subdir
;
next
unless
-d
$subdir_full_path
;
my
@files
=
glob
(
"\Q${subdir_full_path}\E/*"
);
next
unless
@files
;
for
my
$file
(
@files
) {
my
$basename
= basename(
$file
);
$basename
=~ s/.pm$//;
my
$sub_command_class_name
=
$class
.
'::'
.
$basename
;
my
$sub_command_class_meta
= UR::Object::Type->get(
$sub_command_class_name
);
unless
(
$sub_command_class_meta
) {
local
$SIG
{__DIE__};
local
$SIG
{__WARN__};
eval
"use $sub_command_class_name"
;
}
$sub_command_class_meta
= UR::Object::Type->get(
$sub_command_class_name
);
next
unless
$sub_command_class_name
->isa(
"Command"
);
next
if
$sub_command_class_meta
->is_abstract;
my
$name
=
$class
->_command_name_for_class_word(
$basename
);
$mapping
->{
$name
} =
$sub_command_class_name
;
}
}
}
return
$mapping
;
}
sub
sub_command_names {
my
$class
=
shift
;
my
$mapping
=
$class
->_build_sub_command_mapping;
return
keys
%$mapping
;
}
sub
class_for_sub_command
{
my
$self
=
shift
;
my
$class
=
ref
(
$self
) ||
$self
;
my
$sub_command
=
shift
;
return
if
$sub_command
=~ /^\-/;
my
$sub_class
=
join
(
""
,
map
{
ucfirst
(
$_
) }
split
(/-/,
$sub_command
));
$sub_class
=
$class
.
"::"
.
$sub_class
;
my
$meta
= UR::Object::Type->get(
$sub_class
);
unless
(
$meta
) {
eval
"use $sub_class;"
;
if
($@) {
if
($@ =~ /^Can't locate .*\.pm in \
@INC
/) {
return
;
}
else
{
my
@msg
=
split
(
"\n"
,$@);
pop
@msg
;
pop
@msg
;
$self
->error_message(
"$sub_class failed to compile!:\n@msg\n\n"
);
return
;
}
}
}
elsif
(
my
$isa
=
$sub_class
->isa(
"Command"
)) {
if
(
ref
(
$isa
)) {
if
(
$sub_class
->SUPER::isa(
"Command"
)) {
return
$sub_class
;
}
else
{
return
;
}
}
return
$sub_class
;
}
else
{
return
;
}
}
1;
1;