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   3563 use v5.20;
  4         13  
8 4     4   20 use utf8;
  4         7  
  4         24  
9 4     4   454 use Role::Commons -all;
  4         20871  
  4         24  
10 4     4   28464 use feature 'signatures';
  4         10  
  4         411  
11 4     4   47 no warnings "experimental::signatures";
  4         7  
  4         187  
12 4     4   472 use namespace::autoclean 0.16;
  4         9756  
  4         24  
13 4     4   1143 use autodie qw(:all);
  4         22803  
  4         23  
14 4     4   67080 use IPC::System::Simple;
  4         8  
  4         184  
15              
16 4     4   1878 use File::BaseDir qw(data_dirs);
  4         5159  
  4         250  
17 4     4   1303 use Boxer;
  4         10  
  4         126  
18              
19 4     4   935 use Moo;
  4         4591  
  4         23  
20 4     4   4444 use MooX::StrictConstructor;
  4         4419  
  4         32  
21             extends qw(Boxer::Task);
22              
23 4     4   41601 use Types::Standard qw(Maybe);
  4         103314  
  4         99  
24 4     4   3996 use Boxer::Types qw( WorldName DataDir ClassDir NodeDir Suite );
  4         11  
  4         42  
25              
26 4     4   3324 use strictures 2;
  4         28  
  4         151  
27 4     4   698 no warnings "experimental::signatures";
  4         11  
  4         2393  
28              
29             =head1 VERSION
30              
31             Version v1.4.2
32              
33             =cut
34              
35             our $VERSION = "v1.4.2";
36              
37             # permit callers to sloppily pass undefined values
38 7         14 sub BUILDARGS ( $class, %args )
39 7     7 0 43296 {
  7         26  
  7         11  
40 7         40 delete @args{ grep !defined( $args{$_} ), keys %args };
41 7         118 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 {'buster'},
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   118 {
  6         11  
  6         9  
75 6         11 my $dir;
76 6 50       92 if ( $self->datadir ) {
77 6         170 $self->_logger->trace('Resolving classdir from datadir');
78 6         1692 $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', $_[0]->suite, 'classes' );
83             }
84 6         273 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   3659 {
  5         9  
  5         10  
96 5         11 my $dir;
97 5 50       74 if ( $self->datadir ) {
98 5         113 $self->_logger->trace('Resolving nodedir from datadir');
99 5         307 $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         216 return $dir;
106             }
107              
108             sub run ($self)
109 6     6 0 2483 {
  6         13  
  6         13  
110 6         149 my @args = (
111             suite => scalar $self->suite,
112             classdir => scalar $self->classdir,
113             nodedir => scalar $self->nodedir,
114             );
115 5 50       3291 $self->_logger->info(
116             'Classifying with reclass',
117             $self->_logger->is_debug() ? {@args} : (),
118             );
119 5         22059 return Boxer->get_world( $self->world )->new(@args);
120             }
121              
122             =head1 AUTHOR
123              
124             Jonas Smedegaard C<< <dr@jones.dk> >>.
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;