diff --git a/lib/RevBank/TextEditor.pm b/lib/RevBank/TextEditor.pm index 81a671d..de9cd8f 100644 --- a/lib/RevBank/TextEditor.pm +++ b/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; diff --git a/plugins/users b/plugins/users index 27650f7..5249a45 100644 --- a/plugins/users +++ b/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) {