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   3781 use v5.20;
  4         43  
8 4     4   24 use utf8;
  4         8  
  4         30  
9 4     4   580 use Role::Commons -all;
  4         26529  
  4         33  
10 4     4   33823 use feature 'signatures';
  4         10  
  4         447  
11 4     4   33 no warnings "experimental::signatures";
  4         10  
  4         214  
12 4     4   516 use namespace::autoclean 0.16;
  4         11850  
  4         31  
13 4     4   1362 use autodie qw(:all);
  4         27840  
  4         33  
14 4     4   73699 use IPC::System::Simple;
  4         11  
  4         201  
15              
16 4     4   1965 use File::BaseDir qw(data_dirs);
  4         5131  
  4         271  
17 4     4   1503 use Boxer;
  4         13  
  4         139  
18              
19 4     4   1221 use Moo;
  4         6098  
  4         29  
20 4     4   5474 use MooX::StrictConstructor;
  4         5424  
  4         29  
21             extends qw(Boxer::Task);
22              
23 4     4   50959 use Types::Standard qw(Maybe);
  4         127025  
  4         105  
24 4     4   4580 use Boxer::Types qw( WorldName DataDir ClassDir NodeDir Suite );
  4         12  
  4         45  
25              
26 4     4   3700 use strictures 2;
  4         33  
  4         162  
27 4     4   780 no warnings "experimental::signatures";
  4         11  
  4         2631  
28              
29             =head1 VERSION
30              
31             Version v1.4.1
32              
33             =cut
34              
35             our $VERSION = "v1.4.1";
36              
37             # permit callers to sloppily pass undefined values
38 7         19 sub BUILDARGS ( $class, %args )
39 7     7 0 54387 {
  7         30  
  7         15  
40 7         41 delete @args{ grep !defined( $args{$_} ), keys %args };
41 7         139 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             );
56              
57             has suite => (
58             is => 'ro',
59             isa => Suite,
60             required => 1,
61             coerce => 1,
62             default => sub {'buster'},
63             );
64              
65             has classdir => (
66             is => 'lazy',
67             isa => ClassDir,
68             coerce => 1,
69             required => 1,
70             );
71              
72             sub _build_classdir ($self)
73 6     6   141 {
  6         12  
  6         13  
74 6         12 my $dir;
75 6 50       109 if ( $self->datadir ) {
76 6         236 $self->_logger->trace('Resolving classdir from datadir');
77 6         2049 $dir = $self->datadir->child('classes');
78             }
79             else {
80 0         0 $self->_logger->trace('Resolving classdir from XDG_DATA_DIRS');
81 0         0 $dir = scalar data_dirs( 'boxer', $_[0]->suite, 'classes' );
82             }
83 6         319 return $dir;
84             }
85              
86             has nodedir => (
87             is => 'lazy',
88             isa => NodeDir,
89             coerce => 1,
90             required => 1,
91             );
92              
93             sub _build_nodedir ($self)
94 5     5   4089 {
  5         11  
  5         8  
95 5         10 my $dir;
96 5 50       84 if ( $self->datadir ) {
97 5         133 $self->_logger->trace('Resolving nodedir from datadir');
98 5         348 $dir = $self->datadir->child('nodes');
99             }
100             else {
101 0         0 $self->_logger->trace('Setting nodedir to current directory');
102 0         0 $dir = '.';
103             }
104 5         239 return $dir;
105             }
106              
107             sub run ($self)
108 6     6 0 3289 {
  6         13  
  6         11  
109 6         148 my @args = (
110             suite => scalar $self->suite,
111             classdir => scalar $self->classdir,
112             nodedir => scalar $self->nodedir,
113             );
114 5 50       3747 $self->_logger->info(
115             'Classifying with reclass',
116             $self->_logger->is_debug() ? {@args} : (),
117             );
118 5         25238 return Boxer->get_world( $self->world )->new(@args);
119             }
120              
121             =head1 AUTHOR
122              
123             Jonas Smedegaard C<< <dr@jones.dk> >>.
124              
125             =cut
126              
127             our $AUTHORITY = 'cpan:JONASS';
128              
129             =head1 COPYRIGHT AND LICENCE
130              
131             Copyright © 2013-2016 Jonas Smedegaard
132              
133             This is free software; you can redistribute it and/or modify it under
134             the same terms as the Perl 5 programming language system itself.
135              
136             =head1 DISCLAIMER OF WARRANTIES
137              
138             THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
139             WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
140             MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
141              
142             =cut
143              
144             1;