Re: Re: How do I create a sort sub on-the-fly?

[mirod]

No need to be ashamed of the eval, it's a standard technique in happy programs (who said "programs that generate other programs are the happiest programs of all"?).

For a simple case like ascending/descending you can just generate the coderef at once:

sub sortmaker {
  my $order = shift;
  my $sub = $order ? sub { $a <=> $b } : sub {$b <=> $a};
  return $sub;
}

but if you need to build the subroutine then eval is the way to go. I would write it a little more verbosely though:

sub sortmaker {
  my $order = shift;
  my $clause = $order ? '$a <=> $b' : '$b <=> $a';
  my $sub= eval "sub { $clause}";  # create the coderef
  return $sub;                                # explicitely return it
}

[tilly]

I recommend against using a string eval without checking $@ and putting in an error check showing both the error and the generated code that produced that error. Else you could easily have a small typo and never know it, leading to much puzzling about why your sort worked strangely.

But luckily, even for complex sorts, you don't need eval. Instead for each specific clause you can build a function that takes that clause and produces a sort function from it. If you have multiple clauses, then you can combine them easily. Just walk through your clauses, building up an array of comparisons you want to do, and then call something like this:

# Takes a list of comparison subroutines for a sort, and
# returns a combined comparison subroutine.
sub combine_comp_subs {
  my @subs = @_;
  if (1 == @subs) {
    return shift @subs;
  }
  else {
    return sub {
      foreach my $sub (@subs) {
        my $c = $sub->();
        return $c if $c;
      }
      return 0;
    };
  }
}

And now the main problem you have is figuring out how to set up your data structure to compare, and how to turn the individual conditions into individual sort subs. But you have the same problem with an eval solution...

[CharlesClarkson]

Thanks to blakem and mirod my code looks like this.

#!/usr/bin/perl
use strict;
use diagnostics;
use Time::Local;

my (@records, @report);
{
    my $data_file = 'test.dat';
    open my $fh, $data_file or die "Can't open $data_file: $!";
        while (<$fh>) {
            # skip blank and commented lines
            next if /^\s*#/;
            next if /^\s*$/;

            chomp;

            # We'll look for lines that describe a report:
            if (/report:\s+sort\s+(\S*)/ )  {
                @report = split /,/, $1;
            } else {
                push @records, [split /,/];
            }
        }
}
my %field = (   source  => 0,
                time    => 1,
                sip     => 2,
                sport   => 3,
                dip     => 4,
                dport   => 5,
                hits    => 6,
                acl     => 7,
                lnum    => 8
                );

my (@sort_sub, @sort_description);

# Here is where we do the sub building
foreach (@report) {
    my ($name, $order) = split /-/;
    my $cmp = $name =~ /source|time/ ? 'cmp' : '<=>';
    if ($order eq 'd') {
        push @sort_sub,
            qq|\@\$::b[$field{$name}] $cmp \@\$::a[$field{$name}]|;
        push @sort_description, qq|$name:\t\tdescending|;
    } else {
        push @sort_sub,
            qq|\@\$::a[$field{$name}] $cmp \@\$::b[$field{$name}]|;
        push @sort_description, qq|$name:\t\tascending|;
    }
}

# require 'sort.pl'; # created with begin

my $date    = localtime;
$date       =~ s/ /-/g;

### store report data in file
my $report_file_name = 'out.txt';
open my $fh, '>', $report_file_name
        or die "Can't Open $report_file_name: $!";
    print $fh
        qq|\t\tREQUEST FOR SORTING\n\n|,
        sort_description(), "\n\n",
        qq|FILE WAS GENERATED ON:  $date \n\n|;

    my $sort = column_sort(\@sort_sub);
    print $fh (join ',', @$_), "\n" for sort $sort @records;

sub column_sort {
    my $ref = shift;
    my $sort_sub = join " || ", @$ref;
    return eval "sub { $sort_sub }";
}
sub sort_description {
    return join "\n", @sort_description;
}

__END__




Thanks for the help,
Charles K. Clarkson