読者です 読者をやめる 読者になる 読者になる

Zipアーカイバ改良。

perl zip

Windowsから送られてきた Zipファイルの展開 - Life is very shortで作ったけど、
テストしやすいように書きなおした。ついでにマッチするものだけ展開する
オプションを追加。基本的に全部展開でいいと思うんだけど、不要な広告
ファイルはいらね、ってときはいいかなと。

#!/usr/bin/env perl
package Zip::Archiver;
use Mouse;

use Carp;

with 'MouseX::Getopt';

has 'from' => (
    reader => 'from_encoding',
    isa => 'Str',
    default => 'CP932',
    documentation => 'Specify file name encoding included ZIP',
);

has 'l' => (
    reader => 'is_print_only',
    isa => 'Bool',
    documentation => 'Only print files, not extract ZIP file',
);

has 're' => (
    is  => 'ro',
    isa => 'Str',
    documentation => 'Specify regexp for matching file names',
);

has '_regexp' => (
    accessor => 'regexp',
    isa => 'RegexpRef',
);

has '_term_encoding' => (
    accessor => 'term_encoding',
    isa => 'Str',
);

has '_files' => (
    accessor => 'files',
    isa => 'ArrayRef[Str]',
);

__PACKAGE__->meta->make_immutable;

no Mouse;

use Archive::Zip;
use Encode;
use Term::Encoding;

sub run {
    my ($self, $files_ref) = @_;

    $self->_check_files($files_ref);
    $self->_check_encoding;
    $self->_set_term_encoding;

    $self->_set_regexp if defined $self->re;

    for my $zip ( @{$self->files} ) {
        $self->_extract_zip($zip);
    }
}

sub _extract_zip {
    my ($self, $zip) = @_;
    my $archiver = Archive::Zip->new($zip);

    my $regexp = $self->regexp;
    for my $member ($archiver->memberNames) {
        my $decoded = decode($self->from_encoding, $member);
        if (defined $regexp) {
            next unless $decoded =~ m{$regexp};
        }

        my $encoded = encode($self->term_encoding, $decoded);
        print "$encoded\n";
        next if $self->is_print_only;

        $archiver->extractMember($member, $encoded);
    }
}

sub _set_regexp {
    my $self = shift;
    my $re = decode($self->term_encoding, $self->re);

    $self->regexp(qr/$re/);
}

sub _set_term_encoding {
    my $self = shift;
    $self->term_encoding(Term::Encoding::term_encoding());
}

sub _check_encoding {
    my $self = shift;

    unless (find_encoding($self->from_encoding)) {
        Carp::croak("Can't find Encoding : ", $self->from_encoding, "\n");
    }
}

sub _check_files {
    my ($self, $files_ref) = @_;

    Carp::croak("Not specified ZIP files\n") if scalar @{$files_ref} == 0;

    for my $file ( @{$files_ref} ) {
        Carp::croak("$file is not exist\n") unless -e $file;
    }

    $self->files($files_ref);
}

package main;
use strict;
use warnings;

unless (caller) {
    my $app = Zip::Archiver->new_with_options();
    $app->run( $app->extra_argv );
}

おっぱい動画JAPANは閉鎖致しました。よりダウンロードしたファイルを
展開してみる。

# 中身を確認。
% unzip.pl -l 1160-1.zip
1160-1.rm
CPZオンライン|無料アダルト動画.html
おっぱい動画JAPAN|無料アダルト動画.html

# 必要なものだけ展開
% unzip.pl --re '\.rm$'  1160-1.zip
1160-1.rm
% ls
1160-1.rm  1160-1.zip

# rmファイルだけ展開できました

てか unzipはいい加減文字コード対応していいと思うんだけど、
そうはならないのだろうか。それとも私が単に使い方を知らない
だけなのだろうか?