File Coverage

blib/lib/Boxer/Task/Classify.pm
Criterion Covered Total %
statement 75 79 94.9
branch 3 6 50.0
condition n/a
subroutine 20 20 100.0
pod 0 2 0.0
total 98 107 91.5


line stmt bran cond sub pod time code
1             package Boxer::Task::Classify;
2              
3             =encoding UTF-8
4              
5             =cut
6              
7 4     4   3057 use v5.20;
  4         13  
8 4     4   19 use utf8;
  4         5  
  4         22  
9 4     4   453 use Role::Commons -all;
  4         21575  
  4         25  
10 4     4   27665 use feature 'signatures';
  4         8  
  4         372  
11 4     4   23 no warnings "experimental::signatures";
  4         7  
  4         174  
12 4     4   408 use namespace::autoclean 0.16;
  4         9652  
  4         24  
13 4     4   1108 use autodie qw(:all);
  4         25411  
  4         30  
14 4     4   80604 use IPC::System::Simple;
  4         8  
  4         180  
15              
16 4     4   1649 use File::BaseDir qw(data_dirs);
  4         4420  
  4         216  
17 4     4   1248 use Boxer;
  4         10  
  4         120  
18              
19 4     4   924 use Moo;
  4         4644  
  4         23  
20 4     4   4431 use MooX::StrictConstructor;
  4         4403  
  4         24  
21             extends qw(Boxer::Task);
22              
23 4     4   41779 use Types::Standard qw(Maybe);
  4         103803  
  4         95  
24 4     4   3538 use Boxer::Types qw( WorldName DataDir ClassDir NodeDir Suite );
  4         10  
  4         35  
25              
26 4     4   3030 use strictures 2;
  4         24  
  4         127  
27 4     4   631 no warnings "experimental::signatures";
  4         8  
  4         2132  
28              
29             =head1 VERSION
30              
31             Version v1.4.3
32              
33             =cut
34              
35             our $VERSION = "v1.4.3";
36              
37             # permit callers to sloppily pass undefined values
38 7         16 sub BUILDARGS ( $class, %args )
39 7     7 0 38926 {
  7         25  
  7         13  
40 7         38 delete @args{ grep !defined( $args{$_} ), keys %args };
41 7         141 return {%args};
42             }
43              
44             has world => (
45             is => 'ro',
46             isa => WorldName,
47             required => 1,
48             default => sub {'reclass'},
49             );
50              
51             has datadir => (
52             is => 'lazy',
53             isa => Maybe [DataDir],
54             coerce => 1,
55             default => sub {undef},
56             );
57              
58             has suite => (
59             is => 'ro',
60             isa => Suite,
61             required => 1,
62             coerce => 1,
63             default => sub {'bullseye'},
64             );
65              
66             has classdir => (
67             is => 'lazy',
68             isa => ClassDir,
69             coerce => 1,
70             required => 1,
71             );
72              
73             sub _build_classdir ($self)
74 6     6   115 {
  6         11  
  6         9  
75 6         11 my $dir;
76 6 50       88 if ( $self->datadir ) {
77 6         175 $self->_logger->trace('Resolving classdir from datadir');
78 6         1643 $dir = $self->datadir->child('classes');
79             }
80             else {
81 0         0 $self->_logger->trace('Resolving classdir from XDG_DATA_DIRS');
82 0         0 $dir = scalar data_dirs( 'boxer', $self->suite, 'classes' );
83             }
84 6         256 return $dir;
85             }
86              
87             has nodedir => (
88             is => 'lazy',
89             isa => NodeDir,
90             coerce => 1,
91             required => 1,
92             );
93              
94             sub _build_nodedir ($self)
95 5     5   3359 {
  5         14  
  5         8  
96 5         9 my $dir;
97 5 50       78 if ( $self->datadir ) {
98 5         108 $self->_logger->trace('Resolving nodedir from datadir');
99 5         290 $dir = $self->datadir->child('nodes');
100             }
101             else {
102 0         0 $self->_logger->trace('Setting nodedir to current directory');
103 0         0 $dir = '.';
104             }
105 5         195 return $dir;
106             }
107              
108             sub run ($self)
109 6     6 0 2223 {
  6         13  
  6         12  
110 6         139 my @args = (
111             suite => scalar $self->suite,
112             classdir => scalar $self->classdir,
113             nodedir => scalar $self->nodedir,
114             );
115 5 50       3127 $self->_logger->info(
116             'Classifying with reclass',
117             $self->_logger->is_debug() ? {@args} : (),
118             );
119 5         20682 return Boxer->get_world( $self->world )->new(@args);
120             }
121              
122             =head1 AUTHOR
123              
124             Jonas Smedegaard C<< >>.
125              
126             =cut
127              
128             our $AUTHORITY = 'cpan:JONASS';
129              
130             =head1 COPYRIGHT AND LICENCE
131              
132             Copyright © 2013-2016 Jonas Smedegaard
133              
134             This is free software; you can redistribute it and/or modify it under
135             the same terms as the Perl 5 programming language system itself.
136              
137             =head1 DISCLAIMER OF WARRANTIES
138              
139             THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
140             WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
141             MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
142              
143             =cut
144              
145             1;