Yet Another Cryptogram Script

[missingthepoint]

Category:

Cryptography

Description:

Yes, another one.

use strict;
use warnings;
use List::Util qw(shuffle);

sub encode {
    my ($text, @alphabet) = @_;
    local $" = '';
    eval "\$text =~ tr/a-z/@alphabet/";
    $_ = uc for @alphabet;
    eval "\$text =~ tr/A-Z/@alphabet/";
    $text
}

sub decode {
    my ($text, @alphabet) = @_;
    local $" = '';
    eval "\$text =~ tr/@alphabet/a-z/";
    $_ = uc for @alphabet;
    eval "\$text =~ tr/@alphabet/A-Z/";
    $text
}

sub no_lt_ws {
    local $_ = shift;
    s/^\s+//;
    s/\s+$//;
    $_
}

my $opt = shift;
my $func;
my @alphabet;
if ($opt eq '-e') {
    $func = \&encode;
    @alphabet = shuffle('a'..'z');
}
elsif ($opt eq '-d') {
    $func = \&decode;
    local $| = 1;
    print "Alphabet: ";
    @alphabet = split /[^a-z]+/i, no_lt_ws(scalar <STDIN>);
}
else {
    die "Usage: $0 <-e(ncode)/-d(ecode)> [filenames]";
}

print "Alphabet: @alphabet\n";
while (<>) {
    print $func->($_, @alphabet);
}

[jwkrahn]

sub encode {
    my ($text, @alphabet) = @_;
    local $" = '';
    eval "\$text =~ tr/a-z/@alphabet/";
    $_ = uc for @alphabet;
    eval "\$text =~ tr/A-Z/@alphabet/";
    $text
}

sub decode {
    my ($text, @alphabet) = @_;
    local $" = '';
    eval "\$text =~ tr/@alphabet/a-z/";
    $_ = uc for @alphabet;
    eval "\$text =~ tr/@alphabet/A-Z/";
    $text
}

Instead of running eval twice per subroutine you could do it like this:

sub encode {
    my ($text, @alphabet) = @_;
    local $" = '';
    eval "\$text =~ tr/a-zA-Z/\L@alphabet\U@alphabet\E/";
    $text
}

sub decode {
    my ($text, @alphabet) = @_;
    local $" = '';
    eval "\$text =~ tr/\L@alphabet\U@alphabet\E/a-zA-Z/";
    $text
}

[missingthepoint]

Good idea. :) And thanks - you made me realize my understanding of the \U-style escapes was a little fuzzy.