File Coverage

blib/lib/Data/Transform/Map.pm

Criterion	Covered	Total	%
statement	35	35	100.0
branch	23	24	95.8
condition	11	15	73.3
subroutine	9	9	100.0
pod	3	3	100.0
total	81	86	94.1

# vim: ts=3 sw=3 expandtab

package Data::Transform::Map;
use strict;

use Data::Transform;

use vars qw($VERSION @ISA);
$VERSION = '0.01';
@ISA = qw(Data::Transform);

use Carp qw(croak carp);

sub BUFFER   () { 0 }
sub CODEGET  () { 1 }
sub CODEPUT  () { 2 }

=head1 NAME

Data::Transform::Map - transform input and/or output within a filter stack

=head1 SYNOPSIS

   use Data::Transform::Map;
   use Test::More plan => 'no_plan';

   my $filter = Data::Transform::Map( Code => \&uc );
   my $out = $filter->get( [qw(foo bar baz)] );
   is_deeply ( $out, [qw(FOO BAR BAZ)], "shouting it!");

=head1 DESCRIPTION

Data::Transform::Map transforms data inside the filter stack.  It may be
used to transform input, output, or both depending on how it is
constructed.  This filter is named and modeled after Perl's built-in
map() function.

=head1 PUBLIC FILTER METHODS

Data::Transform::Map implements the L API. Only
differences and addition to the API are documented here.

=cut

=head2 new

new() constructs a new Data::Transform::Map object.  It must either be
called with a single Code parameter, or both a Put and a Get
parameter.  The values for Code, Put and Get are code references that,
when invoked, return transformed versions of their sole parameters.  A
Code function will be used for both input and ouput, while Get and Put
functions allow input and output to be filtered in different ways.

  # Decrypt rot13.
  sub decrypt_rot13 {
    my $encrypted = shift;
    $encrypted =~ tr[a-zA-Z][n-za-mN-ZA-M];
    return $encrypted;
  }

  # Encrypt rot13.
  sub encrypt_rot13 {
    my $plaintext = shift;
    $plaintext =~ tr[a-zA-Z][n-za-mN-ZA-M];
    return $plaintext;
  }

  # Decrypt rot13 on input, and encrypt it on output.
  my $rot13_transcrypter = Data::Transform::Map->new(
    Get => \&decrypt_rot13,
    Put => \&encrypt_rot13,
  );

Rot13 is symmetric, so the above example can be simplified to use a
single Code function.

  my $rot13_transcrypter = Data::Transform::Map->new(
    Code => sub {
      local $_ = shift;
      tr[a-zA-Z][n-za-mN-ZA-M];
      return $_;
    }
  );


=cut

sub new {
   my $type = shift;
   croak "$type must be given an even number of parameters" if @_ & 1;
   my %params = @_;

   croak "$type requires a Code or both Get and Put parameters" unless (
             defined($params{Code})
         or (defined($params{Get}) and defined($params{Put}))
      );

   croak "Code element is not a subref"
      unless (defined $params{Code} ? ref $params{Code} eq 'CODE' : 1);

   croak "Get or Put element is not a subref"
         unless ((defined $params{Get} ? (ref $params{Get} eq 'CODE') : 1)
            and  (defined $params{Put} ? (ref $params{Put} eq 'CODE') : 1)
      );

   my $self = bless [
      [ ],           # BUFFER
      $params{Code} || $params{Get},  # CODEGET
      $params{Code} || $params{Put},  # CODEPUT
      ], $type;
}

sub clone {
   my $self = shift;

   my $new = [
      [],
      $self->[CODEGET],
      $self->[CODEPUT],
   ];

   return bless $new, ref $self;
}

# get()           is inherited from Data::Transform.
# get_one_start() is inherited from Data::Transform.
# get_one()       is inherited from Data::Transform.

sub _handle_get_data {
   my ($self, $data) = @_;

   return unless defined $data;
   return $self->[CODEGET]->($data);
}

sub _handle_put_data {
  my ($self, $data) = @_;

   return $self->[CODEPUT]->($data);
}


=head2 modify

modify() changes a Data::Transform::Map object's behavior at runtime.  It
accepts the same parameters as new(), and it replaces the existing
transforms with new ones.

  # Switch to "reverse" encryption for testing.
  $rot13_transcrypter->modify(
    Code => sub { return scalar reverse shift }
  );

=cut

sub modify {
   my ($self, %params) = @_;

   for (keys %params) {
      die "Modify $_ element must be given a coderef"
         unless (ref $params{$_} eq 'CODE');

      if (lc eq 'code') {
         $self->[CODEGET] = $params{$_};
         $self->[CODEPUT] = $params{$_};
      } elsif (lc eq 'put') {
         $self->[CODEPUT] = $params{$_};
      } elsif (lc eq 'get') {
         $self->[CODEGET] = $params{$_};
      }
   }
}

1;

__END__