File-Sort-1.01/Makefile.PL 100666 000000 000000 363 7423375625 15763 0 ustar 00unknown unknown 0 0 #!perl -w
use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
WriteMakefile(
'NAME' => 'File::Sort',
'VERSION_FROM' => 'Sort.pm', # finds $VERSION
);
File-Sort-1.01/MANIFEST 100666 000000 000000 144 7423375625 15137 0 ustar 00unknown unknown 0 0 Makefile.PL
MANIFEST
README
Sort.pm
Sort.pm_rsorted.txt
Sort.pm_sorted.txt
eg/sort.pudge.PL
test.pl
File-Sort-1.01/README 100666 000000 000000 2275 7423375625 14715 0 ustar 00unknown unknown 0 0 This is File::Sort, for sorting files similarly to sort(1). Written
primarily for MacPerl users who do not have sort(1) and because of memory
limitations cannot sort files in memory, but works on all perls, and can
be useful for portable sorting of large files, or for any system that
doesn't have a sort(1) and is virtual-memory-deprived (including Windows).
See HISTORY in the POD for changes.
This archive can always be obtained from:
http://sf.net/projects/file-sort/
http://www.cpan.org/authors/id/CNANDOR/
http://www.cpan.org/modules/by-module/File/
Please let me know how well it does(n't) work, and any changes you'd
like to see.
The sort.pudge program in eg/ does not actually use the File::Sort
module; the actual File::Sort module sources are included in the
program itself, as it is written for distribution with the PPT
project .
Copyright (c) 1997-2002 Chris Nandor. All rights reserved. This program
is free software; you can redistribute it and/or modify it under the same
terms as Perl itself.
--
Chris Nandor pudge@pobox.com http://pudge.net/
Open Source Development Network pudge@osdn.com http://osdn.com/
File-Sort-1.01/Sort.pm 100666 000000 000000 75160 7423375625 15345 0 ustar 00unknown unknown 0 0 package File::Sort;
use Carp;
use Fcntl qw(O_RDONLY O_WRONLY O_CREAT O_TRUNC);
use Symbol qw(gensym);
use strict;
use locale;
use vars qw($VERSION *sortsub *sort1 *sort2 *map1 *map2 %fh);
require Exporter;
use vars qw(@ISA @EXPORT_OK);
@ISA = 'Exporter';
@EXPORT_OK = 'sort_file';
$VERSION = '1.01';
sub sort_file {
my @args = @_;
if (ref $args[0]) {
# fix pos to look like k
if (exists $args[0]{'pos'}) {
my @argv;
my $pos = $args[0]{'pos'};
if (!ref $pos) {
$pos = [$pos];
}
if (!exists $args[0]{'k'}) {
$args[0]{'k'} = [];
} elsif (!ref $args[0]{'k'}) {
$args[0]{'k'} = [$args[0]{'k'}];
}
for (@$pos) {
my $n;
if ( /^\+(\d+)(?:\.(\d+))?([bdfinr]+)?
(?:\s+\-(\d+)(?:\.(\d+))?([bdfinr]+)?)?$/x) {
$n = $1 + 1;
$n .= '.' . ($2 + 1) if defined $2;
$n .= $3 if $3;
if (defined $4) {
$n .= "," . (defined $5 ? ($4 + 1) . ".$5" : $4);
$n .= $6 if $6;
}
push @{$args[0]{'k'}}, $n;
}
}
}
_sort_file(@args);
} else {
_sort_file({I => $args[0], o => $args[1]});
}
}
sub _sort_file {
local $\; # don't mess up our prints
my($opts, @fh, @recs) = shift;
# record separator, default to \n
local $/ = $opts->{R} ? $opts->{R} : "\n";
# get input files into anon array if not already
$opts->{I} = [$opts->{I}] unless ref $opts->{I};
usage() unless @{$opts->{I}};
# "K" == "no k", for later
$opts->{K} = $opts->{k} ? 0 : 1;
$opts->{k} = $opts->{k} ? [$opts->{k}] : [] if !ref $opts->{k};
# set output and other defaults
$opts->{o} = !$opts->{o} ? '' : $opts->{o};
$opts->{'y'} ||= $ENV{MAX_SORT_RECORDS} || 200000; # default max records
$opts->{F} ||= $ENV{MAX_SORT_FILES} || 40; # default max files
# see big ol' mess below
_make_sort_sub($opts);
# only check to see if file is sorted
if ($opts->{c}) {
local *F;
my $last;
if ($opts->{I}[0] eq '-') {
open(F, $opts->{I}[0])
or die "Can't open `$opts->{I}[0]' for reading: $!";
} else {
sysopen(F, $opts->{I}[0], O_RDONLY)
or die "Can't open `$opts->{I}[0]' for reading: $!";
}
while (defined(my $rec = )) {
# fail if -u and keys are not unique (assume sorted)
if ($opts->{u} && $last) {
return 0 unless _are_uniq($opts->{K}, $last, $rec);
}
# fail if records not in proper sort order
if ($last) {
my @foo;
if ($opts->{K}) {
local $^W;
@foo = sort sort1 ($rec, $last);
} else {
local $^W;
@foo = map {$_->[0]} sort sortsub
map &map1, ($rec, $last);
}
return 0 if $foo[0] ne $last || $foo[1] ne $rec;
}
# save value of last record
$last = $rec;
}
# success, yay
return 1;
# if merging sorted files
} elsif ($opts->{'m'}) {
foreach my $filein (@{$opts->{I}}) {
# just open files and get array of handles
my $sym = gensym();
sysopen($sym, $filein, O_RDONLY)
or die "Can't open `$filein' for reading: $!";
push @fh, $sym;
}
# ooo, get ready, get ready
} else {
# once for each input file
foreach my $filein (@{$opts->{I}}) {
local *F;
my $count = 0;
_debug("Sorting file $filein ...\n") if $opts->{D};
if ($filein eq '-') {
open(F, $filein)
or die "Can't open `$filein' for reading: $!";
} else {
sysopen(F, $filein, O_RDONLY)
or die "Can't open `$filein' for reading: $!";
}
while (defined(my $rec = )) {
push @recs, $rec;
$count++; # keep track of number of records
if ($count >= $opts->{'y'}) { # don't go over record limit
_debug("$count records reached in `$filein'\n")
if $opts->{D};
# save to temp file, add new fh to array
push @fh, _write_temp(\@recs, $opts);
# reset record count and record array
($count, @recs) = (0);
# do a merge now if at file limit
if (@fh >= $opts->{F}) {
# get filehandle and restart array with it
@fh = (_merge_files($opts, \@fh, [], _get_temp()));
_debug("\nCreating temp files ...\n") if $opts->{D};
}
}
}
close F;
}
# records leftover, didn't reach record limit
if (@recs) {
_debug("\nSorting leftover records ...\n") if $opts->{D};
_check_last(\@recs);
if ($opts->{K}) {
local $^W;
@recs = sort sort1 @recs;
} else {
local $^W;
@recs = map {$_->[0]} sort sortsub map &map1, @recs;
}
}
}
# do the merge thang, uh huh, do the merge thang
my $close = _merge_files($opts, \@fh, \@recs, $opts->{o});
close $close unless fileno($close) == fileno('STDOUT'); # don't close STDOUT
_debug("\nDone!\n\n") if $opts->{D};
return 1; # yay
}
# take optional arrayref of handles of sorted files,
# plus optional arrayref of sorted scalars
sub _merge_files {
# we need the options, filehandles, and output file
my($opts, $fh, $recs, $file) = @_;
my($uniq, $first, $o, %oth);
# arbitrarily named keys, store handles as values
%oth = map {($o++ => $_)} @$fh;
# match handle key in %oth to next record of the handle
%fh = map {
my $fh = $oth{$_};
($_ => scalar <$fh>);
} keys %oth;
# extra records, special X "handle"
$fh{X} = shift @$recs if @$recs;
_debug("\nCreating sorted $file ...\n") if $opts->{D};
# output to STDOUT if no output file provided
if ($file eq '') {
$file = \*STDOUT;
# if output file is a path, not a reference to a file, open
# file and get a reference to it
} elsif (!ref $file) {
my $tfh = gensym();
sysopen($tfh, $file, O_WRONLY|O_CREAT|O_TRUNC)
or die "Can't open `$file' for writing: $!";
$file = $tfh;
}
my $oldfh = select $file;
$| = 0; # just in case, use the buffer, you knob
while (keys %fh) {
# don't bother sorting keys if only one key remains!
if (!$opts->{u} && keys %fh == 1) {
($first) = keys %fh;
my $curr = $oth{$first};
my @left = $first eq 'X' ? @$recs : <$curr>;
print $fh{$first}, @left;
delete $fh{$first};
last;
}
{
# $first is arbitrary number assigned to first fh in sort
if ($opts->{K}) {
local $^W;
($first) = (sort sort2 keys %fh);
} else {
local $^W;
($first) = (map {$_->[0]} sort sortsub
map &map2, keys %fh);
}
}
# don't print if -u and not unique
if ($opts->{u}) {
print $fh{$first} if
(!$uniq || _are_uniq($opts->{K}, $uniq, $fh{$first}));
$uniq = $fh{$first};
} else {
print $fh{$first};
}
# get current filehandle
my $curr = $oth{$first};
# use @$recs, not filehandles, if key is X
my $rec = $first eq 'X' ? shift @$recs : scalar <$curr>;
if (defined $rec) { # bring up next record for this filehandle
$fh{$first} = $rec;
} else { # we don't need you anymore
delete $fh{$first};
}
}
seek $file, 0, 0; # might need to read back from it
select $oldfh;
return $file;
}
sub _check_last {
# add new record separator if not one there
${$_[0]}[-1] .= $/ if (${$_[0]}[-1] !~ m|$/$|);
}
sub _write_temp {
my($recs, $opts) = @_;
my $temp = _get_temp() or die "Can't get temp file: $!";
_check_last($recs);
_debug("New tempfile: $temp\n") if $opts->{D};
if ($opts->{K}) {
local $^W;
print $temp sort sort1 @{$recs};
} else {
local $^W;
print $temp map {$_->[0]} sort sortsub map &map1, @{$recs};
}
seek $temp, 0, 0; # might need to read back from it
return $temp;
}
sub _parse_keydef {
my($k, $topts) = @_;
# gurgle
$k =~ /^(\d+)(?:\.(\d+))?([bdfinr]+)?
(?:,(\d+)(?:\.(\d+))?([bdfinr]+)?)?$/x;
# set defaults at zero or undef
my %opts = (
%$topts, # get other options
ksf => $1 || 0, # start field
ksc => $2 || 0, # start field char start
kst => $3 || '', # start field type
kff => (defined $4 ? $4 : undef), # end field
kfc => $5 || 0, # end field char end
kft => $6 || '', # end field type
);
# their idea of 1 is not ours
for (qw(ksf ksc kff)) { # kfc stays same
$opts{$_}-- if $opts{$_};
}
# if nothing in kst or kft, use other flags possibly passed
if (!$opts{kst} && !$opts{kft}) {
foreach (qw(b d f i n r)) {
$opts{kst} .= $_ if $topts->{$_};
$opts{kft} .= $_ if $topts->{$_};
}
# except for b, flags on one apply to the other
} else {
foreach (qw(d f i n r)) {
$opts{kst} .= $_ if ($opts{kst} =~ /$_/ || $opts{kft} =~ /$_/);
$opts{kft} .= $_ if ($opts{kst} =~ /$_/ || $opts{kft} =~ /$_/);
}
}
return \%opts;
}
sub _make_sort_sub {
my($topts, @sortsub, @mapsub, @sort1, @sort2) = shift;
# if no keydefs set
if ($topts->{K}) {
$topts->{kst} = '';
foreach (qw(b d f i n r)) {
$topts->{kst} .= $_ if $topts->{$_};
}
# more complex stuff, act like we had -k defined
if ($topts->{kst} =~ /[bdfi]/) {
$topts->{K} = 0;
$topts->{k} = ['K']; # special K ;-)
}
}
# if no keydefs set
if ($topts->{K}) {
_debug("No keydef set\n") if $topts->{D};
# defaults for main sort sub components
my($cmp, $aa, $bb, $fa, $fb) = qw(cmp $a $b $fh{$a} $fh{$b});
# reverse sense
($bb, $aa, $fb, $fa) = ($aa, $bb, $fa, $fb) if $topts->{r};
# do numeric sort
$cmp = '<=>' if $topts->{n};
# add finished expression to array
my $sort1 = "sub { $aa $cmp $bb }\n";
my $sort2 = "sub { $fa $cmp $fb }\n";
_debug("$sort1\n$sort2\n") if $topts->{D};
{
local $^W;
*sort1 = eval $sort1;
die "Can't create sort sub: $@" if $@;
*sort2 = eval $sort2;
die "Can't create sort sub: $@" if $@;
}
} else {
# get text separator or use whitespace
$topts->{t} =
defined $topts->{X} ? $topts->{X} :
defined $topts->{t} ? quotemeta($topts->{t}) :
'\s+';
$topts->{t} =~ s|/|\\/|g if defined $topts->{X};
foreach my $k (@{$topts->{k}}) {
my($opts, @fil) = ($topts);
# defaults for main sort sub components
my($cmp, $ab_, $fab_, $aa, $bb) = qw(cmp $_ $fh{$_} $a $b);
# skip stuff if special K
$opts = $k eq 'K' ? $topts : _parse_keydef($k, $topts);
if ($k ne 'K') {
my($tmp1, $tmp2) = ("\$tmp[$opts->{ksf}]",
($opts->{kff} ? "\$tmp[$opts->{kff}]" : ''));
# skip leading spaces
if ($opts->{kst} =~ /b/) {
$tmp1 = "($tmp1 =~ /(\\S.*)/)[0]";
}
if ($opts->{kft} =~ /b/) {
$tmp2 = "($tmp2 =~ /(\\S.*)/)[0]";
}
# simpler if one field, goody for us
if (! defined $opts->{kff} || $opts->{ksf} == $opts->{kff}) {
# simpler if chars are both 0, wicked pissah
if ($opts->{ksc} == 0 &&
(!$opts->{kfc} || $opts->{kfc} == 0)) {
@fil = "\$tmp[$opts->{ksf}]";
# hmmmmm
} elsif (!$opts->{kfc}) {
@fil = "substr($tmp1, $opts->{ksc})";
# getting out of hand now
} else {
@fil = "substr($tmp1, $opts->{ksc}, ".
($opts->{kfc} - $opts->{ksc}) . ')';
}
# try again, shall we?
} else {
# if spans two fields, but chars are both 0
# and neither has -b, alrighty
if ($opts->{kfc} == 0 && $opts->{ksc} == 0 &&
$opts->{kst} !~ /b/ && $opts->{kft} !~ /b/) {
@fil = "join(''," .
"\@tmp[$opts->{ksf} .. $opts->{kff}])";
# if only one field away
} elsif (($opts->{kff} - $opts->{ksf}) == 1) {
@fil = "join('', substr($tmp1, $opts->{ksc}), " .
"substr($tmp2, 0, $opts->{kfc}))";
# fine, have it your way! hurt me! love me!
} else {
@fil = "join('', substr($tmp1, $opts->{ksc}), " .
"\@tmp[" . ($opts->{ksf} + 1) . " .. " .
($opts->{kff} - 1) . "], " .
"substr($tmp2, 0, $opts->{kfc}))";
}
}
} else {
@fil = $opts->{kst} =~ /b/ ?
"(\$tmp[0] =~ /(\\S.*)/)[0]" : "\$tmp[0]";
}
# fold to upper case
if ($opts->{kst} =~ /f/) {
$fil[0] = "uc($fil[0])";
}
# only alphanumerics and whitespace, override -i
if ($opts->{kst} =~ /d/) {
$topts->{DD}++;
push @fil, "\$tmp =~ s/[^\\w\\s]+//g", '"$tmp"';
# only printable characters
} elsif ($opts->{kst} =~ /i/) {
require POSIX;
$fil[0] = "join '', grep {POSIX::isprint \$_} " .
"split //,\n$fil[0]";
}
$fil[0] = "\$tmp = $fil[0]" if $opts->{kst} =~ /d/;
# reverse sense
($bb, $aa) = ($aa, $bb) if ($opts->{kst} =~ /r/);
# do numeric sort
$cmp = '<=>' if ($opts->{kst} =~ /n/);
# add finished expressions to arrays
my $n = @sortsub + 2;
push @sortsub, sprintf "%s->[$n] %s %s->[$n]",
$aa, $cmp, $bb;
if (@fil > 1) {
push @mapsub, " (\n" .
join(",\n", map {s/^/ /mg; $_} @fil),
"\n )[-1],\n ";
} else {
push @mapsub, " " . $fil[0] . ",\n ";
}
}
# if not -u
if (! $topts->{u} ) {
# do straight compare if all else is equal
push @sortsub, sprintf "%s->[1] %s %s->[1]",
$topts->{r} ? qw($b cmp $a) : qw($a cmp $b);
}
my(%maps, $sortsub, $mapsub) = (map1 => '$_', map2 => '$fh{$_}');
$sortsub = "sub {\n " . join(" || \n ", @sortsub) . "\n}\n";
for my $m (keys %maps) {
my $k = $maps{$m};
$maps{$m} = sprintf "sub {\n my \@tmp = %s;\n",
$topts->{k}[0] eq 'K' ? $k : "split(/$topts->{t}/, $k)";
$maps{$m} .= " my \$tmp;\n" if $topts->{DD};
$maps{$m} .= "\n [\$_, $k";
$maps{$m} .= ",\n " . join('', @mapsub) if @mapsub;
$maps{$m} .= "]\n}\n";
}
_debug("$sortsub\n$maps{map1}\n$maps{map2}\n") if $topts->{D};
{
local $^W;
*sortsub = eval $sortsub;
die "Can't create sort sub: $@" if $@;
*map1 = eval $maps{map1};
die "Can't create sort sub: $@" if $@;
*map2 = eval $maps{map2};
die "Can't create sort sub: $@" if $@;
}
}
}
sub _get_temp { # nice and simple
require IO::File;
IO::File->new_tmpfile;
}
sub _are_uniq {
my $nok = shift;
local $^W;
if ($nok) {
($a, $b) = @_;
return &sort1;
} else {
($a, $b) = map &map1, @_;
return &sortsub;
}
}
sub _debug {
print STDERR @_;
}
sub usage {
local $/ = "\n"; # in case changed
my $u;
seek DATA, 0, 0;
while () {
last if m/^=head1 SYNOPSIS$/;
}
while () {
last if m/^=/;
$u .= $_;
}
$u =~ s/\n//;
die "Usage:$u";
}
__END__
=head1 NAME
File::Sort - Sort a file or merge sort multiple files
=head1 SYNOPSIS
use File::Sort qw(sort_file);
sort_file({
I => [qw(file_1 file_2)],
o => 'file_new', k => '5.3,5.5rn', -t => '|'
});
sort_file('file1', 'file1.sorted');
=head1 DESCRIPTION
This module sorts text files by lines (or records). Comparisons
are based on one or more sort keys extracted from each line of input,
and are performed lexicographically. By default, if keys are not given,
sort regards each input line as a single field. The sort is a merge
sort. If you don't like that, feel free to change it.
=head2 Options
The following options are available, and are passed in the hash
reference passed to the function in the format:
OPTION => VALUE
Where an option can take multiple values (like C, C, and C),
values may be passed via an anonymous array:
OPTION => [VALUE1, VALUE2]
Where the OPTION is a switch, it should be passed a boolean VALUE
of 1 or 0.
This interface will always be supported, though a more perlish
interface may be offered in the future, as well. This interface
is basically a mapping of the command-line options to the Unix
sort utility.
=over 4
=item C I
Pass in the input file(s). This can be either a single string with the
filename, or an array reference containing multiple filename strings.
=item C
Check that single input fle is ordered as specified by the arguments and
the collating sequence of the current locale. No output is produced;
only the exit code is affected.
=item C
Merge only; the input files are assumed to already be sorted.
=item C I
Specify the name of an I file to be used instead of the standard
output.
=item C
Unique: Suppresses all but one in each set of lines having equal keys.
If used with the B option check that there are no lines with
consecutive lines with duplicate keys, in addition to checking that the
input file is sorted.
=item C I
Maximum number of lines (records) read before writing to temp file.
Default is 200,000. This may eventually change to be kbytes instead of
lines. Lines was easier to implement. Can also specify with
MAX_SORT_RECORDS environment variable.
=item C I
Maximum number of temp files to be held open at once. Default to 40,
as older Windows ports had quite a small limit. Can also specify
with MAX_SORT_FILES environment variable. No temp files will be used
at all if MAX_SORT_RECORDS is never reached.
=item C
Send debugging information to STDERR. Behavior subject to change.
=back
The following options override the default ordering rules. When ordering
options appear independent of any key field specifications, the requested
field ordering rules are applied globally to all sort keys. When attached
to a specific key (see B), the specified ordering options override all
global ordering options for that key.
=over 4
=item C
Specify that only blank characters and alphanumeric characters,
according to the current locale setting, are significant in comparisons.
B overrides B.
=item C
Consider all lower-case characters that have upper-case equivalents,
according to the current locale setting, to be the upper-case equivalent
for the purposes of comparison.
=item C
Ignores all characters that are non-printable, according to the current
locale setting.
=item C
Does numeric instead of string compare, using whatever perl considers to
be a number in numeric comparisons.
=item C
Reverse the sense of the comparisons.
=item C
Ignore leading blank characters when determining the starting and ending
positions of a restricted sort key. If the B option is specified
before the first B option, it is applied to all B options.
Otherwise, the B option can be attached indepently to each
field_start or field_end option argument (see below).
=item C I
Use I as the field separator character; char is not considered
to be part of a field (although it can be included in a sort key). Each
occurrence of char is significant (for example,
EcharEEcharE delimits an empty field). If B is not
specified, blank characters are used as default field separators; each
maximal non-empty sequence of blank characters that follows a non-blank
character is a field separator.
=item C I
Same as B, but I is interpreted as a Perl regular expression
instead. Do not escape any characters (C> characters need to be
escaped internally, and will be escaped for you).
The string matched by I is not included in the fields
themselves, unless demanded by perl's regex and split semantics (e.g.,
regexes in parentheses will add that matched expression as an extra
field). See L and L.
=item C I
Record separator, defaults to newline.
=item C I
The keydef argument is a restricted sort key field definition. The
format of this definition is:
field_start[.first_char][type][,field_end[.last_char][type]]
where field_start and field_end define a key field restricted to a
portion of the line, and type is a modifier from the list of characters
B, B, B, B, B, B. The b modifier behaves like the
B option, but applies only to the field_start or field_end to which
it is attached. The other modifiers behave like the corresponding
options, but apply only to the key field to which they are attached;
they have this effect if specified with field_start, field_end, or both.
If any modifier is attached to a field_start or a field_end, no option
applies to either.
Occurrences of the B option are significant in command line order.
If no B option is specified, a default sort key of the entire line
is used. When there are multiple keys fields, later keys are compared
only after all earlier keys compare equal.
Except when the B option is specified, lines that otherwise compare
equal are ordered as if none of the options B, B, B, B
or B were present (but with B still in effect, if it was
specified) and with all bytes in the lines significant to the
comparison. The order in which lines that still compare equal are
written is unspecified.
=item C I<+pos1 [-pos2]>
Similar to B, these are mostly obsolete switches, but some people
like them and want to use them. Usage is:
+field_start[.first_char][type] [-field_end[.last_char][type]]
Where field_end in B specified the last position to be included,
it specifes the last position to NOT be included. Also, numbers
are counted from 0 instead of 1. B must immediately follow
corresponding B<+pos1>. The rest should be the same as the B option.
Mixing B<+pos1> B with B is allowed, but will result in all of
the B<+pos1> B options being ordered AFTER the B options.
It is best if you Don't Do That. Pick one and stick with it.
Here are some equivalencies:
pos => '+1 -2' -> k => '2,2'
pos => '+1.1 -1.2' -> k => '2.2,2.2'
pos => ['+1 -2', '+3 -5'] -> k => ['2,2', '4,5']
pos => ['+2', '+0b -1'] -> k => ['3', '1b,1']
pos => '+2.1 -2.4' -> k => '3.2,3.4'
pos => '+2.0 -3.0' -> k => '3.1,4.0'
=back
=head2 Not Implemented
If the options are not listed as implemented above, or are not
listed in TODO below, they are not in the plan for implementation.
This includes B and B.
=head1 EXAMPLES
Sort file by straight string compare of each line, sending
output to STDOUT.
use File::Sort qw(sort_file);
sort_file('file');
Sort contents of file by second key in file.
sort_file({k => 2, I => 'file'});
Sort, in reverse order, contents of file1 and file2, placing
output in outfile and using second character of second field
as the sort key.
sort_file({
r => 1, k => '2.2,2.2', o => 'outfile',
I => ['file1', 'file2']
});
Same sort but sorting numerically on characters 3 through 5 of
the fifth field first, and only return records with unique keys.
sort_file({
u => 1, r => 1, k => ['5.3,5.5rn', '2.2,2.2'],
o => 'outfile', I => ['file1', 'file2']
});
Print passwd(4) file sorted by numeric user ID.
sort_file({t => ':', k => '3n', I => '/etc/passwd'});
For the anal sysadmin, check that passwd(4) file is sorted by numeric
user ID.
sort_file({c => 1, t => ':', k => '3n', I => '/etc/passwd'});
=head1 ENVIRONMENT
Note that if you change the locale settings after the program has started
up, you must call setlocale() for the new settings to take effect. For
example:
# get constants
use POSIX 'locale_h';
# e.g., blank out locale
$ENV{LC_ALL} = $ENV{LANG} = '';
# use new ENV settings
setlocale(LC_CTYPE, '');
setlocale(LC_COLLATE, '');
=over 4
=item LC_COLLATE
Determine the locale for ordering rules.
=item LC_CTYPE
Determine the locale for the interpretation of sequences of bytes of
text data as characters (for example, single- versus multi-byte
characters in arguments and input files) and the behaviour of
character classification for the B, B, B, B and B
options.
=item MAX_SORT_RECORDS
Default is 200,000. Maximum number of records to use before writing
to a temp file. Overriden by B option.
=item MAX_SORT_FILES
Maximum number of open temp files to use before merging open temp
files. Overriden by B option.
=back
=head1 EXPORT
Exports C on request.
=head1 TODO
=over 4
=item Better debugging and error reporting
=item Performance hit with -u
=item Do bytes instead of lines
=item Better test suite
=item Switch for turning off locale ... ?
=back
=head1 HISTORY
=over 4
=item v1.01, Monday, January 14, 2002
Change license to be that of Perl.
=item v1.00, Tuesday, November 13, 2001
Long overdue release.
Add O_TRUNC to output open (D'oh!).
Played with somem of the -k options (Marco A. Romero).
Fix filehandle close test of STDOUT (Gael Marziou).
Some cleanup.
=item v0.91, Saturday, February 12, 2000
Closed all files in test.pl so they could be unlinked on some
platforms. (Hubert Toullec)
Documented C option. (Hubert Toullec)
Removed O_EXCL flag from C.
Fixed bug in sorting multiple files. (Paul Eckert)
=item v0.90, Friday, April 30, 1999
Complete rewrite. Took the code from this module to write sort
utility for PPT project, then brought changes back over. As a result
the interface has changed slightly, mostly in regard to what letters
are used for options, but there are also some key behavioral differences.
If you need the old interface, the old module will remain on CPAN, but
will not be supported. Sorry for any inconvenience this may cause.
The good news is that it should not be too difficult to update your
code to use the new interface.
=item v0.20
Fixed bug with unique option (didn't work :).
Switched to sysopen for better portability.
Print to STDOUT if no output file supplied.
Added c option to check sorting.
=item v0.18 (31 January 1998)
Tests 3 and 4 failed because we hit the open file limit in the
standard Windows port of perl5.004_02 (50). Adjusted the default
for total number of temp files from 50 to 40 (leave room for other open
files), changed docs. (Mike Blazer, Gurusamy Sarathy)
=item v0.17 (30 December 1998)
Fixed bug in C<_merge_files> that tried to C a passed
C object.
Fixed up docs and did some more tests and benchmarks.
=item v0.16 (24 December 1998)
One year between releases was too long. I made changes Miko O'Sullivan
wanted, and I didn't even know I had made them.
Also now use C to create temp files, so the TMPDIR option is
no longer supported. Hopefully made the whole thing more robust and
faster, while supporting more options for sorting, including delimited
sorts, and arbitrary sorts.
Made CHUNK default a lot larger, which improves performance. On
low-memory systems, or where (e.g.) the MacPerl binary is not allocated
much RAM, it might need to be lowered.
=item v0.11 (04 January 1998)
More cleanup; fixed special case of no linebreak on last line; wrote test
suite; fixed warning for redefined subs (sort1 and sort2).
=item v0.10 (03 January 1998)
Some cleanup; made it not subject to system file limitations; separated
many parts out into separate functions.
=item v0.03 (23 December 1997)
Added reverse and numeric sorting options.
=item v0.02 (19 December 1997)
Added unique and merge-only options.
=item v0.01 (18 December 1997)
First release.
=back
=head1 THANKS
Mike Blazer Eblazer@mail.nevalink.ruE,
Vicki Brown Evlb@cfcl.comE,
Tom Christiansen Etchrist@perl.comE,
Albert Dvornik Ebert@mit.eduE,
Paul Eckert Epeckert@epicrealm.comE,
Gene Hsu Egene@moreinfo.comE,
Andrew M. Langmead Eaml@world.std.comE,
Gael Marziou Egael_marziou@hp.comE,
Brian L. Matthews Eblm@halcyon.comE,
Rich Morin Erdm@cfcl.comE,
Matthias Neeracher Eneeri@iis.ee.ethz.chE,
Miko O'Sullivan Emiko@idocs.comE,
Tom Phoneix Erootbeer@teleport.comE,
Marco A. Romero Emromero@iglou.comE,
Gurusamy Sarathy Egsar@activestate.comE,
Hubert Toullec EHubert.Toullec@wanadoo.frE.
=head1 AUTHOR
Chris Nandor Epudge@pobox.comE, http://pudge.net/
Copyright (c) 1997-2002 Chris Nandor. All rights reserved. This program
is free software; you can redistribute it and/or modify it under the same
terms as Perl itself.
=head1 VERSION
v1.01, Monday, January 14, 2002
=head1 SEE ALSO
sort(1), locale, PPT project, .
=cut
File-Sort-1.01/Sort.pm_rsorted.txt 100666 000000 000000 75160 7423375625 17725 0 ustar 00unknown unknown 0 0 }
}
}
}
}
}
}
}
}
}
}
written is unspecified.
with MAX_SORT_FILES environment variable. No temp files will be used
will not be supported. Sorry for any inconvenience this may cause.
where field_start and field_end define a key field restricted to a
wanted, and I didn't even know I had made them.
values may be passed via an anonymous array:
v1.01, Monday, January 14, 2002
utility for PPT project, then brought changes back over. As a result
user ID.
use vars qw(@ISA @EXPORT_OK);
use vars qw($VERSION *sortsub *sort1 *sort2 *map1 *map2 %fh);
use strict;
use locale;
use Symbol qw(gensym);
use Fcntl qw(O_RDONLY O_WRONLY O_CREAT O_TRUNC);
use Carp;
up, you must call setlocale() for the new settings to take effect. For
to be part of a field (although it can be included in a sort key). Each
to a temp file. Overriden by B option.
to a specific key (see B), the specified ordering options override all
they have this effect if specified with field_start, field_end, or both.
themselves, unless demanded by perl's regex and split semantics (e.g.,
the interface has changed slightly, mostly in regard to what letters
the fifth field first, and only return records with unique keys.
the collating sequence of the current locale. No output is produced;
the B<+pos1> B options being ordered AFTER the B options.
text data as characters (for example, single- versus multi-byte
terms as Perl itself.
suite; fixed warning for redefined subs (sort1 and sort2).
sub usage {
sub sort_file {
sub _write_temp {
sub _sort_file {
sub _parse_keydef {
sub _merge_files {
sub _make_sort_sub {
sub _get_temp { # nice and simple
sub _debug {
sub _check_last {
sub _are_uniq {
standard Windows port of perl5.004_02 (50). Adjusted the default
specified, blank characters are used as default field separators; each
specified) and with all bytes in the lines significant to the
sorts, and arbitrary sorts.
sort. If you don't like that, feel free to change it.
sort(1), locale, PPT project, .
sort utility.
sort regards each input line as a single field. The sort is a merge
require Exporter;
regexes in parentheses will add that matched expression as an extra
reference passed to the function in the format:
positions of a restricted sort key. If the B option is specified
portion of the line, and type is a modifier from the list of characters
platforms. (Hubert Toullec)
package File::Sort;
output.
output to STDOUT.
output in outfile and using second character of second field
or B were present (but with B still in effect, if it was
options.
options, but apply only to the key field to which they are attached;
options appear independent of any key field specifications, the requested
only the exit code is affected.
only after all earlier keys compare equal.
of 1 or 0.
occurrence of char is significant (for example,
no longer supported. Hopefully made the whole thing more robust and
much RAM, it might need to be lowered.
maximal non-empty sequence of blank characters that follows a non-blank
many parts out into separate functions.
low-memory systems, or where (e.g.) the MacPerl binary is not allocated
locale setting.
listed in TODO below, they are not in the plan for implementation.
lines. Lines was easier to implement. Can also specify with
like them and want to use them. Usage is:
it specifes the last position to NOT be included. Also, numbers
it is attached. The other modifiers behave like the corresponding
is used. When there are multiple keys fields, later keys are compared
is free software; you can redistribute it and/or modify it under the same
is basically a mapping of the command-line options to the Unix
interface may be offered in the future, as well. This interface
instead. Do not escape any characters (C> characters need to be
input file is sorted.
global ordering options for that key.
format of this definition is:
for total number of temp files from 50 to 40 (leave room for other open
for the purposes of comparison.
files. Overriden by B option.
files), changed docs. (Mike Blazer, Gurusamy Sarathy)
filename, or an array reference containing multiple filename strings.
field_start or field_end option argument (see below).
field). See L and L.
field ordering rules are applied globally to all sort keys. When attached
faster, while supporting more options for sorting, including delimited
example:
escaped internally, and will be escaped for you).
equal are ordered as if none of the options B, B, B, B
corresponding B<+pos1>. The rest should be the same as the B option.
consecutive lines with duplicate keys, in addition to checking that the
comparison. The order in which lines that still compare equal are
code to use the new interface.
characters in arguments and input files) and the behaviour of
character is a field separator.
character classification for the B, B, B, B and B
before the first B option, it is applied to all B options.
be a number in numeric comparisons.
at all if MAX_SORT_RECORDS is never reached.
as the sort key.
as older Windows ports had quite a small limit. Can also specify
are used for options, but there are also some key behavioral differences.
are counted from 0 instead of 1. B must immediately follow
are based on one or more sort keys extracted from each line of input,
applies to either.
and are performed lexicographically. By default, if keys are not given,
according to the current locale setting, to be the upper-case equivalent
according to the current locale setting, are significant in comparisons.
__END__
Where the OPTION is a switch, it should be passed a boolean VALUE
Where field_end in B specified the last position to be included,
Where an option can take multiple values (like C, C, and C),
Vicki Brown Evlb@cfcl.comE,
Use I as the field separator character; char is not considered
Unique: Suppresses all but one in each set of lines having equal keys.
Tom Phoneix Erootbeer@teleport.comE,
Tom Christiansen Etchrist@perl.comE,
This module sorts text files by lines (or records). Comparisons
This interface will always be supported, though a more perlish
This includes B and B.
The string matched by I is not included in the fields
The keydef argument is a restricted sort key field definition. The
The good news is that it should not be too difficult to update your
The following options override the default ordering rules. When ordering
The following options are available, and are passed in the hash
Tests 3 and 4 failed because we hit the open file limit in the
Switched to sysopen for better portability.
Specify the name of an I file to be used instead of the standard
Specify that only blank characters and alphanumeric characters,
Sort, in reverse order, contents of file1 and file2, placing
Sort file by straight string compare of each line, sending
Sort contents of file by second key in file.
Some cleanup; made it not subject to system file limitations; separated
Some cleanup.
Similar to B, these are mostly obsolete switches, but some people
Send debugging information to STDERR. Behavior subject to change.
Same sort but sorting numerically on characters 3 through 5 of
Same as B, but I is interpreted as a Perl regular expression
Rich Morin Erdm@cfcl.comE,
Reverse the sense of the comparisons.
Removed O_EXCL flag from C.
Record separator, defaults to newline.
Print to STDOUT if no output file supplied.
Print passwd(4) file sorted by numeric user ID.
Played with somem of the -k options (Marco A. Romero).
Paul Eckert Epeckert@epicrealm.comE,
Pass in the input file(s). This can be either a single string with the
Otherwise, the B option can be attached indepently to each
One year between releases was too long. I made changes Miko O'Sullivan
Occurrences of the B option are significant in command line order.
Note that if you change the locale settings after the program has started
More cleanup; fixed special case of no linebreak on last line; wrote test
Mixing B<+pos1> B with B is allowed, but will result in all of
Miko O'Sullivan Emiko@idocs.comE,
Mike Blazer Eblazer@mail.nevalink.ruE,
Merge only; the input files are assumed to already be sorted.
Maximum number of temp files to be held open at once. Default to 40,
Maximum number of open temp files to use before merging open temp
Maximum number of lines (records) read before writing to temp file.
Matthias Neeracher Eneeri@iis.ee.ethz.chE,
Marco A. Romero Emromero@iglou.comE,
Made CHUNK default a lot larger, which improves performance. On
MAX_SORT_RECORDS environment variable.
Long overdue release.
It is best if you Don't Do That. Pick one and stick with it.
Ignores all characters that are non-printable, according to the current
Ignore leading blank characters when determining the starting and ending
If you need the old interface, the old module will remain on CPAN, but
If used with the B option check that there are no lines with
If the options are not listed as implemented above, or are not
If no B option is specified, a default sort key of the entire line
If any modifier is attached to a field_start or a field_end, no option
Hubert Toullec EHubert.Toullec@wanadoo.frE.
Here are some equivalencies:
Gurusamy Sarathy Egsar@activestate.comE,
Gene Hsu Egene@moreinfo.comE,
Gael Marziou Egael_marziou@hp.comE,
For the anal sysadmin, check that passwd(4) file is sorted by numeric
Fixed up docs and did some more tests and benchmarks.
Fixed bug with unique option (didn't work :).
Fixed bug in sorting multiple files. (Paul Eckert)
Fixed bug in C<_merge_files> that tried to C a passed
Fix filehandle close test of STDOUT (Gael Marziou).
First release.
File::Sort - Sort a file or merge sort multiple files
Exports C on request.
Except when the B option is specified, lines that otherwise compare
EcharEEcharE delimits an empty field). If B is not
Does numeric instead of string compare, using whatever perl considers to
Documented C option. (Hubert Toullec)
Determine the locale for the interpretation of sequences of bytes of
Determine the locale for ordering rules.
Default is 200,000. This may eventually change to be kbytes instead of
Default is 200,000. Maximum number of records to use before writing
Copyright (c) 1997-2002 Chris Nandor. All rights reserved. This program
Consider all lower-case characters that have upper-case equivalents,
Complete rewrite. Took the code from this module to write sort
Closed all files in test.pl so they could be unlinked on some
Chris Nandor Epudge@pobox.comE, http://pudge.net/
Check that single input fle is ordered as specified by the arguments and
Change license to be that of Perl.
C object.
Brian L. Matthews Eblm@halcyon.comE,
B overrides B.
B, B, B, B, B, B. The b modifier behaves like the
B option, but applies only to the field_start or field_end to which
Andrew M. Langmead Eaml@world.std.comE,
Also now use C to create temp files, so the TMPDIR option is
Albert Dvornik Ebert@mit.eduE,
Added unique and merge-only options.
Added reverse and numeric sorting options.
Added c option to check sorting.
Add O_TRUNC to output open (D'oh!).
@ISA = 'Exporter';
@EXPORT_OK = 'sort_file';
=over 4
=over 4
=over 4
=over 4
=over 4
=item v1.01, Monday, January 14, 2002
=item v1.00, Tuesday, November 13, 2001
=item v0.91, Saturday, February 12, 2000
=item v0.90, Friday, April 30, 1999
=item v0.20
=item v0.18 (31 January 1998)
=item v0.17 (30 December 1998)
=item v0.16 (24 December 1998)
=item v0.11 (04 January 1998)
=item v0.10 (03 January 1998)
=item v0.03 (23 December 1997)
=item v0.02 (19 December 1997)
=item v0.01 (18 December 1997)
=item Switch for turning off locale ... ?
=item Performance hit with -u
=item MAX_SORT_RECORDS
=item MAX_SORT_FILES
=item LC_CTYPE
=item LC_COLLATE
=item Do bytes instead of lines
=item C I
=item C
=item C I
=item C
=item C I<+pos1 [-pos2]>
=item C I
=item C
=item C
=item C I
=item C
=item C
=item C
=item C
=item C
=item C I
=item C I
=item C I
=item C I
=item C
=item Better test suite
=item Better debugging and error reporting
=head2 Options
=head2 Not Implemented
=head1 VERSION
=head1 TODO
=head1 THANKS
=head1 SYNOPSIS
=head1 SEE ALSO
=head1 NAME
=head1 HISTORY
=head1 EXPORT
=head1 EXAMPLES
=head1 ENVIRONMENT
=head1 DESCRIPTION
=head1 AUTHOR
=cut
=back
=back
=back
=back
=back
$VERSION = '1.01';
# take optional arrayref of handles of sorted files,
# plus optional arrayref of sorted scalars
});
use File::Sort qw(sort_file);
sort_file({
sort_file('file1', 'file1.sorted');
OPTION => [VALUE1, VALUE2]
OPTION => VALUE
});
});
} keys %oth;
} elsif ($opts->{'m'}) {
} elsif (!ref $file) {
} else {
} else {
} else {
} else {
} else {
} else {
}
}
}
}
}
}
}
}
}
}
}
}
while (keys %fh) {
while () {
while () {
use POSIX 'locale_h';
use File::Sort qw(sort_file);
usage() unless @{$opts->{I}};
sort_file({t => ':', k => '3n', I => '/etc/passwd'});
sort_file({k => 2, I => 'file'});
sort_file({c => 1, t => ':', k => '3n', I => '/etc/passwd'});
sort_file({
sort_file({
sort_file('file');
setlocale(LC_CTYPE, '');
setlocale(LC_COLLATE, '');
select $oldfh;
seek DATA, 0, 0;
seek $temp, 0, 0; # might need to read back from it
seek $file, 0, 0; # might need to read back from it
return \%opts;
return 1; # yay
return $temp;
return $file;
require IO::File;
print STDERR @_;
pos => ['+2', '+0b -1'] -> k => ['3', '1b,1']
pos => ['+1 -2', '+3 -5'] -> k => ['2,2', '4,5']
pos => '+2.1 -2.4' -> k => '3.2,3.4'
pos => '+2.0 -3.0' -> k => '3.1,4.0'
pos => '+1.1 -1.2' -> k => '2.2,2.2'
pos => '+1 -2' -> k => '2,2'
o => 'file_new', k => '5.3,5.5rn', -t => '|'
my($uniq, $first, $o, %oth);
my($topts, @sortsub, @mapsub, @sort1, @sort2) = shift;
my($recs, $opts) = @_;
my($opts, @fh, @recs) = shift;
my($opts, $fh, $recs, $file) = @_;
my($k, $topts) = @_;
my @args = @_;
my %opts = (
my $u;
my $temp = _get_temp() or die "Can't get temp file: $!";
my $oldfh = select $file;
my $nok = shift;
my $close = _merge_files($opts, \@fh, \@recs, $opts->{o});
local $^W;
local $\; # don't mess up our prints
local $/ = $opts->{R} ? $opts->{R} : "\n";
local $/ = "\n"; # in case changed
if (ref $args[0]) {
if ($topts->{K}) {
if ($topts->{K}) {
if ($opts->{c}) {
if ($opts->{K}) {
if ($nok) {
if ($file eq '') {
if (!$opts{kst} && !$opts{kft}) {
for (qw(ksf ksc kff)) { # kfc stays same
field_start[.first_char][type][,field_end[.last_char][type]]
die "Usage:$u";
close $close unless fileno($close) == fileno('STDOUT'); # don't close STDOUT
_make_sort_sub($opts);
_debug("\nDone!\n\n") if $opts->{D};
_debug("\nCreating sorted $file ...\n") if $opts->{D};
_debug("New tempfile: $temp\n") if $opts->{D};
_check_last($recs);
IO::File->new_tmpfile;
I => [qw(file_1 file_2)],
+field_start[.first_char][type] [-field_end[.last_char][type]]
);
%oth = map {($o++ => $_)} @$fh;
%fh = map {
$| = 0; # just in case, use the buffer, you knob
${$_[0]}[-1] .= $/ if (${$_[0]}[-1] !~ m|$/$|);
$u =~ s/\n//;
$opts->{o} = !$opts->{o} ? '' : $opts->{o};
$opts->{k} = $opts->{k} ? [$opts->{k}] : [] if !ref $opts->{k};
$opts->{K} = $opts->{k} ? 0 : 1;
$opts->{I} = [$opts->{I}] unless ref $opts->{I};
$opts->{F} ||= $ENV{MAX_SORT_FILES} || 40; # default max files
$opts->{'y'} ||= $ENV{MAX_SORT_RECORDS} || 200000; # default max records
$k =~ /^(\d+)(?:\.(\d+))?([bdfinr]+)?
$fh{X} = shift @$recs if @$recs;
$ENV{LC_ALL} = $ENV{LANG} = '';
# we need the options, filehandles, and output file
# use new ENV settings
# their idea of 1 is not ours
# set output and other defaults
# set defaults at zero or undef
# see big ol' mess below
# record separator, default to \n
# output to STDOUT if no output file provided
# ooo, get ready, get ready
# only check to see if file is sorted
# match handle key in %oth to next record of the handle
# if output file is a path, not a reference to a file, open
# if nothing in kst or kft, use other flags possibly passed
# if no keydefs set
# if no keydefs set
# if merging sorted files
# gurgle
# get input files into anon array if not already
# get constants
# file and get a reference to it
# extra records, special X "handle"
# except for b, flags on one apply to the other
# e.g., blank out locale
# do the merge thang, uh huh, do the merge thang
# arbitrarily named keys, store handles as values
# add new record separator if not one there
# "K" == "no k", for later
} else { # we don't need you anymore
} else {
} else {
}
}
}
}
}
}
}
}
}
}
}
}
}
}
}
}
}
}
}
{
{
{
while (defined(my $rec = )) {
u => 1, r => 1, k => ['5.3,5.5rn', '2.2,2.2'],
sysopen($tfh, $file, O_WRONLY|O_CREAT|O_TRUNC)
return 1;
return &sortsub;
return &sort1;
r => 1, k => '2.2,2.2', o => 'outfile',
print $temp sort sort1 @{$recs};
print $temp map {$_->[0]} sort sortsub map &map1, @{$recs};
o => 'outfile', I => ['file1', 'file2']
my(%maps, $sortsub, $mapsub) = (map1 => '$_', map2 => '$fh{$_}');
my($cmp, $aa, $bb, $fa, $fb) = qw(cmp $a $b $fh{$a} $fh{$b});
my $tfh = gensym();
my $sort2 = "sub { $fa $cmp $fb }\n";
my $sort1 = "sub { $aa $cmp $bb }\n";
my $rec = $first eq 'X' ? shift @$recs : scalar <$curr>;
my $last;
my $fh = $oth{$_};
my $curr = $oth{$first};
local *F;
local $^W;
local $^W;
last if m/^=head1 SYNOPSIS$/;
last if m/^=/;
kst => $3 || '', # start field type
ksf => $1 || 0, # start field
ksc => $2 || 0, # start field char start
kft => $6 || '', # end field type
kff => (defined $4 ? $4 : undef), # end field
kfc => $5 || 0, # end field char end
if (exists $args[0]{'pos'}) {
if (defined $rec) { # bring up next record for this filehandle
if (@recs) {
if ($topts->{kst} =~ /[bdfi]/) {
if ($opts->{u}) {
if ($opts->{I}[0] eq '-') {
if (!$opts->{u} && keys %fh == 1) {
if (! $topts->{u} ) {
foreach my $k (@{$topts->{k}}) {
foreach my $filein (@{$opts->{I}}) {
foreach my $filein (@{$opts->{I}}) {
foreach (qw(d f i n r)) {
foreach (qw(b d f i n r)) {
foreach (qw(b d f i n r)) {
for my $m (keys %maps) {
_sort_file({I => $args[0], o => $args[1]});
_sort_file(@args);
_debug("No keydef set\n") if $topts->{D};
_debug("$sortsub\n$maps{map1}\n$maps{map2}\n") if $topts->{D};
_debug("$sort1\n$sort2\n") if $topts->{D};
I => ['file1', 'file2']
(?:,(\d+)(?:\.(\d+))?([bdfinr]+)?)?$/x;
($bb, $aa, $fb, $fa) = ($aa, $bb, $fa, $fb) if $topts->{r};
($a, $b) = map &map1, @_;
($a, $b) = @_;
($_ => scalar <$fh>);
%$topts, # get other options
$u .= $_;
$topts->{t} =~ s|/|\\/|g if defined $topts->{X};
$topts->{t} =
$topts->{kst} = '';
$sortsub = "sub {\n " . join(" || \n ", @sortsub) . "\n}\n";
$opts{$_}-- if $opts{$_};
$file = \*STDOUT;
$file = $tfh;
$cmp = '<=>' if $topts->{n};
# use @$recs, not filehandles, if key is X
# success, yay
# reverse sense
# records leftover, didn't reach record limit
# once for each input file
# more complex stuff, act like we had -k defined
# if not -u
# get text separator or use whitespace
# get current filehandle
# fix pos to look like k
# don't print if -u and not unique
# don't bother sorting keys if only one key remains!
# do numeric sort
# defaults for main sort sub components
# add finished expression to array
} elsif ($opts->{kst} =~ /i/) {
} elsif (!ref $args[0]{'k'}) {
} else {
} else {
} else {
} else {
} else {
}
}
}
}
}
}
}
}
}
}
}
}
}
while (defined(my $rec = )) {
sysopen(F, $opts->{I}[0], O_RDONLY)
sysopen($sym, $filein, O_RDONLY)
push @sortsub, sprintf "%s->[1] %s %s->[1]",
push @sortsub, sprintf "%s->[$n] %s %s->[$n]",
push @fh, $sym;
print $fh{$first};
print $fh{$first}, @left;
print $fh{$first} if
or die "Can't open `$file' for writing: $!";
open(F, $opts->{I}[0])
my($opts, @fil) = ($topts);
my($cmp, $ab_, $fab_, $aa, $bb) = qw(cmp $_ $fh{$_} $a $b);
my @left = $first eq 'X' ? @$recs : <$curr>;
my @argv;
my $sym = gensym();
my $pos = $args[0]{'pos'};
my $n = @sortsub + 2;
my $k = $maps{$m};
my $curr = $oth{$first};
my $count = 0;
local *F;
local $^W;
local $^W;
last;
if (@fil > 1) {
if ($opts->{u} && $last) {
if ($opts->{kst} =~ /f/) {
if ($opts->{kst} =~ /d/) {
if ($opts->{K}) {
if ($opts->{K}) {
if ($last) {
if ($k ne 'K') {
if ($filein eq '-') {
if (!ref $pos) {
if (!exists $args[0]{'k'}) {
for (@$pos) {
die "Can't create sort sub: $@" if $@;
die "Can't create sort sub: $@" if $@;
die "Can't create sort sub: $@" if $@;
die "Can't create sort sub: $@" if $@;
die "Can't create sort sub: $@" if $@;
delete $fh{$first};
delete $fh{$first};
defined $topts->{t} ? quotemeta($topts->{t}) :
defined $topts->{X} ? $topts->{X} :
close F;
_debug("\nSorting leftover records ...\n") if $opts->{D};
_debug("Sorting file $filein ...\n") if $opts->{D};
_check_last(\@recs);
*sortsub = eval $sortsub;
*sort2 = eval $sort2;
*sort1 = eval $sort1;
*map2 = eval $maps{map2};
*map1 = eval $maps{map1};
($first) = keys %fh;
($bb, $aa) = ($aa, $bb) if ($opts->{kst} =~ /r/);
'\s+';
$uniq = $fh{$first};
$topts->{k} = ['K']; # special K ;-)
$topts->{kst} .= $_ if $topts->{$_};
$topts->{K} = 0;
$opts{kst} .= $_ if ($opts{kst} =~ /$_/ || $opts{kft} =~ /$_/);
$opts{kst} .= $_ if $topts->{$_};
$opts{kft} .= $_ if ($opts{kst} =~ /$_/ || $opts{kft} =~ /$_/);
$opts{kft} .= $_ if $topts->{$_};
$opts = $k eq 'K' ? $topts : _parse_keydef($k, $topts);
$maps{$m} = sprintf "sub {\n my \@tmp = %s;\n",
$maps{$m} .= "]\n}\n";
$maps{$m} .= "\n [\$_, $k";
$maps{$m} .= ",\n " . join('', @mapsub) if @mapsub;
$maps{$m} .= " my \$tmp;\n" if $topts->{DD};
$last = $rec;
$fil[0] = "\$tmp = $fil[0]" if $opts->{kst} =~ /d/;
$fh{$first} = $rec;
$cmp = '<=>' if ($opts->{kst} =~ /n/);
# skip stuff if special K
# save value of last record
# reverse sense
# only printable characters
# only alphanumerics and whitespace, override -i
# just open files and get array of handles
# fold to upper case
# fail if records not in proper sort order
# fail if -u and keys are not unique (assume sorted)
# do straight compare if all else is equal
# do numeric sort
# defaults for main sort sub components
# add finished expressions to arrays
# $first is arbitrary number assigned to first fh in sort
} else {
} else {
}
}
}
}
}
}
sysopen(F, $filein, O_RDONLY)
return 0 unless _are_uniq($opts->{K}, $last, $rec);
return 0 if $foo[0] ne $last || $foo[1] ne $rec;
require POSIX;
push @recs, $rec;
push @mapsub, " (\n" .
push @mapsub, " " . $fil[0] . ",\n ";
push @fil, "\$tmp =~ s/[^\\w\\s]+//g", '"$tmp"';
or die "Can't open `$opts->{I}[0]' for reading: $!";
or die "Can't open `$opts->{I}[0]' for reading: $!";
or die "Can't open `$filein' for reading: $!";
open(F, $filein)
my($tmp1, $tmp2) = ("\$tmp[$opts->{ksf}]",
my @foo;
my $n;
local $^W;
local $^W;
local $^W;
local $^W;
if ($opts->{kst} =~ /b/) {
if ($opts->{kft} =~ /b/) {
if ($opts->{K}) {
if ($count >= $opts->{'y'}) { # don't go over record limit
if (! defined $opts->{kff} || $opts->{ksf} == $opts->{kff}) {
if ( /^\+(\d+)(?:\.(\d+))?([bdfinr]+)?
@recs = sort sort1 @recs;
@recs = map {$_->[0]} sort sortsub map &map1, @recs;
@fil = $opts->{kst} =~ /b/ ?
($first) = (sort sort2 keys %fh);
($first) = (map {$_->[0]} sort sortsub
(!$uniq || _are_uniq($opts->{K}, $uniq, $fh{$first}));
$topts->{r} ? qw($b cmp $a) : qw($a cmp $b);
$topts->{k}[0] eq 'K' ? $k : "split(/$topts->{t}/, $k)";
$topts->{DD}++;
$pos = [$pos];
$fil[0] = "uc($fil[0])";
$fil[0] = "join '', grep {POSIX::isprint \$_} " .
$count++; # keep track of number of records
$args[0]{'k'} = [];
$args[0]{'k'} = [$args[0]{'k'}];
$aa, $cmp, $bb;
# try again, shall we?
# skip leading spaces
# simpler if one field, goody for us
(?:\s+\-(\d+)(?:\.(\d+))?([bdfinr]+)?)?$/x) {
} elsif (($opts->{kff} - $opts->{ksf}) == 1) {
} elsif (!$opts->{kfc}) {
} else {
} else {
}
}
}
}
push @{$args[0]{'k'}}, $n;
push @fh, _write_temp(\@recs, $opts);
or die "Can't open `$filein' for reading: $!";
or die "Can't open `$filein' for reading: $!";
map &map2, keys %fh);
local $^W;
local $^W;
join(",\n", map {s/^/ /mg; $_} @fil),
if (defined $4) {
if (@fh >= $opts->{F}) {
if ($opts->{ksc} == 0 &&
if ($opts->{kfc} == 0 && $opts->{ksc} == 0 &&
_debug("$count records reached in `$filein'\n")
@foo = sort sort1 ($rec, $last);
@foo = map {$_->[0]} sort sortsub
($opts->{kff} ? "\$tmp[$opts->{kff}]" : ''));
($count, @recs) = (0);
$tmp2 = "($tmp2 =~ /(\\S.*)/)[0]";
$tmp1 = "($tmp1 =~ /(\\S.*)/)[0]";
$n = $1 + 1;
$n .= '.' . ($2 + 1) if defined $2;
$n .= $3 if $3;
# simpler if chars are both 0, wicked pissah
# save to temp file, add new fh to array
# reset record count and record array
# if spans two fields, but chars are both 0
# if only one field away
# hmmmmm
# getting out of hand now
# fine, have it your way! hurt me! love me!
# do a merge now if at file limit
# and neither has -b, alrighty
"split //,\n$fil[0]";
"\n )[-1],\n ";
"(\$tmp[0] =~ /(\\S.*)/)[0]" : "\$tmp[0]";
map &map1, ($rec, $last);
if $opts->{D};
_debug("\nCreating temp files ...\n") if $opts->{D};
@fil = "substr($tmp1, $opts->{ksc}, ".
@fil = "substr($tmp1, $opts->{ksc})";
@fil = "join(''," .
@fil = "join('', substr($tmp1, $opts->{ksc}), " .
@fil = "join('', substr($tmp1, $opts->{ksc}), " .
@fil = "\$tmp[$opts->{ksf}]";
@fh = (_merge_files($opts, \@fh, [], _get_temp()));
(!$opts->{kfc} || $opts->{kfc} == 0)) {
$opts->{kst} !~ /b/ && $opts->{kft} !~ /b/) {
$n .= $6 if $6;
$n .= "," . (defined $5 ? ($4 + 1) . ".$5" : $4);
# get filehandle and restart array with it
($opts->{kfc} - $opts->{ksc}) . ')';
"substr($tmp2, 0, $opts->{kfc}))";
"substr($tmp2, 0, $opts->{kfc}))";
"\@tmp[$opts->{ksf} .. $opts->{kff}])";
"\@tmp[" . ($opts->{ksf} + 1) . " .. " .
($opts->{kff} - 1) . "], " .
File-Sort-1.01/Sort.pm_sorted.txt 100666 000000 000000 75160 7423375625 17543 0 ustar 00unknown unknown 0 0
($opts->{kff} - 1) . "], " .
"\@tmp[" . ($opts->{ksf} + 1) . " .. " .
"\@tmp[$opts->{ksf} .. $opts->{kff}])";
"substr($tmp2, 0, $opts->{kfc}))";
"substr($tmp2, 0, $opts->{kfc}))";
($opts->{kfc} - $opts->{ksc}) . ')';
# get filehandle and restart array with it
$n .= "," . (defined $5 ? ($4 + 1) . ".$5" : $4);
$n .= $6 if $6;
$opts->{kst} !~ /b/ && $opts->{kft} !~ /b/) {
(!$opts->{kfc} || $opts->{kfc} == 0)) {
@fh = (_merge_files($opts, \@fh, [], _get_temp()));
@fil = "\$tmp[$opts->{ksf}]";
@fil = "join('', substr($tmp1, $opts->{ksc}), " .
@fil = "join('', substr($tmp1, $opts->{ksc}), " .
@fil = "join(''," .
@fil = "substr($tmp1, $opts->{ksc})";
@fil = "substr($tmp1, $opts->{ksc}, ".
_debug("\nCreating temp files ...\n") if $opts->{D};
if $opts->{D};
map &map1, ($rec, $last);
"(\$tmp[0] =~ /(\\S.*)/)[0]" : "\$tmp[0]";
"\n )[-1],\n ";
"split //,\n$fil[0]";
# and neither has -b, alrighty
# do a merge now if at file limit
# fine, have it your way! hurt me! love me!
# getting out of hand now
# hmmmmm
# if only one field away
# if spans two fields, but chars are both 0
# reset record count and record array
# save to temp file, add new fh to array
# simpler if chars are both 0, wicked pissah
$n .= $3 if $3;
$n .= '.' . ($2 + 1) if defined $2;
$n = $1 + 1;
$tmp1 = "($tmp1 =~ /(\\S.*)/)[0]";
$tmp2 = "($tmp2 =~ /(\\S.*)/)[0]";
($count, @recs) = (0);
($opts->{kff} ? "\$tmp[$opts->{kff}]" : ''));
@foo = map {$_->[0]} sort sortsub
@foo = sort sort1 ($rec, $last);
_debug("$count records reached in `$filein'\n")
if ($opts->{kfc} == 0 && $opts->{ksc} == 0 &&
if ($opts->{ksc} == 0 &&
if (@fh >= $opts->{F}) {
if (defined $4) {
join(",\n", map {s/^/ /mg; $_} @fil),
local $^W;
local $^W;
map &map2, keys %fh);
or die "Can't open `$filein' for reading: $!";
or die "Can't open `$filein' for reading: $!";
push @fh, _write_temp(\@recs, $opts);
push @{$args[0]{'k'}}, $n;
}
}
}
}
} else {
} else {
} elsif (!$opts->{kfc}) {
} elsif (($opts->{kff} - $opts->{ksf}) == 1) {
(?:\s+\-(\d+)(?:\.(\d+))?([bdfinr]+)?)?$/x) {
# simpler if one field, goody for us
# skip leading spaces
# try again, shall we?
$aa, $cmp, $bb;
$args[0]{'k'} = [$args[0]{'k'}];
$args[0]{'k'} = [];
$count++; # keep track of number of records
$fil[0] = "join '', grep {POSIX::isprint \$_} " .
$fil[0] = "uc($fil[0])";
$pos = [$pos];
$topts->{DD}++;
$topts->{k}[0] eq 'K' ? $k : "split(/$topts->{t}/, $k)";
$topts->{r} ? qw($b cmp $a) : qw($a cmp $b);
(!$uniq || _are_uniq($opts->{K}, $uniq, $fh{$first}));
($first) = (map {$_->[0]} sort sortsub
($first) = (sort sort2 keys %fh);
@fil = $opts->{kst} =~ /b/ ?
@recs = map {$_->[0]} sort sortsub map &map1, @recs;
@recs = sort sort1 @recs;
if ( /^\+(\d+)(?:\.(\d+))?([bdfinr]+)?
if (! defined $opts->{kff} || $opts->{ksf} == $opts->{kff}) {
if ($count >= $opts->{'y'}) { # don't go over record limit
if ($opts->{K}) {
if ($opts->{kft} =~ /b/) {
if ($opts->{kst} =~ /b/) {
local $^W;
local $^W;
local $^W;
local $^W;
my $n;
my @foo;
my($tmp1, $tmp2) = ("\$tmp[$opts->{ksf}]",
open(F, $filein)
or die "Can't open `$filein' for reading: $!";
or die "Can't open `$opts->{I}[0]' for reading: $!";
or die "Can't open `$opts->{I}[0]' for reading: $!";
push @fil, "\$tmp =~ s/[^\\w\\s]+//g", '"$tmp"';
push @mapsub, " " . $fil[0] . ",\n ";
push @mapsub, " (\n" .
push @recs, $rec;
require POSIX;
return 0 if $foo[0] ne $last || $foo[1] ne $rec;
return 0 unless _are_uniq($opts->{K}, $last, $rec);
sysopen(F, $filein, O_RDONLY)
}
}
}
}
}
}
} else {
} else {
# $first is arbitrary number assigned to first fh in sort
# add finished expressions to arrays
# defaults for main sort sub components
# do numeric sort
# do straight compare if all else is equal
# fail if -u and keys are not unique (assume sorted)
# fail if records not in proper sort order
# fold to upper case
# just open files and get array of handles
# only alphanumerics and whitespace, override -i
# only printable characters
# reverse sense
# save value of last record
# skip stuff if special K
$cmp = '<=>' if ($opts->{kst} =~ /n/);
$fh{$first} = $rec;
$fil[0] = "\$tmp = $fil[0]" if $opts->{kst} =~ /d/;
$last = $rec;
$maps{$m} .= " my \$tmp;\n" if $topts->{DD};
$maps{$m} .= ",\n " . join('', @mapsub) if @mapsub;
$maps{$m} .= "\n [\$_, $k";
$maps{$m} .= "]\n}\n";
$maps{$m} = sprintf "sub {\n my \@tmp = %s;\n",
$opts = $k eq 'K' ? $topts : _parse_keydef($k, $topts);
$opts{kft} .= $_ if $topts->{$_};
$opts{kft} .= $_ if ($opts{kst} =~ /$_/ || $opts{kft} =~ /$_/);
$opts{kst} .= $_ if $topts->{$_};
$opts{kst} .= $_ if ($opts{kst} =~ /$_/ || $opts{kft} =~ /$_/);
$topts->{K} = 0;
$topts->{kst} .= $_ if $topts->{$_};
$topts->{k} = ['K']; # special K ;-)
$uniq = $fh{$first};
'\s+';
($bb, $aa) = ($aa, $bb) if ($opts->{kst} =~ /r/);
($first) = keys %fh;
*map1 = eval $maps{map1};
*map2 = eval $maps{map2};
*sort1 = eval $sort1;
*sort2 = eval $sort2;
*sortsub = eval $sortsub;
_check_last(\@recs);
_debug("Sorting file $filein ...\n") if $opts->{D};
_debug("\nSorting leftover records ...\n") if $opts->{D};
close F;
defined $topts->{X} ? $topts->{X} :
defined $topts->{t} ? quotemeta($topts->{t}) :
delete $fh{$first};
delete $fh{$first};
die "Can't create sort sub: $@" if $@;
die "Can't create sort sub: $@" if $@;
die "Can't create sort sub: $@" if $@;
die "Can't create sort sub: $@" if $@;
die "Can't create sort sub: $@" if $@;
for (@$pos) {
if (!exists $args[0]{'k'}) {
if (!ref $pos) {
if ($filein eq '-') {
if ($k ne 'K') {
if ($last) {
if ($opts->{K}) {
if ($opts->{K}) {
if ($opts->{kst} =~ /d/) {
if ($opts->{kst} =~ /f/) {
if ($opts->{u} && $last) {
if (@fil > 1) {
last;
local $^W;
local $^W;
local *F;
my $count = 0;
my $curr = $oth{$first};
my $k = $maps{$m};
my $n = @sortsub + 2;
my $pos = $args[0]{'pos'};
my $sym = gensym();
my @argv;
my @left = $first eq 'X' ? @$recs : <$curr>;
my($cmp, $ab_, $fab_, $aa, $bb) = qw(cmp $_ $fh{$_} $a $b);
my($opts, @fil) = ($topts);
open(F, $opts->{I}[0])
or die "Can't open `$file' for writing: $!";
print $fh{$first} if
print $fh{$first}, @left;
print $fh{$first};
push @fh, $sym;
push @sortsub, sprintf "%s->[$n] %s %s->[$n]",
push @sortsub, sprintf "%s->[1] %s %s->[1]",
sysopen($sym, $filein, O_RDONLY)
sysopen(F, $opts->{I}[0], O_RDONLY)
while (defined(my $rec = )) {
}
}
}
}
}
}
}
}
}
}
}
}
}
} else {
} else {
} else {
} else {
} else {
} elsif (!ref $args[0]{'k'}) {
} elsif ($opts->{kst} =~ /i/) {
# add finished expression to array
# defaults for main sort sub components
# do numeric sort
# don't bother sorting keys if only one key remains!
# don't print if -u and not unique
# fix pos to look like k
# get current filehandle
# get text separator or use whitespace
# if not -u
# more complex stuff, act like we had -k defined
# once for each input file
# records leftover, didn't reach record limit
# reverse sense
# success, yay
# use @$recs, not filehandles, if key is X
$cmp = '<=>' if $topts->{n};
$file = $tfh;
$file = \*STDOUT;
$opts{$_}-- if $opts{$_};
$sortsub = "sub {\n " . join(" || \n ", @sortsub) . "\n}\n";
$topts->{kst} = '';
$topts->{t} =
$topts->{t} =~ s|/|\\/|g if defined $topts->{X};
$u .= $_;
%$topts, # get other options
($_ => scalar <$fh>);
($a, $b) = @_;
($a, $b) = map &map1, @_;
($bb, $aa, $fb, $fa) = ($aa, $bb, $fa, $fb) if $topts->{r};
(?:,(\d+)(?:\.(\d+))?([bdfinr]+)?)?$/x;
I => ['file1', 'file2']
_debug("$sort1\n$sort2\n") if $topts->{D};
_debug("$sortsub\n$maps{map1}\n$maps{map2}\n") if $topts->{D};
_debug("No keydef set\n") if $topts->{D};
_sort_file(@args);
_sort_file({I => $args[0], o => $args[1]});
for my $m (keys %maps) {
foreach (qw(b d f i n r)) {
foreach (qw(b d f i n r)) {
foreach (qw(d f i n r)) {
foreach my $filein (@{$opts->{I}}) {
foreach my $filein (@{$opts->{I}}) {
foreach my $k (@{$topts->{k}}) {
if (! $topts->{u} ) {
if (!$opts->{u} && keys %fh == 1) {
if ($opts->{I}[0] eq '-') {
if ($opts->{u}) {
if ($topts->{kst} =~ /[bdfi]/) {
if (@recs) {
if (defined $rec) { # bring up next record for this filehandle
if (exists $args[0]{'pos'}) {
kfc => $5 || 0, # end field char end
kff => (defined $4 ? $4 : undef), # end field
kft => $6 || '', # end field type
ksc => $2 || 0, # start field char start
ksf => $1 || 0, # start field
kst => $3 || '', # start field type
last if m/^=/;
last if m/^=head1 SYNOPSIS$/;
local $^W;
local $^W;
local *F;
my $curr = $oth{$first};
my $fh = $oth{$_};
my $last;
my $rec = $first eq 'X' ? shift @$recs : scalar <$curr>;
my $sort1 = "sub { $aa $cmp $bb }\n";
my $sort2 = "sub { $fa $cmp $fb }\n";
my $tfh = gensym();
my($cmp, $aa, $bb, $fa, $fb) = qw(cmp $a $b $fh{$a} $fh{$b});
my(%maps, $sortsub, $mapsub) = (map1 => '$_', map2 => '$fh{$_}');
o => 'outfile', I => ['file1', 'file2']
print $temp map {$_->[0]} sort sortsub map &map1, @{$recs};
print $temp sort sort1 @{$recs};
r => 1, k => '2.2,2.2', o => 'outfile',
return &sort1;
return &sortsub;
return 1;
sysopen($tfh, $file, O_WRONLY|O_CREAT|O_TRUNC)
u => 1, r => 1, k => ['5.3,5.5rn', '2.2,2.2'],
while (defined(my $rec = )) {
{
{
{
}
}
}
}
}
}
}
}
}
}
}
}
}
}
}
}
}
}
}
} else {
} else {
} else { # we don't need you anymore
# "K" == "no k", for later
# add new record separator if not one there
# arbitrarily named keys, store handles as values
# do the merge thang, uh huh, do the merge thang
# e.g., blank out locale
# except for b, flags on one apply to the other
# extra records, special X "handle"
# file and get a reference to it
# get constants
# get input files into anon array if not already
# gurgle
# if merging sorted files
# if no keydefs set
# if no keydefs set
# if nothing in kst or kft, use other flags possibly passed
# if output file is a path, not a reference to a file, open
# match handle key in %oth to next record of the handle
# only check to see if file is sorted
# ooo, get ready, get ready
# output to STDOUT if no output file provided
# record separator, default to \n
# see big ol' mess below
# set defaults at zero or undef
# set output and other defaults
# their idea of 1 is not ours
# use new ENV settings
# we need the options, filehandles, and output file
$ENV{LC_ALL} = $ENV{LANG} = '';
$fh{X} = shift @$recs if @$recs;
$k =~ /^(\d+)(?:\.(\d+))?([bdfinr]+)?
$opts->{'y'} ||= $ENV{MAX_SORT_RECORDS} || 200000; # default max records
$opts->{F} ||= $ENV{MAX_SORT_FILES} || 40; # default max files
$opts->{I} = [$opts->{I}] unless ref $opts->{I};
$opts->{K} = $opts->{k} ? 0 : 1;
$opts->{k} = $opts->{k} ? [$opts->{k}] : [] if !ref $opts->{k};
$opts->{o} = !$opts->{o} ? '' : $opts->{o};
$u =~ s/\n//;
${$_[0]}[-1] .= $/ if (${$_[0]}[-1] !~ m|$/$|);
$| = 0; # just in case, use the buffer, you knob
%fh = map {
%oth = map {($o++ => $_)} @$fh;
);
+field_start[.first_char][type] [-field_end[.last_char][type]]
I => [qw(file_1 file_2)],
IO::File->new_tmpfile;
_check_last($recs);
_debug("New tempfile: $temp\n") if $opts->{D};
_debug("\nCreating sorted $file ...\n") if $opts->{D};
_debug("\nDone!\n\n") if $opts->{D};
_make_sort_sub($opts);
close $close unless fileno($close) == fileno('STDOUT'); # don't close STDOUT
die "Usage:$u";
field_start[.first_char][type][,field_end[.last_char][type]]
for (qw(ksf ksc kff)) { # kfc stays same
if (!$opts{kst} && !$opts{kft}) {
if ($file eq '') {
if ($nok) {
if ($opts->{K}) {
if ($opts->{c}) {
if ($topts->{K}) {
if ($topts->{K}) {
if (ref $args[0]) {
local $/ = "\n"; # in case changed
local $/ = $opts->{R} ? $opts->{R} : "\n";
local $\; # don't mess up our prints
local $^W;
my $close = _merge_files($opts, \@fh, \@recs, $opts->{o});
my $nok = shift;
my $oldfh = select $file;
my $temp = _get_temp() or die "Can't get temp file: $!";
my $u;
my %opts = (
my @args = @_;
my($k, $topts) = @_;
my($opts, $fh, $recs, $file) = @_;
my($opts, @fh, @recs) = shift;
my($recs, $opts) = @_;
my($topts, @sortsub, @mapsub, @sort1, @sort2) = shift;
my($uniq, $first, $o, %oth);
o => 'file_new', k => '5.3,5.5rn', -t => '|'
pos => '+1 -2' -> k => '2,2'
pos => '+1.1 -1.2' -> k => '2.2,2.2'
pos => '+2.0 -3.0' -> k => '3.1,4.0'
pos => '+2.1 -2.4' -> k => '3.2,3.4'
pos => ['+1 -2', '+3 -5'] -> k => ['2,2', '4,5']
pos => ['+2', '+0b -1'] -> k => ['3', '1b,1']
print STDERR @_;
require IO::File;
return $file;
return $temp;
return 1; # yay
return \%opts;
seek $file, 0, 0; # might need to read back from it
seek $temp, 0, 0; # might need to read back from it
seek DATA, 0, 0;
select $oldfh;
setlocale(LC_COLLATE, '');
setlocale(LC_CTYPE, '');
sort_file('file');
sort_file({
sort_file({
sort_file({c => 1, t => ':', k => '3n', I => '/etc/passwd'});
sort_file({k => 2, I => 'file'});
sort_file({t => ':', k => '3n', I => '/etc/passwd'});
usage() unless @{$opts->{I}};
use File::Sort qw(sort_file);
use POSIX 'locale_h';
while (