Sponsoring The Perl Toolchain Summit 2025: Help make this important event another success Learn more

THALJEF / Pinto-0.14 / lib / Pinto / ArchiveUnpacker.pm 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
—
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103

              
# ABSTRACT: Unpack an archive into a temporary directory
package Pinto::ArchiveUnpacker;
use Moose;
use MooseX::StrictConstructor;
use MooseX::Types::Moose qw(Bool);
use MooseX::MarkAsMethods ( autoclean => 1 );
use Cwd qw(getcwd);
use Cwd::Guard qw(cwd_guard);
use Path::Class qw(dir);
use Archive::Extract;
use File::Temp;
use Pinto::Types qw(File);
use Pinto::Util qw(debug throw);
#-----------------------------------------------------------------------------
our $VERSION = '0.14'; # VERSION
#-----------------------------------------------------------------------------
has archive => (
    is       => 'ro',
    isa      => File,
    required => 1,
    coerce   => 1,
);
has temp_dir => (
    is      => 'ro',
    isa     => 'File::Temp::Dir',
    default => sub { File::Temp->newdir( CLEANUP => $_[0]->cleanup ) },
    lazy    => 1,
);
has cleanup => (
    is      => 'ro',
    isa     => Bool,
    default => 1,
);
#-----------------------------------------------------------------------------
sub unpack {
    my ($self) = @_;
    my $archive   = $self->archive;
    my $temp_dir  = $self->temp_dir->dirname;
    my $cwd_guard = cwd_guard(getcwd);          # Archive::Extract will chdir
    local $Archive::Extract::PREFER_BIN = 1;
    local $Archive::Extract::DEBUG = 1 if ( $ENV{PINTO_DEBUG} || 0 ) > 1;
    my $ae = Archive::Extract->new( archive => $archive );
    debug "Unpacking $archive into $temp_dir";
    my $ok = $ae->extract( to => $temp_dir );
    throw "Failed to unpack $archive: " . $ae->error if not $ok;
    my @children = dir($temp_dir)->children;
    return @children == 1 && -d $children[0] ? $children[0] : dir($temp_dir);
}
#-----------------------------------------------------------------------------
__PACKAGE__->meta->make_immutable;
#-----------------------------------------------------------------------------
1;
__END__
=pod
=encoding UTF-8
=for :stopwords Jeffrey Ryan Thalhammer
=head1 NAME
Pinto::ArchiveUnpacker - Unpack an archive into a temporary directory
=head1 VERSION
version 0.14
=head1 AUTHOR
Jeffrey Ryan Thalhammer <jeff@stratopan.com>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015 by Jeffrey Ryan Thalhammer.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut