Add a database command for database setup and migrations (c4a60375) · Commits · derf / travelynx

lib/Travelynx/Command/database.pm

0 → 100644

+131 −0

Original line number	Diff line number	Diff line
		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 <setup\|migrate>

		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

migrate.pl

deleted100755 → 0

+0 −243

Original line number	Diff line number	Diff line
		#!/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;

Admin message