#!/usr/bin/perl
use strict;
use warnings;

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 ) ],
                 );

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 { $a->[$idx] cmp $b->[$idx] },
                    n => sub { $a->[$idx] <=> $b->[$idx] },
                    # s???  not sure what you mean by 's' ... feel fre
+e to
                    # modify this.
                    's' => sub { $a->[$idx] cmp $b->[$idx] },
                },
                D => {
                    a => sub { $b->[$idx] cmp $a->[$idx] },
                    n => sub { $b->[$idx] cmp $a->[$idx] },
                    # same problem as above.
                    's' => sub { $b->[$idx] cmp $a->[$idx] },
                },
               );
    $subs{$asc}{$type};
}

sub sort_maker
{
    my @subs = @_;
    sub {
        foreach my $sub (@subs) {
            my $result = $sub->(); # you use $a and $b in your littles
+ubs - no need to pass in globals.
            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;

    @results
}

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

use Data::Dumper;
print Dumper [sort_by_column(\@data, @ARGV ? @ARGV : qw{ lastname firs
+tname cno } )];


__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
[download]