kentcowgill.org/blog

So, I released another module to CPAN today.

It's called Perl::Critic::Nits, which at this point only has one policy module, one that discourages accessing what appears to be private member data of a class. Feel free to have a look. Though if you're reading this post significantly after the date I'm posting it, that version may no longer be the most recent release.

It pretty much looks for anything that accesses a hashref subscript or an arrayref subscript. And in case you can't guess - that can be a problem if you're not dealing with an object. Like if, for instance, you have a regular old hash reference.

Drat.

Elliot Shank reminded me that the code being examined isn't compiled, so it's a little tough to figure out whether or not something isa blessed object, or just a plain hashref. D'oh.

At least it's easy enough to disable a policy. :/

However, it will definitely catch attempts to access an object's member data directly, so I don't feel so bad about that. So long as the pseudo convention of assigning $_[0] to a variable called at least either $self, $package, or $class.

Please enjoy, and let me know if you run into any bugs.

So, I'm dutifully going through some 129 modules in our codebase, creating documentation and tests for everything I find.

I mean absolutely everything.

But I wonder if I'm going too far?

For instance, I happened upon a module called Boolean.pm. Seems like it ought to be fairly low-hanging fruit, so I open it up to find that the whole of the module looks like this:

package Boolean;
use strict;
use base q(Exporter);
@Boolean::EXPORT = qw(TRUE FALSE);

use constant TRUE  => 1;
use constant FALSE => 0;

1;
__END__

No joke.

Fine, the tests will be easy enough. I won't repeat them here for brevity, but suffice it to say that the only thing that threw me for a loop is that use_ok didn't seem to import the exported constants into the namespace of my test file - after testing the module, I just use Boolean; and then I can test the constants. Could I have just called import as the module inherited from Exporter? Probably, but I didn't.

The next module I come across is another top level namespace module named Database.pm. Whose primary purpose is to figure out which database server to have the rest of the code connect to, depending on a few external conditions. Part of the module declares a number of constants - the database connection strings - for internal (to the module) use only, and doesn't use base 'Exporter' and subsequently export those constants. However, it makes sense to me that I ought to test those constants as part of my test suite.

So, fresh with my knowledge that constants aren't imported into the test file's namespace via use_ok, I add a use Database; and expect my tests to pass. Oops, not so fast - because I'm testing the constants as barewords, and they're not exported via @EXPORT, they're not recognized as constants and my test file (with use strict at the top) fails miserably complaining about my usage of barewords.

So, what to do?

I decided I would force the Database module to be @ISA = 'Exporter' and add the constants to @EXPORT myself, on behalf of the module, in the test file. So now my test file looks a bit like this:

use strict;
use warnings;

use Test::More tests => 2;

BEGIN {
  use Exporter;
  @Database::ISA = ( 'Exporter' );
  @Database::EXPORT = qw/PROD DEV/;
}

use_ok( 'Database' );

use Database;

is( PROD, 'production:dsn:etc',
    'PROD points to correct db' );
is( DEV, 'development:dsn:etc',
    'DEV points to correct db' );

... but I have to wonder if this is worth all the bother. I suppose for now I'll leave it.

&qidYou may have guessed by now, but I've taken up a particularly onerous gauntlet at my job. I'm afraid to touch any modules. But holy cow, do they need touching.

What do we learn from Refactoring: Improving the Design of Existing Code ? Well, we learn that without tests, you can't refactor. Well, you can - it's really not wise to do so, however. It will be difficult to know if you've broken something or slightly altered a particular functionality.

Of course, tests also help you prove what you've got is a set of modules that performs to their specifications - or in the absense of a specification - proving that the code does what it looks like it's supposed to do based on certain circumstance.

Given that our codebase is huge, undocumented, and more important untested, I've come up with a few snippets of shell code to really move me pretty far forward with my task.

First, to create a directory hierarchy to house all my new tests:

for i in $(find . -name "*.pm")
  do touch $(echo $i | \
           sed -e 's/\./\/path\/to\/dir/' | \
           sed -e 's/\.pm$/.t/')
done

And to give the files some default content (it's ugly but it sorta works, YMMV):

for i in $(find . -size 0)
  do echo '#!/usr/bin/perl' >> $i
    echo "" >> $i
    echo "use strict;" >> $i
    echo "use warnings;" >> $i
    echo "" >> $i
    echo "Test::More 'no_plan';" >> $i
    echo "" >> $i
    echo "use_ok( '`sed -e 's/\//::/' | \
      sed -e 's/\.t//'`' );" >> $i
  done

These snippets, plus my previously mentioned vim tip are really getting me pretty fair along in creating a comprehensive test suite and a good set of documentation for all of our legacy code.

Oh, and as a side benefit, I'm getting to know the modules pretty well while I'm at it :)

I wrote a few days ago about writing my own Test::Harness parser since I had been unable to install the module that does that, and does it well.

On my machine, Test::TAP::HTMLMatrix is beautifully installed - however where this module could do me the most good - as in having tests run all the time for me - I have historically had issues getting modules installed. At the very least, I need to identify all the various dependencies of every module and their dependencies in order for the SAs to search for .rpm files for ease in making the modules easily installable on every other production machine in the cluster. Which makes a certain amount of sense. As long as you don't remember that this test reporting module has no business on production anyhow.

But a brief perusal of the source for HTMLMatrix, and I'm starting to get the impression that having the SAs install it, plus all it's dependencies, plus all their dependencies, might be more hassle and take longer than I'd like.

Since I got my html harness pretty much working before trying to install HTML Matrix again, I might as well start using that at work to keep at-a-glace test results at a handy web page. Without all those dependencies.

So I did. And I copied all the tests over to our dev server. And I tweaked the hell out of them to make them actually run. More on that later.

The above picture is just a snippet of it to be able to fit into my blog, but you can see a fuller version here.

The code to create this is pretty simple. Here are the important bits of it:

#!/usr/bin/perl

use strict;
use warnings;

use Test::Harness::Straps;

my $strap = Test::Harness::Straps->new();

my $graph_width    = 600;
my $filename_width = 150;
my $percent_width  =  75;

print report_head();

my $cnt = 1;
my $tot = 0;
my $ok  = 0;

for my $file( @ARGV ){
  next unless -f $file;
  $cnt++;
  my $style = $cnt % 2 ? 'blue' : 'tan';
  my $result = $strap->analyze_file( $file );
  my( $this_tot, $this_ok )
    = ( $result->seen, $result->ok );
  $tot += $this_tot;
  $ok += $this_ok;
  my $graph
    = return_graph( $this_tot, $this_ok );
  my $percent
    = int( $this_ok / $this_tot * 100 );
  my $status = $percent < 100
      ? '<span style="color:red;">NOK</span>'
      : 'OK';
  my $perstyle = get_percent_style( $percent );
  printf <<END_REPORT, $style, $file,
    $file, $status, $graph, $perstyle, $percent;
  <tr class="row">
    <td class="%s">
      <a href="%s">%s</a>
    </td>
    <td class="status">%s</td>
    <td>
      <table class="graph">
        <tr>
%s
       </tr>
     </table>
   </td>
   <td class="%s ctr">%d\%</td>
 </tr>
END_REPORT
}

print report_end();

sub return_graph {
  my( $cnt, $run ) = @_;
  my $width = int( $graph_width / $cnt );
  my $leftover = $cnt - $run;
  my $bad_cell
    = qq{<td class="nok" style="width: }
    . qq{${width}px"> </td>};
  my $good_cell
    = qq{<td class="ok" style="width: }
    . qq{${width}px"> </td>};
  my $cells = $good_cell x $run;
  $cells .= $bad_cell x $leftover;
  return $cells;
}

sub get_percent_style {
  my $pct = shift;
  return
         $pct == 100    ? 'hundred'
       : $pct >= 95     ? 'ninetyfive'
       : $pct >= 90     ? 'ninety'
       : $pct >= 80     ? 'eighty'
       : $pct >= 70     ? 'seventy'
       : $pct >= 60     ? 'sixty'
       : $pct >= 50     ? 'fifty'
       : $pct >= 40     ? 'forty'
       : $pct >= 30     ? 'thirty'
       : $pct >= 20     ? 'twenty'
       :                  'ten';
}

The missing report_header() and report_end() routines add the head, title, stylesheet, body tags, etc. to turn the meat of the output into a web page.

Btw, if you have 1) unresponsive SAs or 2) too much bureaucracy to get modules installed, and 3) have an improper Scalar::Util installation, and 4) need to use Test::MockObject (or some other module that 'optionally' uses Scalar::Util::weaken - and some Enterprise Linux Distributions ship a broken version of Scalar::Util) you can use this sneaky workaround:

BEGIN {
  # We're not using feature XYZ in
  # Obj::Using::Weaken, so don't
  # care about our improperly
  # installed Scalar::Util
  require Scalar::Util;  # load it into memory
  # we know this causes warnings
  no warnings 'redefine';
  # load our own versions that do nothing.
  *Scalar::Util::weaken = sub { return @_ };
  *Scalar::Util::export_fail = sub { return };
}

I'm going through a lot of legacy code lately, and got tired of manually opening up the first legacy file I documented (to make sure I was following the same standard I had implemented - it's not quite in my long term memory just yet), scrolling through the tedious documentation, copying (or retyping(!)) the text into the file I was working on, etc.

So, I decided to write a quick little mapping for that menial task.

First step is to create a template for the POD I want to insert:

__END__

=NAME

=SYNOPSIS

=DESCRIPTION

...

And then this helpful mapping in my ~/.vimrc

" Automatically add a POD template
" to the end of a file
noremap ,ap maG:r ~/podtemplate<cr>'a

Mnemonic: Add Pod.

... which is at least smart enough to set a mark at your current position, move to the end of the file, insert the contents of ~/podtemplate, and return to your saved position. Caveats: It's NOT smart enough to know if you've already set an 'a' mark, and it's NOT smart enough to NOT insert the template if there's already POD in the file.

I've been tasked with setting up new QA and staging environments at work.

With a twist.

We have several teams working on several sections of our main website. One team migrates code from development to production on a regular basis. I believe I have mentioned this before. In case I haven't, they push files several times an hour. I honestly think they use the production cluster as their QA environment, but that's the subject of another rant.

Also, we are making fairly large changes to our backend. The front-end changes for the backend changes are to initially be carried out on this new QA server.

Do you see the problem?

While developer A makes changes on QA, they don't get reflected on dev, staging, or production.

Developer B makes changes on dev, and they go straight to production. QA and staging fall out of sync.

Hence the suboptimal code migration path:

Life would be much better if we just started using version control. :(

I was working on some code the other day and ran across this little gem. Granted, I've simplified (and removed any proprietary information from) all the expressions, because they're much more verbose than this. But I was pretty incredulous when I saw it, considering I was supposed to modify it to change its functionality. The formatting is about the same, though, but the linebreaks might be in slightly different spots. The important bit is that it was actually much more unreadable than this. The formats actually came from object variables (i.e. $obj->var->{DIRECT_HASH_ACCESS} - other than the one hard coded near the beginning) which helped to clutter everything up, and the %hash keys (and name) were much longer. I also wanted to make it fit in the page without making it expand too wide :)

push @arr, sprintf( q(<div long format string >%s</div>),
     join( '|', map { sprintf ( $_ eq $i ?  'formatA' :
     'formatB', $variable ? $_ : ( $uri !~ /regex/) ?
     join ( '/', 'something', $_ ) : join ( '/',
     'something/else', $_), $hash{$_}) } ( sort {
     $hash{$a} cmp $hash{$b} } ( keys %hash )) ));

If I ever come across the person who wrote this and left it as is, jumbled together and uncommented, I will punch them squarely in the face.

First, the lack of formatting makes it impossible to read. And there are superfluous parenthesis that help to clutter things up.

Then there's the superfluous use of the joins stuck in the middle. The joins don't do anything - I thought at first they might help avoid a "Use of uninitialized value in a concatenation" warning, but that can't happen if you're iterating over the keys of a %hash.

There also seems to be at least one of the ternaries I can avoid by doing a little work up front - it doesn't vary based on which %hash is currently being iterated over.

If you take care of those four things, it helps a bit, but overall it's still not all that great.

my $path = 'something';
if( $uri =~ /regex/ ){
  $path .= '/else';
}
push @arr,
     sprintf
       q(<div long format string >%s</div>),
       join '|',
            map { sprintf $_ eq $i ? 'formatA'
                                   : 'formatB',
                          $variable ? $_
                                    : "$path/$_",
                          $hash{$_}
                }
            sort { $hash{$a} cmp $hash{$b} }
            keys %hash;

I'm still not happy about the push sprintf join map sprintf ?: ?: sort keys %hash structure, and will probably end up breaking it into more readable chunks later. But at least now it's a little easier to follow - and most important, modify.

time passes

So I was able (according to the requirements) to rip out the differing functionality for various states, and as such was able to pull the ternaries out altogether.

my $path = 'something';
if( $uri =~ /regex/ ){
  $path .= '/else';
}
push @arr,
     sprintf
       q(<div long format string >%s</div>),
       join '|',
            map { sprintf 'formatB',
                          "$path/$_",
                          $hash{$_}
                }
            sort { $hash{$a} cmp $hash{$b} }
            keys %hash;

So after some prompting, I added a few of my configuration files to subversion. In order to do that, though - I had to adjust them so they'd work no matter where they are.

For example, in my .vimrc file, I had to separate out the bits that makes my Mac happy from the bits that make the account on my server happy. This is what I seemed to settle on, but I'm not 100% sure it's the cleanest way to do it - I'm counting on the fact that my $HOME directory is particularly unique on my mac versus more unixy boxes:

if exists( "$HOME" )
  if $HOME == '/Users/kentcowgill'
    " my mac and terminal settings need this
    " to display color correctly.
    set term=xterm-color
    " etc...
  else
    set term=xterm
    " etc...
  endif
else
  set term=xterm
  " etc...
endif

The good news is that I've also installed Trac, adjusted the templates a bit to match the rest of my look and feel, and the end result can be viewed in the dotfiles section of my site.

Enjoy browsing around. The rest of my .vimrc is nicely loaded into Trac.

I'm working on making the rest of my code presentable, so that'll show up soon enough.

Going through some old code reviews, I found the following in some of my notes.

The idea was that there's a hunk of code that needs to produce a sorted and unique list of items. That description immediately brings to mind a few data types - an array and a hash - and a sort of some kind or another.

The code I encountered looked like this:

  my @pre_sorted = $s->arrayOfArrays;
  my $unsorted = \@pre_sorted;
  my @key_list = ();
  my @sorted = ();
  my %hash;
  # make the AoA into a hash, keyed on [1], the name
  foreach(@$unsorted){
    $hash{$_->[1]} = $_->[0];
  }
  # copy the keys into a sorted array
  @key_list = sort( keys(%hash));
  # build the sorted AoA
  foreach(@key_list){
    my @temp_array = ( $hash{$_} , $_ );
    push @sorted, \@temp_array;
  }

Don't get me wrong - that does do what it's supposed to do. But does it do it efficiently? Not really - that can all be replaced by the following:

  my %unique_items = ();
  my @sorted = sort { $a->[1] cmp $b->[1] }
               grep { ! $unique_items{$_->[1]}++ }
               $s->arrayOfArrays;

Which has the following benefits:

1. Much more succint.
2. Many fewer temporary variables.
3. More perlish.
4. Quite a bit faster.

How much faster? It depends a little on the size of the data passed to it. I found that most of the time, the data coming to it was very very small, but occasionally would have much larger data sets to sort. I recall having some spare time and more curiousity then is likely good for me, so I set up some benchmarks:

First, results from running the routines
500000 times on a tiny data set:
                Rate    Original New version
Original     98232/s          --        -71%
New version 342466/s        249%          --

Next, results from running the routines
200000 times on a small data set:
                Rate    Original New version
Original     61920/s          --        -69%
New version 200000/s        223%          --

Now running them 10000 times on a
larger data set:
              Rate    Original New version
Original    4032/s          --        -49%
New version 7937/s         97%          --

Here's a handy tip for writing code.

If you find yourself doing the following:

  my $obj = Module->new();
  my $thing_list = $obj->getThings();
  my $thing;
  for my $thingy( @{ $thing_list } ){
    if( $something eq $thingy->{ element } ){
      $thing = $thingy;
    }
  }
  # use $thing here...

That's a pretty good hint that your object is written poorly.

Instead, your object should be hash based, and return a given hash value for a given hash key. Like so:

  my $obj = Module->new();
  my $thing = $obj->getThingForSomething( $something );

You'd think this is fairly common sense, but I just ran across some code that not only loops through a list every time it needs a particular $thing from an $obj, but it used the exact same code copied and pasted 10 some-odd times throughout a single file (and in many other places where the module is used too).

I invite you to peruse at your leisure a great book I've been reading - Refactoring: Improving the Design of Existing Code written by the same guy who wrote UML Distilled, Martin Fowler.

I'm struggling with some major frustrations at my job.

I recently learned of a workaround for a race condition that has been an annoyance for some of my coworkers for nearly a year. Pointing out the silliness to my manager was a bit fruitless - she quickly turned around and assigned the 'fix' to me.

So I took a look at the code.

It was a mess.

At least 27 different files call this code, so to properly refactor the code, all of those files would have to be changed and tested.

But there's no tests.

There can't be tests⁶. Why? Because these files are a mishmash of perl and HTML in a custom templating system which are sucked in and evaluated 6 ways to sunday on every web request. Files include other files, variables are set in weird objects, namespaces are a giant jumble, etc. so forth and so on.

And the people who originally wrote this code have left the company - my guess is in frustration. They were trying to rearchitect the code, but it was taking too long, and so were told to just hack it to make it work.

But surprise, there were performance problems, because the dynamic data originated from flat files on the filesystem which were parsed multiple times per page request. And this custom template system is running under mod_perl - why not make some persistent data?

So I'm writing an email to my boss, and struggling with whether to include the following:

“ I don't think further code reviews for $WEBSITE are worthwhile, since we lack manpower to make any changes. Further, since we don't have any tools to perform at least unit if not functional tests, it's impossible to refactor existing code without being certain nothing was broken in the followup.

Due to the lack of manpower and lack of morale in existing manpower, nearly every IT project will eventually fail abysmally and become completely unmaintainable and unscalable. $COMPANY will continue to struggle along and churn through developer after developer - assuming we are allowed to hire some more to replace the ones that have left in frustration. ”

But I don't think I can do it.

Would you?

⁶ Actually, I've been trying to find free time to finish the Test:: suite I've been developing, which is currently capable of splitting the perl from the HTML, evaling the code in its own namespace, running Perl::Critic and Devel::Cover on the code and HTML::Lint on the HTML, but I'm having trouble with the recursive templating creating new variables in the existing namespaces. Also since I lost half of my team members (including the team leader), it's a little tough to find that free time.