Gtk2 CSV Viewer

I wrote this CSV viewer to use with psql to show the results of the queries I make in a way easier to read than plain "less".
It is a good example of how to implement a Gtk2::TreeModel and how to use a Gtk2::TreeView. You need Gtk2 to use this.
#!/usr/bin/perl

use strict;
use warnings;
use Gtk2 -init;

my $csv = CSVParse->new(*STDIN);
my $model = CSVTreeModel->new($csv);

my $window = Gtk2::Window->new('toplevel');
my $scrolled = Gtk2::ScrolledWindow->new();
my $tree = Gtk2::TreeView->new();


$window->signal_connect(delete_event => sub {Gtk2->main_quit()});
$window->add($scrolled);
$window->show_all();

$scrolled->add($tree);
$scrolled->show();


$tree->set_model($model);

for my $i (0..$model->GET_N_COLUMNS - 1) {
    my $title = $model->get_column_title($i) || 'NULL';
    my $rend = Gtk2::CellRendererText->new();
    my $col = Gtk2::TreeViewColumn->new_with_attributes($title,$rend,t
+ext => $i);
    $tree->append_column($col);
}


$tree->show();

Gtk2->main();


package CSVParse;

sub new {
    my $self = shift;
    $self =
      {
       string_delim => '"',
       escape_char => "\\",
       field_delim => ',',
       reg_delim => "\n"
      };
    bless $self, "CSVParse";
    $self->{fh} = shift;
    return $self;
}

# supomos que ele esteja no início de uma coluna!
sub fetch_column {
    my $self = shift;
    my $context = 'raw_data';
    my @contexts = ();
    my $data = undef;

    while (1) {
        # char buffer
        my $buf;
        read($self->{fh},$buf,1) or do {
            $self->{EOF} = 1;
            last;
        };
        $self->{last_char_read} = $buf;
        if ($context eq 'escape') {
            $data = '' unless defined $data;
            $data .= $buf;
            $context = shift @contexts;
        } elsif ($context eq 'string') {
            if ($buf eq $self->{string_delim}) {
                $context = shift @contexts;
            } else {
                $data = '' unless defined $data;
                $data .= $buf;
            }
        } else {
            if ($buf eq $self->{escape_char}) {
                push @contexts, $context;
                $context = 'escape';
            } elsif ($buf eq $self->{string_delim}) {
                push @contexts, $context;
                $context = 'string';
            } elsif ($buf eq $self->{field_delim} ||
                 $buf eq $self->{reg_delim}) {
                # voltar um caractere
                seek($self->{fh},0,tell($self->{fh})-1);
                # sair do loop.
                last;
            } else {
                $data = '' unless defined $data;
                $data .= $buf;
            }
        }
    }

    return $data;
}

sub fetch_row {
    my $self = shift;
    if ($self->{EOF}) {
        return undef;
    }
    my @cols = ();
    # supomos que ele comece numa posição OK
    while (1) {
        my $col = $self->fetch_column();
        last if $self->{EOF};
        push @cols, $col;
        if ($self->{last_char_read} eq $self->{reg_delim}) {
            # sair do loop.
            last;
        }# elsif ($buf eq ($self->{field_delim})) { next; } else { nex
+t; }
    }
    return \@cols;
}

sub parse_file {
    my $self = shift;
    my @rows = ();
    while (1) {
        my $cols = $self->fetch_row();
        last unless defined $cols;
        push @rows,$cols;
    }
    return @rows;
}

package CSVTreeModel;

use Gtk2;
use Glib::Object::Subclass
  Glib::Object::,
  interfaces => [ Gtk2::TreeModel:: ],
  ;

my $debug = 0;

sub new {
    my $self = shift;
    $self = $self->SUPER::new(@_);
    $self->{csv} = shift;
    $self->{header} = $self->{csv}->fetch_row();
    $self->{buffer} = [];
    return $self;
}

sub get_column_title {
    my $self = shift;
    my $n = shift;
    return $self->{header}[$n];
}

sub GET_FLAGS {
    return ['iters-persist','list-only'];
}

sub GET_N_COLUMNS {
    print "GET_N_COLUMNS ".join(", ",@_).$/ if $debug;
    my $self = shift;
    return scalar @{$self->{header}};
}

sub GET_COLUMN_TYPE {
    print "GET_COLUMN_TYPE ".join(", ",@_).$/ if $debug;
    return 'Glib::String';
}

sub GET_ITER {
    print "GET_ITER ".join(", ",@_).$/ if $debug;
    my $self = shift;
    my $path = shift;
    $path = $path->to_string() if ref $path;
    my $row_number = undef;
    if ($path) {
        $row_number = $path;
    } else {
        $row_number = 0;
    }
    my $data = $self->get_data($row_number);
    return undef unless defined $data;
    return [$row_number,$row_number,$data,0];
}

sub GET_PATH {
    print "GET_PATH ".join(", ",@_).$/ if $debug;
    my $self = shift;
    my $iter = shift;
    return Gtk2::TreePath->new($iter->[0]);
}

sub GET_VALUE {
    print "GET_VALUE ".join(", ",@_).$/ if $debug;
    my $self = shift;
    my $iter = shift;
    my $col = shift;
    return $iter->[2][$col];
}

sub ITER_NEXT {
    print "ITER_NEXT ".join(", ",@_).$/ if $debug;
    my $self = shift;
    my $iter = shift;
    return $self->GET_ITER($iter->[0] + 1);
}

sub ITER_NTH_CHILD {
    print "ITER_NTH_CHILD ".join(", ",@_).$/ if $debug;
    my $self = shift;
    my $iter = shift;
    my $n = shift;
    return undef if $iter;
    return $self->GET_ITER($n);
}

sub get_data {
    my $self = shift;
    my $row_number = shift;
    my $buffer = $self->{buffer};
    while ($row_number > scalar @{$buffer} - 1) {
        my $data = $self->{csv}->fetch_row;
        last unless defined $data;
        push @{$buffer}, $data;
    }
    if ($row_number > scalar @{$buffer} - 1) {
        return undef;
    } else {
        return $buffer->[$row_number];
    }
}
[download]
daniel
Comment on Gtk2 CSV Viewer Download Code

"be consistent"
	PerlMonks