http://www.perlmonks.org?node_id=620413

chargrill has asked for the wisdom of the Perl Monks concerning the following question:

... Surely the root of all evil, but can't a guy be curious?

First a little background, and apologies for the length of this post.

I'm working on a legacy web system.

When the user (or the server) encounters an exceptional situation, the web server generates an error "ticket" and display a "page not found" page. Reports of these tickets are emailed to a mailing list - it's really handy if we lose a database from the cluster and dozens or hundreds (sometimes thousands!) of users start generating tickets. Unfortunately, we'll also get tickets if web bots are crawling the site, etc.

It's been one of my sub-goals to rid our "ticket" system of spurious tickets. Not generating a ticket if the user-agent matched a web bot was easy.

We have users and their sessions, and these are tracked through a number of redundant methods, one of which is appending user ID and session information to the URI.

The User ID format is very specific - [0-9A-Z]{12}. (Then a dot, then the session ID.) If our system sees lowercase letters, it considers this an exceptional situation, and generates an error ticket. (Not my idea.) This is even though an ID would be valid should it only be translated to using uppercase letters. For most users (and their user-agent) - this isn't an issue. But, it appears as though some user agents attempt to pre- (or re-) fetch oft-visited pages (FunWebProducts springs to mind). Ignore the proper URI, try to fetch using a lowercase ID, ticket gets generated, I get an "error" in my mailbox. Annoying.

Should be easy to fix, no?

Long story short, the old code did this:

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

My change was simple:

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

I test it out on the development server. It works, it doesn't give me a "page not found" error, doesn't generate a ticket - problem solved.

I ask my coworker for a code review.

My coworker taps me on the shoulder and says "So, we do this tr/// on every ID even though only a tiny subset of them are bad? I clearly have NO idea how expensive that is."

To borrow a phrase from bobf, I "went all perlmonks on him". "Blah blah blah premature optimization blah blah micro optimization blah blah blah." I essentially suggested we throw it on the servers and see if it causes a problem.

One giant long-running company meeting later, and I'm staring at 20 minutes until it's time to go home for the weekend. Honestly, my curiosity got the better of me and I quickly and quietly setup a little Benchmark.

Much to my surprise, my changed version performed better! Around 30% better!

Granted, I only performed the operation for only lowercased ID + session strings. Once I realized the folly of my ways and also tested properly uppercased ID + session strings, the results were closer.

But still it intrigued me.

Here's the benchmark 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, }, );

And the output:

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% --

From that, I determined that a micro-optimization was possible for the original code - but the results seem fairly clear to me... Performing the transliteration on every ID + session would be a net gain.

But why?

Adding the following (in the same manner) to the benchmark added to my mystery:

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

Output:

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% --

Now the results match my expectation - performing a transliteration on everything is more expensive, but only if I use temporary lexical variables.

Checking B::Concise doesn't shed much light (for me, anyhow):

$ 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.a01f2345b067cde890f12gab345678c +9"] 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.a01f2345b067cde890f12gab345678c +9"] sM ->5 - <1> ex-rv2cv sK/1 ->- 5 <#> gv[*foo] s ->6 -e syntax OK

I see one key difference in 2 <;> nextstate(main 3/4 -e:1 ->3 - is that it?

I'm hoping someone with more internals-fu than I can shed some light on this - if only to sate my insatiable curiosity.


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