has
'+uuid'
=> (
required
=> 0,
);
has
'sort_routine'
=> (
is
=>
'rw'
,
isa
=>
'CodeRef'
,
required
=> 0,
default
=>
sub
{
sub
{
my
$records
=
shift
;
return
(
sort
{
$a
->luid <=>
$b
->luid }
@$records
);
} },
documentation
=>
'A subroutine which takes a arrayref to a list of records and returns them sorted in some way.'
,
);
has
group_routine
=> (
is
=>
'rw'
,
isa
=>
'CodeRef'
,
required
=> 0,
default
=>
sub
{
sub
{
my
$records
=
shift
;
return
[ {
label
=>
''
,
records
=>
$records
} ];
}
},
documentation
=>
'A subroutine which takes an arrayref to a list of records and returns an array of hashrefs { label => $label, records => \@array}'
);
sub
usage_msg {
my
$self
=
shift
;
my
(
$cmd
,
$type_and_subcmd
) =
$self
->get_cmd_and_subcmd_names;
return
<<"END_USAGE";
usage: ${cmd}${type_and_subcmd}
${cmd}${type_and_subcmd} -- prop1=~foo prop2!~bar|baz
END_USAGE
}
sub
default_match { 1 }
sub
get_search_callback {
my
$self
=
shift
;
my
%prop_checks
;
for
my
$check
(
$self
->prop_set) {
push
@{
$prop_checks
{
$check
->{prop} } },
$check
;
}
my
$regex
=
$self
->arg(
'regex'
);
return
sub
{
my
$item
=
shift
;
my
$props
=
$item
->get_props;
my
$did_limit
= 0;
if
(
$self
->prop_names > 0) {
$did_limit
= 1;
for
my
$prop
(
keys
%prop_checks
) {
my
$got
=
$props
->{
$prop
};
my
$ok
= 0;
for
my
$check
(@{
$prop_checks
{
$prop
} }) {
$ok
= 1
if
$self
->_compare(
$check
->{value},
$check
->{cmp},
$got
);
}
return
0
if
!
$ok
;
}
}
if
(
$regex
) {
$did_limit
= 1;
my
$ok
= 0;
for
(
values
%$props
) {
if
(/
$regex
/) {
$ok
= 1;
last
;
}
}
return
0
if
!
$ok
;
}
return
$self
->default_match(
$item
)
if
!
$did_limit
;
return
1;
};
}
sub
_compare {
my
$self
=
shift
;
my
(
$expected
,
$cmp
,
$got
) =
@_
;
$got
=
''
if
!
defined
(
$got
);
if
(
$cmp
eq
'='
) {
return
0
unless
$got
eq
$expected
;
}
elsif
(
$cmp
eq
'=~'
) {
return
0
unless
$got
=~
$expected
;
}
elsif
(
$cmp
eq
'!='
||
$cmp
eq
'<>'
||
$cmp
eq
'ne'
) {
return
0
if
$got
eq
$expected
;
}
elsif
(
$cmp
eq
'!~'
) {
return
0
if
$got
=~
$expected
;
}
return
1;
}
sub
run {
my
$self
=
shift
;
$self
->print_usage
if
$self
->has_arg(
'h'
);
my
$records
=
$self
->get_collection_object();
my
$search_cb
=
$self
->get_search_callback();
$records
->matching(
$search_cb
);
$self
->display_terminal(
$records
);
}
sub
display_terminal {
my
$self
=
shift
;
my
$records
=
shift
;
my
$groups
=
$self
->group_routine->( [
$records
->items] );
foreach
my
$group
( @{
$groups
} ) {
$self
->out_group_heading(
$group
,
$groups
);
$self
->out_record(
$_
)
for
$self
->sort_routine->(
$group
->{records} );
}
}
sub
sort_by_prop {
my
(
$self
,
$prop
,
$records
,
$sort_undef_last
) =
@_
;
no
warnings
'uninitialized'
;
return
(
sort
{
my
$prop_a
=
$a
->prop(
$prop
);
my
$prop_b
=
$b
->prop(
$prop
);
if
(
$sort_undef_last
&& !
defined
(
$prop_a
) ) {
return
1;
}
elsif
(
$sort_undef_last
&& !
defined
(
$prop_b
) ) {
return
-1;
}
else
{
return
$prop_a
cmp
$prop_b
;
}
} @{
$records
});
}
sub
group_by_prop {
my
$self
=
shift
;
my
$prop
=
shift
;
my
$records
=
shift
;
my
$results
= {};
for
my
$record
(
@$records
) {
push
@{
$results
->{ (
$record
->prop(
$prop
) ||
''
) } },
$record
;
}
return
[
map
{ {
label
=>
$_
,
records
=>
$results
->{
$_
} } }
keys
%$results
];
}
sub
out_group_heading {
my
$self
=
shift
;
my
$group
=
shift
;
my
$groups
=
shift
;
return
unless
exists
$group
->{records}->[0];
return
unless
@$groups
> 1;
$group
->{label} ||=
'none'
;
print
"\n"
.
$group
->{label} .
"\n"
. (
"="
x
length
$group
->{label} )
.
"\n\n"
;
}
sub
out_record {
my
$self
=
shift
;
my
$record
=
shift
;
print
$record
->format_summary .
"\n"
;
}
__PACKAGE__->meta->make_immutable;
no
Any::Moose;
1;