diff --git a/lib/Travelynx/Command/database.pm b/lib/Travelynx/Command/database.pm new file mode 100644 index 0000000..e501e47 --- /dev/null +++ b/lib/Travelynx/Command/database.pm @@ -0,0 +1,131 @@ +package Travelynx::Command::database; +use Mojo::Base 'Mojolicious::Command'; + +use DateTime; + +has description => 'Initialize or upgrade database layout'; + +has usage => sub { shift->extract_usage }; + +sub get_schema_version { + my ($dbh) = @_; + for my $entry ( + $dbh->selectall_array(qq{select version from schema_version}) ) + { + return $entry->[0]; + } +} + +sub initialize_db { + my ($dbh) = @_; + return $dbh->do( + qq{ + create table schema_version ( + version integer primary key + ); + create table users ( + id serial not null primary key, + name varchar(64) not null unique, + status smallint not null, + public_level smallint not null, + email varchar(256), + token varchar(80), + password text, + registered_at timestamptz not null, + last_login timestamptz not null, + deletion_requested timestamptz + ); + create table stations ( + id serial not null primary key, + ds100 varchar(16) not null unique, + name varchar(64) not null unique + ); + create table user_actions ( + id serial not null primary key, + user_id integer not null references users (id), + action_id smallint not null, + station_id int references stations (id), + action_time timestamptz not null, + train_type varchar(16), + train_line varchar(16), + train_no varchar(16), + train_id varchar(128), + sched_time timestamptz, + real_time timestamptz, + route text, + messages text + ); + create table pending_mails ( + email varchar(256) not null primary key, + num_tries smallint not null, + last_try timestamptz not null + ); + create table tokens ( + user_id integer not null references users (id), + type smallint not null, + token varchar(80) not null, + primary key (user_id, type) + ); + insert into schema_version values (0); + } + ); +} + +my @migrations = (); + +sub run { + my ( $self, $command ) = @_; + + my $dbh = $self->app->dbh; + + if ( $command eq 'setup' ) { + $dbh->begin_work; + if ( initialize_db($dbh) ) { + $dbh->commit; + } + else { + $dbh->rollback; + } + } + elsif ( $command eq 'migrate' ) { + $dbh->begin_work; + my $schema_version = get_schema_version($dbh); + say "Found travelynx schema v${schema_version}"; + if ( $schema_version == @migrations ) { + say "Database layout is up-to-date"; + } + for my $i ( $schema_version .. $#migrations ) { + printf( "Updating to v%d ...\n", $i + 1 ); + if ( not $migrations[$i]() ) { + say "Aborting migration; rollback to v${schema_version}"; + $dbh->rollback; + last; + } + } + if ( get_schema_version($dbh) == $#migrations ) { + $dbh->commit; + } + } + else { + $self->help; + } + + $dbh->disconnect; + +} + +1; + +__END__ + +=head1 SYNOPSIS + + Usage: index.pl database + + Upgrades the database layout to the latest schema. + + Recommended workflow: + > systemctl stop travelynx + > TRAVELYNX_DB_HOST=... TRAVELYNX_DB_NAME=... TRAVELYNX_DB_USER=... \ + TRAVELYNX_DB_PASSWORD=... perl index.pl migrate + > systemctl start travelynx diff --git a/migrate.pl b/migrate.pl deleted file mode 100755 index 54cb8ce..0000000 --- a/migrate.pl +++ /dev/null @@ -1,243 +0,0 @@ -#!/usr/bin/env perl - -use strict; -use warnings; -use 5.020; - -use DateTime; -use DBI; - -my $dbname = $ENV{TRAVELYNX_DB_FILE} // 'travelynx.sqlite'; -my $dbh = DBI->connect( "dbi:SQLite:dbname=${dbname}", q{}, q{} ); - -my $has_version_query = $dbh->prepare( - qq{ - select name from sqlite_master - where type = 'table' and name = 'schema_version'; -} -); - -sub get_schema_version { - $has_version_query->execute(); - my $rows = $has_version_query->fetchall_arrayref; - if ( @{$rows} == 1 ) { - my $get_version_query = $dbh->prepare( - qq{ - select version from schema_version; - } - ); - $get_version_query->execute(); - my $rows = $get_version_query->fetchall_arrayref; - if ( @{$rows} == 0 ) { - return -1; - } - return $rows->[0][0]; - } - return 0; -} - -my @migrations = ( - - # v0 -> v1 - sub { - $dbh->begin_work; - $dbh->do( - qq{ - create table schema_version ( - version integer primary key - ); - } - ); - $dbh->do( - qq{ - insert into schema_version (version) values (1); - } - ); - $dbh->do( - qq{ - create table new_users ( - id integer primary key, - name char(64) not null unique, - status int not null, - is_public bool not null, - email char(256), - password text, - registered_at datetime not null, - last_login datetime not null, - deletion_requested datetime - ); - } - ); - my $get_users_query = $dbh->prepare( - qq{ - select * from users; - } - ); - my $add_user_query = $dbh->prepare( - qq{ - insert into new_users - (id, name, status, is_public, registered_at, last_login) - values - (?, ?, ?, ?, ?, ?); - } - ); - $get_users_query->execute; - - while ( my @row = $get_users_query->fetchrow_array ) { - my ( $id, $name ) = @row; - my $now = DateTime->now( time_zone => 'Europe/Berlin' )->epoch; - $add_user_query->execute( $id, $name, 0, 0, $now, $now ); - } - $dbh->do( - qq{ - drop table users; - } - ); - $dbh->do( - qq{ - alter table new_users rename to users; - } - ); - $dbh->commit; - }, - - # v1 -> v2 - sub { - $dbh->begin_work; - $dbh->do( - qq{ - update schema_version set version = 2; - } - ); - $dbh->do( - qq{ - create table new_users ( - id integer primary key, - name char(64) not null unique, - status int not null, - public_level int not null, - email char(256), - token char(80), - password text, - registered_at datetime not null, - last_login datetime not null, - deletion_requested datetime - ); - } - ); - my $get_users_query = $dbh->prepare( - qq{ - select * from users; - } - ); - - # At this point, some "users" fields were never used -> skip those - # during migration. - my $add_user_query = $dbh->prepare( - qq{ - insert into new_users - (id, name, status, public_level, registered_at, last_login) - values - (?, ?, ?, ?, ?, ?); - } - ); - - $get_users_query->execute; - - while ( my @row = $get_users_query->fetchrow_array ) { - my ( - $id, $name, $status, - $is_public, $email, $password, - $reg_at, $last_login, $del_requested - ) = @row; - $add_user_query->execute( $id, $name, $status, $is_public, $reg_at, - $last_login ); - } - $dbh->do( - qq{ - drop table users; - } - ); - $dbh->do( - qq{ - alter table new_users rename to users; - } - ); - $dbh->do( - qq{ - create table pending_mails ( - email char(256) not null primary key, - num_tries int not null, - last_try datetime not null - ); - } - ); - $dbh->commit; - }, - - # v2 -> v3 - sub { - $dbh->begin_work; - $dbh->do( - qq{ - update schema_version set version = 3; - } - ); - $dbh->do( - qq{ - create table tokens ( - user_id integer not null, - type integer not null, - token char(80) not null, - primary key (user_id, type) - ); - } - ); - $dbh->commit; - }, - - # v3 -> v4 - sub { - $dbh->begin_work; - $dbh->do( - qq{ - update schema_version set version = 4; - } - ); - $dbh->do( - qq{ - create table monthly_stats ( - user_id integer not null, - year int not null, - month int not null, - km_route int not null, - km_beeline int not null, - min_travel_sched int not null, - min_travel_real int not null, - min_change_sched int not null, - min_change_real int not null, - num_cancelled int not null, - num_trains int not null, - num_journeys int not null, - primary key (user_id, year, month) - ); - } - ); - $dbh->commit; - }, -); - -my $schema_version = get_schema_version(); - -say "Found travelynx schema v${schema_version}"; - -if ( $schema_version == @migrations ) { - say "Database schema is up-to-date"; -} - -for my $i ( $schema_version .. $#migrations ) { - printf( "Updating to v%d\n", $i + 1 ); - $migrations[$i](); -} - -$dbh->disconnect;