#!/usr/bin/perl -w

=head1 NAME

Debian::xviddetect::UI - xviddetect UI

=head1 SYNOPSIS

  use Debian::xviddetect::UI;
  my $ui = new Debian::xviddetect::UI;

  $ui->ReadTemplate('mypackage.template');

  my @ret = $ui->input('mypackage/firstquestion');
  # or
  my $ret = $ui->input('mypackage/secondquestion');

=head1 DESCRIPTION

This is the user interface object for xviddetect. It is meant to be debconf
like, but without all the features of debconf.  Unfortunately, because of the
way xviddtect works, it is not possible to use DebConf directly (yet).

=cut

package Debian::xviddetect::UI;
use strict "vars";
use Text::Wrap qw(wrap $columns);
use IPC::Open3;

my @fields = qw(key type default choices desc ext);
my $debug = 0;

$| = 1;

=head2

=head1 METHODS

=cut

=head2 ReadTemplate

Reads in a template in debconf format

=cut 

sub ReadTemplate {
  my $this = shift;
  my $fn = shift;
  my $templates = $this->{_TEMPLATES};
  my $field;
  # my ($key, $type, $default, $choices, $desc, $ext) = undef;
  my $key;
  
  open (T, "<$fn") || die "Cannot open $fn: $!";
  while (<T>) {
    if (/^Template:\s+(.*)/i) {
      $key = lc $1;
    } elsif (/^Type:\s+(.*)/i) {
#      debug("Setting type of $key to $1");
      $templates->{$key}->{type} = lc $1;
    } elsif (/^Default:\s+(.*)/i) {
      $templates->{$key}->{default} = $1;
    } elsif (/^Choices:\s+(.*)/i) {
      $templates->{$key}->{choices} = $1;
    } elsif (/^Description:\s+(.*)/i) {
      $templates->{$key}->{desc} = $1;
    } elsif (/^\s(.*)/) {
      $_ = $1;
      $_ = "\n" if (/^\.\s*/);
      $templates->{$key}->{ext} .= "$_";
      $templates->{$key}->{ext} .= " " if ($templates->{$key}->{ext} !~ /\s$/);
    } 
  }
  close T;
}

=head2 subst

Do substitutions on templates

=cut

sub subst {
  my $this = shift;
  my $key = shift;
  my $subkey = shift;
  my $subtext = shift;
 
  my $template = $this->{_TEMPLATES}->{$key};
  if (!$template) {
    if (wantarray) {
      return (-1, "Unknown template $key");
    } else {
      return "Unknown template $key";
    }
  }

  foreach $key (@fields) {
    $template->{$key} =~ s/\${$subkey}/$subtext/g;
  }
}

=head2 set

Set a value for a template

=cut

sub set {
  my $this = shift;
  my $name = shift;
  my $value = shift;

  $this->{_TEMPLATES}->{$name}->{value} = $value;
}

=head2 get

Get the value for a template

=cut

sub get {
  my $this = shift;
  my $name = shift;
  my $value = shift;

  return $this->{_TEMPLATES}->{$name}->{value};
}

=head2 input

Displays a given question on the screen

In an array context, returns a 2-element array whose first element is
the return text, and the second element is the return code

=cut

sub input {
  my $this = shift;
  my $name = shift;
  my @ret = undef;

  my $template = $this->{_TEMPLATES}->{$name};
  if (!$template) {
    if (wantarray) {
      return (-1, "Unknown template $name");
    } else {
      return "Unknown template $name";
    }
  }

  my $type = $template->{type};
  @ret = ("Unknown template type $type", -2);

  if ($type eq "boolean") {
    @ret = $this->BooleanUI($template);
  } elsif ($type eq "note") {
    @ret = $this->NoteUI($template);
  } elsif ($type eq "string") {
    @ret = $this->StringUI($template);
  } elsif ($type eq "multiselect") {
    @ret = $this->SelectUI(1, $template);
  } elsif ($type eq "select") {
    @ret = $this->SelectUI(0, $template);
  }

  if ($ret[0] >= 0) {
    $this->set($name, $ret[1]);
  }

  if (wantarray) {
    return @ret;
  } else {
    return $ret[1];
  }
}

=head2 title

Sets the title string of the display

=cut

sub title {
  my $this = shift;
  my $newtitle = shift;

  $this->{_TITLE} = $newtitle if ($newtitle);
  return $this->{_TITLE};
}

=head2 sizetext

Dialog and whiptail have an annoying field of requiring you specify
their dimentions explicitly. This function handles doing that. Just pass in
the text that will be displayed in the dialog, and it will spit out new text,
formatted nicely, then the height for the dialog, and then the width for the
dialog.

(derived from DebConf)

=cut

sub sizetext {
  my $this=shift;
  my $text=shift;

  # Try to guess how many lines the text will take up in the dialog.
  # This is difficult because long lines are wrapped. So what I'll do
  # is pre-wrap the text and then just look at the number of lines it
  # takes up.
  $columns = $this->{_SCREENWIDTH} - 8;
  $text=wrap('', '', $text);
  my @lines=split(/\n/, $text);

  # Now figure out what's the longest line. Look at the title size too.
  my $window_columns = length($this->{_TITLE}) + 10;
  map { $window_columns = length if length > $window_columns } @lines;

  return $text, $#lines + 7, $window_columns + 5;
}


=head2 NoteUI

Displays some textual info

=cut

sub NoteUI {
  my $this = shift;
  my $template = shift;
  my @args;
  my @text = $this->sizetext($template->{ext} . "\n\n" . $template->{desc});
  
  push (@args, "--msgbox");
  push (@args, @text);
  
  return $this->showdialog(@args);
}

=head2 SelectUI

Displays a selection list

=cut

sub SelectUI {
  my $this = shift;
  my $multiselect = shift;
  my $template = shift;
  my @args;
  my %selected;
  my @choices = split(/\s*,\s*/, $template->{choices});
  my @text = $this->sizetext($template->{ext} . "\n\n" . $template->{desc});
  $text[1] += ($#choices < 5 ? $#choices + 1 : 5) + 3;

  foreach (split(/\s*,\s*/, $template->{default})) {
    $selected{$_} = 1;
  }

  if ($multiselect == 0) { 
    push(@args, "--radiolist", @text);
  } else {
    push(@args, "--checklist", @text);
  }

  push(@args, ($#choices < 5 ? $#choices + 1 : 5));

  foreach (@choices) {
    push(@args, $_, "", (defined($selected{$_}) ? "on" : "off"));
  }

  my @ret = $this->showdialog(@args);

  return @ret;
}

=head2 StringUI

Prompts for a line of text

=cut

sub StringUI {
  my $this = shift;
  my $template = shift;
  my @args;
  my @text = $this->sizetext($template->{ext} . "\n\n" . $template->{desc});

  push(@args, "--inputbox", @text);
  push(@args, $template->{default});

  return $this->showdialog(@args);
}

=head2 BooleanUI

Prompts for a boolean answer

=cut

sub BooleanUI {
  my $this = shift;
  my $template = shift;
  my @args;
  my @text = $this->sizetext($template->{ext});
  
  if ($template->{default} =~ /(false|no)/i) {
    push(@args, "--defaultno");
  }
  push(@args, "--yesno", @text);
  
  my @ret = $this->showdialog(@args);
  $ret[1] = ($ret[0] == 0 ? "true" : "false");
  $ret[0] = 0;
  return @ret;
}

=head2 showdialog 

Displays a dialog. All parameters are passed to whiptail/dialog.

Note that the return code of dialog is examined, and if the user hit escape
or cancel, this frontend will assume they wanted to back up.

(derived from DebConf)

=cut

sub showdialog {
  my $this=shift;
  
  #debug("preparing to run dialog. Params are:".join(",", @_));
  
  # Save stdout, stdin, the open3 below messes with them.
  use vars qw{*SAVEOUT *SAVEIN};
  open(SAVEOUT, ">&STDOUT") || die $!;
  open(SAVEIN, "<&STDIN") || die $!;
  
  # If warnings are enabled by $^W, they are actually printed to
  # stdout by IPC::Open3 and get stored in $stdout below! (I have no idea
  # why.) So they must be disabled.
  my $savew=$^W;
  $^W=0;
  
  my $pid = open3('<&STDIN', '>&STDOUT', \*ERRFH, "/usr/bin/whiptail",
            '--backtitle', 'Debian Configuration',
            '--title', $this->{_TITLE}, @_);
  my $stderr;
  while (<ERRFH>) {
    $stderr.=$_;
  }
  chomp $stderr;
  $stderr =~ s/"//g;
  
  # Have to put the wait here to make sure $? is set properly.
  wait;
  $^W=$savew;
  use strict "vars";
  
  # Restore stdout, stdin.
  open(STDOUT, ">&SAVEOUT") || die $!;
  open(STDIN, "<&SAVEIN") || die $!;
  
  # Now check dialog's return code to see if escape (-1) or
  # Cancel (1) were hit. If so, make a note that we should back up.
  #
  # To complicate things, a return code of 1 also means that yes was
  # selected from a yes/no dialog, so we must parse the parameters
  # to see if such a dialog was displayed.
  my $ret=$? >> 8;
  if ($ret == -1 || ($ret == 1 && join(' ', @_) !~ m/--yesno\s/)) {
    $ret = -30;
  }
  return $ret, $stderr;
}

=head2 resize

This method is called whenever the tty is resized, and probes to determine the
new screen size.

(Derived from debconf)

=cut

sub resize {
  my $this=shift;

  if (exists $ENV{'LINES'}) {
    $this->{_SCREENHEIGHT} = $ENV{'LINES'};
  } else {
    # Gotta be a better way..
    my ($rows)=`stty -a </dev/tty` =~ m/rows (\d+)/s;
    $this->{_SCREENHEIGHT} = $rows || 25;
  }

  if (exists $ENV{'COLUMNS'}) {
    $this->{_SCREENWIDTH} = $ENV{'COLUMNS'};
  } else {
    my ($cols)=`stty -a </dev/tty` =~ m/columns (\d+)/s;
    $this->{_SCREENWIDTH} = $cols || 80;
  }
}


# Constructor
sub new {
  my $this = shift;
  my $class = ref($this) || $this;
  my $self = {};
  $self->{_TITLE} = undef;
  $self->{_TEMPLATES} = {};
  $self->{_BACKUP} = undef;
  $self->{_SCREENWIDTH} = undef;
  $self->{_SCREENHEIGHT} = undef;
  
  bless $self, $class;
  
  $self->resize;

  return $self;
}

sub debug {
  my $msg = shift;

  if ($debug) {
    print STDERR "$msg\n";
    <STDIN>;
  }
}

=head1 AUTHOR

Randolph Chung <tausq@debian.org>

=cut

1