comment on

I have, for some time been helping a beginner with a project. After offering a couple of solutions and a pointer or 2, I came up with this rather convoluted solution (below) and another straightforward one (using Sort::Fields). As luck would have it, my friend liked the approach below better. (No, really, I do have friends.)

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

BEGIN {
    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 eq 'source' ? 'cmp' : '<=>';
        if ($order eq 'd') {
            push @sort_sub,
                qq|\@\$::b[$field{$name}] $cmp \@\$::a[$field{$name}]|
+;
            push @sort_description, |$name:\t\tdescending|;
        } else {
            push @sort_sub,
                qq|\@\$::a[$field{$name}] $cmp \@\$::b[$field{$name}]|
+;
            push @sort_description, |$name:\t\tascending|;
        }
    }
    my $sort_sub = join "\n\t\t\t || \n\t", @sort_sub;

    # This is the part I wish to find a better solution for
    # And here is where we create sort.pl
    {
        my $file_name = 'sort.pl';
        open my $fh2, '>', $file_name
                   or die "Cannot open $file_name for write: $!";
            print $fh2
                qq|sub column_sort {\n|,
                qq|\t$sort_sub;|,
                qq|\n}\n1;\n|;
    }
    sub records {
        return @records;
    }
    sub sort_description {
        return join "\n", @sort_description;
    }
}

require 'sort.pl'; # created with BEGIN

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

### store report data in file
# changed from "$date.txt" to conform to winblows
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|;
    print $fh (join ',', @$_), "\n" for sort column_sort records;

__END__
[download]

Here is the report file: test.dat

report:  sort lnum-a,source-a,hits-d,sip-d,time-a
Monmouth,2000-05-2000:00:09-04,192.35.75.69,138,192.100.255,66,2,105,1
+234
Jackson,2000-04-2100:00:10-05,192.35.12.03,144,192.67.29,134,8,101,148
+7
Meade,2001-01-0500:00:11-04,213.132.32,175,184.57.62.35,151,12,107,153
+2
Yuma,200-03-1100:00:12-05,210.0.0.0,156,192.78.54.21,156,10,105,1578
Monmouth,200-04-1000:00:10-08,63.0.0.0,125,192.45.67.2,159,16,101,1879
Lewis,2000-03-1200:21:45-32,167.54.80.65,144,192.67.29,134,32,107,1487
Hero,2001-01-0500:00:11-04,211.34.78.93,132,184.57.62.35,151,12,101,15
+32
Jackson,2000-01-0500:00:11-04,193.0.0.195,175,184.57.62.35,151,14,105,
+153
[download]

Finally, here are the sort.pl and out.txt files.

sub column_sort {
    @$::a[8] <=> @$::b[8]
             || 
    @$::a[0] cmp @$::b[0]
             || 
    @$::b[6] <=> @$::a[6]
             || 
    @$::b[2] <=> @$::a[2]
             || 
    @$::a[1] <=> @$::b[1];
}
1;
[download]

        REQUEST FOR SORTING

lnum:           ascending
source:         ascending
hits:           descending
sip:            descending
time:           ascending

FILE WAS GENERATED ON:  Thu-Nov--1-23:00:53-2001 

Jackson,2000-01-0500:00:11-04,193.0.0.195,175,184.57.62.35,151,14,105,
+153
Monmouth,2000-05-2000:00:09-04,192.35.75.69,138,192.100.255,66,2,105,1
+234
Jackson,2000-04-2100:00:10-05,192.35.12.03,144,192.67.29,134,8,101,148
+7
Lewis,2000-03-1200:21:45-32,167.54.80.65,144,192.67.29,134,32,107,1487
Hero,2001-01-0500:00:11-04,211.34.78.93,132,184.57.62.35,151,12,101,15
+32
Meade,2001-01-0500:00:11-04,213.132.32,175,184.57.62.35,151,12,107,153
+2
Yuma,200-03-1100:00:12-05,210.0.0.0,156,192.78.54.21,156,10,105,1578
Monmouth,200-04-1000:00:10-08,63.0.0.0,125,192.45.67.2,159,16,101,1879
[download]

I would really like to get rid of the extra file. I don't mind keeping the BEGIN block, but I don't want to lose or go around strict. The files are small and a large sort routine is not a big deal.

Thanks,
Charles K. Clarkson

Edit kudra, 2001-11-04 Added readmore

In reply to How do I create a sort sub on-the-fly? by CharlesClarkson

Are you posting in the right place? Check out Where do I post X? to know for sure.
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
Want more info? How to link or How to display code and escape characters are good places to start.


Perl: the Markov chain saw
	PerlMonks