File: | Dpkg/BuildTree.pm |
Coverage: | 88.4% |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | # Copyright © 2023 Guillem Jover <guillem@debian.org> | ||||||
2 | # | ||||||
3 | # This program is free software; you can redistribute it and/or modify | ||||||
4 | # it under the terms of the GNU General Public License as published by | ||||||
5 | # the Free Software Foundation; either version 2 of the License, or | ||||||
6 | # (at your option) any later version. | ||||||
7 | # | ||||||
8 | # This program is distributed in the hope that it will be useful, | ||||||
9 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | ||||||
10 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||||||
11 | # GNU General Public License for more details. | ||||||
12 | # | ||||||
13 | # You should have received a copy of the GNU General Public License | ||||||
14 | # along with this program. If not, see <https://www.gnu.org/licenses/>. | ||||||
15 | |||||||
16 | =encoding utf8 | ||||||
17 | |||||||
18 - 28 | =head1 NAME Dpkg::BuildTree - handle build tree actions =head1 DESCRIPTION The Dpkg::BuildTree module provides functions to handle build tree actions. B<Note>: This is a private module, its API can change at any time. =cut | ||||||
29 | |||||||
30 | package Dpkg::BuildTree 0.01; | ||||||
31 | |||||||
32 | 3 3 3 | 9 4 53 | use strict; | ||||
33 | 3 3 3 | 6 3 93 | use warnings; | ||||
34 | |||||||
35 | 3 3 3 | 6 3 127 | use Cwd; | ||||
36 | |||||||
37 | 3 3 3 | 546 4 401 | use Dpkg::Source::Functions qw(erasedir); | ||||
38 | |||||||
39 - 57 | =head1 METHODS =over 4 =item $bt = Dpkg::BuildTree->new(%opts) Create a new Dpkg::BuildTree object. Supported options are: =over 8 =item dir The build tree directory. If not specified, it assumes the current working directory. =back =cut | ||||||
58 | |||||||
59 | sub new { | ||||||
60 | 3 | 1 | 9 | my ($this, %opts) = @_; | |||
61 | 3 | 17 | my $class = ref($this) || $this; | ||||
62 | |||||||
63 | my $self = { | ||||||
64 | 3 | 7 | buildtree => $opts{dir} || getcwd(), | ||||
65 | }; | ||||||
66 | 3 | 4 | bless $self, $class; | ||||
67 | |||||||
68 | 3 | 6 | return $self; | ||||
69 | } | ||||||
70 | |||||||
71 - 75 | =item $bt->clean() Clean the build tree, by removing any dpkg generated artifacts. =cut | ||||||
76 | |||||||
77 | sub clean { | ||||||
78 | 3 | 1 | 3 | my $self = shift; | |||
79 | |||||||
80 | 3 | 11 | my $buildtree = $self->{buildtree}; | ||||
81 | |||||||
82 | # If this does not look like a build tree, do nothing. | ||||||
83 | 3 | 11 | return unless -f "$buildtree/debian/control"; | ||||
84 | |||||||
85 | 3 | 5 | my @files = qw( | ||||
86 | debian/files | ||||||
87 | debian/files.new | ||||||
88 | debian/substvars | ||||||
89 | debian/substvars.new | ||||||
90 | ); | ||||||
91 | 3 | 4 | my @dirs = qw( | ||||
92 | debian/tmp | ||||||
93 | ); | ||||||
94 | |||||||
95 | 3 | 5 | foreach my $file (@files) { | ||||
96 | 12 | 137 | unlink "$buildtree/$file"; | ||||
97 | } | ||||||
98 | 3 | 3 | foreach my $dir (@dirs) { | ||||
99 | 3 | 6 | erasedir("$buildtree/$dir"); | ||||
100 | } | ||||||
101 | |||||||
102 | 3 | 37 | return; | ||||
103 | } | ||||||
104 | |||||||
105 | =back | ||||||
106 | |||||||
107 - 113 | =head1 CHANGES =head2 Version 0.xx This is a private module. =cut | ||||||
114 | |||||||
115 | 1; |