view release on metacpan or  search on metacpan

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

    grep { $_->fileName =~ /$re/ } $self->sevenZip->members;
}

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

  my $count = $az->numberOfMembers();

=cut

sub numberOfMembers {
    my( $self, %options ) = @_;
    my @m = $self->members( %options );
    0+@m
}

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

  my $entry = $az->memberNamed('hello_world.txt');
  print $entry->fileName, "\n";

=cut

# Archive::Zip API
sub memberNamed {
    #my( $self, $name, %options )
    my( $self, $name )
        = _params( \@_, qw( zipName ));
    #$self->sevenZip->memberNamed($name, %options );
    $self->sevenZip->memberNamed($name);
}

sub extractMember {
    #my( $self, $name, $target, %options ) = @_;
    my( $self, $name, $target )
        = _params(\@_, qw( memberOrZipName name ));
    if( ref $name and $name->can('fileName')) {
        $name = $name->fileName;
    };
    #$self->sevenZip->extractMember( $name, $target, %options );
    $self->sevenZip->extractMember( $name, $target );
}

sub removeMember {
    #my( $self, $name, $target, %options ) = @_;
    my( $self, $name )
        = _params( \@_, qw(memberOrZipName ));
    # Just for the result:
    my $res = ref $name ? $name : $self->memberNamed( $name );

    if( ref $name and $name->can('fileName')) {
        $name = $name->fileName;
    };
    #$self->sevenZip->removeMember( $name, %options );
    $self->sevenZip->removeMember( $name );

    $res
}

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

  $ar->replaceMember('backup.txt', 'new-backup.txt');

Replaces the member in the archive. This is just delete then add.

I clearly don't understand the utility of this method. It clearly
does not update the content of one file with the content of another
file, as the name of the new file can be different.

=cut

# strikingly similar to Archive::Zip API
sub replaceMember {
    my( $self, $name, $replacement, %_options ) = @_;

    my %options = (%$self, %_options);

    if( $^O =~ /MSWin/ ) {
        $name =~ s!/!\\!g;
    }

    my $res = $self->removeMember( $name );
    $self->add( $replacement );

    $res
};


sub addFile {
    my( $self, $name, $target, $compressionLevel )
        = _params(\@_, qw(filename zipName compressionLevel ));
    if( ref $name and $name->can('fileName')) {
        $name = $name->fileName;
    };
    $target ||= $name;
    $self->sevenZip->add( items => [[ $name, $target ]]);
    return $self->memberNamed($target);
}

sub addMember {
    #my( $self, $name, $target, %options ) = @_;
    my( $self, $member ) = _param( \@_, qw(member));
    my $target = $member->fileName;
    my $fh = $member->open( binmode => ':raw' );
    local $/;
    my $content = <$fh>;
    $self->sevenZip->add_scalar( $target => $content );
    return $self->memberNamed($target );
}
{ no warnings 'once';
*add = \&addMember;
}

sub addTree {
    my( $self, $sourceDir, $target, $predicate, %options ) = @_;

    croak "Predicates are not supported, sorry"
        if $predicate;

    $target ||= $sourceDir;
    croak "Different target for ->addTree not supported, sorry"
        if $target ne $sourceDir;