Docendo discimus


  • Calendar

    May 2010
    M T W T F S S
  • Archives

  • Recent Posts

  • Bling

Vedalken counts

Posted by brunorc on May 4, 2010

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;

        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;

            unless $quant;

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


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 );

        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;

            unless $quant;

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


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…

Leave a Reply

Fill in your details below or click an icon to log in: Logo

You are commenting using your account. Log Out /  Change )

Google photo

You are commenting using your Google account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s

%d bloggers like this: