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