view release on metacpan or  search on metacpan

lib/Ante/Deluvian/Dialog.pm  view on Meta::CPAN

package Ante::Deluvian::Dialog;

use strict;
use warnings;
use Term::ReadKey;
use Text::Wrap qw($columns wrap);
use IO::File;

our $VERSION = 0.02;
sub FALSE { return 0; }
sub TRUE  { return 1; }
my $_isWin = FALSE;
my $_doRec = FALSE;
my $_rplay = FALSE;
my $_fhInp = undef;
my $_fhRec = undef;

#------------------------------------------------------------------
sub new {
#------------------------------------------------------------------ 
  my $class = shift;
  my %param = @_; 
	my $self = {};
  my ($iCols, $iRows);
  
  $self = bless {}, $class;
  $self->{'rows'} = 25;
  $self->{'cols'} = 80;
  $self->{'stat'} = 0;
  $self->{'from'} = 1;
  $self->{'eoln'} = "";
  $self->{'curpid'}   = $$,
  $self->{'getdrv'}   = \&_procDfCmd,
  $self->{'usable'}   = 25;
  $self->{'hcenter'}  = 12;
  $self->{'vcenter'}  = 40;
  $self->{'recary'}   = [];
  $self->{'parind'}   = $param{parindent} || 2;
  $self->{'title'}    = $param{title}     || undef;
  $self->{'header'}   = $param{header}    || " ";
  $self->{'prompt'}   = $param{prompt}    || ":";
  $self->{'platform'} = $param{platform}  || "UNIX";
  $_isWin = $param{platform} eq "MSWIN";
  $_doRec = $param{record}   || FALSE;
  $_fhInp = $param{inpfile}  || undef;
  if ((exists($param{replay})) && (-s $param{replay})) {
    my $fi = IO::File->new("< $param{replay}");
    @{$self->{'recary'}} = <$fi>;
    $fi->close();
    $_rplay = TRUE;
  }
  $self->_getWinSize();
  $self->{'usable'} = $self->{'rows'};
  if (defined($self->{'header'})) {
    $self->{'usable'}--;
    $self->{'stat'}++;
    $self->{'from'}++;
  }
  if (defined($self->{'prompt'})) {
    $self->{'usable'}--;
  }
  $self->{'hcenter'} = int ($self->{'cols'} / 2);
  $self->{'vcenter'} = int (($self->{'usable'} - $self->{'from'}) / 2);
  $self->{'lines'} = $self->_drawframe();
  $self->{'usable'} -= 2;
  return $self;
}

#------------------------------------------------------------------
sub DESTROY {
#------------------------------------------------------------------
  my $self = shift;
  
  if ($_doRec) {
    $self->_createRecFile();
    print $_fhRec "@{$self->{'recary'}}\n";
  }
}

#------------------------------------------------------------------
sub _getWinSize {
#------------------------------------------------------------------
  my $self = shift;
  my ($maxCol, $maxRow);
  
  if ($_isWin) {
    require Win32::Console;
    my $cns = new Win32::Console();
    my @info =$cns->Info();
    ($maxCol, $maxRow) = $cns->MaxWindow();
    $self->{'gdrv'} = \&_procNetUse;
    $self->{'eoln'} = "\n";
  }
  else {
    ($maxCol, $maxRow) = GetTerminalSize();
  }
  $self->{'cols'} = $maxCol;
  $self->{'rows'} = $maxRow;
}

#------------------------------------------------------------------
sub _createRecFile {
#------------------------------------------------------------------
  my $self  = shift;
  my $tmpth = $_isWin ? "C:/temp/addialog" : "/tmp/addialog";
  my $tmpf  = sprintf("%s/%s_%d", $tmpth, $_isWin ? $ENV{USERNAME} : $ENV{USER}, $self->{'curpid'});
  
  if (! -d $tmpth) {
    mkdir($tmpth);
  }
  $_fhRec = IO::File->new("> $tmpf");
  print "File $tmpf created to record user input ...\n";
}

#------------------------------------------------------------------
sub _drawframe {
#------------------------------------------------------------------
  my $self = shift;
  my $rows = $self->{'rows'} - 1;
  my $cols = $self->{'cols'} - 2;
  my ($line, @lines, $inp);
  
  if (defined($self->{'prompt'})) {
    $rows--;
  }
  for my $i (0 .. $rows) {
    if (($i == 0) || ($i == $rows)) {
      push @lines, "+" . "-" x $cols . "+";
    }
    else {
      push @lines, "|" . " " x $cols . "|";
    }
  }
  if (defined($self->{'title'})) {
    _formatline(\$lines[0], $self->{'title'}, "C");
  }
  if (defined($self->{'prompt'})) {
    push @lines, "$self->{'prompt'} ";
  }
  return [ @lines ];
}

#------------------------------------------------------------------
sub _doselection {
#
# This function is likely to be called recursively ...
#------------------------------------------------------------------
  my $self  = shift;
  my %param = @_;
  
  my $rpag = $param{pagary};
  my $rsel = $param{selary};

lib/Ante/Deluvian/Dialog.pm  view on Meta::CPAN

      $windrv{"$drv:"} = 0;
    }
    $cmd = "net use";
    $pattern = "\\A\\w+\\s+([A-Z]:)\\s+(\\\\\\\\\\S+)";
  }
  else {
    $cmd = "df | awk '{ print \$NF }'";
    $pattern = "%\\s+(\/\\S*)\\z";
  }
  open(SYST, "$cmd |");
  while ($line = <SYST>) {
    if ($line =~ /$pattern/) {
      push @drives, "$1/";
      push @drvlst, "$1/  $2";
      if (exists($windrv{$1})) {
        delete($windrv{$1});
      }
    }
  }
  close(SYST);
  if ($_isWin) {
    foreach $drv (keys %windrv) {
      if (-d "$drv/") {
        push @drives, "$drv/";
        push @drvlst, "$drv/  Local directory";
      }
    }
  }
  @drvlst = sort(@drvlst);
  $drv = $self->listbox(\@drvlst, select => "atonce", prompt => "Please select a drive or partition:");
  if ($_isWin && ($drv =~ /\A([A-Z]:\/)\s+/)) {
    $drv = $1;
  }
  elsif ($drv =~ /\A(\/\S*)/) {
    $drv = $1;
  }
  else {
    $drv = undef;
  }
  # print "Selected drive: $drv ...\n";
  return($drv);
}

#------------------------------------------------------------------
sub printscreen {
#------------------------------------------------------------------
  my $self   = shift;
  my $rlines = shift;
  my (@lines, $prompt);
  
  if (defined($rlines)) {
    @lines = @$rlines;
  }
  else {
    @lines = @{$self->{'lines'}};
  }
  if (defined($self->{'prompt'})) {
    $prompt = pop(@lines);
  }
  foreach my $line (@lines) {
    print "$line" . $self->{'eoln'};
  }
  if (defined($prompt)) {
    print "$prompt ";
  }
}

#------------------------------------------------------------------
sub _getinput {
#------------------------------------------------------------------
  my $self   = shift;
  my $rLines = shift;
  
  $self->printscreen($rLines);
  if ($_rplay && ($#{$self->{'recary'}} >= 0)) {
    $self->{'input'} = shift(@{$self->{'recary'}});
    print "$self->{'input'}";
  }
  else {
    $self->{'input'} = <STDIN>;
  }
  chomp($self->{'input'});
  if ($_doRec) {
    # print $self->{'recfile'} "$self->{'input'}";
    push @{$self->{'recary'}}, $self->{'input'};
  }
}

#------------------------------------------------------------------
sub _clearselection {
#------------------------------------------------------------------
  my $self = shift;
}

#------------------------------------------------------------------
sub _formatline {
#------------------------------------------------------------------
  # my $self = shift;
  my $line = shift;
  my $text = shift;
  my $frmt = shift;
  my ($llng, $ltxt, $beg);
  
  $llng = length($$line);
  $ltxt = length($text);
  if ($llng > $ltxt) {
    if ($frmt eq "C") {
      $beg = int(($llng - $ltxt) / 2);
    }
    elsif ($frmt eq "R") {
      $beg = $llng - $ltxt - 1;
    }
    elsif ($frmt eq "L") {
      $beg = 1;
    }
    elsif ($frmt =~ /\A(\d+)/) {
      $beg = $1;
    }
  }
  else {
    $text = substr($text, 0, $llng - 5) . "...";