File Coverage

blib/lib/PerlIO/via/Rotate.pm

Criterion	Covered	Total	%
statement	83	131	63.3
branch	16	66	24.2
condition	4	9	44.4
subroutine	26	30	86.6
pod	0	25	0.0
total	129	261	49.4

package PerlIO::via::Rotate;

$VERSION= '0.08';

# be strict and do everything on octets
use strict;
use bytes;

# initialize the base rotational strings
my @rotate= ( '', qw(
 b-za
 c-zab
 d-za-c
 e-za-d
 f-za-e
 g-za-f
 h-za-g
 i-za-h
 j-za-i
 k-za-j
 l-za-k
 m-za-l
 n-za-m
 o-za-n
 p-za-o
 q-za-p
 r-za-q
 s-za-r
 t-za-s
 u-za-t
 v-za-u
 w-za-v
 x-za-w
 yza-x
 za-y
), '' );

# satisfy -require-
1;

#-------------------------------------------------------------------------------
#
# Standard Perl features
#
#-------------------------------------------------------------------------------
#  IN: 1 class to bless with
#      2..N parameters passed in -use-

sub import {
    shift;

    # set up defaults
    @_= 0..26 if @_ == 1 and $_[0] eq ':all';
    @_= 13 if !@_;

    # process all rotations
    my @huh;
  ROTATION:
    foreach (@_) {

        # huh?
        push( @huh, "Invalid rotational value: $_" ), next ROTATION
          if !m#^[0-9]+$# or $_ < 0 or $_ > 26;

        # we've already done this one
	my $module= "PerlIO/via/rot$_.pm";
        next ROTATION if $INC{$module};

        # source for the module
        my $source= <<"SRC";
package PerlIO::via::rot$_;
use bytes;
\@PerlIO::via::rot$_\::ISA=     'PerlIO::via::Rotate';
\$PerlIO::via::rot$_\::VERSION= '$PerlIO::via::Rotate::VERSION';
SRC

        # we can do encoding for this
        if ( my $encode= $rotate[$_] . uc( $rotate[$_] ) ) {
            my $other=  26 - $_;
            my $decode= $rotate[$other] . uc( $rotate[$other] );

            # add the source code for this rotation (PUSHED is inherited)
            $source .= <<"SRC";
sub FILL {
    local \$_= readline( \$_[1] );
    return if !defined \$_;
    tr/a-zA-Z/$decode/;
    return \$_;
} #FILL
sub WRITE {
    local \$_= \$_[1];
    tr/a-zA-Z/$encode/;
    return ( print { \$_[2] } \$_ ) ? length() : -1;
} #WRITE
SRC
        }

        # make the module available and mark as loaded
        if ( eval "$source; 1" ) {
            $INC{$module}= $INC{'PerlIO/via/Rotate.pm'};
        }

        # huh?
        else {
            push @huh, "Could not create module for $_: $@";
        }
    }

    # sorry, can't go on
    die join "\n", "These errors were found:", @huh if @huh;

    return;
} #import

#-------------------------------------------------------------------------------
#  IN: 1 class
#      2 numeric value to check

sub VERSION { 1 } #VERSION

#-------------------------------------------------------------------------------
#  IN: 1 class to bless with
#      2 mode string (ignored)
#      3 file handle of PerlIO layer below (ignored)
# OUT: 1 blessed object

sub PUSHED { bless \*PUSHED, $_[0] } #PUSHED

#-------------------------------------------------------------------------------
#  IN: 1 instantiated object (ignored)
#      2 handle to read from
# OUT: 1 decoded string

sub FILL {

    # huh?
    local( $_ )= ref( $_[0] );
    die "Class $_ was not activated" if !m#::rot(?:0|26)$#;

    return readline( $_[1] );
} #FILL

#-------------------------------------------------------------------------------
#  IN: 1 instantiated object (ignored)
#      2 buffer to be written
#      3 handle to write to
# OUT: 1 number of bytes written

sub WRITE {

    # huh?
    local( $_ ) = ref( $_[0] );
    die "Class $_ was not activated" unless m#::rot(?:0|26)$#;

    return ( print { $_[2] } $_[1] ) ? length( $_[1] ) : -1;
} #WRITE

#-------------------------------------------------------------------------------

__END__