File Coverage

blib/lib/Dpkg/Build/Types.pm
Criterion Covered Total %
statement 55 55 100.0
branch 4 6 66.6
condition 4 8 50.0
subroutine 16 16 100.0
pod 8 8 100.0
total 87 93 93.5


line stmt bran cond sub pod time code
1             # Copyright © 2007 Frank Lichtenheld
2             # Copyright © 2010, 2013-2016 Guillem Jover
3             #
4             # This program is free software; you can redistribute it and/or modify
5             # it under the terms of the GNU General Public License as published by
6             # the Free Software Foundation; either version 2 of the License, or
7             # (at your option) any later version.
8             #
9             # This program is distributed in the hope that it will be useful,
10             # but WITHOUT ANY WARRANTY; without even the implied warranty of
11             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12             # GNU General Public License for more details.
13             #
14             # You should have received a copy of the GNU General Public License
15             # along with this program. If not, see .
16              
17             package Dpkg::Build::Types;
18              
19 1     1   70070 use strict;
  1         10  
  1         30  
20 1     1   5 use warnings;
  1         2  
  1         94  
21              
22             our $VERSION = '0.02';
23             our @EXPORT = qw(
24             BUILD_DEFAULT
25             BUILD_SOURCE
26             BUILD_ARCH_DEP
27             BUILD_ARCH_INDEP
28             BUILD_BINARY
29             BUILD_FULL
30             build_has_any
31             build_has_all
32             build_has_none
33             build_is
34             set_build_type
35             set_build_type_from_options
36             set_build_type_from_targets
37             get_build_options_from_type
38             );
39              
40 1     1   7 use Exporter qw(import);
  1         2  
  1         27  
41              
42 1     1   425 use Dpkg::Gettext;
  1         3  
  1         63  
43 1     1   434 use Dpkg::ErrorHandling;
  1         3  
  1         89  
44              
45             =encoding utf8
46              
47             =head1 NAME
48              
49             Dpkg::Build::Types - track build types
50              
51             =head1 DESCRIPTION
52              
53             The Dpkg::Build::Types module is used by various tools to track and decide
54             what artifacts need to be built.
55              
56             The build types are bit constants that are exported by default. Multiple
57             types can be ORed.
58              
59             =head1 CONSTANTS
60              
61             =over 4
62              
63             =item BUILD_DEFAULT
64              
65             This build is the default.
66              
67             =item BUILD_SOURCE
68              
69             This build includes source artifacts.
70              
71             =item BUILD_ARCH_DEP
72              
73             This build includes architecture dependent binary artifacts.
74              
75             =item BUILD_ARCH_INDEP
76              
77             This build includes architecture independent binary artifacts.
78              
79             =item BUILD_BINARY
80              
81             This build includes binary artifacts.
82              
83             =item BUILD_FULL
84              
85             This build includes source and binary artifacts.
86              
87             =cut
88              
89             # Simple types.
90             use constant {
91 1         80 BUILD_DEFAULT => 1,
92             BUILD_SOURCE => 2,
93             BUILD_ARCH_DEP => 4,
94             BUILD_ARCH_INDEP => 8,
95 1     1   8 };
  1         1  
96              
97             # Composed types.
98 1     1   5 use constant BUILD_BINARY => BUILD_ARCH_DEP | BUILD_ARCH_INDEP;
  1         2  
  1         48  
99 1     1   5 use constant BUILD_FULL => BUILD_BINARY | BUILD_SOURCE;
  1         2  
  1         656  
100              
101             my $current_type = BUILD_FULL | BUILD_DEFAULT;
102             my $current_option = undef;
103              
104             my @build_types = qw(full source binary any all);
105             my %build_types = (
106             full => BUILD_FULL,
107             source => BUILD_SOURCE,
108             binary => BUILD_BINARY,
109             any => BUILD_ARCH_DEP,
110             all => BUILD_ARCH_INDEP,
111             );
112             my %build_targets = (
113             'clean' => BUILD_SOURCE,
114             'build' => BUILD_BINARY,
115             'build-arch' => BUILD_ARCH_DEP,
116             'build-indep' => BUILD_ARCH_INDEP,
117             'binary' => BUILD_BINARY,
118             'binary-arch' => BUILD_ARCH_DEP,
119             'binary-indep' => BUILD_ARCH_INDEP,
120             );
121              
122             =back
123              
124             =head1 FUNCTIONS
125              
126             =over 4
127              
128             =item build_has_any($bits)
129              
130             Return a boolean indicating whether the current build type has any of the
131             specified $bits.
132              
133             =cut
134              
135             sub build_has_any
136             {
137 7     7 1 16 my ($bits) = @_;
138              
139 7         23 return $current_type & $bits;
140             }
141              
142             =item build_has_all($bits)
143              
144             Return a boolean indicating whether the current build type has all the
145             specified $bits.
146              
147             =cut
148              
149             sub build_has_all
150             {
151 8     8 1 18 my ($bits) = @_;
152              
153 8         35 return ($current_type & $bits) == $bits;
154             }
155              
156             =item build_has_none($bits)
157              
158             Return a boolean indicating whether the current build type has none of the
159             specified $bits.
160              
161             =cut
162              
163             sub build_has_none
164             {
165 7     7 1 13 my ($bits) = @_;
166              
167 7         34 return !($current_type & $bits);
168             }
169              
170             =item build_is($bits)
171              
172             Return a boolean indicating whether the current build type is the specified
173             set of $bits.
174              
175             =cut
176              
177             sub build_is
178             {
179 11     11 1 108 my ($bits) = @_;
180              
181 11         49 return $current_type == $bits;
182             }
183              
184             =item set_build_type($build_type, $build_option, %opts)
185              
186             Set the current build type to $build_type, which was specified via the
187             $build_option command-line option.
188              
189             The function will check and abort on incompatible build type assignments,
190             this behavior can be disabled by using the boolean option "nocheck".
191              
192             =cut
193              
194             sub set_build_type
195             {
196 10     10 1 25 my ($build_type, $build_option, %opts) = @_;
197              
198             usageerr(g_('cannot combine %s and %s'), $current_option, $build_option)
199             if not $opts{nocheck} and
200 10 50 66     33 build_has_none(BUILD_DEFAULT) and $current_type != $build_type;
      33        
201              
202 10         13 $current_type = $build_type;
203 10         26 $current_option = $build_option;
204             }
205              
206             =item set_build_type_from_options($build_types, $build_option, %opts)
207              
208             Set the current build type from a list of comma-separated build type
209             components.
210              
211             The function will check and abort on incompatible build type assignments,
212             this behavior can be disabled by using the boolean option "nocheck".
213              
214             =cut
215              
216             sub set_build_type_from_options
217             {
218 3     3 1 13 my ($build_parts, $build_option, %opts) = @_;
219              
220 3         6 my $build_type = 0;
221 3         12 foreach my $type (split /,/, $build_parts) {
222             usageerr(g_('unknown build type %s'), $type)
223 5 50       14 unless exists $build_types{$type};
224 5         11 $build_type |= $build_types{$type};
225             }
226              
227 3         13 set_build_type($build_type, $build_option, %opts);
228             }
229              
230             =item set_build_type_from_targets($build_targets, $build_option, %opts)
231              
232             Set the current build type from a list of comma-separated build target
233             components.
234              
235             The function will check and abort on incompatible build type assignments,
236             this behavior can be disabled by using the boolean option "nocheck".
237              
238             =cut
239              
240             sub set_build_type_from_targets
241             {
242 3     3 1 29 my ($build_targets, $build_option, %opts) = @_;
243              
244 3         14 my $build_type = 0;
245 3         12 foreach my $target (split /,/, $build_targets) {
246 5   50     17 $build_type |= $build_targets{$target} // BUILD_BINARY;
247             }
248              
249 3         12 set_build_type($build_type, $build_option, %opts);
250             }
251              
252             =item get_build_options_from_type()
253              
254             Get the current build type as a set of comma-separated string options.
255              
256             =cut
257              
258             sub get_build_options_from_type
259             {
260 7     7 1 11 my $local_type = $current_type;
261              
262 7         12 my @parts;
263 7         12 foreach my $type (@build_types) {
264 35         51 my $part_bits = $build_types{$type};
265 35 100       69 if (($local_type & $part_bits) == $part_bits) {
266 8         16 push @parts, $type;
267 8         16 $local_type &= ~$part_bits;
268             }
269             }
270              
271 7         41 return join ',', @parts;
272             }
273              
274             =back
275              
276             =head1 CHANGES
277              
278             =head2 Version 0.xx
279              
280             This is a private module.
281              
282             =cut
283              
284             1;