meter-reading/ui.pl

#!/usr/bin/perl

# Based on
# /usr/share/doc/libterm-readline-gnu-perl/examples/fileman.gz

use DBI;
use English qw(-no_match_vars);
use List::Util qw( reduce );
use Term::ExtendedColor qw(:all);
use Term::ReadLine;
use Time::Piece;
use Try::Tiny;
use common::sense;

# Seems to be necessary for utf8 to print correctly when running under tmux.
# Thanks to 'fuzzix' on #perl.
#
binmode STDOUT, ':encoding(UTF-8)';
#-------------------------------------------------------------------------------

# Globals.

my $dbh = DBI->connect(
   "dbi:Pg:dbname=meter_reading", '', '',
   { AutoCommit => 1, RaiseError => 1, PrintError => 0 },
);

my $command_by_name = {
   g => {
      func => \&com_give,
      doc => "Give: record when you gave a meter reading to the supplier.",
      long => <<EOF
Usage: g {E|G|W} TAKEN_DATE [GIVEN_DATE]
You can omit GIVEN_DATE if it's 'today', or use CTRL-t to type today's date.
EOF
   },
   h => {
      func => \&com_help,
      doc => "Help.  Type 'h x' for help on command x.",
   },
   q => {
      func => \&com_quit,
      doc => "Quit.",
   },
   r => {
      func => \&com_report,
      doc => "Report recent readings.",
      long => <<EOF
Usage: r [E|G|W] [ROWS]
Report ROWS recent readings, for the given fluid or for all.
EOF
         },
   t => {
      func => \&com_take,
      doc => "Take: record a reading you took from a meter.",
      long => <<EOF
Usage: t {E|G|W} READING [TAKEN_DATE]
You can omit TAKEN_DATE if it's 'today', or use CTRL-t to type today's date.
EOF
   },
};

my $term = Term::ReadLine->new('Meter Reading');
# Use this ref as a sentinel value.
my $quit = [];
#-------------------------------------------------------------------------------

# Functions for the line reader.

sub stripwhite {
    my $string = shift;
    $string =~ s/^\s*//;
    $string =~ s/\s*$//;
    return $string;
}

sub print_err {
   my ($str) = @_;
   warn sprintf("%s\n", fg("red3", $str));
   return;
}

sub execute_line {
   my ($line) = @_;
   my ($verb, @nouns) = split(' ', $line);
   my $cmd = $command_by_name->{$verb};
   if (! defined $cmd) {
      print_err("'$verb': no such command.");
      return;
   } else {
      return $cmd->{func}->(@nouns);
   }
}
#-------------------------------------------------------------------------------

# Command functions and helpers.

# The $id parameter is for use by com_take() and com_give().  They use
# it to report on the row that's just been taken or given.
sub com_report {
   my ($fluid, $rowcount, $id) = @_;
   # Normalize to (fluid, rowcount).
   if ((defined $rowcount) && $rowcount =~ m/(e|g|w)/i) {
      ($fluid, $rowcount) = ($rowcount, $fluid);
   } elsif ((defined $fluid) && $fluid =~ m/[0-9]/) {
      $rowcount = $fluid;
      $fluid = undef;
   }
   $fluid = ($fluid ? (uc $fluid) : undef);
   $rowcount = ($rowcount ? $rowcount : 5);

   my $sql = <<EOF;
SELECT id, fluid, when_taken, reading, dc_size, dc_unit, when_given
FROM mr_consumption
WHERE id = COALESCE(?, id) AND fluid = COALESCE(?, fluid)
ORDER BY when_taken DESC, when_entered DESC
LIMIT ?
EOF
   my $rows = $dbh->selectall_arrayref($sql, {}, $id, $fluid, $rowcount);
   printf(
      "%5s  %s  %10s  %10s  %9s  %10s\n",
      map { underline(fg('darkred1', bg('grey93', $_))); } (
         "   Id",  "F", "Taken     ", "   Reading", "  Per day", "Given     ",
      ),
   );
   for (my $i = 0; $i < (scalar @$rows); $i++) {
      my ($id, $f, $t, $r, $s, $u, $g) = @{$rows->[$i]};
      my $rowstr = sprintf(
         "%5d  %s  %s  %10.3f  %5.3f %-3s  %10s",
         $id,  $f, $t,     $r,    $s,  $u, $g // "",
      );
      printf("%s\n", $i % 2 ? $rowstr : bg("mistyrose1", $rowstr));
   }
   return;
}

sub com_give {
   my ($fluid, $when_taken, $when_given) = @_;
   $when_given = localtime->ymd if (!  $when_given);
   my $sql = <<EOF;
SELECT give_reading(i_fluid => ?, i_when_taken => ?, i_when_given => ?)
EOF
   my ($id) = $dbh->selectrow_array(
      $sql, {}, (uc $fluid), $when_taken, $when_given
   );
   printf("Reading %d updated as given on %s.\n", $id, $when_given);
   com_report($fluid, 1, $id);
   return;
}

sub com_take {
   my ($fluid, $reading, $when_taken) = @_;
   $when_taken = localtime->ymd if (! defined $when_taken);
   my $sql = <<EOF;
SELECT take_reading(i_fluid => ?, i_reading => ?, i_when_taken => ?)
EOF
   my ($id) = $dbh->selectrow_array($sql, {}, (uc $fluid), $reading, $when_taken);
   printf("Reading saved in row %d.\n", $id);
   com_report($fluid, 1, $id);
   return;
}

sub com_quit {
   my $sure = $term->readline(clear() . italic("Confirm quit? [Y/n]") . " ");
   if ($sure =~ m/^y?$/i) {
      printf("%s\n", italic("Bye."));
      return $quit;
   }
   return;
}

sub com_help {
   my ($cmd) = @_;
   my $help_text = do {
      if (my $cmdref = $command_by_name->{$cmd}) {
         "$cmd: $cmdref->{doc}" . "\n" . $cmdref->{long};
      } else {
         reduce {
            $a . "$b: " . $command_by_name->{$b}->{doc} . "\n";
         } "", (sort keys %$command_by_name);
      }
   };
   printf("%s", fg('blue15', $help_text));
   return;
}
#-------------------------------------------------------------------------------

# Main.

$term->MinLine(0);  # disable implict call of add_history()
$term->add_defun(
   'foo', # dunno what this name is for.
   sub { $term->insert_text(localtime->ymd); },
   ord "\ct",
);
printf("%s\n", italic("For help, type 'h' and press return."));

RUNCMD: while (1) {
   my $line = $term->readline(
      fg('yellow1', bg('green28', "mr>")) . " ",
   );
   my $s = stripwhite($line);
   next RUNCMD if (! length($s));

   $term->AddHistory($s) if ($term->can('AddHistory'));
   my $result = try {
      execute_line($s);
   } catch {
      # Postgres errors take several lines so print only the first.
      my @warning_lines = split(/\n/, $_);
      print_err($warning_lines[0]);
   };
   last RUNCMD if ($quit == $result);
}

exit(0);