Commit | Line | Data |
---|---|---|
1479465f GJ |
1 | # Copyright © 2008 Raphaël Hertzog <hertzog@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 | package Dpkg::Source::Package::V3::Native; | |
17 | ||
18 | use strict; | |
19 | use warnings; | |
20 | ||
21 | our $VERSION = '0.01'; | |
22 | ||
23 | use Cwd; | |
24 | use File::Basename; | |
25 | use File::Temp qw(tempfile); | |
26 | ||
27 | use Dpkg::Gettext; | |
28 | use Dpkg::ErrorHandling; | |
29 | use Dpkg::Compression; | |
30 | use Dpkg::Exit qw(push_exit_handler pop_exit_handler); | |
31 | use Dpkg::Version; | |
32 | use Dpkg::Source::Archive; | |
33 | use Dpkg::Source::Functions qw(erasedir); | |
34 | ||
35 | use parent qw(Dpkg::Source::Package); | |
36 | ||
37 | our $CURRENT_MINOR_VERSION = '0'; | |
38 | ||
39 | sub do_extract { | |
40 | my ($self, $newdirectory) = @_; | |
41 | my $sourcestyle = $self->{options}{sourcestyle}; | |
42 | my $fields = $self->{fields}; | |
43 | ||
44 | my $dscdir = $self->{basedir}; | |
45 | my $basename = $self->get_basename(); | |
46 | my $basenamerev = $self->get_basename(1); | |
47 | ||
48 | my $tarfile; | |
49 | my $comp_ext_regex = compression_get_file_extension_regex(); | |
50 | foreach my $file ($self->get_files()) { | |
51 | if ($file =~ /^\Q$basenamerev\E\.tar\.$comp_ext_regex$/) { | |
52 | error(g_('multiple tarfiles in v1.0 source package')) if $tarfile; | |
53 | $tarfile = $file; | |
54 | } else { | |
55 | error(g_('unrecognized file for a native source package: %s'), $file); | |
56 | } | |
57 | } | |
58 | ||
59 | error(g_('no tarfile in Files field')) unless $tarfile; | |
60 | ||
61 | if ($self->{options}{no_overwrite_dir} and -e $newdirectory) { | |
62 | error(g_('unpack target exists: %s'), $newdirectory); | |
63 | } else { | |
64 | erasedir($newdirectory); | |
65 | } | |
66 | ||
67 | info(g_('unpacking %s'), $tarfile); | |
68 | my $tar = Dpkg::Source::Archive->new(filename => "$dscdir$tarfile"); | |
69 | $tar->extract($newdirectory); | |
70 | } | |
71 | ||
72 | sub can_build { | |
73 | my ($self, $dir) = @_; | |
74 | ||
75 | my $v = Dpkg::Version->new($self->{fields}->{'Version'}); | |
76 | return (0, g_('native package version may not have a revision')) | |
77 | unless $v->is_native(); | |
78 | ||
79 | return 1; | |
80 | } | |
81 | ||
82 | sub do_build { | |
83 | my ($self, $dir) = @_; | |
84 | my @tar_ignore = map { "--exclude=$_" } @{$self->{options}{tar_ignore}}; | |
85 | my @argv = @{$self->{options}{ARGV}}; | |
86 | ||
87 | if (scalar(@argv)) { | |
88 | usageerr(g_("-b takes only one parameter with format '%s'"), | |
89 | $self->{fields}{'Format'}); | |
90 | } | |
91 | ||
92 | my $sourcepackage = $self->{fields}{'Source'}; | |
93 | my $basenamerev = $self->get_basename(1); | |
94 | my $tarname = "$basenamerev.tar." . $self->{options}{comp_ext}; | |
95 | ||
96 | info(g_('building %s in %s'), $sourcepackage, $tarname); | |
97 | ||
98 | my ($ntfh, $newtar) = tempfile("$tarname.new.XXXXXX", | |
99 | DIR => getcwd(), UNLINK => 0); | |
100 | push_exit_handler(sub { unlink($newtar) }); | |
101 | ||
102 | my ($dirname, $dirbase) = fileparse($dir); | |
103 | my $tar = Dpkg::Source::Archive->new(filename => $newtar, | |
104 | compression => compression_guess_from_filename($tarname), | |
105 | compression_level => $self->{options}{comp_level}); | |
106 | $tar->create(options => \@tar_ignore, chdir => $dirbase); | |
107 | $tar->add_directory($dirname); | |
108 | $tar->finish(); | |
109 | rename($newtar, $tarname) | |
110 | or syserr(g_("unable to rename '%s' (newly created) to '%s'"), | |
111 | $newtar, $tarname); | |
112 | pop_exit_handler(); | |
113 | chmod(0666 &~ umask(), $tarname) | |
114 | or syserr(g_("unable to change permission of '%s'"), $tarname); | |
115 | ||
116 | $self->add_file($tarname); | |
117 | } | |
118 | ||
119 | 1; |