File Coverage

blib/lib/SWISH/Filters/Decompress.pm

Criterion	Covered	Total	%
statement	26	55	47.2
branch	2	16	12.5
condition	0	2	0.0
subroutine	6	10	60.0
pod	1	5	20.0
total	35	88	39.7

package SWISH::Filters::Decompress;
use strict;
use warnings;
use Carp;
use vars qw( $VERSION @ISA );
$VERSION = '0.190';
@ISA     = ('SWISH::Filters::Base');
use SWISH::Filter::MIMETypes;

my %mimes = (
    'application/x-gzip' => 'gz',

    # deferred till we have way to deal with
    # multiple docs in single file
    #'application/x-compress' => 'zip',
);

my %ext = reverse %mimes;

sub new {
    my $class = shift;
    my $self = bless( {}, $class );
    my $ok;

    $self->{type} = 1;

    $self->{_mimetypes} = SWISH::Filter::MIMETypes->new;

    # set mimetypes etc. based on which modules/programs we have
    # preference is to use Perl lib over binary cmd
    if ( $self->use_modules(qw/ Compress::Zlib /) ) {
        push( @{ $self->{mimetypes} }, qr!$ext{gz}! );
        $self->{gz}->{perl}++;
        $ok++;
    }
    elsif ( $self->find_binary('gunzip') ) {
        $self->set_programs('gunzip');
        push( @{ $self->{mimetypes} }, qr!$ext{gz}! );
        $self->{gz}->{bin}++;
        $ok++;
    }

    #    if ($self->use_modules(qw/ Archive::Zip /))
    #    {
    #        push(@{$self->{mimetypes}}, qr!$ext{zip}!);
    #        $self->{zip}->{perl}++;
    #        $ok++;
    #    }
    #    elsif ($self->find_binary('unzip'))
    #    {
    #        $self->set_programs('unzip');
    #        push(@{$self->{mimetypes}}, qr!$ext{zip}!);
    #        $self->{zip}->{bin}++;
    #        $ok++;
    #    }

    return $ok ? $self : undef;
}

# TODO
sub zipinfo {
    my $self  = shift;
    my $zfile = shift or croak "need zipfile";
    my $i     = $self->run_program( 'unzip', "-Z -1 $zfile" );
    return split( /\n/, $i || '' );
}

sub get_type {
    my ( $self, $doc ) = @_;
    ( my $name = $doc->name ) =~ s/\.(gz|zip)$//i;
    $self->mywarn(" decompress: getting mime for $name");
    return $self->{_mimetypes}->get_mime_type($name);
}

sub decompress {
    my ( $self, $doc ) = @_;

    my ( $buf, $status );

    if ( $self->{gz}->{perl} ) {
        my $r = $doc->fetch_doc_reference;
        $buf = Compress::Zlib::memGunzip($r);
    }
    elsif ( $self->{gz}->{bin} ) {
        $buf = $self->run_program( 'gunzip', '-c', $doc->fetch_filename );
    }

    $self->mywarn(" decompress: $doc was decompressed");

    #$self->mywarn(ref($buf) ? $$buf : $buf);

    # TODO .zip support

    # return a scalar ref
    return ref($buf) ? $buf : \$buf;
}

sub filter {
    my ( $self, $doc ) = @_;

    my $buf = $self->decompress($doc);    # returns scalar ref

    return undef unless $$buf;

    my $mime = $self->get_type($doc);

    $self->mywarn(
        " decompress: " . $doc->name . " is now flagged as $mime" );

    $doc->set_content_type($mime);
    $doc->set_continue(1);

    # return the document
    return ( $buf, $doc->meta_data );
}

1;

__END__