Vedalken counts

After gathering the information about all the cards ever printed, I wanted to be able to track down their count – per card type. Actually, the whole point of having the list of all cards was being asked by a program “how many items of this card do you have?”. So this script came to the rescue:

#!/usr/bin/env perl

use strict;
use warnings;

use DBI;

my $dbh = DBI->connect( "dbi:SQLite:dbname=vedalken.db" )
    or die "Cannot connect to the database: $DBI::errstr";

my $sth = $dbh->prepare( q/
    SELECT id, name FROM Card
    WHERE color = ? AND cardtype LIKE ?
    ORDER BY name
/ ) or die "Cannot prepare select: ", $dbh->errstr;

my $uth = $dbh->prepare( q/
    UPDATE Card SET amount = ?
    WHERE id = ?
/ );

my %colors = (
    Q => 'Quit',
    W => 'White',
    R => 'Red',
    G => 'Green',
    B => 'Black',
    U => 'Blue',
    L => 'Land',
    M => 'Multicolor',
    C => 'Colorless',
);

my %types = (
    I => 'Instant',
    E => 'Enchant',
    S => 'Sorcery',
    A => 'Artifact',
    C => 'Creature',
);

while ( 1 ) {
    print '[', $_, '] => ', $colors{$_}, $/
        foreach sort keys %colors;
    print "Select color: ";
    my $color = uc <STDIN>;
    chomp $color;

    last
        if $color eq 'Q';

    $color = $colors{$color};
    my $type = '%';

    if ( $color =~ /^[WBUGRM]/ ) {
        print '[', $_, '] => ', $types{$_}, $/
            foreach sort keys %types;
        print "Select type: ";
        $type = uc <STDIN>;
        chomp $type;
        $type = "%$types{$type}%";
    }

    $sth->execute( $color, $type );

    while ( my $card = $sth->fetchrow_hashref ) {
        print "'$card->{name}' quantity: ";
        my $quant = <STDIN>;
        chomp $quant;

        next
            unless $quant;

        $uth->execute( $quant, $card->{id} );
    }
}

$dbh->disconnect;

Of course, the script is very rough – just take a look at the database and you will see, that cards of type “Enchant Creature” will pop up in search for all Enchantments, but also in the search for all Creatures. But then I can just skip them, so they won’t get updated (instead of setting their count to 0).

However, I still have some cards in decks that are currently in use. Moreover, I still have some boosters left. I would like to be able to enter the new amount and have it added to the original one. And I would like to do this per card. But then, I want again to avoid the hassle of writing the long (and sometimes very fancy, thus error-prone) names. Autocompletion could be the right solution, but for this I would need a web page. So for now I will just use my tiny script, and then I will go back to Catalyst, to see what can be done.

But before using Catalyst, one may try to abstract some parts of this script:

while ( 1 ) {
    my $color = get_value( 'color', \%colors );

    last
        if $color eq 'Q';

    my $type = $color =~ /[WBUGRM]/
        ?   '%' . $types{ get_value( 'type', \%types ) } . '%'
        :   '%';

    $sth->execute( $colors{$color}, $type );

    while ( my $card = $sth->fetchrow_hashref ) {
        print "'$card->{name}' quantity: ";
        my $quant = <STDIN>;
        chomp $quant;

        next
            unless $quant;

        $uth->execute( $quant, $card->{id} );
    }
}

$dbh->disconnect;

sub get_value {
    my ( $aspect, $hashref ) = @_;

    print '[', $_, '] => ', $hashref->{$_}, $/
        foreach sort keys %$hashref;

    print "Select $aspect: ";
    my $value = uc <STDIN>;
    chomp $value;

    return $value;
}

I decided to use references to global hashes, so they won’t get copied while being passed to the procedure. Big optimization…

Catalyst is easy

You know some HTML, you have some experience with some ready-made tools, but now you want to write a web application. Of course you cannot touch the topic without hearing about PHP (which you probably already know to some extent), but someone told you that Catalyst is cool, because it is a modern Perl framework for web applications. And it uses Moose, so you can also take advantage of the metaclass model.

Huh? You just wanted to do something simple. Probably even crappy. You don’t want meta…what? model, you just want to start writing code. And see the results. So maybe it would be better to start with something simpler… oh, did they say Perl?

You can have the best of both worlds. Patience is one of the most interesting aspects of Perl, so you can actually start writing crap. I did it too, and reinvented the wheel many, many times. And now I want to show you, that is it possible to start with really crappy code and improve on it with the time.

I don’t plan to cover the Catalyst installation now (smart-ass, eh?). Any modern Linux system will provide you with Catalyst packages and all its dependencies should install without too much hassle. I haven’t used Windows for quite some time, but with Active Perl and Strawberry Perl there should be an easy option. It should be enough to install Catalyst::Runtime and Catalyst::Devel, so you get the necessary modules.

OK, let’s assume the Catalyst is installed and ready to play. Try it:

catalyst.pl --help

If you see the friendly message about skeletons, you can go on. Summit the skeleton:

catalyst.pl helloworld

Whoa, looks like you have a bunch of stuff here. But if you ever unzipped phpbb or anything else, you shouldn’t be afraid, right?

Great, maybe you can use some of this code already? You bet it. Enter the application directory and run your server. Yes, your very own private server:

cd helloworld
script/helloworld_server.pl

It is even so kind to inform you where to reach the first page of your new application – in most cases it would be http://localhost:3000, so go there and see it. Sorry, no wet floor, though.

But you are so eager to start writing the actual code. Perl code, to be precise. The legendary, obfuscated Perl code. Go and face it. Grab your editor and open the file helloworld/lib/helloworld/Controller/Root.pm – it may look scary, but soon you’ll just know, why this tree has to reach so deep. Even more, it won’t be “deep” for you anymore…

OK, you have the file open. If your editor is smart enough, it will highlight the syntax, so you will be able to see that – apart from the strange namespace incantation – there are some comments (good!) and some “=scary” tags – this is the documentation (look, Catalyst documents your code by itself!). But who enjoys the comments? You planned to write some code, so let’s jump to the lines 29-40:

sub index :Path :Args(0) {
    my ( $self, $c ) = @_;

    # Hello World
    $c->response->body( $c->welcome_message );
}

sub default :Path {
    my ( $self, $c ) = @_;
    $c->response->body( 'Page not found' );
    $c->response->status(404);
}

You can see the methods of the main (Root) Controller. Treat the methods as actions your Controller is able to make. And treat the Root Controller as your application. So you see that your application is able to make the index action – that one will show the pretty page you enjoyed a moment ago – and the default action. To see how it works, try to visit http://localhost:3000/catalyst/rulez. Quite useful, right?

But wait, looks like you can stuff the body with anything we want. Let’s try this:

sub index :Path :Args(0) {
    my ( $self, $c ) = @_;

    $c->response->body("I'm in ur controller, writing teh message");
}

Now you can save the file, kill the server – that’s it, Control C should work – and start it again. Now go to http://localhost:3000. You have lost the “Red Ball of Doom” image, but the application does what you want. Since you will experiment a lot, you can now start the server with the -r option, so it will reload the application if the file changes.

Or it will rather try to reload. Start the server with the -r option, then go to the file, and change the last double quote in the “message” line to the single quote, then save the file. Looks like server didn’t like the modification:

Can't find string terminator '"' anywhere before EOF at ... line 33.
Compilation failed in require at (eval 409) line 1.


As you can see, Catalyst not only documents the code, it even tries to debug it for you! With this support you can go and enhance your application. You can make it more flexible by changing the static message to some variable:

sub index :Path :Args(0) {
    my ( $self, $c ) = @_;

    $message = "I'm in ur controller, writing teh message";
    $c->response->body($message);
}

This won’t work, because Perl doesn’t like the variable, since it missed the “my” keyword. And Catalyst told Perl use strict;, so Perl was strict. Of course it is possible to comment or remove the “use strict” line, but believe me – you really don’t want to do this. Better get used to declare your variables:

sub index :Path :Args(0) {
    my ( $self, $c ) = @_;

    my $message = "I'm in ur controller, writing teh message";
    $c->response->body($message);
}

Now you are ready to generate some content:

sub index :Path :Args(0) {
    my ( $self, $c ) = @_;

    my @items = ( 'beer', 'bacon', 'pierogi' );
    my $message = join( ', ', @items );
    $c->response->body($message);
}

That is of course very dynamic, but still no HTML. How about this:

sub index :Path :Args(0) {
    my ( $self, $c ) = @_;

    my @items = ( 'beer', 'bacon', 'pierogi' );
    my $list = '';

    foreach my $item ( @items ) {
        $list .= "<li>$item</li>\n";
    }

    $c->response->body( <<END );
<html>
    <head>
        <title>My items</title>
    </head>
    <body>
        <ul>
        $list
        </ul>
    </body>
</html>
END
} 

So you create your data and HTML template in one file, in one function. Quick and dirty. No metaclasses, just pure crap. Next time I’ll try to make it even worse, but more dynamic – you know, almost Web2.0 – and then I’ll try to make it cleaner.

And even if you feel that this ugly code could have been written “cheaper” with some other tool – don’t worry, I’ll try to show how writing good code with Catalyst is almost as cheap, as writing the crappy one.