use strict;
use warnings;

use Benchmark qw{cmpthese};

my $str = q{123456789};

print q{reRev        - }, reRev($str), qq{\n};
print q{reSwap       - }, reSwap($str), qq{\n};
print q{spliceSwap   - }, spliceSwap($str), qq{\n};
print q{splitMap     - }, splitMap($str), qq{\n};
print q{splitMapGrep - }, splitMapGrep($str), qq{\n};
print q{splitRev     - }, splitRev($str), qq{\n};
print q{splitRevGrep - }, splitRevGrep($str), qq{\n};
print q{substrRev    - }, substrRev($str), qq{\n};
print q{substrSubstr - }, substrSubstr($str), qq{\n};
print q{twoSubstrs   - }, twoSubstrs($str), qq{\n};

$str = $str x 1000;

my $rcUseReRev = sub
   {
       my $ret = reRev($str);
   };

my $rcUseReSwap = sub
   {
       my $ret = reSwap($str);
   };

my $rcUseSpliceSwap = sub
   {
       my $ret = spliceSwap($str);
   };

my $rcUseSplitMap = sub
   {
       my $ret = splitMap($str);
   };

my $rcUseSplitMapGrep = sub
   {
       my $ret = splitMapGrep($str);
   };

my $rcUseSplitRev = sub
   {
       my $ret = splitRev($str);
   };

my $rcUseSplitRevGrep = sub
   {
       my $ret = splitRevGrep($str);
   };

my $rcUseSubstrRev = sub
   {
       my $ret = substrRev($str);
   };

my $rcUseSubstrSubstr = sub
   {
       my $ret = substrSubstr($str);
   };

my $rcUseTwoSubstrs = sub
   {
       my $ret = twoSubstrs($str);
   };

cmpthese (-3,
   {
      ReRev        => $rcUseReRev,
      ReSwap       => $rcUseReSwap,
      SpliceSwap   => $rcUseSpliceSwap,
      SplitMap     => $rcUseSplitMap,
      SplitMapGrep => $rcUseSplitMapGrep,
      SplitRev     => $rcUseSplitRev,
      SplitRevGrep => $rcUseSplitRevGrep,
      SubstrRev    => $rcUseSubstrRev,
      SubstrSubstr => $rcUseSubstrRev,
      TwoSubstrs   => $rcUseTwoSubstrs,
   });

# davido's regexp reverse execute
#
sub reRev
{
    my $str = shift;
    $str =~ s{(.{2})}{reverse $1}eg;
    return $str;
}

# GrandFather's regexp string substitution
#
sub reSwap
{
    my $str = shift;
    $str =~ s{(.)(.)}{$2$1}g;
    return $str;
}

# johngg's original split, splice and join
#
sub spliceSwap
{
    my $str = shift;
    my @chars = split m{}, $str;
    for (my $idx = 0; $idx < $#chars; $idx += 2)
    {
        splice @chars, $idx, 0, splice @chars, $idx + 1, 1;
    }
    return join q{}, @chars;
}

# johngg's split and reverse via map
#
sub splitMap
{
    return
       join q{},
       map
       {
           my $rev = reverse $_
       }
       split m{(..)}, $_[0];
}

# johngg's split and reverse via map with a
# grep to remove empty elements from split
#
sub splitMapGrep
{
    return
       join q{},
       map
       {
           my $rev = reverse $_
       }
       grep {$_}
       split m{(..)}, $_[0];
}

# swampyankee's split and reverse of array
#
sub splitRev
{
    my $str = shift;
    my @pairs = split m{(.{2})}, $str;
    $_ = reverse foreach @pairs;
    return join q{}, @pairs;
}

# swampyankee's split and reverse of array with
# my grep tweak 
#
sub splitRevGrep
{
    my $str = shift;
    my @pairs = grep {$_} split m{(.{2})}, $str;
    $_ = reverse foreach @pairs;
    return join q{}, @pairs;
}

# davido's use of substr
#
sub substrRev
{
    my $str = shift;
    my $rev = q{};
    my $pos = 0;
    while ($pos < length $str)
    {
        $rev .= reverse substr $str, $pos, 2;
        $pos += 2;
    }
    return $rev;
}

# fenLisesi's without error checking so on same
# footing as others
#
sub substrSubstr
{
    my ($str) = @_;
    for my $i (0 .. (length( $str ) >> 1) - 1)
    {
        my $j = $i << 1;
        substr( $str, $j, 2, reverse substr( $str, $j, 2 ) );
    }
    return $str;
}

# bh_perl's original tweaked with a join rather than
# a sprintf plus changing for loop end test to cope
# with odd characters
#
sub twoSubstrs
{
    my $str = shift;
    my ($tmp1, $tmp2);
    my @tmp;
    for (my $idx=0; $idx < length $str; $idx += 2)
    {
        $tmp1 = substr $str, $idx, 1;
        $tmp2 = substr $str, $idx + 1, 1;
        push @tmp, $tmp2 . $tmp1;
    }
    my $out = join q{}, @tmp;
    return $out;
}
[download]