#!/usr/bin/perl

use strict;
use warnings;

use Benchmark qw/:all/;

my $TIMES = 500000;

my $upper_id_string = "ABCD1EFGHI2J.a01f2345b067cde890f12gab345678c9";
my $lower_id_string = "abcd1efghi2j.a01f2345b067cde890f12gab345678c9";

sub only_tr {
  my $string = shift;
  my( $id, $session ) = split( /\./, $string, 2 );
  $id =~ tr/a-z/A-Z/;
  return( $id, $session );
}

sub match_and_tr {
  my $string = shift;
  my( $id, $session ) = split( /\./, $string, 2 );
  $id =~ /[a-z]/ and $id =~ tr/a-z/A-Z/;
  return( $id, $session );
}

sub old {
  my $string = shift;
  return split( /\./, $string, 2 );
}

sub new {
  my $string = shift;
  my( $id, $session ) = split( /\./, $string, 2 );
  return( $id, $session );
}

sub short {
    split( /\./, $_[0],2 );
} 
sub short_lc {
    split( /\./, lc($_[0]),2 );
} 

my $only_tr_low  = sub { my( $id, $session )
                               = only_tr( $lower_id_string ) };
my $only_tr_upp  = sub { my( $id, $session )
                               = only_tr( $upper_id_string ) };
my $match_tr_low = sub { my( $id, $session )
                               = match_and_tr( $lower_id_string ) };
my $match_tr_upp = sub { my( $id, $session )
                               = match_and_tr( $upper_id_string ) };

my $old_low      = sub { my( $id, $session )
                               = old( $lower_id_string ) };
my $old_upp      = sub { my( $id, $session )
                               = old( $upper_id_string ) };

my $new_low      = sub { my( $id, $session )
                               = new( $lower_id_string ) };
my $new_upp      = sub { my( $id, $session )
                               = new( $upper_id_string ) };
my $short_low    = sub { my( $id, $session )
                               = short( $lower_id_string ) };
my $short_upp    = sub { my( $id, $session )
                               = short( $upper_id_string ) };
my $short_lc_low = sub { my( $id, $session )
                               = short_lc( $lower_id_string ) };
my $short_lc_upp = sub { my( $id, $session )
                               = short_lc( $upper_id_string ) };

cmpthese( $TIMES, {
    'Old way L'   => $old_low,
    'New way L'   => $new_low,
    'Old way U'   => $old_upp,
    'New way U'   => $new_upp,
    'Short   L'   => $short_lc_low,
    'Short   U'   => $short_lc_upp,
  }
);

print "\n";

cmpthese( $TIMES, {
    'Match TR LC' => $match_tr_low,
    'Match TR UC' => $match_tr_upp,
    'Only TR  LC' => $only_tr_low,
    'Only TR  UC' => $only_tr_upp,
    'Old way   L' => $old_low,
    'Old way   U' => $old_upp,
    'New way   L' => $new_low,
    'New way   U' => $new_upp,
    'Short lc  L' => $short_lc_low,
    'Short lc  U' => $short_lc_upp,
    'Short way L' => $short_low,
    'Short way U' => $short_upp,
  },
);

##</code><code>##

              Rate New way U New way L Old way U Old way L Short   U Short   L
New way U 227273/s        --      -14%      -35%      -36%      -38%      -38%
New way L 264550/s       16%        --      -24%      -25%      -28%      -28%
Old way U 349650/s       54%       32%        --       -1%       -4%       -5%
Old way L 354610/s       56%       34%        1%        --       -3%       -4%
Short   U 364964/s       61%       38%        4%        3%        --       -1%
Short   L 367647/s       62%       39%        5%        4%        1%        --

                Rate Match TR LC Match TR UC Only TR  UC Only TR  LC New way   U New way   L Old way   U Old way   L Short lc  L Short lc  U Short way U Short way L
Match TR LC 185874/s          --        -10%        -12%        -12%        -18%        -19%        -48%        -48%        -48%        -49%        -55%        -55%
Match TR UC 207469/s         12%          --         -1%         -2%         -8%        -10%        -41%        -42%        -42%        -43%        -49%        -50%
Only TR  UC 210084/s         13%          1%          --         -1%         -7%         -8%        -41%        -41%        -42%        -42%        -49%        -49%
Only TR  LC 211864/s         14%          2%          1%          --         -6%         -8%        -40%        -41%        -41%        -42%        -48%        -49%
New way   U 226244/s         22%          9%          8%          7%          --         -1%        -36%        -37%        -37%        -38%        -45%        -45%
New way   L 229358/s         23%         11%          9%          8%          1%          --        -35%        -36%        -36%        -37%        -44%        -44%
Old way   U 354610/s         91%         71%         69%         67%         57%         55%          --         -1%         -1%         -2%        -13%        -14%
Old way   L 357143/s         92%         72%         70%         69%         58%         56%          1%          --         -1%         -1%        -13%        -14%
Short lc  L 359712/s         94%         73%         71%         70%         59%         57%          1%          1%          --         -1%        -12%        -13%
Short lc  U 362319/s         95%         75%         72%         71%         60%         58%          2%          1%          1%          --        -12%        -12%
Short way U 409836/s        120%         98%         95%         93%         81%         79%         16%         15%         14%         13%          --         -1%
Short way L 413223/s        122%         99%         97%         95%         83%         80%         17%         16%         15%         14%          1%          --

##</code><code>##

sub short_lc { split( /\./, lc($_[0]),2 ) }