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

##</code><code>##

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

##</code><code>##

#!/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 old {
  my $string = shift;
  return split( /\./, $string, 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 $old_low          = sub { my( $id, $session )
                               = match_and_tr( $lower_id_string ) };
my $old_upp          = sub { my( $id, $session )
                               = match_and_tr( $upper_id_string ) };

cmpthese( $TIMES, {
    'Old way   ' => $old_low,
    'Only TR LC' => $only_tr_low,
  },
);

cmpthese( $TIMES, {
    'Only TR UC' => $only_tr_upp,
    'Old way  U' => $old_upp,
  },
);

##</code><code>##

               Rate Old way    Only TR LC
Old way    280899/s         --       -21%
Only TR LC 357143/s        27%         --
               Rate Old way  U Only TR UC
Old way  U 340136/s         --        -4%
Only TR UC 354610/s         4%         --

##</code><code>##

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

##</code><code>##

               Rate Old way    Only TR LC Micro Optm
Old way    277778/s         --       -21%       -28%
Only TR LC 352113/s        27%         --        -9%
Micro Optm 387597/s        40%        10%         --
               Rate Old way  U Only TR UC Micro OptU
Old way  U 340136/s         --        -4%       -12%
Only TR UC 354610/s         4%         --        -8%
Micro OptU 384615/s        13%         8%         --

##</code><code>##

$ perl -MO=Concise -e '
sub foo {
  my $string = shift;
  my( $id, $sess ) = split( /\./, $string, 2 );
  return( $id, $sess );
}
foo( "abcd1efghi2j.a01f2345b067cde890f12gab345678c9" );'
7  <@> leave[1 ref] vKP/REFC ->(end)
1     <0> enter ->2
2     <;> nextstate(main 4 -e:1) v ->3
6     <1> entersub[t2] vKS/TARG,1 ->7
-        <1> ex-list K ->6
3           <0> pushmark s ->4
4           <$> const[PV "abcd1efghi2j.a01f2345b067cde890f12gab345678c9"] sM ->5
-           <1> ex-rv2cv sK/1 ->-
5              <#> gv[*foo] s ->6
-e syntax OK

$ perl -MO=Concise -e '
sub foo {
  my $string = shift;
  return split( /\./, $string, 2 );
}
foo( "abcd1efghi2j.a01f2345b067cde890f12gab345678c9" );'
7  <@> leave[1 ref] vKP/REFC ->(end)
1     <0> enter ->2
2     <;> nextstate(main 3 -e:1) v ->3
6     <1> entersub[t2] vKS/TARG,1 ->7
-        <1> ex-list K ->6
3           <0> pushmark s ->4
4           <$> const[PV "abcd1efghi2j.a01f2345b067cde890f12gab345678c9"] sM ->5
-           <1> ex-rv2cv sK/1 ->-
5              <#> gv[*foo] s ->6
-e syntax OK

##</code><code>##

s**lil*;  $*=join'',sort split q**;  s;.*;grr; &&s+(.(.)).+$2$1+; $; =
qq-$_-;s,.*,ahc,;$,.=chop for split q,,,reverse;print for($,,$;,$*,$/)