Category: Cryptography
Author/Contact Info missingthepoint
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);
}
Replies are listed 'Best First'.
Re: Yet Another Cryptogram Script
by jwkrahn (Abbot) on Mar 20, 2009 at 11:35 UTC 
    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
}

    [download]

    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
}

    [download]
[reply]
[d/l]
[select]

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

      "Half of all adults in the United States say they have registered as an organ donor, although only some have purchased a motorcycle to show that they're really serious about it."
[reply]
[d/l]

Back to Code Catacombs