File Coverage

blib/lib/Dist/Zilla/Plugin/ArchiveTar.pm
Criterion Covered Total %
statement 61 63 96.8
branch 8 16 50.0
condition 1 3 33.3
subroutine 11 11 100.0
pod 0 1 0.0
total 81 94 86.1


line stmt bran cond sub pod time code
1 1     1   413818 use strict;
  1         9  
  1         31  
2 1     1   6 use warnings;
  1         2  
  1         45  
3 1     1   21 use 5.020;
  1         4  
4 1     1   5 use experimental qw( postderef );
  1         3  
  1         9  
5              
6             package Dist::Zilla::Plugin::ArchiveTar 0.02 {
7              
8 1     1   789 use Moose;
  1         445572  
  1         7  
9 1     1   7454 use Archive::Tar;
  1         3  
  1         68  
10 1     1   972 use Path::Tiny ();
  1         11536  
  1         28  
11 1     1   8 use Moose::Util::TypeConstraints;
  1         2  
  1         14  
12 1     1   2315 use namespace::autoclean;
  1         3  
  1         9  
13 1     1   87 use experimental qw( signatures postderef );
  1         3  
  1         9  
14              
15             # ABSTRACT: Create dist archives using Archive::Tar
16              
17              
18             with 'Dist::Zilla::Role::ArchiveBuilder';
19              
20             enum ArchiveFormat => [qw/ tar tar.gz tar.bz2 tar.xz /];
21              
22             has format => (
23             is => 'ro',
24             isa => 'ArchiveFormat',
25             required => 1,
26             default => 'tar.gz',
27             );
28              
29             our $VERBOSE;
30              
31 2         8 sub build_archive ($self, $archive_basename, $built_in, $basedir)
  2         5  
  2         4  
32 2     2 0 163669 {
  2         6  
  2         7  
33 2         30 my $archive = Archive::Tar->new;
34              
35 2         113 my $archive_path = Path::Tiny->new(join '.', $archive_basename, $self->format);
36              
37 2         74 my %dirs;
38 2   33     10 my $verbose = $VERBOSE || $self->zilla->logger->get_debug;
39              
40 2         6 my $now = time;
41 2         66 foreach my $distfile (sort { $a->name cmp $b->name } $self->zilla->files->@*)
  6         480  
42             {
43             {
44 6         3696 my @parts = split /\//, $distfile->name;
  6         25  
45 6         347 pop @parts;
46              
47 6         18 my $dir = '';
48 6         20 foreach my $part ('', @parts)
49             {
50 18         1230 $dir .= "/$part";
51 18 100       57 next if $dirs{$dir};
52 8         25 $dirs{$dir} = 1;
53              
54 8 50       51 $self->log("DIR @{[ $basedir->child($dir) ]}") if $verbose;
  8         36  
55 8         3175 $archive->add_data(
56             $basedir->child($dir),
57             '',
58             {
59             type => Archive::Tar::Constant::DIR(),
60             mode => oct('0755'),
61             mtime => $now,
62             uid => 0,
63             gid => 0,
64             uname => 'root',
65             gname => 'root',
66             }
67             );
68             }
69             }
70              
71 6 50       1665 $self->log("FILE @{[ $basedir->child($distfile->name) ]}") if $verbose;
  6         28  
72 6 50       2504 $archive->add_data(
73             $basedir->child($distfile->name),
74             $built_in->child($distfile->name)->slurp_raw,
75             {
76             mode => -x $built_in->child($distfile->name) ? oct('0755') : oct('0644'),
77             mtime => $now,
78             uid => 0,
79             gid => 0,
80             uname => 'root',
81             gname => 'root',
82             },
83             );
84             }
85              
86 2         1499 $self->log("writing archive to $archive_path");
87              
88 2 100       685 if($self->format eq 'tar.gz')
    50          
    0          
    0          
89             {
90 1         7 $archive->write("$archive_path", Archive::Tar::COMPRESS_GZIP());
91             }
92             elsif($self->format eq 'tar')
93             {
94 1         4 $archive->write("$archive_path");
95             }
96             elsif($self->format eq 'tar.bz2')
97             {
98 0         0 $archive->write("$archive_path", Archive::Tar::COMPRESS_BZIP());
99             }
100             elsif($self->format eq 'tar.xz')
101             {
102 0         0 $archive->write("$archive_path", Archive::Tar::COMPRESS_XZ());
103             }
104              
105 2         11478 return $archive_path;
106             }
107              
108             __PACKAGE__->meta->make_immutable;
109             }
110              
111             1;
112              
113             __END__
114              
115             =pod
116              
117             =encoding UTF-8
118              
119             =head1 NAME
120              
121             Dist::Zilla::Plugin::ArchiveTar - Create dist archives using Archive::Tar
122              
123             =head1 VERSION
124              
125             version 0.02
126              
127             =head1 SYNOPSIS
128              
129             In your C<dist.ini>
130              
131             [ArchiveTar]
132              
133             =head1 DESCRIPTION
134              
135             This L<Dist::Zilla> plugin overrides the build in archive builder and uses L<Archive::Tar> only.
136             Although L<Dist::Zilla> does frequently use L<Archive::Tar> itself, it is different from the built
137             in version in the following ways:
138              
139             =over 4
140              
141             =item Predictable
142              
143             The built in behavior will sometimes use L<Archive::Tar> or L<Archive::Tar::Wrapper>. The problem with L<Archive::Tar::Wrapper>
144             is that it depends on the system implementation of tar, which in some cases can produce archives that are not readable by older
145             implementations of tar. In particular GNU tar which is typically the default on Linux systems includes unnecessary features that
146             break tar on HP-UX. (You should probably be getting off HP-UX if you are still using it in 2021 as I write this).
147              
148             =item Sorted by name
149              
150             The contents of the archive are sorted by name instead of being sorted by filename length. While sorting by length makes for
151             a pretty display when they are unpacked, I find it harder to find stuff when the content is listed.
152              
153             =item Additional formats
154              
155             This plugin supports the use of compression formats supported by L<Archive::Tar>.
156              
157             =back
158              
159             =head1 PROPERTIES
160              
161             =head2 format
162              
163             [ArchiveTar]
164             format = tar.gz
165              
166             Sets the output format. The default, most common and easiest to unpack for cpan clients is C<tar.gz>. You should consider
167             carefully before not using the default. Supported formats:
168              
169             =over 4
170              
171             =item C<tar>
172              
173             =item C<tar.gz>
174              
175             =item C<tar.bz2>
176              
177             =item C<tar.xz>
178              
179             =back
180              
181             =head1 SEE ALSO
182              
183             =over 4
184              
185             =item L<Archive::Libarchive>
186              
187             =item L<Dist::Zilla>
188              
189             =item L<Dist::Zilla::Plugin::Libarchive>
190              
191             =item L<Dist::Zilla::Role::ArchiveBuilder>
192              
193             =back
194              
195             =head1 AUTHOR
196              
197             Graham Ollis <plicease@cpan.org>
198              
199             =head1 COPYRIGHT AND LICENSE
200              
201             This software is copyright (c) 2021 by Graham Ollis.
202              
203             This is free software; you can redistribute it and/or modify it under
204             the same terms as the Perl 5 programming language system itself.
205              
206             =cut