has
'_formatters'
=> (
is
=>
"rw"
,
isa
=>
"HashRef"
,
default
=>
sub
{ +{} },);
sub
copy_from
{
my
(
$dest
,
$source
,
$fields
) =
@_
;
foreach
my
$f
(
@$fields
)
{
$dest
->
$f
(
$source
->
$f
());
}
return
;
}
sub
_get_formatter
{
my
(
$self
,
$fmt
) =
@_
;
return
Text::Sprintf::Named->new(
{
fmt
=>
$fmt
, },
);
}
sub
_register_formatter
{
my
(
$self
,
$name
,
$fmt
) =
@_
;
$self
->_formatters->{
$name
} =
$self
->_get_formatter(
$fmt
);
return
;
}
sub
_get_obj_formatter
{
my
(
$self
,
$fmt
) =
@_
;
return
Test::Run::Sprintf::Named::FromAccessors->new(
{
fmt
=>
$fmt
, },
);
}
sub
_register_obj_formatter
{
my
(
$self
,
$args
) =
@_
;
my
$name
=
$args
->{name};
my
$fmt
=
$args
->{
format
};
$self
->_formatters->{
$name
} =
$self
->_get_obj_formatter(
$fmt
);
return
;
}
sub
_format
{
my
(
$self
,
$format
,
$args
) =
@_
;
if
(
ref
(
$format
) eq
""
)
{
return
$self
->_formatters->{
$format
}->
format
({
args
=>
$args
});
}
else
{
return
$self
->_get_formatter(${
$format
})->
format
({
args
=>
$args
});
}
}
sub
_format_self
{
my
(
$self
,
$format
,
$args
) =
@_
;
$args
||= {};
return
$self
->_format(
$format
, {
obj
=>
$self
, %{
$args
}});
}
sub
accum_array
{
my
(
$self
,
$args
) =
@_
;
my
$method_name
=
$args
->{method};
my
@results
;
foreach
my
$isa_class
(
$self
->meta->find_all_methods_by_name(
$method_name
)
)
{
my
$body
=
$isa_class
->{code}->body();
push
@results
, @{
$self
->
$body
() };
}
return
\
@results
;
}
sub
_list_pluralize
{
my
(
$self
,
$noun
,
$list
) =
@_
;
return
$self
->_pluralize(
$noun
,
scalar
(
@$list
));
}
sub
_pluralize
{
my
(
$self
,
$noun
,
$count
) =
@_
;
return
sprintf
(
"%s%s"
,
$noun
,
((
$count
> 1) ?
"s"
:
""
)
);
}
sub
_run_sequence
{
my
$self
=
shift
;
my
$params
=
shift
|| [];
my
$sub
= (
caller
(1))[3];
$sub
=~ s{::_?([^:]+)$}{};
my
$calc_cbs_sub
=
"_calc__${1}__callbacks"
;
return
[
map
{
my
$cb
=
$_
;
$self
->
$cb
(
@$params
); }
@{
$self
->
$calc_cbs_sub
(
@$params
)}
];
}
1;