in reply to Re^5: Building a sorting subroutine on the fly
in thread Building a sorting subroutine on the fly
sub sort_by_column { my $self = shift; my $columns_selected_ref = shift; my %data = %{$self}; _validate_args($columns_selected_ref, \%fp); $columns_selected_ref = _verify_presence_of_index(\%data, $columns_selected_ref); my @records; foreach my $k (keys %data) { push (@records, $data{$k}) unless ($reserved{$k}); } my $sortref = _sort_maker( map { _make_single_comparator( $_ ) } @{$columns_selected_ref} ); return _extract_columns_selected( [ sort $sortref @records ], $columns_selected_ref, ); } sub _verify_presence_of_index { my $dataref = shift; my $columns_selected_ref = shift; my @fields = @{$dataref->{fields}}; my $index = ${$dataref}{index}; my @columns_selected = @{$columns_selected_ref}; my %cols = map {$_, 1} @columns_selected; unless ($cols{$fields[$index]}) { # line 205 carp "Field '$fields[$index]' which serves as unique index for + records must be one of the columns selected for output; adding it to + end of list of columns selected: $!"; push @columns_selected, $fields[$index]; } return [ @columns_selected ]; } sub _sort_maker { my @littlesubs = @_; sub { foreach my $sub (@littlesubs) { my $result = $sub->(); return $result if $result; } }; } sub _make_single_comparator { my $field = shift; my $sort_order = $fp{$field}->[1]; my $sort_type = $fp{$field}->[2]; my $idx = $fieldlabels{$field}; no warnings qw(uninitialized numeric); 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{$sort_order}{$sort_type}; } sub _extract_columns_selected { my ($intermed_ref, $columns_selected_ref) = @_; my @results; foreach my $record (@{$intermed_ref}) { my @temp; foreach my $col (@{$columns_selected_ref}) { push @temp, $record->[$fieldlabels{$col}]; } push @results, [ @temp ]; } return [ @results ]; }
Thanks again, tanktalus and brian.
Jim Keenan
|
|---|