Use internal pager + new command "log"

No pager for "shame" because Curses::UI::TextEditor doesn't do color. If
it doesn't fit on the screen, you have bigger problems anyway.

lib/RevBank/TextEditor.pm

@@ -13,6 +13,17 @@ use Time::HiRes qw(sleep);
 
 my $tab = 4;
 
+sub _require {
+    if (not eval { require Curses::UI }) {
+        my $install = -e "/etc/debian_version"
+            ? "apt install libcurses-ui-perl"
+            : "cpan Curses::UI";
+
+        die "Couldn't load the Perl module Curses::UI.\n" .
+            "Please install it! (sudo $install)\n";
+    }
+}
+
 sub _find_next($win, $textref) {
     my $editor = $win->getobj('editor');
     my $find = $win->getobj('find');
@@ -87,10 +98,12 @@ sub _find($win) {
     $win->delete('find');
 }
 
-sub _editor($title, $origdata) {
+sub _editor($title, $origdata, $readonly = 0) {
     our $cui ||= Curses::UI->new;
     my $win = $cui->add('main', 'Window');
-    $title = "[$title]  Ctrl+X: exit  Ctrl+F: find  Ctrl+C/K/V: copy/cut/paste";
+    $title = $readonly
+        ? "[$title]  Press q to quit"
+        : "[$title]  Ctrl+X: exit  Ctrl+F: find  Ctrl+C/K/V: copy/cut/paste";
 
     my $editor = $win->add(
         'editor', 'TextEditor',
@@ -101,6 +114,8 @@ sub _editor($title, $origdata) {
         -wrapping   => 0,
         -hscrollbar => 0,
         -vscrollbar => 0,
+        -pos        => ($readonly ? length($origdata) : 0),
+        #-readonly => !!$readonly  # does not support -pos
     );
 
     my $return;
@@ -138,7 +153,9 @@ sub _editor($title, $origdata) {
         } ],
     );
 
+    $editor->readonly(1) if $readonly;  # must be before bindings
     $editor->set_binding(reverse @$_) for @keys;
+    $editor->set_binding(sub { $cui->mainloopExit }, "q") if $readonly;
     $editor->focus();
 
     $cui->mainloop;
@@ -149,14 +166,7 @@ sub _editor($title, $origdata) {
 }
 
 sub edit($filename) {
-    if (not eval { require Curses::UI }) {
-        my $install = -e "/etc/debian_version"
-            ? "apt install libcurses-ui-perl"
-            : "cpan Curses::UI";
-
-        die "Couldn't load the Perl module Curses::UI.\n" .
-            "Please install it! (sudo $install)\n";
-    }
+    _require();
 
     open my $fh, ">>", $filename;
     flock $fh, LOCK_EX | LOCK_NB
@@ -172,4 +182,9 @@ sub edit($filename) {
     }
 }
 
+sub pager($title, $data) {
+    _require();
+    _editor($title, $data, 1);
+}
+
 1;

plugins/users

@@ -9,6 +9,8 @@ sub command :Tab(list,ls,shame,USERS) ($self, $cart, $command, @) {
     return $self->list  if $command eq 'ls';
     return $self->shame if $command eq 'shame';
 
+    return "Username", \&log_for if $command eq 'log';
+
     my $user = parse_user($command)
         or return NEXT;
 
@@ -28,19 +30,45 @@ sub hook_checkout($class, $cart, $user, $transaction_id, @) {
 }
 
 sub list($self) {
-    system "sort -f revbank.accounts | grep -v ^# | perl -ne's/( -[\\d.]+)/\\e[31;1m\$1\\e[0m/; print if not /^[-+]/' | more";
+    require RevBank::TextEditor;
+    my $list = join "", sort grep !/^[-+]/, slurp("revbank.accounts");
+    RevBank::TextEditor::pager("RevBank account list", $list);
     return ACCEPT;
 }
 
 sub shame($self) {
-    system "sort -k2 -n revbank.accounts | grep -v ^# | grep -- ' -' | perl -ne's/( -[\\d.]+)/\\e[31;1m\$1\\e[0m/; print if not /^[-+]/' | more";
+    my $list = join "", sort grep / -/ && !/^[-+]/, slurp("revbank.accounts");
+    $list =~ s/( -[\d.]+)/\e[31;1m$1\e[0m/g;
+    print $list;
+    return ACCEPT;
+}
+
+sub _grep($u) {
+    my @lines;
+    open my $fh, "<", ".revbank.log" or die $!;
+    while (defined($_ = readline $fh)) {
+        s/CHECKOUT\s+\S+\s+(\S+)\s+// or next;
+        lc($1) eq lc($u) or next;
+        s/  #// or next;
+        s/_/ /; 
+        push @lines, $_;
+    }
+    return @lines;
+}
+
+sub log_for($self, $cart, $input, @) {
+    my $user = parse_user($input) or return REJECT, "Unknown user";
+    my @lines = _grep($user);
+
+    require RevBank::TextEditor;
+    RevBank::TextEditor::pager("RevBank log for $user", join("", @lines, "(end)"));
     return ACCEPT;
 }
 
 sub _recent($n, $u) {
     $n += 0;
     print "Last $n transactions for $u:\n";
-    system "perl -lane'lc(\$F[3]) eq lc(qq[\Q$u\E]) or next; s/CHECKOUT\\s+\\S+\\s+\\S+\\s+// or next; s/  #// or next; s/_/ /; print' .revbank.log | tail -n$n";
+    print +(_grep($u))[-$n .. -1];
 }
 
 sub balance($self, $u) {