Sunday, January 21, 2007

JUnit-Style XML from Perl Test Files

Here is an experimental program that runs Perl test files and produces the same sort of XML output as the <junit> ant task. Getting this XML output is helpful when running Perl tests under CruiseControl.
#!/usr/bin/perl

use strict;
use warnings;

use Test::Harness::Straps;
use Time::HiRes qw(gettimeofday tv_interval);
use XML::Generator ':noimport';

my @files = @ARGV;

my $strap     = Test::Harness::Straps->new;
my $generator = XML::Generator->new(':pretty');

my @properties = _get_properties($generator);
my $test_results = _run_tests( $strap, $generator, @files );

my $xml = _get_junit_xml( $generator, \@properties, $test_results );

print "$xml\n";

exit;

#-------------------------------------------------------------------------------

sub _get_junit_xml {
    my ( $generator, $properties, $test_results ) = @_;

    my $system_out = 'system-out';
    my $system_err = 'system-err';
    my $xml        = '';
    $xml .= "\n";
    $xml .= $generator->testsuite(
        {
            errors   => 0,
            failures => $test_results->{total_failures},
            name     => 'name of the test suite',
            tests    => $test_results->{total_tests},
            'time'   => $test_results->{total_time},
        },
        $generator->properties(@properties),
        @{ $test_results->{test_cases} },
        $generator->$system_out(),
        $generator->$system_err(),

    );
    return $xml;
}

sub _run_tests {
    my ( $strap, $generator, @files ) = @_;
    my @test_cases     = ();
    my $total_tests    = 0;
    my $total_time     = 0;
    my $total_failures = 0;

    foreach my $test_file (@files) {
        my $start_time   = [gettimeofday];
        my $file_results = $strap->analyze_file($test_file);
        my $elapsed_time = tv_interval( $start_time, [gettimeofday] );
        $total_time += $elapsed_time;
        foreach my $assertion ( @{ $file_results->details } ) {
            if ( _skip($assertion) ) {
                next;
            }
            $total_tests++;
            $total_failures += _is_failure($assertion);
            my $test_case = {
                classname => $test_file,
                name      => $assertion->{name},
                'time'    => 0,
            };
            push @test_cases, $generator->testcase($test_case);
        }
    }
    my $test_results = {
        total_time     => $total_time,
        test_cases     => \@test_cases,
        total_tests    => $total_tests,
        total_failures => $total_failures,
    };
    return $test_results;
}

sub _skip {
    my $assertion = shift;
    return $assertion->{type} =~ / skip | todo /x;
}

sub _is_failure {
    my $assertion = shift;
    return !$assertion->{ok};
}

sub _get_properties {
    my $generator  = shift;
    my @properties = ();
    foreach my $key ( sort keys %ENV ) {
        push @properties,
          $generator->property( { name => "$key", value => $ENV{$key} } );
    }
    return @properties;
}

__END__

=head1 NAME

junit_xml.pl - Run Perl tests and get JUnit-style XML output

=head1 SYNOPSIS

   junit_xml.pl file1 [ file2 ... ]

=head1 DESCRIPTION

Experimental script to run perl test files and produce the
same XML output as produced by the <junit> ant task.

=head1 DEPENDENCIES

 Test::Harness
 Time::HiRes
 XML::Generator 

=head1 BUGS

  - Doesn't do anything with the STDERR from tests.
  - Doesn't fill in the 'errors' attribute in the  <testsuite> element.
  - Doesn't handle when all tests in file are skipped (skip_all)
  - Doesn't get the elapsed time for each 'test' (i.e. assertion.)


=head1 AUTHOR

Matisse Enzer <matisse@matisse.net>

=head1 COPYRIGHT & LICENSE

Copyright (c) 2007 Matisse Enzer. All Rights Reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut
Updates: This post was originally published on 2007-01-21. 2008-05-26: I noticed that Justin Mason has created a better script for converting TAP output to JUnit-style XML

Technorati Tags: ,

Unix shell: Finding the run-time directory of a script

I've been trying to come up with an elegant way, in a shell script, to find the full path of the directory in which the script is located.

So far, I have this, which works for bash but not for sh (sh does not support substring expansion on variables):


 #!/usr/local/bin/bash -x
# Finds the full path to the directory containing this script

dir_containing_this_script=""
script_dirname=`dirname $0`
first_char="${script_dirname:0:1}" ; # Starting at index 0, 1 character
case "$first_char" in
("/")
# It's a full path. Use it unmodified.
dir_containing_this_script="${script_dirname}"
;;
(*)
# Strip leading . characters
while [ "${first_char}" = "." ]; do
script_dirname="${script_dirname:1}" ; # substring from index 1 to end
first_char="${script_dirname:0:1}"
done
current_dir=`pwd`
if [ -s "${script_dirname}" ] ; then
dir_containing_this_script="${current_dir}/${script_dirname}"
else
dir_containing_this_script="${current_dir}"
fi
;;
esac

echo "$dir_containing_this_script"


Update: Eric M on The WELL posted this most excellent solution:

dn=`dirname $0`
path=`(cd $dn; pwd)`
echo "path = $path"

Technorati Tags: , ,

Friday, January 19, 2007

Super Easy Graphics Programming

Eric Townsend pointed me to Processing - super easy programming environment for creating graphics programs.

Here's an applet I generated from it in a few minutes work, starting with an example Eric posted on The WELL.

/// start
void setup() {
size(600,600);
}

void draw(){
background(255);

int left_x = 0;
int right_x = width;
int top_y = 0;
int bottom_y = height;
int light_green = #99FF99;
int light_blue = #66CCFF;
int light_yellow = #FFCC66;
int pale_red = #FF3366;

for (int n=0; n < 100; n++) {
int y_of_n = n * (bottom_y/100);
int x_of_n = n * (right_x/100);

stroke(pale_red);
line(left_x,y_of_n,mouseX,mouseY);

stroke(light_yellow);
line(right_x,y_of_n,mouseX,mouseY);

stroke(light_blue);
line(x_of_n,0,mouseX,mouseY);

stroke(light_green);
line(x_of_n,bottom_y,mouseX,mouseY);
}
}

/// end

Technorati Tags: ,

Tuesday, December 26, 2006

Provider Injection, not Dependency Injection

The term "provider injection" should replace the term "dependency injection."

The term misleads by seeming to say that you are "injecting" a dependency. This would mean that the thing got the "dependency" injected into it now depends upon something that it didn't depend upon before. This is not what "dependency injection" means.

The term "dependency injection" actually means that if Object A depends upon having a "B" object that you "inject" a B object into object A (instead of object A fetching or creating a B on its own.) A classic example would be a Person object that depends upon having a database connection in order to create/update/edit/delete people in the database. Instead of the Person object creating its own database connection it gets one passed to it (i.e. "injected") perhaps as an argument to its constructor. But, see, you are not injecting a dependency. You are injecting a provider.

A "dependency" is not the thing upon which you depend. The thing you depend upon is a tool, resource, skill, or capability and you get those things by making them yourself, or from a provider.

So, I think the term "provider injection" should replace the term "dependency injection."

By the way, I want to thank Mike Ward for originally introducing me to the term "dependency injection" - whatever phrase is used, the actual practice is one I have done in the past and it is good to have a phrase to describe this technique.

See also:
Wikipedia entry on Dependency Injection (which I have attempted to edit.)
Inversion of Control Containers and the Dependency Injection pattern - 2004 article by Martin Fowler
Spring in Action - Book on Spring

Technorati Tags: ,

Saturday, December 09, 2006

countperl - count lines, packages, subs and complexity of Perl files

I recently released a new version of Perl::Metrics::Simple (0.03) that includes the countperl script. The program reports on how complicated your Perl code is - giving you direction on where to start refactoring it to make it easier to understand, debug, and maintain. Try to keep the McCabe Complexity at 9 or less for every subroutine and "main" section of your code.
countperl is a command line tool that you execute with a list of one or more files andor directories. The program examines the named files and recursivesly searches named directories for Perl files.
The countperl program produces a report on STDOUT of total lines, packages, subroutines/methods, the minimum, maximum, mean, standard deviation, and median size and mccabe_complexity (aka cyclomatic complexity) of subroutines and the 'main' portion of each file (everything not in a subroutine.)

Output Format

Line counts do not include comments nor pod.
The current output format is human-readable text. For example, a report based on analyzing three files might look like this:
 Perl files found:                3

Counts
------
total code lines: 856
lines of non-sub code: 450
packages found: 3
subs/methods: 42

Subroutine/Method Size
----------------------
min: 3 lines
max: 32 lines
mean: 9.67 lines
std. deviation: 7.03
median: 7.50

McCabe Complexity
-----------------
Code not in any subroutine::
min: 1
max 1
mean: 1.00
std. deviation: 0.00
median: 1.00

Subroutines/Methods:
min: 1
max: 5
avg: 1.00
std. deviation: 1.36
median: 1.00

Tab-delimited list of subroutines, with most complex at top
-----------------------------------------------------------
complexity sub path size
5 is_perl_file lib/Perl/Metrics/Simple.pm 11
5 _has_perl_shebang lib/Perl/Metrics/Simple.pm 13
5 _init lib/Perl/Metrics/Simple/Analysis/File.pm 30
4 find_files lib/Perl/Metrics/Simple.pm 11
4 new lib/Perl/Metrics/Simple/Analysis.pm 10
4 is_ref lib/Perl/Metrics/Simple/Analysis.pm 8

Chris Chedgey has a posting that describes a common situation - you have accumulated a huge pile of "complexity debt" - well, using countperl is one tool to help "keep a lid on it."



Technorati Tags: , , , , ,

Thursday, November 02, 2006

Very Simple Wrapper for Perl DBI

I've released a new Perl module: DBIx::Wrapper::VerySimple which provides a very simple (object-oriented) wrapper around DBI.

DBIx::Wrapper::VerySimple provides three methods that between them cover about 98% of the SQL calls I've seen in Perl code over the years:
  • fetch_all() - run a SQL statement (typically a SELECT statement) and get back an arrayref of hashrefs (one hashref for each result row.)

  • fetch_hash() - run a SQL statement (typically a SELECT statement) and get back a single hashref (for just one row.)

  • Do() - run a non-SELECT statement such as CREATE or DELETE.
DBIx::Wrapper::VerySimple will use bind-variables if you pass them as additional arguments to fetch_all(), fetch_hash() or Do().

DBIx::Wrapper::VerySimple also provides a get_args() method and a dbh() method. get_args() returns the arguments originally passed to new() so you can re-connect, etc. if need be. dbh() returns the raw DBI databse handle so you have ready access to all the features of DBI.

DBIx::Wrapper::VerySimple is available on the CPAN: http://search.cpan.org/dist/DBIx-Wrapper-VerySimple/

Technorati tags: CPAN, DBI, Perl

Tuesday, October 03, 2006

Perl::Metrics::Simple

Counts files, packages, subroutines, and calculates cyclomatic complexity of Perl files.

I recently released an alpha version of new Perl module: Perl::Metrics::Simple

There is an included script, in the examples/ directory which produces output like this:


Perl Files: $file_count

Line Counts
-----------
lines: $lines
packages: $package_count
subs: $sub_count
all main code: $main_stats->{lines}

min. sub size: $lines{min} lines
max. sub size: $lines{max} lines
avg. sub size: $lines{average} lines
median sub size: $lines{median}

McCabe Complexity
-----------------
min. main: $main_complexity{min}
max. main: $main_complexity{max}
median main: $main_complexity{median}
average main: $main_complexity{average}

subs:
min: $complexity{min}
max: $complexity{max}
avg: $complexity{average}
median: $complexity{median}
std. deviation: $complexity{standard_deviation}