Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw

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

by mirod (Canon)
on Nov 02, 2001 at 15:17 UTC ( #122781=note: print w/replies, xml ) Need Help??

in reply to Re: How do I create a sort sub on-the-fly?
in thread How do I create a sort sub on-the-fly?

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 }

Replies are listed 'Best First'.
Re (tilly) 3: How do I create a sort sub on-the-fly?
by tilly (Archbishop) on Nov 02, 2001 at 18:41 UTC
    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...
Re: Re: Re: How do I create a sort sub on-the-fly?
by CharlesClarkson (Curate) on Nov 06, 2001 at 11:12 UTC

    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 ''; # 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

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://122781]
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (10)
As of 2018-06-19 15:19 GMT
Find Nodes?
    Voting Booth?
    Should cpanminus be part of the standard Perl release?

    Results (114 votes). Check out past polls.