File Coverage

blib/lib/Text/Shift.pm

Criterion	Covered	Total	%
statement	14	15	93.3
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	19	20	95.0

package Text::Shift;

# Boilerplate package imports
use 5.008;
use strict;
use warnings;
use Carp;

# Implementation-specific imports
use Crypt::Cipher v0.02;
use integer; # potential speed increase

# Constants
use constant {
    # Change the following values to modify the default alphabets
    UPPER  => join("","A".."Z"),
    LOWER  => join("","a".."z"),
    NUMBS  => join("",0..9)
    };
use constant {        # constant is broken for self-reference
    FROM   => join("",UPPER,LOWER,NUMBS),

    # THE FOLLOWING THREE CONSTANTS MUST NOT CHANGE
    UPPDEX => 0,
    LOWDEX => 1,
    NUMDEX => 2
    };

# Class variables
our @ISA = qw(Crypt::Cipher);
our $VERSION = '1.00';
our %_abs;  # Hash of callers' package names pointing to arrays
            # The array is made up of UPPERCASE, LOWERCASE, NUMBERS


#############
# FUNCTIONS #
#############
# The following function rotates the alphabet by magnitude amount
sub _rotate_alphabet($$) {
    # Get parameters
    my($string,$mag) = (shift, int(shift));
    my $strlng = length($string);

    # Handle outliers
    $mag += $strlng while($mag < 0);      # Negative magnitude
    $mag %= $strlng if($mag > $strlng);   # Too large magnitude

    # Return rotated string
    return $string if($mag == 0);
    $string .= substr($string,0,$mag, "");
    return $string;
}

###########
# Methods #
###########

# Create the alphabet control methods
BEGIN {
    my $funcref = sub( $ ) {
	my $index = shift;
	return sub($$) {
	    (undef, my $caller) = (shift, caller);
	    if(scalar(@_)) {
		# Modifier return
		$_abs{$caller} = [] unless($_abs{$caller});
		return $_abs{$caller}->[$index] = join("",@_);
	    } else {
		# Accessor return
		return $_abs{$caller}->[$index];
	    }
	};
    };

    *uppercase = $funcref->(UPPDEX);
    *lowercase = $funcref->(LOWDEX);
    *numbers   = $funcref->(NUMDEX);
}

sub new($;$$$) {
    # get the parameters
    my $caller = caller;
    my $class = shift;
    my $caps  = (int(shift) or 0);
    my $small = @_ ? int(shift) : $caps;
    my $nums  = @_ ? int(shift) : $caps;


    # Get the cipher mapping -- note order in source
    if($_abs{$caller}) {
	our @source;
	*source = $_abs{$caller};
	my $upcase = ($source[UPPDEX] or UPPER);
	my $lwcase = ($source[LOWDEX] or LOWER);
	my $numbrs = ($source[NUMDEX] or NUMBS);
	my $to =
	    _rotate_alphabet($upcase, $caps).
	    _rotate_alphabet($lwcase, $small).
	    _rotate_alphabet($numbrs, $nums);
	return $class->SUPER::new(
				  ($upcase.$lwcase.$numbrs),
				  $to
				  );
    } else {
	my $to =
	    _rotate_alphabet(UPPER, $caps).
	    _rotate_alphabet(LOWER, $small).
	    _rotate_alphabet(NUMBS, $nums);
	return $class->SUPER::new(FROM,$to);
    }
}


return 1;
__END__