view release on metacpan or  search on metacpan

lib/Archive/SevenZip.pm  view on Meta::CPAN

    my $found;
    if( $ENV{PERL_ARCHIVE_SEVENZIP_BIN}) {
        $class_defaults{'7zip'} = $ENV{PERL_ARCHIVE_SEVENZIP_BIN};
        $found = $class->version || "7zip not found via environment '($ENV{PERL_ARCHIVE_SEVENZIP_BIN})'";
    } else {
        my @search;
        push @search, split /$envsep/, $ENV{PATH};
        if( $^O =~ /MSWin/i ) {
            push @search, map { "$_\\7-Zip" } grep {defined} ($ENV{'ProgramFiles'}, $ENV{'ProgramFiles(x86)'});
        };
        $found = $class->version;

        while( ! defined $found and @search) {
            my $dir = shift @search;
            if ($^O eq 'MSWin32') {
                next unless -e file("$dir", "7z.exe" );
            }
            $class_defaults{'7zip'} = "" . file("$dir", "7z" );
            $found = $class->version;
        };
    };

    if( ! $found) {
        $class_defaults{ '7zip' } = $old_default;
    };
    return defined $found ? $found : ()
}

=head2 C<< Archive::SevenZip->new >>

  my $ar = Archive::SevenZip->new( $archivename );

  my $ar = Archive::SevenZip->new(
      archivename => $archivename,
      find => 1,
  );

Creates a new class instance.

C<find> - will try to find the executable using C<< ->find_7z_executable >>

=cut

sub new {
    my( $class, %options);
    if( @_ == 2 ) {
        ($class, $options{ archivename }) = @_;
    } else {
        ($class, %options) = @_;
    };

    if( $options{ find }) {
        $class->find_7z_executable();
    };

    for( keys %class_defaults ) {
        $options{ $_ } = $class_defaults{ $_ }
            unless defined $options{ $_ };
    };

    bless \%options => $class
}

sub version {
    my( $self_or_class, %options) = @_;
    for( keys %class_defaults ) {
        $options{ $_ } = $class_defaults{ $_ }
            unless defined $options{ $_ };
    };
    my $self = ref $self_or_class ? $self_or_class : $self_or_class->new( %options );

    my $cmd = $self->get_command(
        command => '',
        archivename => undef,
        options => [], # on Debian, 7z doesn't like any options...
        fs_encoding => undef, # on Debian, 7z doesn't like any options...
        default_options => [], # on Debian, 7z doesn't like any options...
    );
    my $fh = eval { $self->run($cmd, binmode => ':raw') };

    if( ! $@ ) {
        local $/ = "\n";
        my @output = <$fh>;
        if( @output >= 3) {
            # 7-Zip 19.00 (x64) : Copyright (c) 1999-2022 Igor Pavlov : 2019-02-21
            # 7-Zip [64] 16.02 : Copyright (c) 1999-2022 Igor Pavlov : 2016-05-21
            # 7-Zip [64] 9.20  Copyright (c) 1999-2022 Igor Pavlov  2010-11-18
            $output[1] =~ /^7-Zip\s+.*?\b(\d+\.\d+)\s+(?:\(x64\))?(?:\s*:\s*)?Copyright/
                or return undef;
            return $1;
        } else {
            return undef
        }
    }
}

=head2 C<< $ar->open >>

  my @entries = $ar->open;
  for my $entry (@entries) {
      print $entry->fileName, "\n";
  };

Lists the entries in the archive. A fresh archive which does not
exist on disk yet has no entries. The returned entries
are L<Archive::SevenZip::Entry> instances.

This method will one day move to the Path::Class-compatibility
API.

=cut
# Iterate over the entries in the archive
# Path::Class API
sub open {
    my( $self )= @_;
    my @contents = $self->list();
}

=head2 C<< $ar->memberNamed >>

  my $entry = $ar->memberNamed('hello_world.txt');