#!/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,
  },
);