Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight

Re: Sorting by column

by ph0enix (Friar)
on Sep 16, 2009 at 11:55 UTC ( [id://795579]=note: print w/replies, xml ) Need Help??

in reply to Sorting by column

Try following column-oriented sort script. Columns are expected to be delimited by one or more whitespaces. You can specify column(s) and column type to be used for sorting.

#!/usr/bin/perl -w # # Description: # Column oriented sort utility # my @columns; my $column; my $type; my $first; my $line; my $sort_code; my $sort_tmpl = q|sub sort_sub { my @col_a = split(/\s+/, $a); my @col_b = split(/\s+/, $b); __SORT_CODE__ }|; sub print_usage { my $exit = shift || 0; my $error = shift; print qq|Usage: $0 <column>[,<column>]+ [file] Column oriented sort. Input data columns are expected to be delimited by one or more whitespaces. Param(s): column - number of column (starting from 1) to be used for sorting. Use suffix to specify column type. Available suffixes a - column is text (default) d - column is decimal number x - column is hexadecimal number file - source data file. Data are read from STDIN if omitted Example: $0 3d,2x,4 /input/data Sort content of /input/data using 1. 3rd column as decimal number, 2. 2nd column as hexadecimal number and 3. finaly 4th column as text |; print "ERROR: $error\n" if ($error); exit $exit; } print_usage(1, "Missing params") if (@ARGV < 1); print_usage(0) if ($ARGV[0] =~ /^--?h(e(lp?)?)?/); @columns = split(/,/, shift @ARGV); print_usage(1, "Incorrect 'column(s)' param") if (!@columns); $first = 1; $line = <>; for (@columns) { $sort_code .= "|| " if (!$first); if ($_ =~ /^(\d+)(.)?/) { $column = $1 - 1; $type = $2 ? lc($2) : 'a'; $type = 'a' if ($type !~ /^(?:a|d|x)$/); if ($type eq 'x') { $sort_code .= "hex(\$col_a[$column]) <=> hex(\ +$col_b[$column]) "; } elsif($type eq 'd') { $sort_code .= "\$col_a[$column] <=> \$col_b[$c +olumn] "; } else { $sort_code .= "\$col_a[$column] cmp \$col_b[$c +olumn] "; } } else { print_usage(1, "Incorrect 'column(s)' param"); } $first = 0; } $sort_code .= ";\n"; $sort_tmpl =~ s/__SORT_CODE__/$sort_code/; eval $sort_tmpl; print sort sort_sub $line, <>;

Log In?

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://795579]
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others studying the Monastery: (4)
As of 2024-06-14 22:43 GMT
Find Nodes?
    Voting Booth?

    No recent polls found

    erzuuli‥ 🛈The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.