view release on metacpan or  search on metacpan

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

    $stln = sprintf("%-*s", $self->{'cols'} - 2, $start);
    _formatline(\$lines[$self->{'stat'}], $stln, "L");
    $inp = $self->listbox(\@flist, lines => \@lines, select => $hmodes{$fmode}[0]);
    if (defined($inp)) {
      print "FSEL: $inp\n";
      if ($inp =~ /\A\.\.[\\\/]*/) {
        @files = split(/[\\\/]+/, $start);
        $start = $files[0];
        pop(@files); shift(@files);
        $start = join "/", $start, @files, "";
      }
      elsif (-d "$start/$inp") {
        $start .= $inp;
      }
      elsif (-f "$start/$inp") {
        return("$start$inp");
      }
      elsif ($inp eq "OK") {
          return($start);
      }
      print "Neues Verzeichnis: $start ...\n";
    }
    else {
      return(undef);
    }
  }
}

#------------------------------------------------------------------
sub fselect {
#------------------------------------------------------------------
  my $self   = shift;
  my $start  = shift;
  my $rLines = shift;
  my $fmode  = shift || "FILE";
  
  $self->_select($start, $fmode, $rLines);
}

#------------------------------------------------------------------
sub dselect {
#------------------------------------------------------------------
  my $self   = shift;
  my $start  = shift;
  my $rLines = shift;
  my $fmode  = "DIR";
  
  my $dir = $self->_select($start, $fmode, $rLines);
  return($dir);
}

#------------------------------------------------------------------
sub textbox {
#------------------------------------------------------------------
  my $self   = shift;
  my $itxt   = shift;
  my %param  = @_;
  my $text   = undef;
  my $doFmt  = $param{keepformat} || TRUE;
  my @stNames = qw(
      dev ino mode nlink uid gid rdev size
      atime mtime ctime blksize blocks
  );
  my (@lines, $fmtxt, $pref,
      @txtlns, @filstat,
  );
  
  if (!defined($itxt)) {
    return;
  }
  $pref = ref($itxt);
  if ($pref eq "ARRAY") {
    @txtlns = @$itxt; 
  }
  elsif ($pref eq "SCALAR") {
    $text = $$itxt;
    # @txtlns = split(/\n/, $$itxt);
  }
  elsif ($pref eq "IO::File") {
    @txtlns = <$itxt>;
  }
  elsif (($pref eq "") && (-f $itxt)) {
    my $fi = IO::File->new("< $itxt");
    if (-T $itxt) {
      @txtlns = <$fi>;
    }
    else {
      #$/ = "\0";
      #while (<$fi>) {
      #  while (/([\040-\176\s]{4,})/g) {
      #    push @txtlns, $1;
      #  }
      #}
      $doFmt = FALSE;
      @filstat = stat($itxt);
      @txtlns  = ( "$itxt", "appears to be a binary file ...", "");
      foreach my $i (0 .. $#filstat) {
        push @txtlns, sprintf("%-10s  ->  %s", $stNames[$i], $stNames[$i] =~ /time/ ? scalar localtime($filstat[$i]) : $filstat[$i]);
      }
    }
    $fi->close();
  }
  if ($doFmt) {
    if (!defined($text)) {
      $text = join "", @txtlns;
    } 
    $text =~ s/\n\n+/#PAR#/g;
    $text =~ tr/[\n\t ]/ /s;
    print "$text\n";
    $text =~ s/#PAR#/\n\n/g;
    $text =~ s/#LN#/\n/g;
    @txtlns = split(/\t/, $text);
    $columns = $self->{'cols'} - 4;
    $text = wrap("", "", @txtlns);
    @lines = split(/\n/, $text);
  }
  else {
    @lines = @txtlns;
  }
  print "Maximal $columns Spalten ...\n\n@lines\n";
  $self->listbox(\@lines, input => "text");