File Coverage

blib/lib/Path/Resolver/Resolver/Archive/Tar.pm
Criterion Covered Total %
statement 19 19 100.0
branch n/a
condition n/a
subroutine 7 7 100.0
pod 0 1 0.0
total 26 27 96.3


line stmt bran cond sub pod time code
1             package Path::Resolver::Resolver::Archive::Tar 3.100455;
2             # ABSTRACT: find content inside a tar archive
3 1     1   534 use Moose;
  1         2  
  1         11  
4 1     1   5599 use Moose::Util::TypeConstraints;
  1         2  
  1         7  
5             with 'Path::Resolver::Role::Resolver';
6              
7 1     1   1804 use namespace::autoclean;
  1         2  
  1         8  
8              
9 1     1   2279 use Archive::Tar;
  1         76190  
  1         59  
10 1     1   9 use File::Spec::Unix;
  1         2  
  1         18  
11 1     1   5 use Path::Resolver::SimpleEntity;
  1         2  
  1         228  
12              
13             #pod =head1 SYNOPSIS
14             #pod
15             #pod my $resolver = Path::Resolver::Resolver::Archive::Tar->new({
16             #pod archive => 'archive-file.tar.gz',
17             #pod });
18             #pod
19             #pod my $simple_entity = $resolver->entity_at('foo/bar.txt');
20             #pod
21             #pod This resolver looks for files inside a tar archive or a compressed tar archive.
22             #pod It uses L<Archive::Tar|Archive::Tar>, and can read any archive understood by
23             #pod that library.
24             #pod
25             #pod The native type of this resolver is a class type of
26             #pod L<Path::Resolver::SimpleEntity|Path::Resolver::SimpleEntity> and it has no
27             #pod default converter.
28             #pod
29             #pod =cut
30              
31 4     4 0 12 sub native_type { class_type('Path::Resolver::SimpleEntity') }
32              
33             #pod =attr archive
34             #pod
35             #pod This attribute stores the Archive::Tar object in which content will be
36             #pod resolved. A simple string may be passed to the constructor to be used as an
37             #pod archive filename.
38             #pod
39             #pod =cut
40              
41             has archive => (
42             is => 'ro',
43             required => 1,
44             initializer => sub {
45             my ($self, $value, $set) = @_;
46              
47             my $archive = ref $value ? $value : Archive::Tar->new($value);
48              
49             confess("$value is not a valid archive value")
50             unless class_type('Archive::Tar')->check($archive);
51            
52             $set->($archive);
53             },
54             );
55              
56             #pod =attr root
57             #pod
58             #pod If given, this attribute specifies a root inside the archive under which to
59             #pod look. This is useful when dealing with an archive in which all content is
60             #pod under a common directory.
61             #pod
62             #pod =cut
63              
64             has root => (
65             is => 'ro',
66             required => 0,
67             );
68              
69             sub entity_at {
70             my ($self, $path) = @_;
71             my $root = $self->root;
72             my @root = (length $root) ? $root : ();
73              
74             my $filename = File::Spec::Unix->catfile(@root, @$path);
75             return unless $self->archive->contains_file($filename);
76             my $content = $self->archive->get_content($filename);
77              
78             Path::Resolver::SimpleEntity->new({ content_ref => \$content });
79             }
80              
81             1;
82              
83             __END__
84              
85             =pod
86              
87             =encoding UTF-8
88              
89             =head1 NAME
90              
91             Path::Resolver::Resolver::Archive::Tar - find content inside a tar archive
92              
93             =head1 VERSION
94              
95             version 3.100455
96              
97             =head1 SYNOPSIS
98              
99             my $resolver = Path::Resolver::Resolver::Archive::Tar->new({
100             archive => 'archive-file.tar.gz',
101             });
102              
103             my $simple_entity = $resolver->entity_at('foo/bar.txt');
104              
105             This resolver looks for files inside a tar archive or a compressed tar archive.
106             It uses L<Archive::Tar|Archive::Tar>, and can read any archive understood by
107             that library.
108              
109             The native type of this resolver is a class type of
110             L<Path::Resolver::SimpleEntity|Path::Resolver::SimpleEntity> and it has no
111             default converter.
112              
113             =head1 PERL VERSION
114              
115             This library should run on perls released even a long time ago. It should work
116             on any version of perl released in the last five years.
117              
118             Although it may work on older versions of perl, no guarantee is made that the
119             minimum required version will not be increased. The version may be increased
120             for any reason, and there is no promise that patches will be accepted to lower
121             the minimum required perl.
122              
123             =head1 ATTRIBUTES
124              
125             =head2 archive
126              
127             This attribute stores the Archive::Tar object in which content will be
128             resolved. A simple string may be passed to the constructor to be used as an
129             archive filename.
130              
131             =head2 root
132              
133             If given, this attribute specifies a root inside the archive under which to
134             look. This is useful when dealing with an archive in which all content is
135             under a common directory.
136              
137             =head1 AUTHOR
138              
139             Ricardo Signes <cpan@semiotic.systems>
140              
141             =head1 COPYRIGHT AND LICENSE
142              
143             This software is copyright (c) 2022 by Ricardo Signes.
144              
145             This is free software; you can redistribute it and/or modify it under
146             the same terms as the Perl 5 programming language system itself.
147              
148             =cut