Curses-UI-DelimitedTextViewer

 view release on metacpan or  search on metacpan

DelimitedTextViewer.pm  view on Meta::CPAN

package Curses::UI::DelimitedTextViewer;
###############################################################################
# subclass of Curses::UI::TextViewer that display delimited files onscreen
# in fixed width columns
#
# (c) 2002 by Garth Sainio. All rights reserved.
#
# This program is free software; you can redistribute it and/or modify it
# under the same terms as perl itself.
###############################################################################
use strict;
use warnings;
use Curses;
use Curses::UI::Common;
use Curses::UI::TextViewer;

use vars qw(
    $VERSION
    @ISA
);

$VERSION = '0.10';

@ISA = qw(
          Curses::UI::TextViewer
);

sub new () {
    my $class = shift;

    my %userargs = @_;
    keys_to_lowercase(\%userargs);

    my %args = (
        %userargs,
    );
    my $obj =  $class->SUPER::new( %args);

    # set the delimiter, default to tab
    $obj->{'-delimiter'} = $userargs{'-delimiter'} || "\t";

    # set the fieldSeparator
    $obj->{'-fieldSeparator'} = $userargs{'-fieldSeparator'} || "|";

    # Caclulate the widths of the columns
    $obj->{'-widths'} = $obj->calculate_widths($userargs{'-text'});
    $obj->{'-maxcolumns'} = scalar(@{$obj->{'-widths'}});
    $obj->{'-current_column'} = 0;

    # Turn the delimited text into fixed width text
    $obj->{'-text'} = $obj->process_text($obj->{'-text'});

    # Check to see if the user wants to scroll by column
    if($userargs{'-columnScroll'}) {
        $obj = $obj->set_routine('cursor-right', \&scroll_column_right);
        $obj = $obj->set_routine('cursor-left', \&scroll_column_left);
    }

    return $obj;
}

###############################################################################
# process_text
# reformat the incoming text and get a list of the width of each delimited
# field. Store those widths for future scrolling
###############################################################################
sub process_text {
    my ($self, $text) = @_;

    my $out_text = "";
    my $column_width = $self->{'-widths'};

    # split on new lines
    my @lines = split($/, $text);

    # Now format the lines
    foreach my $line (@lines) {
        chomp($line);
        my @parts = split("\t", $line);
        foreach my $i (0..$#parts) {
            # pad the part
            my $spaces = $column_width->[$i] - length($parts[$i]);
            $out_text .= $parts[$i] . " " x $spaces;
            $out_text .= $self->{'-fieldSeparator'};
        }

        if($self->{'-addBlankColumns'}) {
            # Check to see if there were fewer columns in the line
            # than in the column_width array
            my $missing = scalar(@{$column_width}) - scalar(@parts);
            foreach my $i (1..$missing) {
                $out_text .= " " x $column_width->[$#parts + $i];
                $out_text .= $self->{'-fieldSeparator'};
            }
        }

        $out_text .= "$/";
    }

    return $out_text;
}

###############################################################################
# calculate_widths
###############################################################################
sub calculate_widths {
    my($self, $text) = @_;
    my @column_widths;

    # calculate the column widths
    # split on new lines
    my @lines = split("$/", $text);
    foreach my $line (@lines) {
        # then split on the delimiter
        my @parts = split("\t", $line);
        # Check to see if the width of the column is greater than the
        # already existing width
        foreach my $i (0..$#parts) {
            my $length = length($parts[$i]);
            unless(defined($column_widths[$i])) {
                $column_widths[$i] = $length;
            }
            $column_widths[$i] = $length if($length > $column_widths[$i]);
        }
    }
    return \@column_widths;
}

###############################################################################
# scroll the cursor by a column width at a time
###############################################################################

sub scroll_column_right {
    my $self = shift;

    # Check to make sure that the cursor is not already at the last
    # column

    return $self->dobeep 
      if($self->{'-current_column'} == $self->{'-maxcolumns'});

    # Look up the current columns width and use that as the offset
    my $index = $self->{'-current_column'};
    my @widths = @{$self->{'-widths'}};
    my $offset = $self->{'-widths'}->[$self->{'-current_column'}];

    # Don't scroll if the last column is already completely on screen
    return $self->dobeep 
      if(($self->{-xscrpos}) >= ($self->{-hscrolllen} - $self->canvaswidth));

    # The first column should only be shifted the width the column
    # whereas the others should be shifted the width of the column
    # plus one. This keep the left edge of the screen (where the $
    # appears) as the last space in the previous column.
    if($index > 0) {
        $offset++;
    }

    # update the current column
    $self->{'-current_column'}++;

    $self->{-xscrpos} += $offset;
    $self->{-hscrollpos} = $self->{-xscrpos};
    $self->{-xpos} = $self->{-xscrpos};

    return $self;
}

###############################################################################
# scroll the cursor by a column width at a time
###############################################################################

sub scroll_column_left {
    my $self = shift;

    # Check to make sure that the cursor is not already at the first column

    return $self->dobeep if($self->{'-current_column'} == 0);

    # Look up the previous column's width and use that as the offset
    my $index = $self->{'-current_column'};
    $index--;
    my $offset = $self->{'-widths'}->[$index];

    # The first column should only be shifted the width the column
    # whereas the others should be shifted the width of the column
    # plus one. This keep the left edge of the screen (where the $
    # appears) as the last space in the previous column.
    if($index > 0) {
        $offset++;
    }

    # update the current column
    $self->{'-current_column'}--;

    $self->{-xscrpos} -= $offset;
    $self->{-hscrollpos} = $self->{-xscrpos};
    $self->{-xpos} = $self->{-xscrpos};

    return $self;
}


1;

=pod

=head1 NAME
Curses::UI::DelimitedTextViewer - Displays delimited files as fixed width.

=head1 CLASS HIERARCHY

 Curses::UI::Widget
 Curses::UI::Searchable
    |
    +----Curses::UI::TextEditor
            |
            +----Curses::UI::TextViewer
                    |
                    +----Curses::UI::DelimitedTextViewer

=head1 SYNOPSIS

  my $editor = $screen->add(
        'editor', 'DelimitedTextViewer',
        -border          => 1,
        -padtop          => 0,
        -padbottom       => 3,
        -showlines       => 0,
        -sbborder        => 0,
        -vscrollbar      => 1,
        -hscrollbar      => 1,
        -showhardreturns => 0,
        -wrapping        => 0,
        -text            => $text,
        -columnScroll    => 1,



( run in 1.657 second using v1.01-cache-2.11-cpan-140bd7fdf52 )