#!/usr/bin/env perl
use warnings;
use strict;

use Benchmark qw':all';

my %rot = (
  'A' => 'N','B' => 'O','C' => 'P','D' => 'Q','E' => 'R','F' => 'S',
  'G' => 'T','H' => 'U','I' => 'V','J' => 'W','K' => 'X','L' => 'Y',
  'M' => 'Z','N' => 'A','O' => 'B','P' => 'C','Q' => 'D','R' => 'E',
  'S' => 'F','T' => 'G','U' => 'H','V' => 'I','W' => 'J','X' => 'K',
  'Y' => 'L','Z' => 'M','a' => 'n','b' => 'o','c' => 'p','d' => 'q',
  'e' => 'r','f' => 's','g' => 't','h' => 'u','i' => 'v','j' => 'w',
  'k' => 'x','l' => 'y','m' => 'z','n' => 'a','o' => 'b','p' => 'c',
  'q' => 'd','r' => 'e','s' => 'f','t' => 'g','u' => 'h','v' => 'i',
  'w' => 'j','x' => 'k','y' => 'l','z' => 'm',
);

our(%sub, @subname);
sub rot13sub {
  my($name, $code) = @_;
  push @subname, $name;
  $sub{$name} = $code;
}


##</code><code>##

# The original subroutine

rot13sub "orig", sub {
  # as close as possible to source project's code
  join '', map { exists $rot{$_} ? $rot{$_} : $_ } split('',shift);
};

# Firstly, let's fill in the defaults in the hash table so that we 
# can use a hash slice

my %rotd = %rot;
exists($rotd{$_}) or $rotd{$_} = $_ for 
  map chr, 0 .. 255;

rot13sub "hashslice-s", sub {
  join '', @rotd{split('',shift)};
};


##</code><code>##

# Two variants instead of the split

rot13sub "hashslice-m", sub {
  my ($x) = @_;
  my @t = $x =~ /./gs;
  join '', @rotd{@t};
};

rot13sub "hashslice-u", sub {
  my ($x) = @_;
  join '', @rotd{unpack "(a)*", $x};
};


##</code><code>##

# Now let's use an array slice instead of a hash

my @rot = do {
  my $c;
  map { $c = chr($_); exists $rot{$c} ? ord($rot{$c}) : $_ } 0 .. 255;
};

rot13sub "arrayslice", sub {
  pack "C*", @rot[unpack("C*", $_[0])];
};

# Now let's try some solutions with s, as demerphq has suggested. 
# The first one has to know the exact character range to be replaced.

rot13sub "gsub-class", sub {
  (my $s = $_[0]) =~ s/([a-zA-Z])/$rot{$1}/g;
  $s;
};

rot13sub "gsub-dot", sub {
  (my $s = $_[0]) =~ s/(.)/$rotd{$1}/gs;
  $s;
};

# Now your tr equivalent

rot13sub "tr", sub {
  (my $s = shift) =~ tr/a-zA-Z/n-za-mN-ZA-M/;
  $s;
};


##</code><code>##

# First, check correctness.  This is important.

our $data = join "", <DATA>;
our $correct = &{$sub{"orig"}}($data);
print $correct;

{
  for my $name (@subname) {
    my $result = &{$sub{$name}}($data);
    $correct eq $result or
      die "error: subroutine $name produces incorrect result";
  }
  warn "all ok";
}

# Next, compare them.

{
  cmpthese(-5, {map { 
    my($name, $sub) = ($_, $sub{$_});
      $name, sub {
        my $r = &$sub($data);
      } 
    } @subname});
}

__DATA__
Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Vivamus luctus nulla
sed tellus. Sed vitae sapien in elit vestibulum faucibus. Maecenas sollicitudin,
 magna quis vestibulum convallis, ligula nulla fringilla augue, nec rutrum dolor
 quam vel justo. Vivamus nisi odio, ullamcorper sed, venenatis id, imperdiet
eleifend, neque. Vivamus justo felis, euismod in, convallis auctor, egestas id,
purus. In rutrum nisi in lectus. Aliquam elementum placerat dui. Integer ut pede
sit amet magna pulvinar placerat. Maecenas massa lorem, lobortis ut, adipiscing
at, suscipit nec, lectus. Curabitur mattis adipiscing sem. Mauris pharetra
vehicula eros. Sed pellentesque elit laoreet augue. Cras non tellus. Quisque
volutpat lectus in sem. Fusce vulputate justo ut pede. Aliquam ante pede, tempor
in, dictum in, blandit eu, sapien. Morbi vestibulum, metus eu auctor vulputate,
nulla lectus condimentum nisi, ac pulvinar ligula nunc in felis. Curabitur id
orci ac est luctus molestie.

##</code><code>##

                Rate   orig hashslice-m gsub-dot hashslice-s gsub-class hashslice-u arrayslice   tr
orig           962/s     --        -20%     -30%        -40%       -43%        -58%       -82% -99%
hashslice-m   1206/s    25%          --     -12%        -25%       -29%        -47%       -78% -99%
gsub-dot      1372/s    43%         14%       --        -15%       -19%        -40%       -75% -99%
hashslice-s   1605/s    67%         33%      17%          --        -5%        -30%       -70% -99%
gsub-class    1687/s    75%         40%      23%          5%         --        -26%       -69% -99%
hashslice-u   2278/s   137%         89%      66%         42%        35%          --       -58% -98%
arrayslice    5414/s   463%        349%     295%        237%       221%        138%         -- -96%
tr          148174/s 15308%      12184%   10701%       9135%      8681%       6403%      2637%   --