File Coverage

blib/lib/Lego/Part/Action.pm
Criterion Covered Total %
statement 22 40 55.0
branch 0 6 0.0
condition 0 3 0.0
subroutine 7 10 70.0
pod 3 3 100.0
total 32 62 51.6


line stmt bran cond sub pod time code
1             package Lego::Part::Action;
2              
3 3     3   176330 use strict;
  3         6  
  3         128  
4 3     3   27 use warnings;
  3         5  
  3         208  
5              
6 3     3   2291 use Class::Utils qw(set_params);
  3         45639  
  3         69  
7 3     3   266 use English;
  3         11  
  3         20  
8 3     3   1519 use Error::Pure qw(err);
  3         5  
  3         153  
9 3     3   20 use Scalar::Util qw(blessed);
  3         5  
  3         3409  
10              
11             our $VERSION = 0.04;
12              
13             # Constructor.
14             sub new {
15 1     1 1 338079 my ($class, @params) = @_;
16              
17             # Create object.
18 1         4 my $self = bless {}, $class;
19              
20             # Process parameters.
21 1         13 set_params($self, @params);
22              
23             # Object.
24 1         10 return $self;
25             }
26              
27             # Load design id to Lego::Part object.
28             sub load_design_id {
29 0     0 1   my ($self, $part_transfer_class, $part) = @_;
30 0           $self->_check_part_transfer_class($part_transfer_class);
31 0           eval {
32 0           $part_transfer_class->element2design($part);
33             };
34 0 0         if ($EVAL_ERROR) {
35 0           err 'Cannot load design ID.',
36             'Error', $EVAL_ERROR;
37             }
38 0           return;
39             }
40              
41             # Load element id to Lego::Part object.
42             sub load_element_id {
43 0     0 1   my ($self, $part_transfer_class, $part) = @_;
44 0           $self->_check_part_transfer_class($part_transfer_class);
45 0           eval {
46 0           $part_transfer_class->design2element($part);
47             };
48 0 0         if ($EVAL_ERROR) {
49 0           err 'Cannot load element ID.',
50             'Error', $EVAL_ERROR;
51             }
52 0           return;
53             }
54              
55             # Check transfer class.
56             sub _check_part_transfer_class {
57 0     0     my ($self, $part_transfer_class) = @_;
58 0 0 0       if (! blessed($part_transfer_class)
59             || ! $part_transfer_class->isa('Lego::Part::Transfer')) {
60              
61 0           err "Bad transfer class. Must be 'Lego::Part::Transfer' ".
62             'class.';
63             }
64 0           return;
65             }
66              
67             1;
68              
69             __END__