[perl-win32-gui-users] Enhanced Listview Module

[Ariel Serbin]

Hi all,

I've (mostly) completed a listview subclass that helps
simplify dealing with listview data.  It's primarily
designed for data that is keyed by ID.  The main tasks
of the subclass are importing data, handling sorting,
and retrieving the IDs/data of the selected items. 
See the attached example for more details.

I haven't completed the documentation, though most
functions should be self-explanatory.  This is the
first time I've attempted to prepare a module for
public distribution, so I've got a little homework to
do in that respect.

For those of you interested in this sort of thing, I'd
appreciate your input on these issues:

1. Naming, both for the module and for the methods.

2. Error handling.  Right now, it's just carping on
errors.

3. Overriding regular ListView methods.  Since the
underlying data relies on having IDs, I should
probably replace/disable the regular ListView->Add...

4. Any other opinions...

EZ_LV_tester.pl
Description: 1059067997-EZ_LV_tester.pl

package Win32::GUI::EZ::ListView;

use strict;
use Win32::GUI;
use Carp;

our @ISA = ('Win32::GUI::ListView');

sub new {
  my ($package,%options) = @_;
  

  my $self = $package->SUPER::new($package,%options);
  
  bless $self, $package;
  
  $self->{_DISPLAY_COLUMNS} = [];
  $self->{_IDS} = [];
  $self->{_COLUMNS} = [];
  $self->{_DEFAULT_WIDTH} = $options{-default_width} || -2;
  $self->{_DATA} = {};
  
  $self->{-can_sort} ||= 1; # if this listview can be sorted
  $self->{-sort_asc} ||= 1;
  $self->{-sort_col} = -1; # initially, no columns have been sorted
  
  # remap column click event
  $self->SetEvent("ColumnClick", sub {sort_lv(@_)});
  
  return $self;
}

sub AUTOLOAD {
  my $func = our $AUTOLOAD;
  my $self = $_[0];
  
  $func =~ s/.*:://;
  
  my $col = $self->get_column($func);
  
  unless ($col) {
    carp("can't find column '$func'");
    return;
  }
  
  return $col;
}

sub get_selected {
  my $self = shift;
  
  my @sel = $self->SelectedItems();
  return undef unless defined $sel[0];
  
  print $self->SelectedItems() . "\n";
  
  return @{$self->[EMAIL PROTECTED];
  
}

sub get_data {
  my $self = shift;
  my @data;
  
  my @sel = $self->get_selected();
  
  return undef unless defined $sel[0];
  
  for (@sel) {
    push @data, $self->{_DATA}->{$_};
  }
  return @data;
}

sub display_columns {
  my $self = shift;
  my @columns = @_;
  
  my @col_objects = ();
  
  my $index = 0;
  
  # clear columns
  $self->Clear();
  $self->hide_all_columns;
  
  # add columns
  foreach my $col_name (@columns) {
    
    my $col = $self->get_column($col_name) or croak("Can't display column: 
$col_name");
    
    push @col_objects, $col;
    
    # keep track of where the column's position in the list
    $col->{-visible} = 1;
    $col->{-index} = $index;
    
    # copy the attributes from the column object
    my @opts = grep { m/^-/ } keys %$col;
    my %options;
    foreach my $opt (@opts) {
      $options{$opt} = $col->{$opt};
    }
    
    # just use the column object as the options hash
    $self->InsertColumn(%options);
    
    $index++;
  }
  
  # show data
  foreach my $id (@{$self->{_IDS}}) {
    my @toinsert = ();

    foreach my $cl  (@col_objects) {
      push @toinsert, $self->{_DATA}->{$id}->{$cl->{-name}};
    }
    $self->InsertItem(-text => [EMAIL PROTECTED]);
  }
  
  # size columns if needed
  if ($self->{set_width}) {
    my $i = 0;
    foreach my $cl  (@col_objects) {
      $self->ColumnWidth($i,$cl->{-width});
      $i++;
    }
    $self->{set_width} = 0;
  }

  @{$self->{_DISPLAY_COLUMNS}} = @columns;
}

sub hide_all_columns {
  my $self = shift;
  
  # remove column from listview
  # this does NOT destroy the EZ::ListView::Column object
  
  for my $col ( @{$self->{_COLUMNS} } ) {
    $col->hide;
  }
}

sub get_column {
  my ($self, $name) = @_;
  
  return (grep {($_->{-name} eq $name) || ($_->{-text} eq $name)} 
@{$self->{_COLUMNS}})[0];
}

sub redraw {
  my $self = shift;
  
  $self->display_columns(@{$self->{_DISPLAY_COLUMNS}});
  
  return 1;
}

sub import_hashref {
  # this function imports a hashref of hashrefs in the form returned by DBI's 
fetchall_hashref
  my ($self, $hashref) = @_;
  
  carp("can't import_hashref without a hashref") unless $hashref;
  
  ##
  ## first we need to create the columns if we don't have them already
  ##
  
  # these will be the IDs of the hash items
  my @keys = keys %{$hashref};
  
  # these will be the field/column names of the individual entries
  my @column_names = keys %{ $hashref->{$keys[0]} };
  
  foreach my $column (@column_names) {
    # call autoload to see if we already have that column
    unless ($self->get_column($column)) {
      $self->add_column(-name => $column);
    }
  }
  
  # create a handle to the data
  $self->{_DATA} = $hashref;
  $self->{_IDS} = [EMAIL PROTECTED];
  
  # tell display to set width
  $self->{set_width} = 1;
}

sub sql_populate {
  my ($self, $dbh, $sql, $key) = @_;
  
  my $crs = $dbh->prepare($sql) or carp($dbh->errstr);
  my $res = $crs->execute or carp($dbh->errstr);
  
  if ($res eq '0E0') {
    $crs->finish;
    return;
  }
  
  $self->import_hashref($crs->fetchall_hashref($key));

  $crs->finish;
  return $res;
}

sub add {
  my ($self, $key, $hashref) = @_;
  
  # these will be the field/column names of the individual entries
  my @column_names = keys %{ $hashref };
  
  foreach my $column (@column_names) {
    # call autoload to see if we already have that column
    unless ($self->get_column($column)) {
      $self->add_column(-name => $column);
    }
  }
  
  # create a handle to the data
  $self->{_DATA}->{$key} = $hashref;
  push @{$self->{_IDS}}, $key ;
  return 1;
}

sub remove {
  my ($self, $key) = @_;
  
  # this is permanent!
  delete $self->{_DATA}->{$key};
  @{$self->{_IDS}} = grep {$_ != $key} @{$self->{_IDS}};
}

sub default_width {
  my ($self, $width) = shift;
  $self->{_DEFAULT_WIDTH} = $width if $width;
  return $self->{_DEFAULT_WIDTH};
}

sub add_column {
  my ($self, %options) = @_;
  my $name = $options{-name};
  
  #set initial visibility to 0
  $options{-visible} ||= 0;
  
  unless ($name) {
    carp('Column must have a name');
    return 0;
  }
  
  if ($self->get_column($name)) {
    carp("Column '$options{-name}' duplicated");
    return 0;
  }
  
  $options{-parent} = $self;
  
  my $col = Win32::GUI::EZ::ListView::Column->new(%options);
  
  push @{$self->{_COLUMNS}}, $col;
  
}

sub sort_lv {
  my ($self, $column) = @_;
  # note that $column is the column index, not the object

  # find the object
  my $col = (grep {(defined $_->{-index}) && ($_->{-index} == $column)} 
@{$self->{_COLUMNS}})[0];
  
  return 1 unless ($col->{-can_sort} && $self->{-can_sort});
  
  carp("yikes! can't find column $column") unless $col;
  
  # use dummy sub as default
  my $sub = $col->{-sorter} || sub { my ($one, $two) = @_; return $one cmp 
$two; };
  
  #make some shortcuts to make this a little more readable
  my $sort_col = $self->{-sort_col};
  my $column_name = $col->{-name};
  my @ids = @{$self->{_IDS}};
  my $data = $self->{_DATA};
  
  no warnings;
  if ($sort_col == $column) {
  # sort_col is the current sorting column so we'll invert the sort order
  if ($self->{-sort_asc}) {
   $self->{-sort_asc} = 0;
   @{$self->{_IDS}} = sort { &$sub($data->{$b}->{$column_name}, 
$data->{$a}->{$column_name}) } @ids;
  }
  else {
   $self->{-sort_asc} = 1;
   @{$self->{_IDS}} = sort { &$sub($data->{$a}->{$column_name}, 
$data->{$b}->{$column_name}) } @ids;
  }
 }
 else {
  # this wasn't the last column we sorted so we'll sort it asc
   $self->{-sort_col} = $column;
   $self->{-sort_asc} = 1;
   @{$self->{_IDS}} = sort { &$sub($data->{$a}->{$column_name}, 
$data->{$b}->{$column_name}) } @ids;
 }
 $self->display_columns(@{$self->{_DISPLAY_COLUMNS}});
}


##
## COLUMN CLASS
##

package Win32::GUI::EZ::ListView::Column;

sub new {
  my ($package, %options) = @_;
  
  my $self = \%options;
  
  # use name as text if we don't have -text
  $self->{-text} ||= $self->{-name};
  $self->{-can_sort} ||= 1; # if this column can be sorted
  $self->{-width} ||= $self->{-parent}->{_DEFAULT_WIDTH};
  
  bless $self, $package;
  
}

sub width {
  my ($self, $width) = @_;
  if ($width) {
    $self->{-width} = $width;
    if ($self->{-visible}) {
      $self->{-parent}->ColumnWidth($self->{-index}, $width);
    }
  }
  return $self->{-width};
}

sub text {
  my ($self, $text) = @_;
  if ($text){
    $self->{-text} = $text;
    if ($self->{-visible}) {
      $self->{-parent}->SetColumn($self->{-index}, $text);
    }
  }
  return $self->{-text};
}

sub sorter {
  my ($self, $sorter) = @_;
  croak('sorter needs a coderef') unless ref($sorter) eq 'CODE';
  $self->{-sorter} = $sorter;
}

sub hide {
  my $self = shift;
  
  return unless $self->{-visible};
  
  # we'll need to remember the current width
  # in case the user changed it
  $self->{-width} = $self->{-parent}->ColumnWidth($self->{-index});
  
  # if there are columns with higher indexes then we'll need to decrement them
  foreach my $col (grep {$_->{-index} > $self->{-index}} 
@{$self->{-parent}->{_COLUMNS}}) {
    $col->{-index} -= 1;
  }
  
  # remove the column from view
  $self->{-parent}->DeleteColumn($self->{-index});
  
  $self->{-index} = undef;
  $self->{-visible} = 0;
}
1;

__END__

=head1 NAME

Win32::GUI::EZ::ListView - Enhanced ListView control for Win32::GUI

=head1 SYNOPSIS
  
  use strict;
  use Win32::GUI;
  use Win32::GUI::EZ::ListView;
  
  my $test_data = {
   1 => {
    fname => 'john',
    lname => 'smith',
    bday => '8/1/2002',
    money => '500.82'
        },
   2 => {
    fname => 'john',
    lname => 'doe',
    bday => '8/01/1402',
    money => '1.04'
        },
   3 => {
    fname => 'jane',
    lname => 'smith',
    bday => '1/1/1999',
    money => '1,928,347'
        },
   4 => {
    fname => 'icabod',
    lname => 'crane',
    bday => '8/31/2002',
    money => '$3,500'
        },
   5 => {
    fname => 'john',
    lname => 'smith',
    bday => '06/02/1950',
    money => '0.25'
        },
  };
  
  my $win = new Win32::GUI::Window(
    -name => 'win',
    -left => 100,
    -top => 100,
    -width => 450,
    -height => 350,
    -text => 'EZ Listview Test'
  );
  
  my $lv = Win32::GUI::EZ::ListView->new(
    -name => 'lv',
    -left => 10,
    -top => 10,
    -width => 430,
    -height => 250,
    -parent => $win,
    -singlesel => 1,
    -fullrowselect => 1,
  );
  
  my $button = $win->AddButton (
    -name => 'btn',
    -top => 270,
    -left => 20,
    -text => 'test',
    -onClick => \&clicker,
  );
  
  # you can populate from a database:
  # my $sql = 'select * from people';
  # $lv->sql_populate($dbh, $sql, 'person_id');
  #
  # or populate using a hashref of hashrefs (see the above definition of 
$test_data)
  $lv->import_hashref($test_data);
  
  # refer to columns by the underlying column name
  $lv->fname->width(100);
  
  # give the column a nicer name
  $lv->lname->text("Last Name");
  
  # don't let users sort by last name
  # all sorting can be disabled with $lv->{-can_sort} = 0
  $lv->lname->{-can_sort} = 0;
  
  $lv->add(12, { fname => 'bob', lname=>'smith', bday => '6/7/1974'});
  
  # define custom sorting subrefs
  my $datesort = sub {
    my ($arg, $arg2) = @_;
    $arg =~ m|^(\d+)/(\d+)/(\d+)|;
    $arg = sprintf('%02d%02d%02d', $3, $1, $2);
    $arg2 =~ m|^(\d+)/(\d+)/(\d+)|;
    $arg2 = sprintf('%02d%02d%02d', $3, $1, $2);
    return $arg <=> $arg2;
  };
  
  my $moneysort = sub {
    my ($arg, $arg2) = @_;
    $arg =~ s/[\$\,]//g;
    $arg2 =~ s/[\$\,]//g;
    return $arg <=> $arg2;
  };
  
  # assign the subrefs to the listview
  $lv->money->sorter($moneysort);
  $lv->bday->sorter($datesort);
  
  # tell the listview which columns to show in which order
  $lv->display_columns(qw/fname lname bday money/);
  
  $win->Center;
  $win->Show;
  
  #Win32::GUI::DoEvents();
  #sleep(2);
  #
  # # remove a row
  #$lv->remove(4);
  #$lv->redraw;
  
  Win32::GUI::Dialog;
  
  sub clicker {
    
    # get the ids of the selected items
    my @stuff = $lv->get_selected();
    
    # get the hashrefs of the selected items
    my @dat = $lv->get_data();
  
    if (defined $stuff[0]) {
      print "These IDs were selected: " . join(',',@stuff) . "\nfirst selected 
item:\n";
      foreach (keys %{$dat[0]}) {
        print "\t$_\t$dat[0]->{$_}\n";
      }
    }
    else {
      print "No Selection\n";
    }
  }
  
  sub win_Terminate {
    -1
  }
  


=head1 DESCRIPTION

This module subclasses the standard Win32::GUI::ListView control to:

=over 8

=item *
Keep track of IDs for each "record" in the ListView

=item *
Assist with column management

=item *
Simplify sorting

=item *
Simplify populating a listview with a database query

=back



=cut