File Coverage

blib/lib/ExtUtils/Builder/ArgumentCollector.pm
Criterion Covered Total %
statement 30 30 100.0
branch 3 4 75.0
condition 2 4 50.0
subroutine 9 9 100.0
pod 0 5 0.0
total 44 52 84.6


line stmt bran cond sub pod time code
1             package ExtUtils::Builder::ArgumentCollector;
2             $ExtUtils::Builder::ArgumentCollector::VERSION = '0.036';
3 4     4   1928 use strict;
  4         12  
  4         178  
4 4     4   24 use warnings;
  4         7  
  4         1224  
5              
6             sub _init {
7 15     15   50 my ($self, %args) = @_;
8 15   50     126 $self->{arguments} = $args{arguments} // [];
9 15         71 return;
10             }
11              
12             sub add_argument {
13 3     3 0 457 my ($self, %arguments) = @_;
14 3         10 $arguments{ranking} = $self->fix_ranking(delete @arguments{qw/ranking fix/});
15 3         6 push @{ $self->{arguments} }, $self->new_argument(%arguments);
  3         10  
16 3         7 return;
17             }
18              
19             sub new_argument {
20 31     31 0 90 my ($self, %args) = @_;
21 31   50     138 return [ $args{ranking} // 50, $args{value} ];
22             }
23              
24             sub collect_arguments {
25 15     15 0 27 my $self = shift;
26 15         30 return @{ $self->{arguments} };
  15         68  
27             }
28              
29             sub arguments {
30 15     15 0 45 my ($self, @args) = @_;
31 4     4   1925 use sort 'stable';
  4         1477  
  4         24  
32 15         63 return map { @{ $_->[1] } } sort { $a->[0] <=> $b->[0] } $self->collect_arguments(@args);
  31         48  
  31         109  
  20         57  
33             }
34              
35             sub fix_ranking {
36 10     10 0 31 my (undef, $baseline, $override) = @_;
37 10 100       29 return $baseline if not defined $override;
38 1 50       4 return (ref($override) eq 'CODE') ? $override->($baseline) : $override;
39             }
40              
41             1;
42              
43             =pod
44              
45             =encoding UTF-8
46              
47             =head1 NAME
48              
49             ExtUtils::Builder::ArgumentCollector - Helper role for argument collecting classes
50              
51             =head1 VERSION
52              
53             version 0.036
54              
55             =head1 DESCRIPTION
56              
57             This is a helper role for classes that collect arguments for their command. Classes that use this include ExtUtils::Builder::Compiler and ExtUtils::Builder::Linker
58              
59             =head1 AUTHOR
60              
61             Leon Timmermans
62              
63             =head1 COPYRIGHT AND LICENSE
64              
65             This software is copyright (c) 2012 by Leon Timmermans.
66              
67             This is free software; you can redistribute it and/or modify it under
68             the same terms as the Perl 5 programming language system itself.
69              
70             =cut
71              
72             __END__