in reply to Dynamic sort criteria for an Array in Perl
Following up on choroba's suggestion re. eval, you could build a hash of sort criteria whereby the sort string can be validated so as to avoid running arbitrary code.
use strict; use warnings; use 5.014; my %sortCriteria = ( field1 => { q{} => q{$a->[ 1 ] cmp $b->[ 1 ]}, a => q{$a->[ 1 ] cmp $b->[ 1 ]}, d => q{$b->[ 1 ] cmp $a->[ 1 ]}, n => q{$a->[ 1 ] <=> $b->[ 1 ]}, na => q{$a->[ 1 ] <=> $b->[ 1 ]}, nd => q{$b->[ 1 ] <=> $a->[ 1 ]}, an => q{$a->[ 1 ] <=> $b->[ 1 ]}, dn => q{$b->[ 1 ] <=> $a->[ 1 ]}, }, field2 => { q{} => q{$a->[ 2 ] cmp $b->[ 2 ]}, a => q{$a->[ 2 ] cmp $b->[ 2 ]}, d => q{$b->[ 2 ] cmp $a->[ 2 ]}, }, field3 => { q{} => q{$a->[ 3 ] cmp $b->[ 3 ]}, a => q{$a->[ 3 ] cmp $b->[ 3 ]}, d => q{$b->[ 3 ] cmp $a->[ 3 ]}, n => q{$a->[ 3 ] <=> $b->[ 3 ]}, na => q{$a->[ 3 ] <=> $b->[ 3 ]}, nd => q{$b->[ 3 ] <=> $a->[ 3 ]}, an => q{$a->[ 3 ] <=> $b->[ 3 ]}, dn => q{$b->[ 3 ] <=> $a->[ 3 ]}, }, field4 => { q{} => q{$a->[ 4 ] cmp $b->[ 4 ]}, a => q{$a->[ 4 ] cmp $b->[ 4 ]}, d => q{$b->[ 4 ] cmp $a->[ 4 ]}, }, ); my @array = map { map { [ split m{,} ] } split m{\n} } <<EOD; Line1,123,cat,79,Tiddles Line2,427,dog,298,Jack Line3,278,aardvark,9,Digger Line4,89,gerbil,88,Jerry Line5,427,ferret,706,Faustus Line6,123,goldfish,23,Fred EOD say q{Original array}; say q{-} x 35; say join q{,}, @$_ for @array; say q{=} x 35; foreach my $sortBy ( do { no warnings qw{ qw }; qw{ field1 field1(n) field1(d) field1(nd),field2(d) field2(d),field3 field4(d) field3 field3(n) }; } ) { say qq{Sort String - $sortBy}; say q{-} x 35; my $sortCode = buildSorter( $sortBy ); my @sorted = sort $sortCode @array; say join q{,}, @$_ for @sorted; say q{=} x 35; } sub buildSorter { my $sortStr = shift; my @criteria = map { [ m{(?x) ^ ( [^(]+ ) (?: \( ([and]+) \) )? $} ] } split m{\s*,\s*}, $sortStr; foreach my $criterion ( @criteria ) { die qq{Invalid field "$criterion->[ 0 ]"\n} unless exists $sortCriteria{ $criterion->[ 0 ] }; $criterion->[ 1 ] = q{} unless defined $criterion->[ 1 ]; die qq{Invalid modifier "$criterion->[ 1 ]"}, qq{ for field "$criterion->[ 0 ]"\n} unless exists $sortCriteria{ $criterion->[ 0 ] }->{ $criterion-> +[ 1 ] }; } return eval q|sub { | . join( q{ || }, map { $sortCriteria{ $_->[ 0 ] }->{ $_->[ 1 ] } } @criteria ) . q| }|; }
The output
Original array ----------------------------------- Line1,123,cat,79,Tiddles Line2,427,dog,298,Jack Line3,278,aardvark,9,Digger Line4,89,gerbil,88,Jerry Line5,427,ferret,706,Faustus Line6,123,goldfish,23,Fred =================================== Sort String - field1 ----------------------------------- Line1,123,cat,79,Tiddles Line6,123,goldfish,23,Fred Line3,278,aardvark,9,Digger Line2,427,dog,298,Jack Line5,427,ferret,706,Faustus Line4,89,gerbil,88,Jerry =================================== Sort String - field1(n) ----------------------------------- Line4,89,gerbil,88,Jerry Line1,123,cat,79,Tiddles Line6,123,goldfish,23,Fred Line3,278,aardvark,9,Digger Line2,427,dog,298,Jack Line5,427,ferret,706,Faustus =================================== Sort String - field1(d) ----------------------------------- Line4,89,gerbil,88,Jerry Line2,427,dog,298,Jack Line5,427,ferret,706,Faustus Line3,278,aardvark,9,Digger Line1,123,cat,79,Tiddles Line6,123,goldfish,23,Fred =================================== Sort String - field1(nd),field2(d) ----------------------------------- Line5,427,ferret,706,Faustus Line2,427,dog,298,Jack Line3,278,aardvark,9,Digger Line6,123,goldfish,23,Fred Line1,123,cat,79,Tiddles Line4,89,gerbil,88,Jerry =================================== Sort String - field2(d),field3 ----------------------------------- Line6,123,goldfish,23,Fred Line4,89,gerbil,88,Jerry Line5,427,ferret,706,Faustus Line2,427,dog,298,Jack Line1,123,cat,79,Tiddles Line3,278,aardvark,9,Digger =================================== Sort String - field4(d) ----------------------------------- Line1,123,cat,79,Tiddles Line4,89,gerbil,88,Jerry Line2,427,dog,298,Jack Line6,123,goldfish,23,Fred Line5,427,ferret,706,Faustus Line3,278,aardvark,9,Digger =================================== Sort String - field3 ----------------------------------- Line6,123,goldfish,23,Fred Line2,427,dog,298,Jack Line5,427,ferret,706,Faustus Line1,123,cat,79,Tiddles Line4,89,gerbil,88,Jerry Line3,278,aardvark,9,Digger =================================== Sort String - field3(n) ----------------------------------- Line3,278,aardvark,9,Digger Line6,123,goldfish,23,Fred Line1,123,cat,79,Tiddles Line4,89,gerbil,88,Jerry Line2,427,dog,298,Jack Line5,427,ferret,706,Faustus ===================================
I hope this is helpful.
Update: Added headers for each sort operation to make it clearer what is going on.
Cheers,
JohnGG
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re^2: Dynamic sort criteria for an Array in Perl
by ftonjes (Initiate) on Sep 10, 2015 at 17:57 UTC |