File Coverage

blib/lib/Arepa/PackageDb.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             package Arepa::PackageDb;
2              
3 4     4   70881 use strict;
  4         7  
  4         146  
4 4     4   22 use warnings;
  4         8  
  4         161  
5              
6 4     4   19 use Carp qw(croak);
  4         10  
  4         235  
7 4     4   10588 use DBI;
  4         80579  
  4         441  
8 4     4   177530 use TheSchwartz;
  0            
  0            
9             use Migraine;
10              
11             use constant SOURCE_PACKAGE_FIELDS => qw(name full_version
12             architecture distribution
13             comments);
14             use constant COMPILATION_QUEUE_FIELDS => qw(source_package_id architecture
15             distribution builder
16             status compilation_requested_at
17             compilation_started_at
18             compilation_completed_at);
19              
20             sub new {
21             my ($class, $path) = @_;
22              
23             # See if the DB was there before connecting, so we know if we have to
24             # create the table structure
25             my $create_tables = 0;
26             if (!defined $path || -z $path || ! -e $path) {
27             $create_tables = 1;
28             }
29              
30             my $dsn = "dbi:SQLite:dbname=" . ($path || "");
31             my $self = bless {
32             path => $path,
33             dbh => DBI->connect($dsn),
34             }, $class;
35              
36             if ($create_tables) {
37             $self->create_db;
38             }
39             my $migration_dir = '/usr/share/arepa/migrations';
40             my $migraine = Migraine->new($dsn, migrations_dir => $migration_dir);
41             $migraine->migrate;
42              
43             return $self;
44             }
45              
46             sub create_db {
47             my ($self) = @_;
48             my $r;
49              
50             $r = $self->_dbh->do(<
51             CREATE TABLE source_packages (id INTEGER PRIMARY KEY,
52             name VARCHAR(50),
53             full_version VARCHAR(20),
54             architecture VARCHAR(10),
55             distribution VARCHAR(30),
56             comments TEXT);
57             EOSQL
58             if (!$r) {
59             croak "Couldn't create table 'source_packages' in $self->{path}";
60             }
61              
62             $r = $self->_dbh->do(<
63             CREATE TABLE compilation_queue (id INTEGER PRIMARY KEY,
64             source_package_id INTEGER,
65             architecture VARCHAR(10),
66             distribution VARCHAR(30),
67             builder VARCHAR(50),
68             status VARCHAR(20),
69             compilation_requested_at TIMESTAMP,
70             compilation_started_at TIMESTAMP,
71             compilation_completed_at TIMESTAMP);
72             EOSQL
73             if (!$r) {
74             croak "Couldn't create table 'compilation_queue' in $self->{path}";
75             }
76             }
77              
78             sub default_timestamp {
79             my ($self) = @_;
80              
81             my ($sec, $min, $hour, $mday, $mon, $year) = localtime;
82             return sprintf("%i-%02i-%02i %02i:%02i:%02i",
83             $year+1900, $mon+1, $mday, $hour, $min, $sec);
84             }
85              
86             sub _dbh {
87             my ($self) = @_;
88             return $self->{dbh};
89             }
90              
91             sub get_source_package_id {
92             my ($self, $name, $full_version) = @_;
93              
94             my $extra_sql = "AND full_version = ?";
95             my @bind_vars = ($full_version);
96             if ($full_version eq '*latest*') {
97             $extra_sql = "ORDER BY full_version DESC LIMIT 1";
98             @bind_vars = ();
99             }
100              
101             my $sth = $self->_dbh->prepare("SELECT id FROM source_packages
102             WHERE name = ?
103             $extra_sql");
104             $sth->execute($name, @bind_vars);
105             $sth->bind_columns(\my $id);
106             return $sth->fetch ? $id : undef;
107             }
108              
109             sub get_source_package_by_id {
110             my ($self, $id) = @_;
111              
112             my $fields = join(", ", SOURCE_PACKAGE_FIELDS);
113             my $sth = $self->_dbh->prepare("SELECT $fields
114             FROM source_packages
115             WHERE id = ?");
116             $sth->execute($id);
117             $sth->bind_columns(\my $name, \my $fv, \my $arch, \my $distro,
118             \my $comments);
119             return $sth->fetch ? (id => $id,
120             name => $name,
121             full_version => $fv,
122             architecture => $arch,
123             distribution => $distro,
124             comments => $comments) :
125             croak "Can't find a source package with id '$id'";
126             }
127              
128             sub insert_source_package {
129             my ($self, %props) = @_;
130              
131             my (@fields, @field_values);
132             # Check that the props are valid
133             foreach my $field (keys %props) {
134             if (not grep { $_ eq $field } SOURCE_PACKAGE_FIELDS) {
135             croak "Don't recognise field '$field'";
136             }
137             }
138             # Check that at least we have 'name' and 'full_version'
139             if (!defined $props{name} || !defined $props{full_version}) {
140             croak "At least 'name' and 'full_version' are needed in a source package\n";
141             }
142              
143             my $id = $self->get_source_package_id($props{name},
144             $props{full_version});
145             if (defined $id) {
146             return $id;
147             }
148             else {
149             my $sth = $self->_dbh->prepare("INSERT INTO source_packages (" .
150             join(", ", keys %props) .
151             ") VALUES (" .
152             join(", ", map { "?" }
153             keys %props) .
154             ")");
155             if ($sth->execute(values %props)) {
156             return $self->_dbh->last_insert_id(undef, undef,
157             qw(source_packages), undef);
158             }
159             else {
160             print STDERR "ERROR: SQL query failed: ", $self->_dbh->errstr, "\n";
161             return 0;
162             }
163             }
164             }
165              
166             sub request_compilation {
167             my ($self, $source_id, $arch, $dist, $tstamp) = @_;
168             $tstamp ||= $self->default_timestamp;
169              
170             # Check that the source package id is valid. We are not going to use the
171             # returned value for anything, but it will die with an exception if the id
172             # is not valid
173             my %source_package = $self->get_source_package_by_id($source_id);
174              
175             my $sth = $self->_dbh->prepare("INSERT INTO compilation_queue (
176             source_package_id,
177             architecture,
178             distribution,
179             status,
180             compilation_requested_at)
181             VALUES (?, ?, ?, ?, ?)");
182             $sth->execute($source_id, $arch, $dist, "pending", $tstamp);
183              
184             my $compilation_id = $self->_dbh->last_insert_id('%', '',
185             'compilation_queue',
186             'id');
187             my $theschwartz_db_conf = [
188             { dsn => "dbi:SQLite:dbname=" . $self->{path} }
189             ];
190             my $client = TheSchwartz->new(databases => $theschwartz_db_conf);
191             $client->insert('Arepa::Job::CompilePackage',
192             { compilation_queue_id => $compilation_id });
193             }
194              
195             sub get_compilation_queue {
196             my ($self, %user_opts) = @_;
197             my %opts = (order => "compilation_requested_at", %user_opts);
198              
199             my $fields = join(", ", COMPILATION_QUEUE_FIELDS);
200             my ($condition, $limit) = ("", "");
201             if (exists $opts{status}) {
202             $condition = "WHERE status = " . $self->_dbh->quote($opts{status});
203             }
204             if (exists $opts{limit}) {
205             $limit = "LIMIT " . $self->_dbh->quote($opts{limit});
206             }
207             my $sth = $self->_dbh->prepare("SELECT id, $fields
208             FROM compilation_queue
209             $condition
210             ORDER BY $opts{order}
211             $limit");
212             $sth->execute;
213             $sth->bind_columns(\my $id,
214             \my $source_id, \my $arch, \my $distro,
215             \my $builder, \my $stat, \my $requested_at,
216             \my $started_at, \my $completed_at);
217             my @queue = ();
218             while ($sth->fetch) {
219             push @queue, {id => $id,
220             source_package_id => $source_id,
221             architecture => $arch,
222             distribution => $distro,
223             builder => $builder,
224             status => $stat,
225             compilation_requested_at => $requested_at,
226             compilation_started_at => $started_at,
227             compilation_completed_at => $completed_at}
228             }
229             return @queue;
230             }
231              
232             sub get_compilation_request_by_id {
233             my ($self, $compilation_id) = @_;
234              
235             my $fields = join(", ", COMPILATION_QUEUE_FIELDS);
236             my $sth = $self->_dbh->prepare("SELECT $fields
237             FROM compilation_queue
238             WHERE id = ?");
239             $sth->execute($compilation_id);
240             $sth->bind_columns(\my $source_id, \my $arch, \my $distro,
241             \my $builder, \my $stat, \my $requested_at,
242             \my $started_at, \my $completed_at);
243             my @queue = ();
244             if ($sth->fetch) {
245             $sth->finish;
246             return (id => $compilation_id,
247             source_package_id => $source_id,
248             architecture => $arch,
249             distribution => $distro,
250             builder => $builder,
251             status => $stat,
252             compilation_requested_at => $requested_at,
253             compilation_started_at => $started_at,
254             compilation_completed_at => $completed_at);
255             }
256             else {
257             croak "Can't find any compilation request with id '$compilation_id'";
258             }
259             }
260              
261             sub _set_compilation_status {
262             my ($self, $status, $compilation_id, $tstamp) = @_;
263             $tstamp ||= $self->default_timestamp;
264              
265             my $sth = $self->_dbh->prepare("UPDATE compilation_queue
266             SET status = ?,
267             compilation_completed_at = ?
268             WHERE id = ?");
269             $sth->execute($status, $tstamp, $compilation_id);
270             }
271              
272             sub mark_compilation_started {
273             my ($self, $compilation_id, $builder, $tstamp) = @_;
274             $tstamp ||= $self->default_timestamp;
275             my $sth = $self->_dbh->prepare("UPDATE compilation_queue
276             SET status = ?,
277             builder = ?,
278             compilation_started_at = ?
279             WHERE id = ?");
280             $sth->execute('compiling', $builder, $tstamp, $compilation_id);
281             }
282              
283             sub mark_compilation_completed {
284             my ($self, $compilation_id, $tstamp) = @_;
285             $self->_set_compilation_status('compiled', $compilation_id, $tstamp);
286             }
287              
288             sub mark_compilation_failed {
289             my ($self, $compilation_id, $tstamp) = @_;
290             $self->_set_compilation_status('compilationfailed',
291             $compilation_id, $tstamp);
292             }
293              
294             sub mark_compilation_pending {
295             my ($self, $compilation_id, $tstamp) = @_;
296             $self->_set_compilation_status('pending', $compilation_id, $tstamp);
297             my $theschwartz_db_conf = [{ dsn => "dbi:SQLite:dbname=".$self->{path} }];
298             my $client = TheSchwartz->new(databases => $theschwartz_db_conf);
299             $client->insert('Arepa::Job::CompilePackage',
300             { compilation_queue_id => $compilation_id });
301             }
302              
303             1;
304              
305             __END__