#!/usr/local/bin/perl
use strict;
use warnings;
use Data::Dumper;

my @cols = qw (
    lastname
    firstname
    cno
    unit
    ward
    dateadmission
    datebirth
);
my %cols_idx = do { my $i = 0; map { $_ => $i++ } @cols };
my %parameters = (
    lastname       => [ qw( U a ) ],
    firstname      => [ qw( U a ) ],
    cno            => [ qw( U n ) ],
    unit           => [ qw( U s ) ],
    ward           => [ qw( U n ) ],
    dateadmission  => [ qw( D a ) ],
    datebirth      => [ qw( D a ) ],
);

my @data = map [ split ] => <DATA>;

print Dumper sort_by_column(
    \@data, @ARGV ? @ARGV : qw{ lastname firstname cno }
);

########## SUBROUTINES ##########

sub make_single_comparator {
    print "parms: @_\n";
    my $data = shift;
    my $col = shift;
    my $asc = shift;
    my $type = shift;
    my $idx = $cols_idx{$col};
    print "idx: $idx\n";

    my %subs = (
        U => {
            a => sub { lc($a->[$idx]) cmp lc($b->[$idx]) },
            n => sub {    $a->[$idx]  <=>    $b->[$idx]  },
            s => sub {    $a->[$idx]  cmp    $b->[$idx]  },
        },
        D => {
            a => sub { lc($b->[$idx]) cmp lc($a->[$idx]) },
            n => sub {    $b->[$idx]  <=>    $a->[$idx]  },
            s => sub {    $b->[$idx]  cmp    $a->[$idx]  },
        },
    );
    $subs{$asc}{$type};
}

sub sort_maker {
    my @littlesubs = @_;
    sub {
        foreach my $sub (@littlesubs) {
            my $result = $sub->();
            return $result if $result;
        }
    };
}

sub sort_by_column {
    my $data = shift;
    my @order = @_;

    my $sortref = sort_maker(
        map { make_single_comparator( $data, $_, @{$parameters{$_}}) }
+ @order
    );

    my @results = sort $sortref @$data;
    return [ @results ];
}

__DATA__
HERNANDEZ      HECTOR     456791 SAMSON 0217      2001-07-25 1963-08-0
+1
VASQUEZ        JOAQUIN    456789 SAMSON 0209      1990-11-14 1970-03-2
+5
JONES          TIMOTHY    803092 LAVER  0103      2001-03-19 1969-06-2
+9
SMITH          BETTY_SUE  698389 SAMSON 0211      1992-01-23 1949-08-1
+2
VASQUEZ        LEONARDO   456788 LAVER  0107      1990-08-23 1970-15-2
+3
SMITH          HAROLD     359962 TRE    0111      2001-07-19 1973-10-0
+2
VASQUEZ        ADALBERTO  786792 LAVER  0104      2001-07-26 1973-08-1
+7
VASQUEZ        JORGE      456787 LAVER  0105      1986-01-17 1956-01-1
+3
VAZQUEZ        TOMASINA   456790 LAVER  0110      1980-11-14 1960-14-0
+2
WILSON         SYLVESTER  498703 LAVER  0110      1983-04-02 1953-06-2
+2
VASQUEZ        ALBERTO    906786 TRE    0111      2001-07-15 1953-02-2
+8
[download]