Slash Boxes
NOTE: use Perl; is on undef hiatus. You can read content, but you can't post it. More info will be forthcoming forthcomingly.

All the Perl that's Practical to Extract and Report

The Fine Print: The following comments are owned by whoever posted them. We are not responsible for them in any way.
More | Login | Reply
Loading... please wait.
  • And the best thing is that if you ever reintroduce that bug, you will recatch it as well.

    Test everything. Test your most basic assumptions. Once you write it, it's done, and will be in your employ forever.

    Here's some stuff I wrote yesterday that reads a tree structure of nodes from the DB and makes sure that there are no stray, unlinked nodes:

    #!/usr/bin/perl -w

    use strict;
    use Test::More tests=>5;
    use FLR::DB qw( :sqldo );

    my %nodes;
    my %children;
    my @tops;


    This little baby looks at all the nodes in the tree and makes sure that
    all the parent and children relationships make sense.

    First, we build up two data stores: C<%nodes> is a hash of the parents
    for each node, and C<%children> is a hash of the children for each node,
    where each element is a list reference of all the children.


    my $set = sqldo_set( 'select nodeid, parent_nodeid from nodes' );

    for my $row ( @$set ) {
        my $parent = $row->{PARENT_NODEID};
        my $nodeid = $row->{NODEID};

        $nodes{$nodeid} = $parent;
        if ( $parent ) {
            push( @{$children{$parent}}, $nodeid );
        } else {
            push( @tops, $nodeid );


    Make sure that there are exactly two top nodes.  If the number of top
    nodes changes, then we'll have to adjust this.


    is( scalar @tops, 2, "Correct number of top nodes" );
    my $nnodes = scalar keys %nodes;
    ok( $nnodes > 10_000, "Have a reasonably big number of nodes" );
    diag( "$nnodes total nodes" );


    Now, we want to confirm that all the nodes in the database are in fact
    members of the two top level trees.  We do this by deleting the trees
    and making sure no nodes are left.

    Tree deletion is done by recursively deleting each node's children.
    The C<delete_children()> function keeps track of which nodes it's
    currently deleting, so that if it sees them again it can flag them and
    not continue circling.


    my %seen_while_digging;
    my $circles = 0;
    delete_children( @tops );


    Once we've deleted the two trees, there should be no nodes left in the
    hash, and there should be no circular references having been noted.


    is( $circles, 0, 'Any circular references?' );
    is( scalar keys %nodes, 0, 'Any nodes left over?' );
    is( scalar keys %seen_while_digging, $nnodes, 'Do deleted nodes match total nodes?' );

    sub delete_children {
        my @deleters = @_;

        for my $node ( @deleters ) {
            if ( $seen_while_digging{$node}++ ) {
            my $kidlist = $children{$node};
            if ( $kidlist ) {
                delete_children( @$kidlist );

            if ( exists $nodes{$node} ) {
                delete $nodes{$node};
            } else {
                die "Tried to delete node $node, but it wasn't there";
        } # for @deleters
    Note that I'm testing some really obvious stuff, like that the number of nodes I checked is the same as the number of nodes total, but the next time you goof up and exit from a loop early or forget to include the starting nodes, you'll be glad you did.

    Some of the stuff might not be strictly necessary, but it doesn't hurt to have it in there...



    • How useful are you finding embedded POD in your tests? I've been of the opinion that good test names go a long way, but does a little documentation go even further?

      • This example is pretty uncommon, since usually the code behind the tests is pretty obvious. In this case, since I was building up trees and then deleting them recursively, I thought it warranted comments.

        I do always make sure that every test has a name, though. I hate seeing:

        ok 1
        ok 2
        ok 3
        not ok 4
        ok 5
        ok 6
        and then having to count down to test 4 in the code to see what it is