Catalyst and DBIx::Class: Part 1

[For instructions on the installation of Catalyst, please see the Catalyst Manual page on installation.]

This is an attempt at introducing DBIx::Class and using it in Catalyst, so you can be familiar with it enough to start using it.

Understanding ORM

First, you'll need to understand the purpose of Object-relational mapping. It is what DBIx::Class is. To quote the wikipedia.org page:

Object-Relational mapping (aka O/RM, ORM, and O/R mapping) is a programming technique for converting data between incompatible type systems in databases and Object-oriented programming languages. This creates, in effect, a "virtual object database" which can be used from within the programming language.

So, what you end up with is classes that have the ability to look and feel like database tables, yet all read/write operations happen behind the scenes. This enables you to work with the database without having to make database specific calls. This also allows you to code where all you need to worry about in the code is just what to call, not what database is under the hood. DBIx::Class makes this easy and is pretty simple to wrap your brain around.

The basic idea is that you have one controller master class, and then one or more different classes that usually represent each table in the database. The controller master class is where you will specify the database connection information (and other optional settings) and load the table classes.

This may seem complex, yet it makes life much easier and allow your code to be much more flexibly to change. It also fulfills the need of having the Controller layer not be aware of the Model layer details in the Model-View-Controller design pattern (which is most common in serious web applications).

Getting to know DBIx::Class

Please take a moment to go over the examples in the DBIx::Class CPAN page.

Then go over the manuals (they're pretty brief and include code to explain everything): Intro, Example, Joining, Cookbook with interest on prefetch and joins, and Troubleshooting.

These documents do a much better job at explaining how to use DBIx::Class and all it's specifics than I could do. Be sure to check out the documentation map also.

Using DBIx::Class in Catalyst

Please table a moment to go over the Catalyst manual tutorial, the database access with DBIx::Class section. This will get you familiar with the basics.

If you already have an existing database schema and it's in a database, you can have Catalyst create them for you. It's advised that you just do this once, so that you can save some typing initially (if you already have a database with schema in it... like in this example). First make sure you're in your Catalyst root directory, made with this:

$ catalyst.pl MyTestApp

Then you can use the Catalyst create script to create your DBIx::Class classes for you:

$ cd MyTestApp
$ ./script/mytestapp_create.pl model DB DBIC::Schema DB::Schema create=static dbi:Pg:dbname=ticketingsystem chris
 exists "/home/chris/MyTestApp/script/../lib/MyTestApp/Model"
 exists "/home/chris/MyTestApp/script/../t"
Dumping manual schema for DB::Schema to directory /home/chris/MyTestApp/script/../lib ...
Schema dump completed.
created "/home/chris/MyTestApp/script/../lib/MyTestApp/Model/DB.pm"
created "/home/chris/MyTestApp/script/../t/model_DB.t"
$ 

Ok, now let's take a look at what it created:

$ head -13 lib/MyTestApp/Model/DB.pm
package MyTestApp::Model::DB;

use strict;
use base 'Catalyst::Model::DBIC::Schema';

__PACKAGE__->config(
    schema_class => 'DB::Schema',
    connect_info => [
        'dbi:Pg:dbname=ticketingsystem',
        'chris',
        
    ],
);
$ 

Ok, so from looking at the Model class for this database, it seems pretty easy to figure out. It creates a class that is based off Catalyst::Model::DBIC::Schema and sets up some configuration values (what the master DBIx::Class is and the database connection information used by DBI). Ok, now lets look at the DB::Schema file:

$ cat lib/DB/Schema.pm 
package DB::Schema;

# Created by DBIx::Class::Schema::Loader v0.03009 @ 2007-09-04 19:26:55

use strict;
use warnings;

use base 'DBIx::Class::Schema';

__PACKAGE__->load_classes;

1;

$ 

Hrm, even simplier right? '__PACKAGE__->load_classes' subroutine loads up all the configured schema classes in the lib/DB/Schema/ directory. Let's look at one:

$ cat lib/DB/Schema/Status.pm 
package DB::Schema::Status;

# Created by DBIx::Class::Schema::Loader v0.03009 @ 2007-09-04 19:26:55

use strict;
use warnings;

use base 'DBIx::Class';

__PACKAGE__->load_components("PK::Auto", "Core");
__PACKAGE__->table("status");
__PACKAGE__->add_columns(
  "id",
  {
    data_type => "integer",
    default_value => "nextval('status_id_seq'::regclass)",
    is_nullable => 0,
    size => 4,
  },
  "name",
  {
    data_type => "character varying",
    default_value => undef,
    is_nullable => 0,
    size => 40,
  },
);
__PACKAGE__->set_primary_key("id");
__PACKAGE__->has_many(
  "users_ticket_status_logs",
  "DB::Schema::UsersTicketStatusLog",
  { "foreign.status_id" => "self.id" },
);
__PACKAGE__->has_many(
  "staff_ticket_status_logs",
  "DB::Schema::StaffTicketStatusLog",
  { "foreign.status_id" => "self.id" },
);
__PACKAGE__->has_many(
  "tickets",
  "DB::Schema::Ticket",
  { "foreign.status_id" => "self.id" },
);

1;

This was obviously generated from PostgreSQL, as you can note the default_value for "id". Anyways, without focusing too much on that, the important parts are all the function calls ('has_many', 'set_primary_key', 'add_columns', 'table', and 'load_components'). Here is a breakdown on what they all are for:

• load_components: Loads the components you need, which should almost always be the same (PK::Auto and Core) unless you need custom components detailed in the DBIx::Class component manual. [technically I guess you don't need PK::Auto as it's in Core now]


• table: obviously sets the name of the table


• add_columns: defines the columns of the table


• set_primary_key: sets the primary key of the table


• has_many: one of a few relationship definition functions for the table, see more about them in detail here.

It's pretty simple once you read the documentation links I gave. The naming of everything is pretty intuitive, so makes wrapping your brain around what's going on pretty easy.

Summary

So you should now have an idea of what DBIx::Class' purpose is and some details about it's use. You should also know where to look for documentation on each part discussed here and have a good general knowledge of DBIx::Class' implementation of ORM.

You should have a simple understanding of DBIx::Class and Catalyst. I'll continue in another article on more details and dive more into using DBIx::Class in Catalyst Controllers and using multiple databases.

Hopefully this was useful to you. I'd like to keep going, yet it's more appropriate to break this up into parts. If I made any mistakes or feel I should have written something in a better way, let me know and I'll be sure to update!

Enjoy playing with Catalyst and DBIx::Class!

Using Perl's WWW::Myspace

For getting information on your Myspace page and other people's, posting comments and updates to your profile, or anything inbox related (and some other stuff)... WWW::Myspace is a good module to use.

In this article, I'll show some examples of how to use some of the functionality of this module. Pretty handy... especially if you just want the information without dealing with the horrible interface that Myspace has (and people's themes and playing songs by default and other annoyances).

Get your friends

Get a list of all your friends, maybe handy, maybe not... this is just an example so it doesn't have to be useful! :)

Here is how one would get all their friends and what times they last logged in:

#!/opt/local/bin/perl
#
use strict;
use warnings;

use WWW::Myspace;

$| = 1;

my $username = $ARGV[0];
my $password = $ARGV[1];
my @friends;

print "Username: $username\tPassword: $password\n";

print "Logging in... ";
my $myspace = WWW::Myspace->new( $username, $password );
print "done\n";
if ( ! $myspace->logged_in ) { 
  print "Unable to login: " . $myspace->error . "\n";
}

# Get list of your friends
print "Getting friends... ";
@friends = $myspace->get_friends();
print "done\n";

# Present list all nice-like
foreach my $friend (@friends) {
  eval {
    print "friend id.: $friend\n";
    
    my $friend_name = $myspace->friend_user_name($friend);
    print "name......: $friend_name\n";
    
    my $last_login = $myspace->last_login_ymd($friend);
    print "last login: $last_login\n\n";
  };
  if ($@) {
	# Usually an error when can't view profile due to "maintenance", yet WWW::Myspace breaks
    print "Unable to complete request: $@\n\n";
  }
}

Get your inbox

This is pretty simple, get all messages from your inbox:

#!/opt/local/bin/perl
#
use strict;
use warnings;

use WWW::Myspace;

$| = 1;

my $username = $ARGV[0];
my $password = $ARGV[1];
my @friends;

print "Username: $username\tPassword: $password\n";

print "Logging in... ";
my $myspace = WWW::Myspace->new( $username, $password );
print "done\n";
if ( ! $myspace->logged_in ) { 
  print "Unable to login: " . $myspace->error . "\n";
}


print "Getting inbox...\n";
my $inbox = $myspace->inbox;

foreach my $message (@{$inbox}) {
  print "Sender: " . $message->{sender} . "\n";
  print "Status: " . $message->{status} . "\n";
  print "messageID: " . $message->{message_id} . "\n";
  print "Subject: " . $message->{subject} . "\n\n";

  # Note, to read each message do
  #my $message_hashref = $myspace->read_message($message->{message_id}); 
  #print "From: $message_hashref->{'from'}\n";  # Friend ID of sender
  #print "Date: $message_hashref->{'date'}\n";      # Date (as formatted on Myspace)
  #print "Subject: $message_hashref->{'subject'}\n";
  #print "Body: $message_hashref->{'body'}\n\n";    # Message body
}

Note that it will print out all messages you have. The message details part of the example is commented out due to being very spammy (you can uncomment it out if you wish).

Get the last 5 comments of all your friends

This just gets your friends list like before, then goes over each to get their comments on their Myspace page. It reports back the friend name, id and time they posted the comment.

#!/opt/local/bin/perl
#
use strict;
use warnings;

use WWW::Myspace;

$| = 1;

my $username = $ARGV[0];
my $password = $ARGV[1];
my @friends;

print "Username: $username\tPassword: $password\n";

print "Logging in... ";
my $myspace = WWW::Myspace->new( $username, $password );
print "done\n";
if ( ! $myspace->logged_in ) { 
  print "Unable to login: " . $myspace->error . "\n";
}

# Get list of your friends
print "Getting friends... ";
@friends = $myspace->get_friends();
print "done\n";

my %friend_mapping; # key = id, value = name

# Present list all nice-like
foreach my $friend (@friends) {
  eval {
    print "friend id.: $friend\n";
    
    my $friend_name = $myspace->friend_user_name($friend);
    print "name......: $friend_name\n";
    $friend_mapping{$friend} = $friend_name;

    print "Getting last 5 comments.\n";
    
    my $comments = $myspace->get_comments($friend);
    my $max_comments_display = 5;
    do {
	my $comment = shift @{$comments};
	my $friend_name_comment = "";
	if (exists $friend_mapping{$comment->{sender}}) {
	    $friend_name_comment = $friend_mapping{$comment->{sender}};
	} else {
	    eval { $friend_name_comment = $myspace->friend_user_name($comment->{sender})};
	    if ($friend_name_comment) {
		$friend_mapping{$comment->{sender}} = $friend_name_comment;
	    }
	}
	if ($friend_name_comment) { 
	    print "- $friend_name_comment ($comment->{sender}) @ $comment->{date}\n";
	} else {
	    print "- N/A ($comment->{sender}) @ $comment->{date}\n";
	}
	#print "$comment->{comment}\n"; # The actual comment 
	$max_comments_display--;
    } while ($max_comments_display > 0);


  };
  if ($@) {
    print "Unable to complete request: $@\n";
  }
}

Pretty simple, eh? I hope you explore the CPAN page yourself for more functionality, as I've only covered a small part.

A handy little module!

Using Perl's Test::Simple and Test::More

Testing is simple. You are basically seeing if something is either true or false, usually comparing two values. That's pretty much it. It's that way on purpose.

There are two main modules for doing this: Test::More and Test::Simple.

I'd like to show you how to use them to write your own tests.

Test::Simple

Test::Simple is perfect in naming as it is simple and runs tests. Well, actually it only runs one test multiple times, if you choose to run it multiple times. It only has one subroutine, 'ok()', which will either evaluate an expression to true or false (pass or fail). Here is an example of using Test::Simple.

Here is the simple class we'll be testing (that just tests multiples [of 5 and 30]):

#!/usr/bin/perl
#
use strict;
use warnings;


package MultipleAsker;

sub new {
    my ($class) = shift;
    my $attrs = {};
    bless ($attrs, $class);
    return ($attrs);
}

# See if $what is a multiple of $number, return 1/0
sub _ofNumber {
    my ($self, $number, $what) = @_;
    my $ret = 0;
    $ret = 1 if (($what % $number) == 0);
    return ($ret);
}

sub ofFive {
    my ($self, $what) = @_;
    return ($self->_ofNumber(5, $what));
}

sub ofThirty {
    my ($self, $what) = @_;
    return ($self->_ofNumber(30, $what));
}

1;

See, the class is pretty simple. It just has two subroutines available: ofFive and ofThirty (_ofNumber is implied private).

Now we just need to test those two functions (and if new worked):

#!/usr/bin/perl
#
use strict;
use warnings;

use Test::Simple tests => 7;

use MultipleAsker;

my $ma = MultipleAsker->new();

# Test of new()
ok (defined($ma) && ref $ma eq 'MultipleAsker', 'new worked');

# Test ofFive()
ok ($ma->ofFive(24) == 0, '24 is not multiple of 5');
ok ($ma->ofFive(25) == 1, '25 is multiple of 5');
ok ($ma->ofFive(5) == 1, '5 is multiple of 5');

# Test ofThirty()
ok ($ma->ofThirty(34) == 0, '34 is not multiple of 30');
ok ($ma->ofThirty(120) == 1, '120 is multiple of 30');
ok ($ma->ofThirty(30) == 1, '30 is multiple of 30');

As you can see, only making use of the one function: ok. Notice 'test => 7'. This is how you tell Test::Simple how many tests you're going to run. You should know this when writing your code. Note that the second arguement (the test description) is purely optional.

Here is the output of the tests:

1..7
ok 1 - new worked
ok 2 - 24 is not multiple of 5
ok 3 - 25 is multiple of 5
ok 4 - 5 is multiple of 5
ok 5 - 34 is not multiple of 30
ok 6 - 120 is multiple of 30
ok 7 - 30 is multiple of 30

Pretty simple eh?! Yeah it is.

So, that seems pretty good, what more does Test::More offer me... other than 'more'?!

It offers you some more methods for testing, that are basically ok() under-the-hood, yet make your tests... erm more 'simple'. Yeah, it seems ironic, yet it isn't. It provides your methods of testing things so your first argument to ok() isn't huge for more complex things. It also helps with clarity.

Test::More

Let's go right into some code. Here is an example of using Test:More on the MultipleAsker class also:

#!/usr/bin/perl
#
use strict;
use warnings;

use Test::More tests => 8;

use_ok( 'MultipleAsker' ); # Easy to test importing the module

my $ma = MultipleAsker->new();

## Test of new()
# Much cleaner! (third argument is what to call the object)
isa_ok ($ma, 'MultipleAsker', 'ma');

## Test ofFive()
# Compare values as seperate arguments
is ($ma->ofFive(24), 0, '24 is not multiple of 5');
is ($ma->ofFive(25), 1, '25 is multiple of 5');

# Opposite of is, checks that first and second argument are not the same
isnt ($ma->ofFive(5), 0, '5 is multiple of 5');

## Test ofThirty()

# Show how to compare explicitly
cmp_ok ($ma->ofThirty(34), '==', 0, '34 is not multiple of 30');

# Finish the rest out, can still use ok()
ok ($ma->ofThirty(120) == 1, '120 is multiple of 30');
ok ($ma->ofThirty(30) == 1, '30 is multiple of 30');

Ask you can tell, there are several new methods available to use. Much more handy! Much cleaner and shorter way to test things that are not just an evaluation. While 'ok' works, it is not as clear as some of the names of the other methods... you can figure out what is being tested and in what way much easier with Test::More.

Oh! I almost forgot, here is the output:

1..8
ok 1 - use MultipleAsker;
ok 2 - ma isa MultipleAsker
ok 3 - 24 is not multiple of 5
ok 4 - 25 is multiple of 5
ok 5 - 5 is multiple of 5
ok 6 - 34 is not multiple of 30
ok 7 - 120 is multiple of 30
ok 8 - 30 is multiple of 30

As you can see, using these modules is very simple. Testing is meant to be very simple and test simple things only. While I'm not sure why anyone would want to use Test::Simple, it is available to you. Test::More is much more standard. All that really matters is that you do write tests.

Be sure to read the CPAN documentation for each module for a more complete description of all it's abilities.

Hope you increase your testing percentages if they aren't maxed out already!

Using Perl's Net::SSH::Perl

One important point of Net::SSH::Perl => no humans required. Yeah, a BIG win.

It's purpose is to provide all the SSH client functionality, yet purely in Perl where the ssh binary is not required. The big feature is that you don't have to type the password manually or setup passwordless ssh trust relationships (usually a bad idea unless you absolutely trust each side).

So, it provides an easy way to ssh into machines and run commands (and get stdout, stderr, and exit code), providing the password and username in the code.

With SSH 1, each command you run opens up a new session (it's how SSH1 works, yeah it's poo now-a-days), and with SSH 2 each command runs in the same session.

One tip you'll need to know about is that you should install the Math::BigInt::GMP module. Why?! Because it is a fast BigInt implementation that will speed up SSH 2 sessions from like 30 seconds to 1 second.

The awesomeness (if not obvious now): logging into machines via ssh and doing stuff in a perl program.

At work, I use it to monitor and help manage machines, where I keep tabs on many things from software versions (and what needs updated), disk usage, sanity checks, ensuring backups... and an added feature of making sure that passwords are still the same and sshd is working. Much easier to manage all the activity from one place instead of having many machines do the same thing via crontab. You could do many of these things via crontab on all servers, people have for years and years. I prefer to do it from one place where changes and new things are much more scalable and reliable.

Here is an example of logging into a remote machine and checking it's diskspace, reporting back if it was over a certian amount:

#!/opt/local/bin/perl
#
# checkDiskspace.pl: See if any partitions are greater than a percentage and notify
#
use strict;
use warnings;

use Net::SSH::Perl;
use Math::BigInt::GMP;  # Don't forget this!

$| = 1;

my $alert_percent = 75;
my $server = 'niroze.net';
my $username = 'christopher';
my $password = '*******************************';


# However you wanna notify yourself (like email)
sub alert_notify {
    my $message = shift;
    print "STUB: $message\n";
}

# Log into server
print "Creating ssh object... ";
my $ssh = Net::SSH::Perl->new($server); # Error check this
print "done\n";
print "Logging into server... ";
$ssh->login($username, $password); # Error check this
print "done\n";

# Check df
my $command = "df";
print "Running command ($command)... ";
my ($stdout, $stderr, $exit) = $ssh->cmd($command); # Check output
print "done\n";

# Find percentage
foreach my $df_line (split(/\n/, $stdout)) {
    # If disk space usage percent > $alert_percent, notify
    if ($df_line =~ /\s+(\d+)%\s+(\/.*)/ && $1 >= $alert_percent) {
        alert_notify ("[$server] device $2 at $1 percent!");
    }
}

This is just a simple example, yet you see how easy it is to do. Here is the output of the script:

Creating ssh object... done
Logging into server... done
Running command (df)... done
STUB: [niroze.net] device / at 75 percent!

Hopefully this handy module will help you streamline your tasks that require managing multiple servers that are sshd enabled. It has helped me greatly at my job.

It's nice to have programs do work and report back to you. Let the program do some of your work, especially the stuff where it is a lot of the same thing!

Note: there is more the module can do, so be sure to check the Net::SSH::Perl CPAN page for more details.

Using Perl's Mac::Glue

Are you like me? Did you get a Mac and are in awe of the integration of everything? It was one of the reasons I got a Mac, yet I didn't look into the details of how everything was integrated. How do applications "talk" to one another?

No, it was not Appletalk (yet that seems fitting word-wise). It's Applescript.

I may be a Mac newbie, yet I don't like "programming" Applescript at all. It should be natural, yet it isn't. It's actually very frustrating, yet that's just part of learning it.

To quote devintosh.com FAQ (freenode IRC network #macdev channel):

I have a problem with my AppleScript, can you help?
Probably not. AppleScript is a crappy language that makes it hard to do almost anything. If your AppleScript code is more than a few lines then you're already going beyond what it's good at. Learn a real language: it's harder to start with and it takes time to learn, but in the end you'll be solving more problems and solving them faster

Ok, I got that. Am past it... I still don't like it (thanks to mikeash on #macdev for enlightening me... before I went too far down the wrong rabbit hole).

I want a real programming language to be able to do the same things Applescript does. Isn't there a way?! Yes! There is Mac::Glue, which gives you all the same functionality of Applescript except you can now do it in Perl. Hrm... sounds like a bunch of bologna? Yeah, I agree... till I poked around into learning it. I'd like to share with you what I found.

First, install Mac::Glue. It's in MacPorts (p5-mac-glue) or you can install it via CPAN. Either way doesn't really matter, but in these examples I'll be using the MacPorts version (it's Perl is newer). Be sure to read the README file in the tarball. You will need to create the "glue" for programs you want to work with, ex: "sudo /opt/local/bin/gluemac /Applications/iTunes.app". No big deal, just be sure to do it for programs you plan on working with.

Second, note this isn't a full coverage of all that Mac::Glue does. This just shows how to port over some Applescript and "talk" to other programs via their bindings.

Now, to my favorite part. Some code! [sorry, it's not that impressive -ed.]

In the first example, lets port over something easy like "/Library/Scripts/Basics/AppleScript Help.scpt". It opens up 'Help Viewer.app', activates it, and then searches looking for 'AppleScript'.

Here is the AppleScript code:

tell application "Help Viewer"
	activate
	search looking for "AppleScript"
end tell

Here is the Perl code:

#!/opt/local/bin/perl
#
# Glue requirement:
#   * sudo /opt/local/bin/gluemac "/System/Library/CoreServices/Help Viewer.app"
# Port of:
#   * "/Library/Scripts/Basics/AppleScript Help.scpt"
#
use strict;
use warnings;

use Mac::Glue;


my $glue = new Mac::Glue 'Help_Viewer';
$glue->search(looking_for => 'AppleScript');

You may be wondering how I knew what subroutine to call. It's in the glue code pod file. Since I'm using MacPorts in these examples, I did this: "perldoc /opt/local/lib/perl5/vendor_perl/5.8.8/Mac/Glue/glues/Help_Viewer.pod". Be sure to look in that directory for help on how to use the "glue".

How about a simple adding someone to your address book?

#!/opt/local/bin/perl                                                                                                                            
#                                                                                                                                                
# Glue requirement:                                                                                                                              
#   * sudo /opt/local/bin/gluemac "/Applications/Address Book.app"                                                                               
# Explanation and original code examples from Chris Nandor:                                                                                      
#   * http://www.nntp.perl.org/group/perl.macosx/2004/04/msg7285.html                                                                          
#                                                                                                                                                
use strict;
use warnings;

use Mac::Glue ':all'; # all for 'location'

my $glue = new Mac::Glue 'Address_Book';

my $me = $glue->make (new => 'person', 
                      with_properties => {
                                          'first_name' => 'Steve',
                                          'last_name' => 'Jobs'
                                         }
                     );
$glue->make (new => 'email', at => location(end => $me->prop('emails')),
           with_properties => {
                               'value' => 'fakestevejobs@gmail.com',
                               'label' => 'home'
                              }
          );

I'm still a Mac::Glue and AppleScript newbie. There is much to learn, yet all the power that is desired is available at your finger tips. I hope this was communicated enough to educate you that it does exist and you can use it in place of AppleScript for use in real programs.

Much thanks to Chris Nandor and everyone else that may have been involved in Mac::Glue.

I still have much to learn, yet at least we both know that we can do what we need in Perl... at least in this respect. In any place you can use AppleScript, try using Mac::Glue instead. I recommend getting the FastScripts utility if you can, it's like the regular AppleScripts menu, yet much more flexible as it can run any kind of program and have custom keybindings (very handy).

To be fair, before I get complaints in my inbox, the ability to do the same thing exists for Ruby, Objective-C and Python available at http://appscript.sourceforge.net/. I played with it in Python and Ruby and it seems to work very well. So, give it a try if you're not a Perl coder.

Do you have any cool Mac::Glue examples? If so, post them and happy hacking!

Using Perl's Test::Class for Organized Unit Testing

I'm not going to go over the merits of unit testing. I've heard it all and discussed both sides till blue in the face. If you're unsure about unit testing, then please google it or ask some programmers you know about it.

What I do want to discuss is how one does unit testing in Perl. It's pretty simple, fortunately.

In the world of testing classes in CPAN, there are a few that you'll actually use: Test::Simple, Test::More, Test::Harness, and Test::Class. There are basically two schools of testing that is either Test::Harness based or Test::Class based. Test::Harness school runs a series of scripts which have tests in them top down, usually with a plan at the top of the file (plan is the number of tests you are planning on running). Test::Class manages itself, using Test::Class for tests and to run them (Test::Class allows you to have a plan per Test::Class subclass subroutine... I'll explain in a bit).

Today, I'm not going to talk about Test::Harness or Test::Simple. I will some other time.

I will talk about Test::More and Test::Class. They're pretty awesome and really really simple to use. Don't believe me?! Let's jump into some code.

In this example set, we're going to be dealing with a Hotdog Vendor class. It's purpose is to provide a way to know about a Hotdog Vendor and what's in his cart (east coast style). The Hotdog Vendor class only does a few things: takes the vendors name and how many hotdogs he plans on selling. We're assuming in this example a hotdog is a bun with a frank in it with mustard and kraut (yeah, sounds awesome).

Here's the Hotdog Vendor class (download here):

#
# HotdogVendor.pm: Provide a Hotdog Vendor
#
package HotdogVendor;

use strict;
use warnings;

sub new {
  my ($class, $name, $how_many) = @_;
  my $attrs = {
	       franks => $how_many,
	       buns => $how_many,
	       mustard => $how_many,
	       kraut => $how_many,
	       name => $name
	      };
  bless ($attrs, $class);
}

sub _use_product {
  my ($self, $product, $how_many) = @_;

  if (($self->{$product} - $how_many) < 1) {
    die "[$self->{name}] use_$product: Unable to processor order, not enough $product (you wanted $how_many, I only got $self->{$product}";
  }

  $self->{$product} -= $how_many;
}

sub _has_product {
  my ($self, $product) = @_;

  if (!defined $self->{$product}) {
    die "[$self->{name}] has_$product: undefined product (wrong vendor?!)";
  }

  return ($self->{$product});
}

# Franks
sub use_franks {
  my ($self, $how_many) = @_;

  $self->_use_product('franks', $how_many);
}
sub has_franks {
  my ($self) = shift;

  return ($self->_has_product('franks'));
}

# Buns
sub use_buns {
  my ($self, $how_many) = @_;

  $self->_use_product('buns', $how_many);
}
sub has_buns {
  my ($self) = shift;

  return ($self->_has_product('buns'));
}

# Mustard
sub use_mustard {
  my ($self, $how_many) = @_;

  $self->_use_product('mustard', $how_many);
}
sub has_mustard {
  my ($self) = shift;

  return ($self->_has_product('mustard'));
}

# Kraut
sub use_kraut {
  my ($self, $how_many) = @_;

  $self->_use_product('kraut', $how_many);
}
sub has_kraut {
  my ($self) = shift;

  return ($self->_has_product('kraut'));
}

# Name
sub name {
  my ($self) = shift;

  return ($self->{name});
}

1;

As you can see, it saves the name and amount for each product. It then provides subroutines to get the amount of product left, use up some product, and see what the vendor's name is. Pretty simple.. excuse my copy and paste.

Now we need to write some tests to make sure the subroutines work. It's pretty simple, in fact writing tests is brain dead simple it almost seems like it's too simple to even bother with. Wrong. Things change over time, simple changes can cause big problems if not checked. Anyways, enough preaching, time for tests (which should have came before the code, but you knew that already, eh?).

Here is the Hotdog Vendor Test class (download here):

#
# HotdogVendor_Test.pl: HotdogVendor.pm Test (Test::Class, unit testing)
#

package HotdogVendorTest;

use base qw(Test::Class);
use Test::More;

use HotdogVendor;

# Test that name is saved on new vendor creation
sub test_name : Test(1) {
    my $name = "Thomas";
    my $hotdogVendor = HotdogVendor->new($name, 100);
    is ($hotdogVendor->name, $name, 'name saved');
}

# Test product franks is saved and used works
sub test_franks : Test(2) {
    my $how_many = 100;
    my $hotdogVendor = HotdogVendor->new('Chris', $how_many);
    is ($hotdogVendor->has_franks, $how_many, 'franks amount saved');
    $hotdogVendor->use_franks(60);
    is ($hotdogVendor->has_franks, 40, '100 - 60 franks is 40 franks');
}

# Test product buns is saved and used works
sub test_buns : Test(2) {
    my $how_many = 100;
    my $hotdogVendor = HotdogVendor->new('Chris', $how_many);
    is ($hotdogVendor->has_buns, $how_many, 'buns amount saved');
    $hotdogVendor->use_buns(60);
    is ($hotdogVendor->has_buns, 40, '100 - 60 buns is 40 buns');
}

# Test product mustard is saved and used works
sub test_mustard : Test(2) {
    my $how_many = 100;
    my $hotdogVendor = HotdogVendor->new('Chris', $how_many);
    is ($hotdogVendor->has_mustard, $how_many, 'mustard amount saved');
    $hotdogVendor->use_mustard(60);
    is ($hotdogVendor->has_mustard, 40, '100 - 60 mustard is 40 mustard');
}

# Test product mustard is saved and used works
sub test_kraut : Test(2) {
    my $how_many = 100;
    my $hotdogVendor = HotdogVendor->new('Chris', $how_many);
    is ($hotdogVendor->has_kraut, $how_many, 'kraut amount saved');
    $hotdogVendor->use_kraut(60);
    is ($hotdogVendor->has_kraut, 40, '100 - 60 kraut is 40 kraut');
}
1;

As you can see, it's using the "secret" Perl attribute technique. You can look that up yourself. Just know that it is pretty much what it seems. You can search about the specifics on the Test::Class CPAN page. The one I'm using is 'Test(<number of tests in this subroutine>)', which is pretty simple. A much easier way to organize tests, versus Test::Harness.

How do you run the tests? Here is how (download here):

#!/opt/local/bin/perl
#
use strict;
use warnings;

use Test::Class;

use HotdogVendorTest;


Test::Class->runtests;

The output:

$ /opt/local/bin/perl run_tests.pl
1..9
ok 1 - buns amount saved
ok 2 - 100 - 60 buns is 40 buns
ok 3 - franks amount saved
ok 4 - 100 - 60 franks is 40 franks
ok 5 - kraut amount saved
ok 6 - 100 - 60 kraut is 40 kraut
ok 7 - mustard amount saved
ok 8 - 100 - 60 mustard is 40 mustard
ok 9 - name saved

Pretty simple? Yes. Unit testing is simple and you can be as resource intensive and take as long as you want to run the tests, as that stuff doesn't matter. The only thing that matters is testing tiny parts of your class and program modules. It's pretty easy if your code isn't one big huge function that does 10 more things than it needs to be doing.

Comments? Suggestions? This is my first in a big series of Perl and Mac development articles. I'm starting off simple so I have something to build on for later articles. Hrm, now that I think about it... what do you want to know about??

Let me know and happy testing!