POE::Filter::LZW - A POE filter wrapped around Compress::LZW

POE-Filter-LZW documentation Contained in the POE-Filter-LZW distribution.

Index

Code Index:

NAME

Top

POE::Filter::LZW - A POE filter wrapped around Compress::LZW

SYNOPSIS

Top

    use POE::Filter::LZW;

    my $filter = POE::Filter::LZW->new();
    my $scalar = 'Blah Blah Blah';
    my $compressed_array   = $filter->put( [ $scalar ] );
    my $uncompressed_array = $filter->get( $compressed_array );

    use POE qw(Filter::Stackable Filter::Line Filter::LZW);

    my ($filter) = POE::Filter::Stackable->new();
    $filter->push( POE::Filter::LZW->new(),
		   POE::Filter::Line->new( InputRegexp => '\015?\012', OutputLiteral => "\015\012" ),

DESCRIPTION

Top

POE::Filter::LZW provides a POE filter for performing compression/decompression using Compress::LZW. It is suitable for use with POE::Filter::Stackable.

CONSTRUCTOR

Top

new

Creates a new POE::Filter::LZW object.

METHODS

Top

get_one_start
get_one
get

Takes an arrayref which is contains lines of compressed input. Returns an arrayref of decompressed lines.

put

Takes an arrayref containing lines of uncompressed output, returns an arrayref of compressed lines.

clone

Makes a copy of the filter, and clears the copy's buffer.

level

Sets the compression level. Consult Compress::LZW for details.

AUTHOR

Top

Chris BinGOs Williams <chris@bingosnet.co.uk>

LICENSE

Top

Copyright © Chris Williams

This module may be used, modified, and distributed under the same terms as Perl itself. Please see the license that came with your Perl distribution for details.

SEE ALSO

Top

POE

Compress::LZW

POE::Filter::Stackable

POE-Filter-LZW documentation Contained in the POE-Filter-LZW distribution. 
package POE::Filter::LZW;

use strict;
use warnings;
use Carp;
use Compress::LZW qw(compress decompress);
use vars qw($VERSION);
use base qw(POE::Filter);

$VERSION = '1.72';

sub new {
  my $type = shift;
  croak "$type requires an even number of parameters" if @_ % 2;
  my $buffer = { @_ };
  $buffer->{ lc $_ } = delete $buffer->{ $_ } for keys %{ $buffer };
  $buffer->{BUFFER} = [];
  return bless $buffer, $type;
}

sub level {
  my $self = shift;
  my $level = shift;
  $self->{level} = $level if defined $level;
  return $self->{level};
}

sub get {
  my ($self, $raw_lines) = @_;
  my $events = [];

  foreach my $raw_line (@$raw_lines) {
	if ( my $line = decompress( $raw_line ) ) {
		push @$events, $line;
	} 
	else {
		warn "Couldn\'t decompress input\n";
	}
  }
  return $events;
}

sub get_one_start {
  my ($self, $raw_lines) = @_;
  push @{ $self->{BUFFER} }, $_ for @{ $raw_lines };
}

sub get_one {
  my $self = shift;
  my $events = [];

  if ( my $raw_line = shift @{ $self->{BUFFER} } ) {
	if ( my $line = decompress( $raw_line ) ) {
		push @$events, $line;
	} 
	else {
		warn "Couldn\'t decompress input\n";
	}
  }
  return $events;
}

sub put {
  my ($self, $events) = @_;
  my $raw_lines = [];

  foreach my $event (@$events) {
	if ( my $line = compress( $event, $self->{level} ) ) {
		push @$raw_lines, $line;
	} 
	else {
		warn "Couldn\'t compress output\n";
	}
  }
  return $raw_lines;
}

sub clone {
  my $self = shift;
  my $nself = { };
  $nself->{$_} = $self->{$_} for keys %{ $self };
  $nself->{BUFFER} = [ ];
  return bless $nself, ref $self;
}

1;

__END__