#!/usr/bin/perl

# debian package browser
#
# simple ncurses wrapper around `grep-dctrl` and `apt-cache show`
# for viewing details of one or more packages.
#
# (C) Copyright Craig Sanders <cas@taz.net.au>, 2016
#
# This program is licensed under the terms of the GNU General Public
# License (GPL) Version 2 ((or later, at your option).

use strict;
use File::Basename;

my $program = basename($0);
my $pversion = '0.1';

use Curses::UI;
use Term::ReadKey qw(GetTerminalSize);
#use Getopt::Long;

use Data::Dump qw(pp dd);

my $debug = 0;

use diagnostics;
#use Carp;

# pre-declare subroutines (see below for implementation)
#use subs qw( clear_sel fork_shell run_search show_pkgs tag untag help quit );

# external binary locations
#my $dlocate  = '/usr/bin/dlocate';   # use system dlocate
my $dlocate  = './dlocate';           # use dev version
my $aptcache = '/usr/bin/apt-cache';
my $dctrl    = '/usr/bin/grep-dctrl';
my $dctrl_f  = '/var/lib/dpkg/status /var/lib/dpkg/available';
my $less     = '/usr/bin/less +Gg';
my $debtags  = '/usr/bin/debtags';   # TODO: maybe add debtags support to generate pkg list?
my $supercat = '/usr/bin/spc';

my $scat='';
foreach my $dir (qw(/etc/supercat /usr/share/dlocate ~/.spcrc . )) {
  $scat="$supercat -c $dir/spcrc-package | $less -R" if (-e "$dir/spcrc-package") ;
};

my $pager = $ENV{'DLOCATE_PAGER'} || "$scat" || "$less";

# option processing
# this is good enough for testing with.  Use Getopt::Long later.
# TODO: options for:
#   - fixed pkg names
#   - pass-through of grep-dctrl options
#   - grep-dctrl of /var/lib/apt/lists/*_Packages
#   - dlocate -l search
#   - debtags search
#   - anything else that can generate a list of pkg names (eliminate need for `xargs | dlocate-browse`)
#
# read all of the above from stdin in their native output formats
#
# TODO:  signal handling, SIGTSTP and SIGCONT

my $dctrl_args = '-e';

# -f == fixed package names
if ($ARGV[0] eq '-f') {
  shift ;
  $dctrl_args = '-P -e';
};

my @search = @ARGV;
my $search = join('|',sort(@search));

$search = '^(' . $search . ')$' if ($dctrl_args =~ /-P/o);

my (@values, %labels, @help);

run_search(@search);


# Create the root Curses::UI object.
my $cui = new Curses::UI(-clear_on_exit => 0,
                         -mouse_support => 0,
                         -color_support => 1,
#                         -bg => "blue",
#                         -fg => "white",
                         -debug => $debug,
                        );

# create window objects
my ($w,$w0);

my %args = (-border        => 0,
            -titlereverse  => 1,
            -padtop        => 0,
            -padbottom     => 2,
            -ipad          => 0,
#            -bg => "blue",
#            -fg => "white",
           );

$w = $cui->add('w', 'Window',
               -title => "Debian Package Browser",
               %args
              );

$w0 = $cui->add('w0', 'Window',
                -border        => 0,
                -y             => -1,
                -height        => 2,
#                -bg => "blue",
#                -fg => "white",
               );

$w0->add('explain', 'Label',
#         -text => "v=view           c=clear selection     t=tag     u=untag                       \n" .
         -text => "v=view           c=clear selection                                             \n" .
                  "/,?=search                                              s=fork shell     q=quit"
        );


sub listbox_callback() {
    # add/remove current item to/from @sel when space/enter is pressed
    my $listbox = shift;
    my $label = $listbox->parent->getobj('pkgboxlabel');

    my @sel = $listbox->get;
    @sel = ('<none>') unless @sel;

    my $sel = join (", ", @sel);
    $sel =~ s/::::[^ ]*( |$)/$1/og;

    # TODO: wrap $sel, based on tty width.

    $label->text("Selected: $sel");
}

$w->add('pkgbox', 'Listbox',
        -y          => 0,
        -padbottom  => 2,
        -values     => \@values,
        -labels     => \%labels,
        -border     => 1,
        -title      => 'Package List',
        -vscrollbar => 0,
        -multi      => 1,
        -wraparound => 1,
        -onchange   => \&listbox_callback,
);

$w->add('pkgboxlabel', 'Label',
        -y => -1,
        -bold => 1,
        -text => "Select package(s) to view",
        -textwrap => 1,
        -width => -1,
        -height => 2,
);


# ----------------------------------------------------------------------
# Setup bindings and focus
# ----------------------------------------------------------------------

sub bindkey {
  # (keys), subroutine, help-message
  my $msg = pop;
  my $sub = pop;
  push @help, $msg if ($msg ne '');

  foreach (@_) {
    $cui->set_binding( $sub, $_);
  };
};

bindkey( qw( v V ),         \&show_pkgs,     "v  - View selected packages" );
bindkey( qw( c C ),         \&clear_sel,     "c  - Clear current selection" );
#bindkey( qw( t T ),         \&tag,           "t  - tag   - search & select" );
#bindkey( qw( u U ),         \&untag,         "u  - untag - search & unselect" );
bindkey( qw( s S ),         \&fork_shell,    "\ns  - Fork a shell, without losing selections" );
bindkey( qw( q Q ),         \&quit,          "q  - Quit" );
bindkey( qw( h H ),         \&help,          "h  - This help" );
#bindkey( qw( "\cL" "\cR" ), sub{ $cui->draw; $w->draw}, "\n^L - Redraw" );
bindkey( qw( "\cZ" ), sub{ \&STOP}, '');


# ----------------------------------------------------------------------
# Get things rolling...
# ----------------------------------------------------------------------

$w->focus;
# start the event loop
$cui->mainloop;


###
###
### subroutines
###
###

sub maxlen {
  # return the maximum string length of elements in an array
  my $width = 0;
  foreach (@_) {
    $width = length($_) if (length($_) > $width);
  };
  return($width);
};

sub run_search {
  @values = ();  # global
  %labels = ();  # global

  local $/='';

  my $pwidth=0;
  my $vwidth=0;
  my $dwidth=0;

  my %p = ();
  my %d = ();
  my %v = ();

  my $cmd="$dctrl -s Package,Version,Description $dctrl_args '$search' $dctrl_f";

  open(DCTRL,'-|',$cmd);
  while (<DCTRL>) {
   my ($pkg,$version,$desc) = ('','');

   foreach (split /\n/) {
     next unless (m/^(Package|Version|Description)/io);
     chomp;
     my ($key,$val) = split /\s*:\s*/,$_,2;
     $pkg     = $val if ($key eq 'Package');
     $version = $val if ($key eq 'Version');
     $desc    = $val if ($key =~ m/^Description/io);
    };
    my $key = "${pkg}::::${version}";

    $p{$key} = $pkg;
    $d{$key} = $desc;
    $v{$key} = $version;

    #$pwidth = length($pkg) if (length($pkg) > $pwidth);
    #$vwidth = length($version) if (length($version) > $vwidth);
  };
  close(DCTRL);

  $pwidth = maxlen(keys %p);
  $vwidth = maxlen(keys %v);

  my ($cols,$rows) = GetTerminalSize;
  my $c2  = int(($cols - 8) / 2); # half of the usable space
  my $pmax = int($c2 * 2/3);   # maximum of 1/3 of term. width for pkg name
  my $vmax = int($c2 * 1/3);   # maximum of 1/6 of term. width for pkg version

  $pwidth = $pmax if ($pwidth gt $pmax);
  $vwidth = $vmax if ($vwidth gt $vmax);

  $dwidth = $cols - $pwidth - $vwidth - 8; # remainder of term. width for desc

  %labels = map { $_ => sprintf( "%-${pwidth}s %${vwidth}s %-${dwidth}s",
                          substr($p{$_},0,($pwidth-1)),
                          substr($v{$_},0,($vwidth-1)),
                          substr($d{$_},0,($dwidth-1))
                        )
                } keys %p;

  @values = sort keys %labels;

#  if ($debug) {
    print STDERR "cmd='$cmd'\n";
    print STDERR "c=$cols r=$rows c2=$c2\n";
    print STDERR "pw=$pwidth vw=$vwidth dw=$dwidth\n";
    print STDERR "pm=$pmax vm=$vmax\n";
#    print STDERR pp(\@values), "\n";
#    print STDERR pp(\%labels), "\n";
    #exit;
#  };

};

sub tag {
  # TODO: dialog box to search and select packages
  #       e.g. like mutt, but much more primitive.
};

sub untag {
  # TODO: dialog box to search and unselect packages
};

sub clear_sel {
  my $listbox = $w->getobj('pkgbox');
  $listbox->clear_selection();
  $listbox->draw;
};

sub show_pkgs {
  my $listbox = $w->getobj('pkgbox');

  my $sel = '';
  my @sel = $listbox->get;

  if (@sel) {
    # show the current selections, if any
    $sel = join(' ',@sel);
  } else {
    # else show the package under the cursor
    $sel = $listbox->get_active_value;
  };
  $sel =~ s/::::[^ ]*( |$)/$1/og;

  return unless $sel;

  $cui->leave_curses();
  system("(echo ; $aptcache show $sel) | $pager");
  $cui->reset_curses();

  $cui->draw;
  $w->draw;
};

sub fork_shell {
  my $listbox = $w->getobj('pkgbox');

  my $shell = $ENV{'SHELL'} || '/bin/bash';

  $cui->leave_curses();
  print "Forking shell.  Type 'exit' to return to $program\n\n";

  # print the selections, if any for convenient copy-pasting.
  my @sel = $listbox->get;
  if (@sel) {
    my $sel = join(' ',@sel);
    $sel =~ s/::::[^ ]*( |$)/$1/og;
    print "Packages selected: $sel\n";
  };

  print STDERR "exec shell\n" if $debug;

  system($shell);

  $cui->reset_curses();
  $cui->draw;
  $w->draw;
};

sub quit {
  my $listbox = $w->getobj('pkgbox');

  $cui->leave_curses();

  # print the selections, if any for convenient copy-pasting or
  # for populating a bash array with pkgs=`( $(dlocate-browser ... ) )`
  my @sel = $listbox->get;
  if (@sel) {
    my $sel = join(' ',@sel);
    $sel =~ s/::::[^ ]*( |$)/$1/og;
    print "$sel\n";
  } ;

  exit ;
};

sub help {
  $cui->dialog(
# TODO: height and width options aren't used by cui->dialog.
# create a new window instead.
#               -height    => (@help + 5),
#               -width     => (maxlen(@help) + 10),

               -title     => "$program $pversion help",
               -message   => join("\n",@help,"\n\nIf any packages are selected, they will be printed\nto STDOUT on quitting or forking.\n"),
              );
};

sub TSTP {
  $cui->leave_curses();
  kill 'STOP', $$;
};

sub CONT {
  $cui->reset_curses();
  $cui->draw;
  $w->draw;
}

$SIG{TSTP} = &TSTP;
$SIG{CONT} = &CONT;

# Local variables:
# mode: shell-script
# End:
# ex: ts=2 sts=2 sw=2 et filetype=perl
