#!/usr/bin/perl

use strict;
use warnings;
use utf8;
use open qw(:std :encoding(UTF-8));

use Data::Dumper;
use DateTime;
use DBI;
use DBD::Pg;
use Encode;
use Getopt::Std;
use JSON::PP;
use Readonly;

our %opts;

Readonly my $appname => "mnmx-facture";

# Default invoice background, embedded verbatim (as EPS) in the generated
# PostScript. Edit this for your install; override per run with -b.
Readonly my $background_eps =>
	"/usr/local/share/mnmx-facture/eps/minmaxiste_facture_background.eps";

my $dbh;

sub usage
{
	print <<~"END";
		$appname: [-h] <command>

		$appname: [-h] invoice json <id>
		$appname: [-h] [-b <eps>] invoice ps [<id>]
		$appname: [-h] [-b <eps>] invoice pdf <id>
		$appname: [-h] invoice create
		$appname: [-h] invoice modify <id>
		$appname: [-h] invoice paid <id>
		$appname: [-h] invoice cancel <id>
		$appname: [-h] invoice additem
		$appname: [-h] invoice moditem <id>
		$appname: [-h] invoice delitem <id>

		$appname: [-h] client add
		$appname: [-h] client modify <id>
		$appname: [-h] client search <name|id>
		$appname: [-h] client show <id>

		$appname: [-h] po create
		$appname: [-h] po show <id>
		END
}

sub fail
{
	warn "$appname: @_\n";
	exit 1;
}

sub usage_die
{
	usage();
	exit 1;
}

sub read_line
{
	my $input = <STDIN>;

	# EOF (Ctrl-D) cancels the operation.
	defined $input or do {
		print "\n";
		exit 1;
	};

	chomp $input;

	# Strip control characters, plus the bidi-control and zero-width
	# format characters that can hide or reorder displayed text, then
	# trim the edges.
	$input =~ s{
		  \p{Cc}            # C0/C1 controls and DEL
		| \p{Bidi_Control}  # LRM/RLM, embeddings, overrides, isolates
		| \x{200B}          # zero width space
		| \x{200D}          # zero width joiner
		| \x{2060}          # word joiner
		| \x{FEFF}          # zero width no-break space / BOM
	}{}gx;
	$input =~ s/\A\s+//;
	$input =~ s/\s+\z//;

	return $input;
}

sub prompt
{
	my ($label, $default) = @_;

	my $shown = defined $default && length $default ? " [$default]" : "";
	print "$label$shown: ";

	my $input = read_line();

	# A lone "-" clears the field; empty input keeps the default.
	return undef if $input eq "-";
	return length $input ? $input : $default;
}

sub confirm
{
	my $question = shift;

	print "$question [y/N]: ";
	return read_line() =~ /\A \s* y/xi;
}

sub today
{
	my @t = localtime();
	return sprintf "%04d-%02d-%02d", $t[5] + 1900, $t[4] + 1, $t[3];
}

# True if an executable by this name is found on PATH.
sub have_command
{
	my $cmd = shift;

	for my $dir (split /:/, $ENV{PATH} // "") {
		return 1 if length $dir && -x "$dir/$cmd";
	}
	return;
}

# True only for a real YYYY-MM-DD calendar date, so the database never has
# to reject something like 2026-02-31 for us. The shape is checked here;
# DateTime rejects out-of-range fields (and gets the leap years right).
sub valid_date
{
	my $date = shift;

	return unless defined $date
		&& $date =~ /\A(\d{4})-(\d{2})-(\d{2})\z/;

	my $dt = eval {
		DateTime->new(year => $1, month => $2, day => $3);
	};
	return $dt ? 1 : 0;
}

# Normalize a yes/no answer to 1, 0, or undef (unrecognized).
sub yesno
{
	my $answer = shift;

	return 1 if defined $answer && $answer =~ /\A (?:y|yes|t|true|1) \z/xi;
	return 0 if defined $answer && $answer =~ /\A (?:n|no|f|false|0) \z/xi;
	return;
}

# Swap the decimal point for the language's separator (French uses a comma).
sub localize_decimal
{
	my ($s, $lang) = @_;
	$s =~ s/\./,/ if $lang eq "fr";
	return $s;
}

# Wrap text to $width, breaking on spaces. Widths are counted in characters,
# so an accented letter counts as one. Existing newlines are preserved as
# hard breaks.
sub wordwrap
{
	my ($text, $width) = @_;

	my @lines;
	for my $para (split /\n/, $text, -1) {
		my $line = "";
		my $len  = 0;
		for my $word (split / /, $para, -1) {
			my $wlen = length $word;
			if ($line eq "") {
				$line = $word;
				$len  = $wlen;
			} elsif ($len + 1 + $wlen <= $width) {
				$line .= " $word";
				$len  += 1 + $wlen;
			} else {
				push @lines, $line;
				$line = $word;
				$len  = $wlen;
			}
		}
		push @lines, $line;
	}

	return join "\n", @lines;
}

sub db_open
{
	$dbh = DBI->connect(
		"dbi:Pg:dbname=minmaxiste",
		"",
		"",
		{AutoCommit => 0, PrintError => 0, pg_enable_utf8 => 1})
		or fail("cannot connect: $DBI::errstr");

	$dbh->{RaiseError} = 1;
}

# Run a database action (coderef); translate an expected constraint
# violation, keyed by SQLSTATE, into a clean message instead of letting the
# raw DBI error reach the user. %message maps SQLSTATE => text.
sub db_try
{
	my ($action, %message) = @_;

	my $result = eval { $action->() };
	return $result unless $@;

	my $problem = $message{$dbh->state} // $dbh->errstr;
	$dbh->rollback();
	fail($problem);
}

sub print_client
{
	my $row = shift;

	my $addr = join " ", grep { defined && length }
		@$row{qw(address1 addr2)};

	print "\n";
	print "ID:      $row->{id}\n";
	print "Name:    $row->{name}\n";
	print "Address: $addr\n";
	print "         $row->{city}, $row->{prov_state}\n";
	print "         $row->{name_native}, $row->{postal_code}\n";
	print "Phone:   +$row->{pcode} $row->{phone}\n";
}

sub client_query
{
	my ($where, @bind) = @_;

	db_open();
	my $sth = $dbh->prepare("select id, name, address1, " .
		"coalesce(address2, '') as addr2, city, " .
		"prov_state, name_native, postal_code, " .
		"trim(phone_code) as pcode, phone " .
		"from clients " .
		"left join countries on " .
		"clients.country_code = countries.country_code " .
		$where);
	$sth->execute(@bind);

	my $count = 0;
	while (my $row = $sth->fetchrow_hashref()) {
		print_client($row);
		$count++;
	}
	$sth->finish();
	$dbh->rollback();

	return $count;
}

sub client_search
{
	my $pattern = shift @ARGV;
	usage_die() unless defined $pattern && length $pattern;

	client_query("where name ilike ? order by name", "%$pattern%")
		or fail("no client matching '$pattern'");
}

sub client_show
{
	my $id = shift @ARGV;
	usage_die() unless defined $id && length $id;

	client_query("where id = ?", $id)
		or fail("no client with id $id");
}

sub country_codes
{
	db_open();
	my $sth = $dbh->prepare("select country_code from countries");
	$sth->execute();

	my %valid;
	while (my ($code) = $sth->fetchrow_array()) {
		$valid{$code} = 1;
	}
	$sth->finish();
	$dbh->rollback();

	return \%valid;
}

sub client_insert
{
	my $client = shift;

	db_open();
	my $sth = $dbh->prepare("insert into clients " .
		"(name, address1, address2, city, prov_state, " .
		"country_code, postal_code, phone) " .
		"values (?, ?, ?, ?, ?, ?, ?, ?) " .
		"returning id");
	$sth->execute(@{$client}{qw(
		name address1 address2 city prov_state
		country_code postal_code phone
	)});

	my ($id) = $sth->fetchrow_array();
	$sth->finish();
	$dbh->commit();

	return $id;
}

sub client_load
{
	my $id = shift;

	db_open();
	my $sth = $dbh->prepare("select name, address1, address2, city, " .
		"prov_state, country_code, postal_code, phone " .
		"from clients where id = ?");
	$sth->execute($id);
	my $row = $sth->fetchrow_hashref();
	$sth->finish();
	$dbh->rollback();

	return $row;
}

sub client_update
{
	my ($id, $client) = @_;

	db_open();
	my $sth = $dbh->prepare("update clients set " .
		"name = ?, address1 = ?, address2 = ?, city = ?, " .
		"prov_state = ?, country_code = ?, postal_code = ?, phone = ? " .
		"where id = ?");
	$sth->execute(@{$client}{qw(
		name address1 address2 city prov_state
		country_code postal_code phone
	)}, $id);
	$sth->finish();
	$dbh->commit();
}

# Prompt for every client field, validating until confirmed. The hash is
# seeded for a modify and stays empty for a fresh add; either way the
# current value becomes each prompt's default.
sub client_form
{
	my ($client, $valid_country) = @_;

	my @fields = (
		[ name         => "Name" ],
		[ address1     => "Address 1" ],
		[ address2     => "Address 2" ],
		[ city         => "City" ],
		[ prov_state   => "Province/State" ],
		[ country_code => "Country (ISO 2)" ],
		[ postal_code  => "Postal code" ],
		[ phone        => "Phone" ],
	);

	while (1) {
		for my $field (@fields) {
			my ($key, $label) = @$field;
			$client->{$key} = prompt($label, $client->{$key});
		}

		# Normalize the country code so "ca" matches "CA".
		if (defined $client->{country_code}
			&& length $client->{country_code}) {
			$client->{country_code} = uc $client->{country_code};
		}

		if (!defined $client->{name} || !length $client->{name}) {
			print "Name is required.\n\n";
			next;
		}

		if (length($client->{country_code} // "")
			&& !$valid_country->{$client->{country_code}}) {
			print "Unknown country code " .
				"'$client->{country_code}'.\n\n";
			next;
		}

		print "\n";
		for my $field (@fields) {
			my ($key, $label) = @$field;
			printf "%-18s%s\n", "$label:", $client->{$key} // "";
		}
		print "\n";

		return if confirm("Save this client?");
		print "\n";
	}
}

sub client_add
{
	STDOUT->autoflush(1);

	my $valid_country = country_codes();

	my %client;
	client_form(\%client, $valid_country);

	my $id = client_insert(\%client);
	print "Created client $id.\n";
}

sub client_modify
{
	my $id = shift @ARGV;
	usage_die() unless defined $id && length $id;

	STDOUT->autoflush(1);

	my $client = client_load($id) or fail("no client with id $id");
	print "Editing client $id -- Enter keeps the current value, " .
		"- clears it.\n";
	my $valid_country = country_codes();
	client_form($client, $valid_country);

	client_update($id, $client);
	print "Updated client $id.\n";
}

sub client
{
	my %dispatch = (
		add    => \&client_add,
		modify => \&client_modify,
		show   => \&client_show,
		search => \&client_search,
	);

	my $subcommand = shift @ARGV;
	my $handler = $subcommand && $dispatch{$subcommand}
		or usage_die();

	$handler->();
}

sub enum_values
{
	my $type = shift;

	db_open();
	my $sth = $dbh->prepare("select enumlabel from pg_enum " .
		"join pg_type on pg_type.oid = pg_enum.enumtypid " .
		"where pg_type.typname = ? " .
		"order by enumsortorder");
	$sth->execute($type);

	my @labels;
	while (my ($label) = $sth->fetchrow_array()) {
		push @labels, $label;
	}
	$sth->finish();
	$dbh->rollback();

	return @labels;
}

sub lookup_client_name
{
	my $id = shift;

	db_open();
	my $sth = $dbh->prepare("select name from clients where id = ?");
	$sth->execute($id);
	my ($name) = $sth->fetchrow_array();
	$sth->finish();
	$dbh->rollback();

	return $name;
}

sub invoice_lookup_po
{
	my ($po, $client_id) = @_;

	db_open();
	my $sth = $dbh->prepare("select internal_id from purchase_orders " .
		"where id = ? and client_id = ?");
	$sth->execute($po, $client_id);
	my ($internal_id) = $sth->fetchrow_array();
	$sth->finish();
	$dbh->rollback();

	return $internal_id;
}

sub invoice_insert
{
	my $invoice = shift;

	db_open();
	my $sth = $dbh->prepare("insert into invoices " .
		"(client_id, po_id, lang, unit, hourly_rate, " .
		"payment_grace_period_days, date_created, paid, canceled) " .
		"values (?, ?, ?, ?, ?, ?, ?, ?, ?) " .
		"returning id");
	$sth->execute(
		@{$invoice}{qw(client_id po_id lang unit hourly_rate grace
			date_created)},
		yesno($invoice->{paid}),
		yesno($invoice->{canceled}));

	my ($id) = $sth->fetchrow_array();
	$sth->finish();
	$dbh->commit();

	return $id;
}

sub invoice_load
{
	my $id = shift;

	db_open();
	my $sth = $dbh->prepare("select i.client_id, p.id as po, " .
		"i.lang, i.unit, i.hourly_rate::numeric as hourly_rate, " .
		"i.payment_grace_period_days as grace, i.date_created, " .
		"case when i.paid then 'y' else 'n' end as paid, " .
		"case when i.canceled then 'y' else 'n' end as canceled " .
		"from invoices i " .
		"join purchase_orders p on p.internal_id = i.po_id " .
		"where i.id = ?");
	$sth->execute($id);
	my $row = $sth->fetchrow_hashref();
	$sth->finish();
	$dbh->rollback();

	return $row;
}

sub invoice_update
{
	my ($id, $invoice) = @_;

	db_open();
	my $sth = $dbh->prepare("update invoices set " .
		"client_id = ?, po_id = ?, lang = ?, unit = ?, " .
		"hourly_rate = ?, payment_grace_period_days = ?, " .
		"date_created = ?, paid = ?, canceled = ? " .
		"where id = ?");
	$sth->execute(
		@{$invoice}{qw(client_id po_id lang unit hourly_rate grace
			date_created)},
		yesno($invoice->{paid}),
		yesno($invoice->{canceled}),
		$id);
	$sth->finish();
	$dbh->commit();
}

# Prompt for every invoice field, validating until confirmed. The hash is
# seeded for a modify and stays empty for a fresh create; either way the
# current value becomes each prompt's default. The human PO number is
# resolved to its internal id, scoped to the chosen client.
sub invoice_form
{
	my $invoice = shift;

	my @langs = enum_values("language");
	my @units = enum_values("invoice_units");
	my %valid_lang = map { $_ => 1 } @langs;
	my %valid_unit = map { $_ => 1 } @units;

	my $client_name;
	while (1) {
		$invoice->{client_id} =
			prompt("Client ID", $invoice->{client_id});
		if (!defined $invoice->{client_id}
			|| $invoice->{client_id} !~ /\A\d+\z/) {
			print "Client ID must be a number.\n\n";
			next;
		}

		$client_name = lookup_client_name($invoice->{client_id});
		if (!defined $client_name) {
			print "No client with id $invoice->{client_id}.\n\n";
			next;
		}

		$invoice->{po} = prompt("Purchase order", $invoice->{po});
		if (!defined $invoice->{po} || !length $invoice->{po}) {
			print "Purchase order is required.\n\n";
			next;
		}

		$invoice->{po_id} =
			invoice_lookup_po($invoice->{po}, $invoice->{client_id});
		if (!defined $invoice->{po_id}) {
			print "No purchase order '$invoice->{po}' " .
				"for this client.\n\n";
			next;
		}

		$invoice->{lang} =
			uc(prompt("Language (" . join("/", @langs) . ")",
				$invoice->{lang} // $langs[0]) // "");
		if (!$valid_lang{$invoice->{lang}}) {
			print "Language must be one of: " .
				join(", ", @langs) . ".\n\n";
			next;
		}

		$invoice->{unit} = uc(prompt("Unit (" . join("/", @units) . ")",
			$invoice->{unit} // $units[0]) // "");
		if (!$valid_unit{$invoice->{unit}}) {
			print "Unit must be one of: " .
				join(", ", @units) . ".\n\n";
			next;
		}

		$invoice->{hourly_rate} = prompt("Hourly rate",
			$invoice->{hourly_rate} // "150.00");
		if (!defined $invoice->{hourly_rate}
			|| $invoice->{hourly_rate} !~ /\A\d+(?:\.\d{1,2})?\z/) {
			print "Hourly rate must be a number.\n\n";
			next;
		}

		$invoice->{grace} = prompt("Payment grace period (days)",
			$invoice->{grace} // "30");
		if (!defined $invoice->{grace} || $invoice->{grace} !~ /\A\d+\z/) {
			print "Grace period must be a whole number of days.\n\n";
			next;
		}

		$invoice->{date_created} = prompt("Date created (YYYY-MM-DD)",
			$invoice->{date_created} // today());
		if (!valid_date($invoice->{date_created})) {
			print "Date must be a valid YYYY-MM-DD date.\n\n";
			next;
		}

		$invoice->{paid} = prompt("Paid (y/n)", $invoice->{paid} // "n");
		if (!defined yesno($invoice->{paid})) {
			print "Answer y or n.\n\n";
			next;
		}

		$invoice->{canceled} =
			prompt("Canceled (y/n)", $invoice->{canceled} // "n");
		if (!defined yesno($invoice->{canceled})) {
			print "Answer y or n.\n\n";
			next;
		}

		print "\n";
		printf "%-18s%s\n", "Client:",
			"$invoice->{client_id} ($client_name)";
		printf "%-18s%s\n", "Purchase order:", $invoice->{po};
		printf "%-18s%s\n", "Language:", $invoice->{lang};
		printf "%-18s%s\n", "Unit:", $invoice->{unit};
		printf "%-18s%s\n", "Hourly rate:", $invoice->{hourly_rate};
		printf "%-18s%s\n", "Grace (days):", $invoice->{grace};
		printf "%-18s%s\n", "Date created:", $invoice->{date_created};
		printf "%-18s%s\n", "Paid:",
			yesno($invoice->{paid}) ? "yes" : "no";
		printf "%-18s%s\n", "Canceled:",
			yesno($invoice->{canceled}) ? "yes" : "no";
		print "\n";

		return if confirm("Save this invoice?");
		print "\n";
	}
}

sub invoice_create
{
	STDOUT->autoflush(1);

	my %invoice;
	invoice_form(\%invoice);

	my $id = invoice_insert(\%invoice);
	print "Created invoice $id.\n";
}

sub invoice_modify
{
	my $id = shift @ARGV;
	usage_die() unless defined $id && length $id;

	STDOUT->autoflush(1);

	my $invoice = invoice_load($id) or fail("no invoice with id $id");
	print "Editing invoice $id -- Enter keeps the current value.\n";
	invoice_form($invoice);

	invoice_update($id, $invoice);
	print "Updated invoice $id.\n";
}

sub invoice_exists
{
	my $id = shift;

	db_open();
	my $sth = $dbh->prepare("select 1 from invoices where id = ?");
	$sth->execute($id);
	my ($found) = $sth->fetchrow_array();
	$sth->finish();
	$dbh->rollback();

	return $found;
}

sub invoice_item_insert
{
	my $item = shift;

	db_open();
	my $sth = $dbh->prepare("insert into invoice_items " .
		"(invoice_id, work_date, description, units) " .
		"values (?, ?, ?, ?) " .
		"returning id");
	$sth->execute(@{$item}{qw(invoice_id work_date description units)});

	my ($id) = $sth->fetchrow_array();
	$sth->finish();
	$dbh->commit();

	return $id;
}

sub invoice_item_load
{
	my $id = shift;

	db_open();
	my $sth = $dbh->prepare("select invoice_id, work_date, " .
		"description, units from invoice_items where id = ?");
	$sth->execute($id);
	my $row = $sth->fetchrow_hashref();
	$sth->finish();
	$dbh->rollback();

	return $row;
}

sub invoice_item_update
{
	my ($id, $item) = @_;

	db_open();
	my $sth = $dbh->prepare("update invoice_items set " .
		"invoice_id = ?, work_date = ?, description = ?, units = ? " .
		"where id = ?");
	$sth->execute(@{$item}{qw(
		invoice_id work_date description units
	)}, $id);
	$sth->finish();
	$dbh->commit();
}

# Prompt for every invoice-item field, validating until confirmed. As with
# the other forms, the hash is seeded for a modify and empty for an add.
sub invoice_item_form
{
	my $item = shift;

	while (1) {
		$item->{invoice_id} =
			prompt("Invoice ID", $item->{invoice_id});
		if (!defined $item->{invoice_id}
			|| $item->{invoice_id} !~ /\A\d+\z/) {
			print "Invoice ID must be a number.\n\n";
			next;
		}
		if (!invoice_exists($item->{invoice_id})) {
			print "No invoice with id $item->{invoice_id}.\n\n";
			next;
		}

		$item->{work_date} = prompt("Work date (YYYY-MM-DD)",
			$item->{work_date} // today());
		if (!valid_date($item->{work_date})) {
			print "Date must be a valid YYYY-MM-DD date.\n\n";
			next;
		}

		$item->{description} =
			prompt("Description", $item->{description});

		$item->{units} = prompt("Units", $item->{units});
		if (!defined $item->{units}
			|| $item->{units} !~ /\A\d+(?:\.\d+)?\z/) {
			print "Units must be a number.\n\n";
			next;
		}

		print "\n";
		printf "%-18s%s\n", "Invoice:", $item->{invoice_id};
		printf "%-18s%s\n", "Work date:", $item->{work_date};
		printf "%-18s%s\n", "Description:", $item->{description} // "";
		printf "%-18s%s\n", "Units:", $item->{units};
		print "\n";

		return if confirm("Save this item?");
		print "\n";
	}
}

sub invoice_additem
{
	STDOUT->autoflush(1);

	my %item;
	invoice_item_form(\%item);

	my $id = invoice_item_insert(\%item);
	print "Added invoice item $id.\n";
}

sub invoice_moditem
{
	my $id = shift @ARGV;
	usage_die() unless defined $id && length $id;

	STDOUT->autoflush(1);

	my $item = invoice_item_load($id)
		or fail("no invoice item with id $id");
	print "Editing invoice item $id -- Enter keeps the current value, " .
		"- clears it.\n";
	invoice_item_form($item);

	invoice_item_update($id, $item);
	print "Updated invoice item $id.\n";
}

sub invoice_paid
{
	my $id = shift @ARGV;
	usage_die() unless defined $id && length $id;

	STDOUT->autoflush(1);

	invoice_exists($id) or fail("no invoice with id $id");

	exit 0 unless confirm("Mark invoice $id paid?");

	db_open();
	my $sth = $dbh->prepare("update invoices set paid = true " .
		"where id = ?");
	$sth->execute($id);
	$sth->finish();
	$dbh->commit();

	print "Marked invoice $id paid.\n";
}

sub invoice_cancel
{
	my $id = shift @ARGV;
	usage_die() unless defined $id && length $id;

	STDOUT->autoflush(1);

	invoice_exists($id) or fail("no invoice with id $id");

	exit 0 unless confirm("Cancel invoice $id?");

	db_open();
	my $sth = $dbh->prepare("update invoices set canceled = true " .
		"where id = ?");
	$sth->execute($id);
	$sth->finish();
	$dbh->commit();

	print "Canceled invoice $id.\n";
}

sub invoice_delitem
{
	my $id = shift @ARGV;
	usage_die() unless defined $id && length $id;

	STDOUT->autoflush(1);

	my $item = invoice_item_load($id)
		or fail("no invoice item with id $id");

	print "\n";
	printf "%-18s%s\n", "Invoice:", $item->{invoice_id};
	printf "%-18s%s\n", "Work date:", $item->{work_date};
	printf "%-18s%s\n", "Description:", $item->{description} // "";
	printf "%-18s%s\n", "Units:", $item->{units};
	print "\n";

	exit 0 unless confirm("Delete this invoice item?");

	db_open();
	my $sth = $dbh->prepare("delete from invoice_items where id = ?");
	$sth->execute($id);
	$sth->finish();
	$dbh->commit();

	print "Deleted invoice item $id.\n";
}

# Build the invoice document (the same shape the JSON output and the
# PostScript renderer both consume) from the database. The billed quantities,
# taxes, and totals come from the invoice_totals/invoice_tax_lines views, so
# all money math happens in Postgres. Returns a hashref, or undef when there
# is no invoice with that id.
sub invoice_doc
{
	my $id = shift;

	db_open();
	my $sth = $dbh->prepare("select " .
		"c.name, c.address1, c.address2, " .
		"c.city, c.prov_state, c.postal_code, " .
		"c.phone, trim(co.phone_code) as phone_code, " .
		"i.paid, i.canceled, " .
		"lower(i.lang::text) as lang, " .
		"lower(left(i.unit::text, 1)) as unit, " .
		"trim_scale(i.hourly_rate::numeric)::text as hourly_rate, " .
		"lpad(i.id::text, 7, '0') as invoice_id, " .
		"p.id as po, " .
		"i.date_created as date, " .
		"i.payment_grace_period_days::text as payment_grace_period, " .
		"vt.units::text as units, " .
		"vt.billed_units::text as billed_units, " .
		"vt.billed_hours::text as billed_hours, " .
		"vt.subtotal::text as subtotal, " .
		"vt.total::text as total " .
		"from invoices i " .
		"join clients c on c.id = i.client_id " .
		"join purchase_orders p on p.internal_id = i.po_id " .
		"join invoice_totals vt on vt.invoice_id = i.id " .
		"left join countries co on co.country_code = c.country_code " .
		"where i.id = ?");
	$sth->execute($id);
	my $h = $sth->fetchrow_hashref();
	$sth->finish();

	$h or do {
		$dbh->rollback();
		return;
	};

	my $isth = $dbh->prepare("select id, " .
		"work_date as date, " .
		"description, units::text as units " .
		"from invoice_items where invoice_id = ? " .
		"order by work_date, id");
	$isth->execute($id);

	my @items;
	while (my $row = $isth->fetchrow_hashref()) {
		push @items, {
			id          => 0 + $row->{id},
			date        => $row->{date},
			description => $row->{description},
			units       => $row->{units},
		};
	}
	$isth->finish();

	# Tax lines, one row per applicable tax in display order. The rate in
	# effect on the invoice date, the percentage, and the dollar amount are
	# all resolved by the view.
	my $tsth = $dbh->prepare("select code::text as code, " .
		"pct::text as pct, amount::text as amount, registration_id " .
		"from invoice_tax_lines where invoice_id = ? " .
		"order by sort_order");
	$tsth->execute($id);

	my @taxes;
	while (my $row = $tsth->fetchrow_hashref()) {
		push @taxes, {
			code            => $row->{code},
			pct             => $row->{pct},
			amount          => $row->{amount},
			registration_id => $row->{registration_id},
		};
	}
	$tsth->finish();
	$dbh->rollback();

	my $address = join ", ", grep { defined && length }
		$h->{address1}, $h->{address2};

	my $city_prov_postal = join ", ", grep { defined && length }
		$h->{city}, $h->{prov_state}, $h->{postal_code};

	my $phone = "";
	if (defined $h->{phone} && length $h->{phone}) {
		$phone = defined $h->{phone_code} && length $h->{phone_code}
			? "+$h->{phone_code} $h->{phone}"
			: $h->{phone};
	}

	return {
		client => {
			name             => $h->{name},
			address          => $address,
			city_prov_postal => $city_prov_postal,
			phone            => $phone,
		},
		invoice => {
			paid                 => $h->{paid} ? \1 : \0,
			canceled             => $h->{canceled} ? \1 : \0,
			lang                 => $h->{lang},
			unit                 => $h->{unit},
			hourly_rate          => $h->{hourly_rate},
			invoice_id           => $h->{invoice_id},
			po                   => $h->{po},
			date                 => $h->{date},
			payment_grace_period => $h->{payment_grace_period},
		},
		invoice_items => \@items,
		totals => {
			units        => $h->{units},
			billed_units => $h->{billed_units},
			billed_hours => $h->{billed_hours},
			subtotal     => $h->{subtotal},
			total        => $h->{total},
		},
		taxes => \@taxes,
	};
}

sub invoice_json
{
	my $id = shift @ARGV;
	usage_die() unless defined $id && length $id;

	my $doc = invoice_doc($id) or fail("no invoice with id $id");

	# Preferred (not alphabetical) key order for the document.
	my @order = qw(
		client invoice invoice_items totals taxes
		name address city_prov_postal phone
		lang unit hourly_rate invoice_id po
		id date payment_grace_period
		description units
		billed_units billed_hours subtotal total
		code pct amount registration_id
	);
	my %rank;
	$rank{$order[$_]} = $_ for 0 .. $#order;

	my $json = JSON::PP->new->indent->space_after;
	$json->sort_by(sub {
		($rank{$JSON::PP::a} // 999) <=> ($rank{$JSON::PP::b} // 999)
	});

	my $out = $json->encode($doc);

	# JSON::PP indents three spaces per level; convert to tabs.
	$out =~ s/^(\x20+)/"\t" x (length($1) \/ 3)/gem;

	print $out;
}

# PostScript form writer. Every method emits straight to the stored
# filehandle, which the caller has put into raw mode -- the generated
# PostScript is Latin-1 with embedded raw EPS, not UTF-8.
package PS;

sub new
{
	my ($class, $fh) = @_;
	return bless {
		fh => $fh,
		page => 1,
		eps_read_size => 16000,
		needed => {},      # base fonts pulled from the interpreter
		supplied => [],    # resources this document defines, in order
	}, $class;
}

sub emit
{
	my $self = shift;
	print {$self->{fh}} @_;
}

sub begin_init
{
	my ($self, $title) = @_;
	my $eps_size = $self->{eps_read_size};

	$self->emit(<<"END");
%!PS-Adobe-3.0
%%Creator: mnmx-facture
%%Title: $title
%%BoundingBox: 0 0 612 792
%%Pages: (atend)
%%DocumentData: Clean8Bit
%%DocumentNeededResources: (atend)
%%DocumentSuppliedResources: (atend)
%%LanguageLevel: 2
%%EndComments
%%BeginProlog
%%BeginResource: procset SFE
userdict /sfe_ops 10 dict dup begin put
/cm {28.346457 mul} bind def
/in {72 mul} bind def
/encodefont {
	findfont dup
	maxlength dict begin
	{ 1 index /FID ne
	{ def }
	{ pop pop }
	ifelse }
	forall
	/Encoding exch def
	dup /FontName exch def
	currentdict definefont
	end
} bind def
/choosefont {
	exch
	findfont
	exch
	scalefont
	setfont
} bind def
/lshow {
	dup stringwidth pop neg
	0 rmoveto
	show
} bind def
/begin_epsf {
	userdict begin
	/preEPS_state save def
	/dict_count countdictstack def
	/op_count count 1 sub def
	/showpage {} def
	/setpagedevice /pop load def
	0 setgray 0 setlinecap
	1 setlinewidth 0 setlinejoin
	10 setmiterlimit [] 0 setdash newpath
	false setstrokeadjust false setoverprint
} bind def
/end_epsf {
	count op_count sub {pop} repeat
	countdictstack dict_count sub {end} repeat
	preEPS_state restore
	end
} bind def
/eps_string_size $eps_size def
/eps_string eps_string_size string def
/read_eps_data {
	/eps_file exch def
	1 {
		2 copy
		eps_file eps_string readstring
		4 1 roll
		eps_string_size string copy
		put
		not {exit} if
		1 add
	} loop
	1 add 2 copy () put pop
	currentglobal true setglobal exch
	0 1 array put
	setglobal
} bind def
currentdict readonly pop end
%%EndResource
%%EndProlog
%%BeginSetup
<< /MaxFormItem currentsystemparams /MaxFormCache get >> setuserparams
sfe_ops begin
userdict begin
END
	push @{$self->{supplied}}, "procset SFE";
}

# Re-encode a font family into ISOLatin1. The invoice only ever asks for
# Courier and Helvetica, so those are the only families we know. Each base
# variant is a needed resource (pulled from the interpreter); each re-encoded
# variant is a supplied resource, so both are bracketed for DSC tools.
sub init_font
{
	my ($self, $font) = @_;

	my %family = (
		Courier => [qw(
			Courier Courier-Bold Courier-Oblique Courier-BoldOblique
		)],
		Helvetica => [qw(
			Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique
			Helvetica-Narrow Helvetica-Narrow-Bold
			Helvetica-Narrow-Oblique Helvetica-Narrow-BoldOblique
		)],
	);

	my $variants = $family{$font}
		or main::fail("unknown font: $font");

	for my $base (@$variants) {
		my $enc = "$base-ISOLatin1";
		$self->{needed}{$base} = 1;
		push @{$self->{supplied}}, "font $enc";
		$self->emit(
			"%%IncludeResource: font $base\n" .
			"%%BeginResource: font $enc\n" .
			"/$enc ISOLatin1Encoding /$base encodefont pop\n" .
			"%%EndResource\n");
	}
}

sub end_init
{
	my $self = shift;
	$self->emit("%%EndSetup\n");
}

sub begin_page
{
	my $self = shift;
	my $p = $self->{page};
	$self->emit(
		"%%Page: $p $p\n" .
		"%%PageBoundingBox: 0 0 612 792\n" .
		"%%BeginPageSetup\n" .
		"/page_state_$p save def\n" .
		"%%EndPageSetup\n");
}

sub end_page
{
	my $self = shift;
	my $p = $self->{page};
	$self->emit(
		"%%PageTrailer\n" .
		"page_state_$p restore\n" .
		"showpage\n");
	$self->{page}++;
}

sub end
{
	my $self = shift;

	$self->emit(
		"%%Trailer\n" .
		"end\n" .
		"end\n" .
		"%%Pages: " . ($self->{page} - 1) . "\n");

	# Resolve the (atend) resource declarations from what was actually used.
	my @needed = sort keys %{$self->{needed}};
	$self->emit("%%DocumentNeededResources: font " .
		join(" ", @needed) . "\n") if @needed;

	# Supplied resources, grouped by type onto continuation lines.
	my (%names, @types);
	for my $res (@{$self->{supplied}}) {
		my ($type, $name) = split / /, $res, 2;
		push @types, $type unless $names{$type};
		push @{$names{$type}}, $name;
	}
	my @lines = map { "$_ " . join(" ", @{$names{$_}}) } @types;
	if (@lines) {
		$self->emit("%%DocumentSuppliedResources: " . shift(@lines) . "\n");
		$self->emit("%%+ $_\n") for @lines;
	}

	$self->emit("%%EOF\n");
}

sub setfont
{
	my ($self, $font, $size) = @_;
	$self->emit("/$font-ISOLatin1 $size choosefont\n");
}

sub setgray
{
	my ($self, $gray) = @_;
	$self->emit("$gray setgray\n");
}

sub moveto
{
	my ($self, $x, $y) = @_;
	$self->emit("$x $y moveto\n");
}

# Latin-1 encode, then escape the PostScript string delimiters.
sub sanitize
{
	my ($self, $text) = @_;

	my $s = Encode::encode("iso-8859-1", $text // "");
	$s =~ s/\\/\\\\/g;
	$s =~ s/\(/\\(/g;
	$s =~ s/\)/\\)/g;
	return $s;
}

sub show
{
	my ($self, $text) = @_;
	$self->emit("(" . $self->sanitize($text) . ") show\n");
}

sub lshow
{
	my ($self, $text) = @_;
	$self->emit("(" . $self->sanitize($text) . ") lshow\n");
}

sub loadimage
{
	my ($self, $id, $path, $bbox) = @_;

	open my $eps, "<:raw", $path
		or main::fail("cannot open background image $path: $!");
	my $bytes = do { local $/; <$eps> };
	close $eps;

	(my $name = $path) =~ s{.*/}{};

	# read_eps_data streams everything between here and the end marker --
	# the %%BeginDocument/%%EndDocument wrapper plus the EPS itself -- in
	# fixed-size chunks. Size the array from that exact byte count: one slot
	# per chunk, plus slot 0 (the chunk counter) and a trailing empty slot,
	# plus one more to cover the exact-multiple boundary.
	my $chunk = $self->{eps_read_size};
	my $data_len = length("%%BeginDocument: $name\n")
		+ length($bytes)
		+ length("%%EndDocument\n");
	my $arr_size = int(($data_len + $chunk - 1) / $chunk) + 3;

	$self->emit(<<"END");
%%BeginResource: form Form_$id
/Form_$id
10 dict begin
/FormType 1 def
/EPSArray $arr_size array def
/AcquisitionProc {
EPSArray dup 0 get dup 0 get
dup 3 1 roll
1 add 0 exch put
get
} bind def
/PaintProc {
begin
begin_epsf
EPSArray 0 get 0 1 put
//AcquisitionProc 0 () /SubFileDecode filter
cvx exec
end_epsf
end
} bind def
/BBox [$bbox] def
/Matrix [1 0 0 1 0 0] def
currentdict end def
Form_$id /EPSArray get
currentfile 0 (*_End_Of_${id}_EPS_Data_*) /SubFileDecode filter
read_eps_data
%%BeginDocument: $name
END
	$self->emit($bytes);
	$self->emit("%%EndDocument\n");
	$self->emit("*_End_Of_${id}_EPS_Data_*\n");
	$self->emit("%%EndResource\n");

	push @{$self->{supplied}}, "form Form_$id";
}

sub showimage
{
	my ($self, $id, $x, $y) = @_;
	$self->emit(
		"save\n" .
		"$x $y translate\n" .
		"Form_$id execform\n" .
		"restore\n");
}

package main;

# Render an invoice document (the invoice_doc/JSON shape) as PostScript to
# $fh. The billed quantities and dollar amounts are read straight from the
# document's totals and taxes (computed in Postgres); the renderer only
# formats them.
sub invoice_render_ps
{
	my ($doc, $fh, $eps_path) = @_;

	my $inv  = $doc->{invoice};
	my $lang = $inv->{lang};
	$lang eq "fr" || $lang eq "en"
		or fail("invoice language must be 'fr' or 'en'");
	my $unit = $inv->{unit};
	my $rate = $inv->{hourly_rate};
	my $grace = $inv->{payment_grace_period};

	my $t = $doc->{totals}
		or fail("invoice document has no totals");
	my $taxes = $doc->{taxes} // [];

	# The renderer only formats: swap the decimal separator for the language
	# and lay the figures out. All arithmetic happened in the database.
	my $num = sub { localize_decimal($_[0], $lang) };

	my %label = (
		billed_to    => {fr => "Facturé à",         en => "Billed to"},
		invoice      => {fr => "Facture",            en => "Invoice"},
		units        => {fr => "Unités",             en => "Units"},
		billed_units => {fr => "Unités facturées",   en => "Billed units"},
	);
	my %due = (
		subtotal => {fr => "Sous-total", en => "Subtotal"},
		total    => {fr => "Total", en => "Total"},
	);

	# Per-tax display names, keyed by the tax code carried in each tax line.
	my %tax_label = (
		GST => {fr => "T.P.S.", en => "G.S.T."},
		QST => {fr => "T.V.Q.", en => "Q.S.T."},
	);
	my %payment = (
		fr => "Payable par chèque ou dépôt dans les $grace " .
			"jours à:\nMinMaxiste Inc.",
		en => "Payable by check or deposit within $grace " .
			"days to:\nMinMaxiste Inc.",
	);
	my %billing = (
		fr => "Le temps est facturé par incrément de 15 minutes au " .
			"taux horaire de $rate\$ / heure.",
		en => "Time is billed by 15-minute increments at a rate of " .
			"$rate\$ per hour.",
	);

	# Billed-to block lists the client values in order.
	my @client_fields = qw(name address city_prov_postal phone);

	# Invoice block: [label, value, bold?] rows in display order. The invoice
	# number is bold; each tax contributes a registration-number row, its
	# label decorated with a number sign (prefixed in French, suffixed in
	# English).
	my @invoice_rows = (
		[{fr => "Facture",         en => "Invoice"}->{$lang},
			$inv->{invoice_id}, 1],
		[{fr => "Bon de commande", en => "P.O."}->{$lang},
			$inv->{po}, 0],
		[{fr => "Date",            en => "Date"}->{$lang},
			$inv->{date}, 0],
	);
	for my $tax (@$taxes) {
		my $base = $tax_label{$tax->{code}}{$lang};
		push @invoice_rows,
			[$lang eq "fr" ? "#$base" : "$base#",
				$tax->{registration_id}, 0];
	}

	my $ps = PS->new($fh);

	$ps->begin_init($label{invoice}{$lang} . " " . $inv->{invoice_id});
	$ps->init_font("Courier");
	$ps->init_font("Helvetica");
	$ps->loadimage("bg", $eps_path, "0 0 612 792");
	$ps->end_init();

	# Item rows live in the body band between the two middle rules of the
	# background frame: the first baseline sits at $body_top, each line steps
	# down $line_h, and an item must finish at or above $body_floor (clear of
	# the rule over the totals box). Pre-wrap every description and pack the
	# items into pages up front, so a long invoice spills onto continuation
	# pages and the page count is known before anything is emitted (needed for
	# the "Page N of M" strip).
	my $body_top   = 18.9;
	my $body_floor = 6.0;
	my $line_h     = 0.6;

	my @items = @{$doc->{invoice_items} // []};
	for my $item (@items) {
		$item->{lines} =
			[split /\n/, wordwrap($item->{description} // "", 110), -1];
	}

	my @pages;
	{
		my $page = [];
		my $y = $body_top;
		for my $item (@items) {
			my $rows = @{$item->{lines}} || 1;
			my $span = $line_h * ($rows - 1);
			if (@$page && $y - $span < $body_floor) {
				push @pages, $page;
				$page = [];
				$y = $body_top;
			}
			push @$page, $item;
			$y -= $span + $line_h;
		}
		push @pages, $page if @$page;
	}
	# Always at least one page, so a zero-item invoice still gets its totals.
	@pages = ([]) unless @pages;
	my $npages = @pages;

	for my $pno (1 .. $npages) {
		my $page_items = $pages[$pno - 1];

		$ps->begin_page();
		$ps->setgray("0");
		$ps->showimage("bg", "0", "0");

		# Column header, repeated on every page.
		$ps->setfont("Courier-Bold", "11");
		$ps->moveto("1.3 cm", "19.6 cm");
		$ps->show("Description");
		$ps->moveto("20.3 cm", "19.6 cm");
		$ps->lshow($label{units}{$lang});

		if ($pno == 1) {
			# Billed-to block.
			my $y = 23.5;
			$ps->moveto("1.3 cm", "$y cm");
			$ps->setfont("Helvetica-Bold", "11");
			$ps->show($label{billed_to}{$lang} . ":");
			$ps->setfont("Helvetica", "11");
			$y -= 0.6;
			for my $field (@client_fields) {
				$ps->moveto("1.3 cm", "$y cm");
				$ps->show($doc->{client}{$field});
				$y -= 0.6;
			}

			# Invoice block.
			$y = 23.5;
			for my $row (@invoice_rows) {
				my ($row_label, $value, $bold) = @$row;
				next unless defined $value;

				$ps->setfont($bold ? "Helvetica-Bold" : "Helvetica", "11");
				$ps->moveto("11.5 cm", "$y cm");
				$ps->show("$row_label:");
				$ps->moveto("20.3 cm", "$y cm");
				$ps->lshow($value);
				$y -= 0.6;
			}
		} else {
			# Continuation strip: just enough to identify a loose page.
			my %page_of = (
				fr => "Page $pno de $npages",
				en => "Page $pno of $npages",
			);
			$ps->moveto("1.3 cm", "23.5 cm");
			$ps->setfont("Helvetica-Bold", "11");
			$ps->show($label{invoice}{$lang} . " " . $inv->{invoice_id});
			$ps->setfont("Helvetica", "11");
			$ps->moveto("1.3 cm", "22.9 cm");
			$ps->show($inv->{date});
			$ps->moveto("20.3 cm", "23.5 cm");
			$ps->lshow($page_of{$lang});
		}

		$ps->setfont("Helvetica", "9");
		my $y = $body_top;
		for my $item (@$page_items) {
			$ps->moveto("1.3 cm", "$y cm");
			$ps->show($item->{date});
			$ps->moveto("3.5 cm", "$y cm");

			my @lines = @{$item->{lines}};
			for my $i (0 .. $#lines) {
				$ps->moveto("3.5 cm", "$y cm");
				$ps->show($lines[$i]);
				$y -= $line_h if $i < $#lines;
			}

			$ps->moveto("20.3 cm", "$y cm");
			$ps->lshow($item->{units} . $unit);
			$y -= $line_h;
		}

		# Totals, billing note, and payment block: last page only.
		next unless $pno == $npages;

		$y = 5.2;
		$ps->setfont("Helvetica", "11");
		$ps->moveto("13 cm", "$y cm");
		$ps->show($label{units}{$lang});
		$ps->moveto("20.3 cm", "$y cm");
		$ps->lshow($num->($t->{units}) . " $unit");
		$y -= 0.7;

		$ps->setfont("Helvetica", "11");
		$ps->moveto("13 cm", "$y cm");
		$ps->show($label{billed_units}{$lang});
		$ps->moveto("20.3 cm", "$y cm");
		$ps->lshow($unit eq "m"
			? $num->($t->{billed_units}) . " $unit / " .
				$num->($t->{billed_hours}) . " h"
			: $num->($t->{billed_units}) . " h");
		$y -= 0.7;

		$ps->setfont("Helvetica-Bold", "11");
		$ps->moveto("13 cm", "$y cm");
		$ps->show($due{subtotal}{$lang});
		$ps->moveto("20.3 cm", "$y cm");
		$ps->lshow($num->($t->{subtotal}) . " \$");
		$y -= 0.7;

		for my $tax (@$taxes) {
			my $base = $tax_label{$tax->{code}}{$lang};
			$ps->setfont("Helvetica", "11");
			$ps->moveto("13 cm", "$y cm");
			$ps->show("$base ($tax->{pct}%)");
			$ps->moveto("20.3 cm", "$y cm");
			$ps->lshow($num->($tax->{amount}) . " \$");
			$y -= 0.7;
		}

		$ps->setfont("Helvetica-Bold", "11");
		$ps->moveto("13 cm", "$y cm");
		$ps->show($due{total}{$lang});
		$ps->moveto("20.3 cm", "$y cm");
		$ps->lshow($num->($t->{total}) . " \$");

		$y = 5.2;
		$ps->setfont("Helvetica", "8");
		for my $line (split /\n/, wordwrap($billing{$lang}, 90), -1) {
			$ps->moveto("1.3 cm", "$y cm");
			$ps->show($line);
			$y -= 0.5;
		}
		$y -= 0.5;
		for my $line (split /\n/, wordwrap($payment{$lang}, 90), -1) {
			$ps->moveto("1.3 cm", "$y cm");
			$ps->show($line);
			$y -= 0.5;
		}
	}
	continue {
		$ps->end_page();
	}
	$ps->end();
}

sub invoice_ps
{
	my $id = shift @ARGV;

	my $doc;
	if (defined $id && length $id) {
		$doc = invoice_doc($id) or fail("no invoice with id $id");
	} else {
		# No id: render a JSON invoice document read on stdin, so an
		# already-exported document can be rendered as-is.
		local $/;
		my $json = <STDIN>;
		fail("no JSON invoice on stdin")
			unless defined $json && length $json;
		$doc = eval { JSON::PP->new->decode($json) }
			or fail("could not decode JSON input");
	}

	my $eps_path = $opts{b} // $background_eps;

	# The PostScript is Latin-1 with embedded raw EPS, so step off the
	# script's UTF-8 output layer for the duration.
	binmode STDOUT, ":raw";
	invoice_render_ps($doc, \*STDOUT, $eps_path);
}

# Render an invoice to PDF by piping its PostScript through Ghostscript. The
# output path is prompted, defaulting to facture-<id>-<date>.pdf in the current
# directory.
sub invoice_pdf
{
	my $id = shift @ARGV;
	usage_die() unless defined $id && length $id;

	STDOUT->autoflush(1);

	have_command("gs")
		or fail("gs (Ghostscript) not found in PATH");

	my $doc = invoice_doc($id) or fail("no invoice with id $id");

	my $default = "facture-$doc->{invoice}{invoice_id}-$doc->{invoice}{date}.pdf";
	my $out = prompt("Output file", $default);
	$out = $default unless defined $out && length $out;

	if (-e $out) {
		exit 0 unless confirm("Overwrite $out?");
	}

	my $eps_path = $opts{b} // $background_eps;

	# Pipe the PostScript straight into Ghostscript, which writes the PDF.
	# List-form open keeps the filename out of the shell. The stream is
	# Latin-1 with embedded raw EPS, so the pipe is raw.
	open my $gs, "|-", "gs", "-q", "-dBATCH", "-dNOPAUSE", "-dSAFER",
		"-sDEVICE=pdfwrite", "-sOutputFile=$out", "-"
		or fail("cannot run gs: $!");
	binmode $gs, ":raw";
	invoice_render_ps($doc, $gs, $eps_path);
	close $gs
		or fail($! ? "gs: $!" : "gs exited with status " . ($? >> 8));

	print "Wrote $out.\n";
}

sub invoice
{
	my %dispatch = (
		json    => \&invoice_json,
		ps      => \&invoice_ps,
		pdf     => \&invoice_pdf,
		create  => \&invoice_create,
		modify  => \&invoice_modify,
		paid    => \&invoice_paid,
		cancel  => \&invoice_cancel,
		additem => \&invoice_additem,
		moditem => \&invoice_moditem,
		delitem => \&invoice_delitem,
	);

	my $subcommand = shift @ARGV;
	my $handler = $subcommand && $dispatch{$subcommand}
		or usage_die();

	$handler->();
}

sub po_insert
{
	my $po = shift;

	db_open();
	return db_try(sub {
		my $sth = $dbh->prepare("insert into purchase_orders " .
			"(id, client_id, created) values (?, ?, ?) " .
			"returning internal_id");
		$sth->execute(@{$po}{qw(id client_id created)});

		my ($internal_id) = $sth->fetchrow_array();
		$sth->finish();
		$dbh->commit();

		return $internal_id;
	}, "23505", "purchase order '$po->{id}' already exists " .
		"for this client");
}

sub po_create
{
	STDOUT->autoflush(1);

	my %po;
	my $client_name;
	while (1) {
		$po{id} = prompt("PO number", $po{id});
		if (!defined $po{id} || !length $po{id}) {
			print "PO number is required.\n\n";
			next;
		}

		$po{client_id} = prompt("Client ID", $po{client_id});
		if (!defined $po{client_id} || $po{client_id} !~ /\A\d+\z/) {
			print "Client ID must be a number.\n\n";
			next;
		}

		$client_name = lookup_client_name($po{client_id});
		if (!defined $client_name) {
			print "No client with id $po{client_id}.\n\n";
			next;
		}

		$po{created} = prompt("Created (YYYY-MM-DD)",
			$po{created} // today());
		if (!valid_date($po{created})) {
			print "Date must be a valid YYYY-MM-DD date.\n\n";
			next;
		}

		print "\n";
		printf "%-18s%s\n", "PO number:", $po{id};
		printf "%-18s%s\n", "Client:", "$po{client_id} ($client_name)";
		printf "%-18s%s\n", "Created:", $po{created};
		print "\n";

		last if confirm("Create this purchase order?");
		print "\n";
	}

	my $internal_id = po_insert(\%po);
	print "Created purchase order $po{id} (internal id $internal_id).\n";
}

sub print_po
{
	my $row = shift;

	print "\n";
	print "PO number:   $row->{id}\n";
	print "Client:      $row->{client_id} ($row->{client_name})\n";
	print "Created:     $row->{created}\n";
	print "Internal ID: $row->{internal_id}\n";
}

sub po_show
{
	my $id = shift @ARGV;
	usage_die() unless defined $id && length $id;

	db_open();
	my $sth = $dbh->prepare("select p.id, p.client_id, " .
		"c.name as client_name, p.created, p.internal_id " .
		"from purchase_orders p " .
		"join clients c on c.id = p.client_id " .
		"where p.id = ? " .
		"order by p.client_id");
	$sth->execute($id);

	my $count = 0;
	while (my $row = $sth->fetchrow_hashref()) {
		print_po($row);
		$count++;
	}
	$sth->finish();
	$dbh->rollback();

	$count or fail("no purchase order with id $id");
}

sub po
{
	my %dispatch = (
		create => \&po_create,
		show   => \&po_show,
	);

	my $subcommand = shift @ARGV;
	my $handler = $subcommand && $dispatch{$subcommand}
		or usage_die();

	$handler->();
}

sub main
{
	getopts("hdvb:", \%opts) or usage_die();

	if ($opts{h}) {
		usage();
		exit 0;
	}

	my %dispatch = (
		client  => \&client,
		invoice => \&invoice,
		po      => \&po,
	);

	my $command = shift @ARGV;
	my $handler = $command && $dispatch{$command}
		or usage_die();

	$handler->();
}

unless (caller()) {
	main();
	exit 0;
}

1;
