view release on metacpan or  search on metacpan

lib/PerlIO/via/Bzip2.pm  view on Meta::CPAN

package PerlIO::via::Bzip2;

use 5.008000;
use strict;
use warnings;

use Compress::Bzip2 ();

our $VERSION = '0.02';

my $Buf_Size = 8192;

# Default (de)compression parameters, see Compress::Bzip2 for details.
my $Level    = 1;          # Compression level 1..9

# Get and set (de)compression level (0..9)
sub level {
    $Level = $_[1] if $_[1];
    $Level;
}

sub import {
    my ($class, %args) = @_;

    $class->level($args{level});
}


sub PUSHED {
    my ($class, $mode, $fh) = @_;

    my $self = {
        buf    => '',
        mode   => $mode,
    };
    if ($mode eq 'r') {
        $self->{stream} = Compress::Bzip2::decompress_init()
          or return -1;
    }
    elsif ($mode eq 'w') {
        $self->{stream} = Compress::Bzip2::compress_init(level => $Level)
          or return -1;
    }
    else {
        return -1;
    }
    return bless $self => $class;
}


sub FILL {
    my ($self, $fh) = @_;

    my ($data);
    my $stream = $self->{stream};
    if ($stream and (read($fh, $data, $Buf_Size) > 0)) {
        return $stream->add($data);
    }
    elsif ($stream) {
        $self->{stream} = undef;
        return $stream->finish;
    }
    else {
        return;
    }
}


sub WRITE {
    my ($self, $buf, $fh) = @_;

    my $data = $self->{stream}->add($buf);
    return if not defined $data;
    return (print {$fh} $data) ? 1 : 0;
}


sub FLUSH {
    my ($self, $fh) = @_;

    return 0 if $self->{mode} eq 'r';
    my $data = $self->{stream}->finish;
    if ($data) {
        return (print {$fh} $data) ? 0 : -1;
    }
    return 0;
}

1;
__END__

=head1 NAME

PerlIO::via::Bzip2 - PerlIO layer for Bzip2 (de)compression

=head1 SYNOPSIS

    use PerlIO::via::Bzip2;
    # or
    use PerlIO::via::Bzip2 level => 9; # Maximum compression

    # Read a bzip2 compressed file from disk.
    open(my $fh, "<:via(Bzip2)", "compressed_file");
    my $uncompressed_data = <$fh>;

    # Compress data on-the-fly to a bzip2 compressed file on disk.
    open(my $fh, ">:via(Bzip2)", "compressed_file");