| Category: |
Text Processing |
| Author/Contact Info |
ignatz |
| Description: |
Takes in a LOH (List of Hashes) and an array of keys to sort
by and returns a new, sorted LOH. This module closely relates
to Sort::Fields. in terms of it's interface and how it does things.
One of it's main differences is that it is OO, so one can create
a Sort::LOH object and perform multiple sorts on it.
Comments and hash criticism are most welcome. I tried to find something here or on CPAN that did this, but the closest that I got was Sort::Fields. Close, but no cigar. Perhaps there is some simple way to do this with a one liner. Even so, it was fun and educational to write. |
package Sort::LOH;
use strict;
use Carp;
use vars qw($VERSION);
$VERSION = '0.01';
######################################################################
+#####
# D O C U M E N T A T I O N
=head1 NAME
Sort::LOH - Sorter for List of Hashes
=head1 SYNOPSIS
use strict;
use Sort::LOH;
my @SAMPLE_DATA = (
{F1 => "1", F2 => "2", F3 => "3",
FLOAT => "2", ST => "123 Main Street"},
{F1 => "2", F2 => "3", F3 => "4",
FLOAT => "9", ST => "45 Main Street",},
{F1 => "3", F2 => "4", F3 => "4",
FLOAT => "045", ST => "2459 Main St"},
{F1 => "4", F2 => "5", F3 => "6",
FLOAT => "1.3", ST => "2580 Main Street"},
{F1 => "5", F2 => "6", F3 => "7",
FLOAT => "9", ST => "39 Main Street"},
{F1 => "6", F2 => "7", F3 => "8",
FLOAT => "8.8", ST => "1888 Main Street"}
);
my $sorter = Sort::LOH->new(\@LOH);
my @sorted = $sorter->sortMe(["F3", "ST"]);
Sorting in reverse order:
my @sorted = $sorter->sortMe(["-F3", "-ST"]);
Sorting numerically, as opposed to the default alphabetical:
my @sorted = $sorter->sortMe(["FLOAT n"]);
=head1 DESCRIPTION
Takes in a LOH (List of Hashes) and an array of keys to sort
by and returns a new, sorted LOH. This module closely relates
to Sort::Fields in terms of it's interface how it does things.
On of it's main differences is that it is OO, so one can create
a Sort::LOH object and perform multiple sorts on it.
=cut
=head1 PUBLIC METHODS
=cut
# D O C U M E N T A T I O N
######################################################################
+#####
######################################################################
+#####
# C O N S T R U C T O R
=head2 new(\@LOH_to_sort)
The class constructor. To create a Sort::LOH object, simply call:
my $sorter = Sort::LOH->new(\@LOH);
=cut
sub new
{
my $class = shift;
my $self = {};
bless $self, $class;
unless (ref($self->{LOH} = shift) eq 'ARRAY') {
croak 'LOH needs a reference to a List of Hashes';
}
$self->{SORT_BY} = undef;
return $self;
}
# C O N S T R U C T O R
######################################################################
+#####
######################################################################
+#####
# S T A T I C M E T H O D S
=head2 element_class()
The name of the class for use in calling methods. This is a trick to
simplify inheritance of static factory methods that I got from Perlmon
+ks:
http://www.perlmonks.org/index.pl?node_id=74924 Inheriting classes wou
+ld
create override element_class with the name of their class.
=cut
sub element_class
{
return "Sort::LOH";
}
=head2 static(@sort_by, \@LOH_to_sort)
A static method that allows caller to make the class do all the work
with one swell foop:
my @sorted = Sort::LOH->static(["F1", "F2"], \@SAMPLE_DATA);
as opposed to
my $sorter = Sort::LOH->new(\@LOH);
my @sorted = $sorter->sortMe(["F1", "F2"]);
If caller wants to do multiple sorts, one should use the constructor,
+and
create a Sort::LOH object, since then one only has to pass in the data
+ once:
my $sorter = Sort::LOH->new(\@LOH);
my @sorted = $sorter->sortMe(["F1", "F2"]);
my @revSort = $sorter->sortMe(["-F1", "-F2"]);
=cut
sub static
{
my $self = shift;
my @sortby = shift || croak 'USAGE: Sort::LOH->factory(@LIST, \@L
+OH)';
my @loh = shift || croak 'Sort::LOH::factory() needs 2 args';
my $sorter = $self->element_class()->new(@loh);
return $sorter->sortMe(@sortby);
}
# S T A T I C M E T H O D S
######################################################################
+#####
######################################################################
+#####
# C L A S S M E T H O D S
=head2 sortMe(@sort_by)
The workhorse of this class. Expects a list of the LOH keys to determi
+ne
the sort order for the returned LOH.
my @sorted = $sorter->sortMe(["F1", "F2"]);
It is possible to do a reverse sort for a particular key by placing a
+minus
sign at the front of it:
my @sorted = $sorter->sortMe(["-F1", "-F2"]);
If one wants to do a numeric sort, instead of a alphabetical sort, pla
+ce
" n" after the key in the list:
my @sorted = $sorter->sortMe(["F1 n", "F2 n"]);
=cut
sub sortMe
{
my $self = shift;
$self->{SORT_BY} = shift || croak 'LOH needs a list of fields to s
+ort by';
my (@sortcode, @sortedLOH);
for (@{$self->{SORT_BY}}) {
unless (/^-?\w+\s*n?$/) {
croak "improperly formatted sort column specifier '$_'";
}
# Logic from Sort::Fields
# Set a and b depending on '-' flag at the start of a key
my ($a, $b) = /^-/ ? qw(b a) : qw(a b);
# Is it a string or numeric sort?
my $op = /\s+n$/ ? '<=>' : 'cmp';
# Get the actual column name
my ($col) = /^-?(\w+)/;
# Make sure that the sort key being passed in exists.
if (exists($self->{LOH}[0]{$col})) {
push @sortcode, "\$${a}->{${col}} $op \$${b}->{${col}}";
}
}
# Croak if there were no valid sort keys specified.
unless ($sortcode[0]) {
croak "No valid key match to sort LOH.";
}
my $sortcode = join " or ", @sortcode;
$sortcode = "sort { $sortcode } \@{\$self->{LOH}};";
@sortedLOH = eval "$sortcode";
if ($@) {
croak "Sort Failure of LOH\n$@";
}
return @sortedLOH;
}
# C L A S S M E T H O D S
######################################################################
+#####
1;
__END__
=head1 BUGS
=over
=item *
When a LOH is passed in that has a key that isn't present in each
row in the list, and the class is sorted on that key, sort will print
out errors for comparing with undefined values. For instance:
my @the_data = (
{ID => "a", CITY => "f1 f"},
{ID => "b", CITY => "f2 a"},
{ID => "c"},
{ID => "f", CITY => "f6 e"}
);
my $lohSorter = Sort::LOH->new(\@the_data);
my @sorted = $lohSorter->sortMe(["CITY"]);
Making sure that each key has an empty string as a defined value will
solve this:
my @better_data = (
{ID => "a", CITY => "f1 f"},
{ID => "b", CITY => "f2 a"},
{ID => "c", CITY => ""},
{ID => "f", CITY => "f6 e"}
);
I haven't figured out a way to trap this error as of yet.
=back
=head1 SUPPORT
The author always welcomes your comments, critiques, suggestions or
requests.
=head1 AUTHOR
Christopher Baker
<ignatz@ignatzmouse.com>
http://www.ignatzmouse.com
=head1 COPYRIGHT
Copyright (c) 2002 Christopher Baker. All rights reserved.
This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.
The full text of the license can be found in the
LICENSE file included with this module.
=head1 SEE ALSO
Sort::File, Data::Table
=cut
|
|
Re: Sort::LOH
by ignatz (Vicar) on Jul 22, 2002 at 23:41 UTC
|
Here's the test script (as if you cared) that I'm using on this sucka:
package Sort::Test::LOH_test;
use strict;
use base qw(Test::Unit::TestCase);
my @SAMPLE_DATA = (
{ID => "a1 a", F_NAME => "asd b1 b", L_NAME => "ggfsdf
+c1 c", STREET => "5", ADDRESS => "2", CITY => "f1 f"},
{ID => "a2 b", F_NAME => "zxczxc b2 c", L_NAME => "sdvwevc
+2 d", STREET => "2", ADDRESS => "9", CITY => "f2 a"},
{ID => "a3 c", F_NAME => "cdaer b3 d", L_NAME => "sdfwbbf
+ c3 e", STREET => "4", ADDRESS => "045", CITY => "f3 b"},
{ID => "a4 d", F_NAME => "aaaa asdafsdf b4 e", L_NAME => "asdferw
+v c6 b", STREET => "4", ADDRESS => "1.3", CITY => "f4 c"},
{ID => "a5 e", F_NAME => "vdasdvqd43 b5 f", L_NAME => "aaaaa c
+5 a", STREET => "1", ADDRESS => "9", CITY => "f5 d"},
{ID => "a6 f", F_NAME => "eee ecasd b6 a", L_NAME => "asdferw
+v c6 b", STREET => "6", ADDRESS => "8.8", CITY => "f6 e"}
);
my @WACKY_DATA = (
{ID => "a1 a", NAMES => ["BOB", "ELLEN"], STREET => "5",
+ ADDRESS => "2", CITY => "f1 f"},
{ID => "a2 b", NAMES => ["SUE", "ROB"], STREET => [@SAMPLE_DAT
+A], ADDRESS => "9", CITY => "f2 a"},
{ID => "a3 c", NAMES => ["JOHN", "JANE"], STREET => "4",
+ ADDRESS => "045", CITY => "f3 b"},
{ID => "a4 d", NAMES => ["LOUIS", "ELLA"], STREET => "4",
+ ADDRESS => "1.3", CITY => "f4 c"},
{ID => "a5 e", NAMES => ["RICK", "MARK"], STREET => "1",
+ ADDRESS => "9", CITY => "f5 d"},
{ID => "a6 f", NAMES => ["IGNATZ", "CRAZY"],STREET => "6",
+ ADDRESS => "8.8", CITY => "f6 e"}
);
sub test_lohsorter
{
my $self = shift;
my $lohSorter = Sort::LOH->new(\@SAMPLE_DATA);
my @sorted = $lohSorter->sortMe(["L_NAME", "F_NAME"]);
$self->assert($sorted[0]{CITY} eq "f5 d", "Test ALPHA on L_NAME");
$self->assert($sorted[2]{CITY} eq "f6 e");
$self->assert($sorted[5]{CITY} eq "f2 a");
@sorted = $lohSorter->sortMe(["-L_NAME", "F_NAME"], "Test inverted
+ prime ALPHA with sub not inverted on L_NAME");
$self->assert($sorted[4]{CITY} eq "f6 e");
@sorted = $lohSorter->sortMe(["STREET n"]);
$self->assert($sorted[1]{CITY} eq "f2 a", "Test ALPHA on STREET");
@sorted = $lohSorter->sortMe(["-STREET n"]);
$self->assert($sorted[1]{CITY} eq "f1 f", "Test inverted ALPHA on
+STREET");
@sorted = $lohSorter->sortMe(["ADDRESS"]);
$self->assert($sorted[0]{CITY} eq "f3 b", "Test ALPHA on ADDRESS")
+;
# Test one row to make sure that all the fields are intact.
$self->assert($sorted[1]{ID} eq "a4 d");
$self->assert($sorted[1]{F_NAME} eq "aaaa asdafsdf b4 e");
$self->assert($sorted[1]{L_NAME} eq "asdferwv c6 b");
$self->assert($sorted[1]{STREET} eq "4");
$self->assert($sorted[1]{ADDRESS} eq "1.3");
$self->assert($sorted[1]{CITY} eq "f4 c");
$self->assert($sorted[2]{CITY} eq "f1 f");
$self->assert($sorted[3]{CITY} eq "f6 e");
$self->assert($sorted[4]{CITY} eq "f2 a");
$self->assert($sorted[5]{CITY} eq "f5 d");
@sorted = $lohSorter->sortMe(["-ADDRESS n"]);
$self->assert($sorted[0]{CITY} eq "f3 b", "Test inverted NUMERIC o
+n ADDRESS");
$self->assert($sorted[3]{CITY} eq "f6 e");
$self->assert($sorted[4]{CITY} eq "f1 f");
$self->assert($sorted[5]{CITY} eq "f4 c");
}
sub test_factory
{
my $self = shift;
my @sorted = Sort::LOH->static(["L_NAME", "F_NAME"], \@SAMPLE_DATA
+);
$self->assert($sorted[0]{CITY} eq "f5 d", "Test of factory method
+with ALPHA on L_NAME");
$self->assert($sorted[2]{CITY} eq "f6 e");
$self->assert($sorted[5]{CITY} eq "f2 a");
}
sub test_wacky_data
{
my $self = shift;
my $sorter = Sort::LOH->new(\@WACKY_DATA);
my @sorted = $sorter->sortMe(["-ID", "F_NAME"]);
$self->assert($sorted[0]{CITY} eq "f6 e", "Wacky data test with re
+verse ALPHA on ID and bad field call.");
}
1;
()-()
\"/
`
| [reply]
[d/l] |
Re: Sort::LOH
by zentara (Archbishop) on Jul 23, 2002 at 19:59 UTC
|
I couldn't get your test package to work, so I made a little
test script of my own which is more "straight-forward",
and some more "realistic data".
It sorts as advertised.
I'm not real good at dereferencing but I worked out a little
routine that will print out the sort results, and will dereference
the arrays and hashes that are returned automatically.
I hate it when you print out results, and get HASH019283474
or ARRAY1234234.
my LOH.pm test
##############################################
#!/usr/bin/perl
use warnings;
use strict;
use Sort::LOH;
my @SAMPLE_DATA = (
{ID => "a1 a", F_NAME => "asd b1 b", L_NAME => "ggfsdfc1 c"
+, STREET => "5",
{ID => "a2 b", F_NAME => "zxczxc b2 c", L_NAME => "sdvwevc2 d"
+, STREET => "2",
{ID => "a3 c", F_NAME => "cdaer b3 d", L_NAME => "sdfwbbfc3 e
+", STREET => "4",
{ID => "a4 d", F_NAME => "aaaa asdafsdf b4 e", L_NAME => "asdferwv c6
+ b", STREET => "4",
{ID => "a5 e", F_NAME => "vdasdvqd43 b5 f", L_NAME => "aaaaa c5 a"
+, STREET => "1",
{ID => "a6 f", F_NAME => "eee ecasd b6 a", L_NAME => "asdferwv c6
+ b", STREET => "6",
);
my @WACKY_DATA = (
{ID => "a1 a", NAMES => ["BOB", "ELLEN"], STREET => "2nd Ave.",
ADDRESS => "2", CITY => "Detroit"},
{ID => "a2 b", NAMES => ["SUE", "ROB"], STREET => [home=>"Birdview
+ Lane",vacation=>"Lake George Circle"],
ADDRESS => [home=>"9",vacation=>"20"], CITY => "Lake George"},
{ID => "a3 c", NAMES => ["JOHN", "JANE"], STREET => "1rst",
ADDRESS => "1045", CITY => "Lansing"},
{ID => "a4 d", NAMES => ["LOUIS", "ELLA"], STREET => "Silvery Lane",
ADDRESS => "13", CITY => "Macon"},
{ID => "a5 e", NAMES => ["RICK", "MARK"], STREET => "Plaza Center",
ADDRESS => "9", CITY => "Albany"},
{ID => "a6 f", NAMES => ["IGNATZ", "CRAZY"],STREET => "6th Street",
ADDRESS => "66", CITY => "Wackoville"}
);
######################################################################
+########
my $lohSorter = Sort::LOH->new(\@SAMPLE_DATA);
my @sorted = $lohSorter->sortMe(["STREET"]);
#print "@sorted\n";
foreach my $href(@sorted){
print "########################################\n";
foreach my $key (keys %$href){
print "$key ---> ${$href}{$key}\n";
}
print "########################################\n";
}
######################################################################
+########
print "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+\n";
######################################################################
+###
my $lohSorter1 = Sort::LOH->new(\@WACKY_DATA);
my @sorted1 = $lohSorter1->sortMe(["ADDRESS"]);
#print "@sorted1\n";
foreach my $href1(@sorted1){
# print Dumper(%$_);
print "########################################\n";
foreach my $key (keys %$href1){
if (${$href1}{$key} =~ /ARRAY/)
{print "$key --->@{${$href1}{$key}}\n"}
elsif (${$href1}{$key} =~ /HASH/)
{print "$key --->${${$href1}{$key}}\n"}
else {print "$key ---> ${$href1}{$key}\n"}
}
print "########################################\n";
}
| [reply]
[d/l] |
|
|
use Test::Unit::TestRunner;
my $testrunner = Test::Unit::TestRunner->new();
$testrunner->start("Sort::Test::LOH_test");
This isn't the best way to do things I'm sure. Part of packaging it up into a standard package install will be getting the tests to run with $> make test. In future I'll have to organize things like that from the start.
()-()
\"/
`
| [reply]
[d/l] |
|
|
