Arepa::PackageDb - Arepa package database API

 my $pdb = Arepa::PackageDb->new('path/to/packages.db');
 %attrs = (name         => 'dhelp',
           full_version => '0.6.17',
           architecture => 'all',
           distribution => 'unstable');
 my $id = $package_db->insert_source_package(%attrs);
 my $id2 = $package_db->get_source_package_id($name,
                                              $full_version);
 my $id3 = $package_db->get_source_package_id($name,
                                              '*latest*');
 my %source_package = $package_db->get_source_package_by_id($id);

 $pdb->request_compilation($source_id,
                           $arch,
                           $distribution);

 @queue        = $pdb->get_compilation_queue;
 @latest_queue = $pdb->get_compilation_queue(limit => 5);
 @pending_queue   = $pdb->get_compilation_queue(status => 'pending');
 @compiling_queue = $pdb->get_compilation_queue(status => 'compiling');

 my %compilation_attrs = $pdb->get_compilation_request_by_id($id);

 $pdb->mark_compilation_started($compilation_id, $builder_name);
 $pdb->mark_compilation_completed($compilation_id);
 $pdb->mark_compilation_failed($compilation_id);
 $pdb->mark_compilation_pending($compilation_id);

package Arepa::PackageDb;

use Carp qw(croak);
use DBI;

use constant SOURCE_PACKAGE_FIELDS => qw(name full_version
                                         architecture distribution
                                         comments);
use constant COMPILATION_QUEUE_FIELDS => qw(source_package_id architecture
                                            distribution builder
                                            status compilation_requested_at
                                            compilation_started_at
                                            compilation_completed_at);

sub new {
    my ($class, $path) = @_;

    # See if the DB was there before connecting, so we know if we have to
    # create the table structure
    my $create_tables = 0;
    if (-z $path || ! -e $path) {
        $create_tables = 1;
    }

    my $self = bless {
        path => $path,
        dbh  => DBI->connect("dbi:SQLite:dbname=$path"),
    }, $class;

    if ($create_tables) {
        $self->create_db;
    }

    return $self;
}

sub create_db {
    my ($self) = @_;
    my $r;

    $r = $self->_dbh->do(<<EOSQL);
CREATE TABLE source_packages (id           INTEGER PRIMARY KEY,
                              name         VARCHAR(50),
                              full_version VARCHAR(20),
                              architecture VARCHAR(10),
                              distribution VARCHAR(30),
                              comments     TEXT);
EOSQL
    if (!$r) {
        croak "Couldn't create table 'source_packages' in $self->{path}";
    }

    $r = $self->_dbh->do(<<EOSQL);
CREATE TABLE compilation_queue (id                       INTEGER PRIMARY KEY,
                                source_package_id        INTEGER,
                                architecture             VARCHAR(10),
                                distribution             VARCHAR(30),
                                builder                  VARCHAR(50),
                                status                   VARCHAR(20),
                                compilation_requested_at TIMESTAMP,
                                compilation_started_at   TIMESTAMP,
                                compilation_completed_at TIMESTAMP);
EOSQL
    if (!$r) {
        croak "Couldn't create table 'compilation_queue' in $self->{path}";
    }
}

sub default_timestamp {
    my ($self) = @_;

    my ($sec, $min, $hour, $mday, $mon, $year) = localtime;
    return sprintf("%i-%02i-%02i %02i:%02i:%02i",
                   $year+1900, $mon+1, $mday, $hour, $min, $sec);
}

sub _dbh {
    my ($self) = @_;
    return $self->{dbh};
}

sub get_source_package_id {
    my ($self, $name, $full_version) = @_;

    my $extra_sql = "AND full_version = ?";
    my @bind_vars = ($full_version);
    if ($full_version eq '*latest*') {
        $extra_sql = "ORDER BY full_version DESC LIMIT 1";
        @bind_vars = ();
    }

    my $sth = $self->_dbh->prepare("SELECT id FROM source_packages
                                                                                          WHERE name = ?
                                                                                              $extra_sql");
    $sth->execute($name, @bind_vars);
    $sth->bind_columns(\my $id);
    return $sth->fetch ? $id : undef;
}

sub get_source_package_by_id {
    my ($self, $id) = @_;

    my $fields = join(", ", SOURCE_PACKAGE_FIELDS);
    my $sth = $self->_dbh->prepare("SELECT $fields
                                                                            FROM source_packages
                                                                          WHERE id = ?");
    $sth->execute($id);
    $sth->bind_columns(\my $name, \my $fv, \my $arch, \my $distro,
                       \my $comments);
    return $sth->fetch ? (id           => $id,
                          name         => $name,
                          full_version => $fv,
                          architecture => $arch,
                          distribution => $distro,
                          comments     => $comments) :
                         croak "Can't find a source package with id '$id'";
}

sub insert_source_package {
    my ($self, %props) = @_;

    my (@fields, @field_values);
    # Check that the props are valid
    foreach my $field (keys %props) {
        if (not grep { $_ eq $field } SOURCE_PACKAGE_FIELDS) {
            croak "Don't recognise field '$field'";
        }
    }
    # Check that at least we have 'name' and 'full_version'
    if (!defined $props{name} || !defined $props{full_version}) {
        croak "At least 'name' and 'full_version' are needed in a source package\n";
    }

    my $id = $self->get_source_package_id($props{name},
                                          $props{full_version});
    if (defined $id) {
        return $id;
    }
    else {
        my $sth = $self->_dbh->prepare("INSERT INTO source_packages (" .
                                            join(", ", keys %props) .
                                            ") VALUES (" .
                                            join(", ", map { "?" }
                                                           keys %props) .
                                            ")");
        if ($sth->execute(values %props)) {
            return $self->_dbh->last_insert_id(undef, undef,
                                               qw(source_packages), undef);
        }
        else {
            print STDERR "ERROR: SQL query failed: ", $self->_dbh->errstr, "\n";
            return 0;
        }
    }
}

sub request_compilation {
    my ($self, $source_id, $arch, $dist, $tstamp) = @_;
    $tstamp ||= $self->default_timestamp;

    # Check that the source package id is valid. We are not going to use the
    # returned value for anything, but it will die with an exception if the id
    # is not valid
    my %source_package = $self->get_source_package_by_id($source_id);

    my $sth = $self->_dbh->prepare("INSERT INTO compilation_queue (
                                                                                                source_package_id,
                                                                                                architecture,
                                                                                                distribution,
                                                                                                status,
                                                                                                compilation_requested_at)
                                                                                VALUES (?, ?, ?, ?, ?)");
    $sth->execute($source_id, $arch, $dist, "pending", $tstamp);
}

sub get_compilation_queue {
    my ($self, %user_opts) = @_;
    my %opts = (order => "compilation_requested_at", %user_opts);

    my $fields = join(", ", COMPILATION_QUEUE_FIELDS);
    my ($condition, $limit) = ("", "");
    if (exists $opts{status}) {
        $condition = "WHERE status = " . $self->_dbh->quote($opts{status});
    }
    if (exists $opts{limit}) {
        $limit = "LIMIT " . $self->_dbh->quote($opts{limit});
    }
    my $sth = $self->_dbh->prepare("SELECT id, $fields
                                                                            FROM compilation_queue
                                                                                      $condition
                                                                    ORDER BY $opts{order}
                                                                                      $limit");
    $sth->execute;
    $sth->bind_columns(\my $id,
                       \my $source_id,  \my $arch,         \my $distro,
                       \my $builder,    \my $stat,         \my $requested_at,
                       \my $started_at, \my $completed_at);
    my @queue = ();
    while ($sth->fetch) {
        push @queue, {id                       => $id,
                      source_package_id        => $source_id,
                      architecture             => $arch,
                      distribution             => $distro,
                      builder                  => $builder,
                      status                   => $stat,
                      compilation_requested_at => $requested_at,
                      compilation_started_at   => $started_at,
                      compilation_completed_at => $completed_at}
    }
    return @queue;
}

sub get_compilation_request_by_id {
    my ($self, $compilation_id) = @_;

    my $fields = join(", ", COMPILATION_QUEUE_FIELDS);
    my $sth = $self->_dbh->prepare("SELECT $fields
                                                                            FROM compilation_queue
                                                                          WHERE id = ?");
    $sth->execute($compilation_id);
    $sth->bind_columns(\my $source_id,  \my $arch,         \my $distro,
                       \my $builder,    \my $stat,         \my $requested_at,
                       \my $started_at, \my $completed_at);
    my @queue = ();
    if ($sth->fetch) {
        $sth->finish;
        return (id                       => $compilation_id,
                source_package_id        => $source_id,
                architecture             => $arch,
                distribution             => $distro,
                builder                  => $builder,
                status                   => $stat,
                compilation_requested_at => $requested_at,
                compilation_started_at   => $started_at,
                compilation_completed_at => $completed_at);
    }
    else {
        croak "Can't find any compilation request with id '$compilation_id'";
    }
}

sub _set_compilation_status {
    my ($self, $status, $compilation_id, $tstamp) = @_;
    $tstamp ||= $self->default_timestamp;

    my $sth = $self->_dbh->prepare("UPDATE compilation_queue
                                                                              SET status                   = ?,
                                                                                      compilation_completed_at = ?
                                                                          WHERE id = ?");
    $sth->execute($status, $tstamp, $compilation_id);
}

sub mark_compilation_started {
    my ($self, $compilation_id, $builder, $tstamp) = @_;
    my $sth = $self->_dbh->prepare("UPDATE compilation_queue
                                                                              SET status                 = ?,
                                                                                      builder                = ?,
                                                                                      compilation_started_at = ?
                                                                          WHERE id = ?");
    $sth->execute('compiling', $builder, $tstamp, $compilation_id);
}

sub mark_compilation_completed {
    my ($self, $compilation_id, $tstamp) = @_;
    $self->_set_compilation_status('compiled', $compilation_id, $tstamp);
}

sub mark_compilation_failed {
    my ($self, $compilation_id, $tstamp) = @_;
    $self->_set_compilation_status('compilationfailed',
                                   $compilation_id, $tstamp);
}

sub mark_compilation_pending {
    my ($self, $compilation_id, $tstamp) = @_;
    $self->_set_compilation_status('pending', $compilation_id, $tstamp);
}

1;

__END__