#!/usr/bin/perl -w
$VERSION
=
"0.01_52"
;
my
$sort_type
=
'alpha'
;
my
$reverse
;
my
$ignore_leading_blanks
;
my
$ignore_case
;
my
$ignore_nonprinting
;
my
$perlscript
;
my
@modules
;
my
$cmp_perlscript
;
Getopt::Long::Configure(
"bundling"
);
GetOptions(
"n|numeric-sort"
=>
sub
{
$sort_type
=
'numeric'
},
"N|natural-sort"
=>
sub
{
$sort_type
=
'sort_naturally'
},
"V|version-sort"
=>
sub
{
$sort_type
=
'version'
},
"C|compare-function=s"
=> \
$cmp_perlscript
,
"b|ignore-leading-blanks"
=> \
$ignore_leading_blanks
,
"f|ignore-case"
=> \
$ignore_case
,
"i|ignore-nonprinting"
=> \
$ignore_nonprinting
,
"r|reverse"
=> \
$reverse
,
"e|field-function=s"
=> \
$perlscript
,
'M|module=s@'
=> \
@modules
,
"v|version"
=>
sub
{
print
"psort version $VERSION\n"
;
exit
0;
},
) or
die
<<EOF;
usage: $0 [-n | -N | -V | -C ...] [-r] -e ...
-n: compare numerically
-N: compare using Sort::Naturally
-V: compare versions
-C: compare using any perl code (\$a and \$b are defined)
-r: reverse sorting
-e: perl oneliner, should return the value to be compared as last value
-M: add perl modules
EOF
if
(
$cmp_perlscript
) {
$sort_type
=
eval
"sub { $cmp_perlscript }"
;
die
"Cannot compile 'cmp' code: $@"
if
$@;
}
for
my
$module_spec
(
@modules
) {
my
(
$module
,
$imports
) =
split
/=/,
$module_spec
, 2;
eval
qq{require $module}
;
die
$@
if
$@;
my
@imports
;
if
(
defined
$imports
) {
@imports
=
split
/,/,
$imports
;
$module
->
import
(
@imports
);
}
}
my
@data
;
my
$cb
=
defined
$perlscript
?
do
{
my
$sub
=
eval
"sub { $perlscript }"
;
die
"Cannot compile code: $@"
if
$@;
$sub
;
} :
sub
{
$_
};
if
(
@ARGV
) {
for
my
$file
(
@ARGV
) {
add_psort(
do
{
open
my
$fh
,
$file
or
die
"Can't open $file: $!"
;
$fh
});
}
}
else
{
add_psort(\
*STDIN
);
}
if
(
$sort_type
eq
'numeric'
) {
no
warnings
'numeric'
,
'uninitialized'
;
if
(
$reverse
) {
@data
=
sort
{
$b
->[1] <=>
$a
->[1] }
@data
;
}
else
{
@data
=
sort
{
$a
->[1] <=>
$b
->[1] }
@data
;
}
}
elsif
(
$sort_type
eq
'alpha'
) {
no
warnings
'uninitialized'
;
if
(
$reverse
) {
@data
=
sort
{
$b
->[1] cmp
$a
->[1] }
@data
;
}
else
{
@data
=
sort
{
$a
->[1] cmp
$b
->[1] }
@data
;
}
}
elsif
(
$sort_type
eq
'sort_naturally'
) {
no
warnings
'uninitialized'
;
if
(
$reverse
) {
@data
=
sort
{ Sort::Naturally::ncmp(
$b
->[1],
$a
->[1]) }
@data
;
}
else
{
@data
=
sort
{ Sort::Naturally::ncmp(
$a
->[1],
$b
->[1]) }
@data
;
}
}
elsif
(
$sort_type
eq
'version'
) {
no
warnings
'uninitialized'
;
if
(
$reverse
) {
@data
=
sort
{ CPAN::Version->vcmp(
$b
->[1],
$a
->[1]) }
@data
;
}
else
{
@data
=
sort
{ CPAN::Version->vcmp(
$a
->[1],
$b
->[1]) }
@data
;
}
}
elsif
(UNIVERSAL::isa(
$sort_type
,
'CODE'
)) {
no
warnings
'uninitialized'
;
if
(
$reverse
) {
@data
=
sort
{
local
(
$a
,
$b
) = (
$b
->[1],
$a
->[1]);
$sort_type
->() }
@data
;
}
else
{
@data
=
sort
{
local
(
$a
,
$b
) = (
$a
->[1],
$b
->[1]);
$sort_type
->() }
@data
;
}
}
else
{
die
"Unhandled sort type '$sort_type'"
;
}
for
(
@data
) {
print
$_
->[0];
}
sub
add_psort {
my
(
$fh
) =
@_
;
while
(<
$fh
>) {
my
$line
=
$_
;
my
$res
=
$cb
->(
$_
);
$res
=
lc
$res
if
$ignore_case
;
$res
=~ s{^\s+}{}
if
$ignore_leading_blanks
;
$res
=~ s{[[:^
print
]]}{}g
if
$ignore_nonprinting
;
push
@data
, [
$line
,
$res
];
}
}