The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/local/bin/perl -w-
# perl implementation of sort(1), by pudge@pobox.com
# see POD below for more information

use Getopt::Long qw(GetOptions);
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);

$VERSION = '1.00';
Getopt::Long::config('bundling');  # -cmu == -c -m -u

{
    my(%o, @argv, @pos);

    # take care of +pos1 -pos2 now instead of in getopts
    foreach my $argv (0..$#ARGV) {
        $_ = $ARGV[$argv];
        my $n;
        if (/^\+(\d+)(?:\.(\d+))?([bdfinr]+)?/) {
           $n = $1 + 1;
           $n .= '.' . ($2 + 1) if defined $2;
           $n .= $3 if $3;
           push @argv, $argv;
        } else {
          next;
        }

        $_ = $ARGV[$argv + 1];
        if (/^\-(\d+)(?:\.(\d+))?([bdfinr]+)?/) {
           $n .= "," . (defined $2 ? ($1 + 1) . ".$2" : $1);
           $n .= $3 if $3;
           push @argv, $argv;
        }

        push @pos, $n;
    }

    # delete used elements from @ARGV
    for (reverse @argv) {
        splice(@ARGV, $_, 1);
    }

    GetOptions(\%o, 'k=s@', qw(c m u d f i n r b D),
        map {"$_=s"} qw(X t y F o R));
    push @{$o{'k'}}, @pos if @pos;   # add pos stuff back
    @ARGV = '-' unless @ARGV;
    $o{I} = [@ARGV];    # input files

    my $exit = _sort_file(\%o);
    warn "Exit status is $exit\n" if $exit != 1;
    exit($exit == 1 ? $exit ? 0 : $exit : 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 = <F>)) {
            # 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 = <F>)) {
                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 (<DATA>) {
        last if m/^=head1 SYNOPSIS$/;
    }

    while (<DATA>) {
        last if m/^=/;
        $u .= $_;
    }

    $u =~ s/\n//;
    
    die "Usage:$u";

}

__END__

=head1 NAME

sort - sort or merge text files


=head1 SYNOPSIS

  sort [-cmudfinrbD] [-o output_file]
    [-t field_separator] [-X regex_field_separator] [-R record_separator]
    [-k pos1[,pos2]] [+pos1 [-pos2]]
    [-y max_records] [-F max_files]
    input_file1 [input_file2 ...]

  See docs for more information.


=head1 DESCRIPTION

The sort utility 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:

=over 4

=item C<I> I<INPUT>

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<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<m>

Merge only; the input files are assumed to already be sorted.

=item C<o> I<OUTPUT>

Specify the name of an I<OUTPUT> file to be used instead of the standard
output.

=item C<u>

Unique: Suppresses all but one in each set of lines having equal keys.
If used with the B<c> 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<y> I<MAX_SORT_RECORDS>

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<F> I<MAX_SORT_FILES>

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<D>

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<k>), the specified ordering options override all
global ordering options for that key.


=over 4

=item C<d>

Specify that only blank characters and alphanumeric characters,
according to the current locale setting, are significant in comparisons.
B<d> overrides B<i>.

=item C<f>

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<i>

Ignores all characters that are non-printable, according to the current
locale setting.

=item C<n>

Does numeric instead of string compare, using whatever perl considers to
be a number in numeric comparisons.

=item C<r>

Reverse the sense of the comparisons.

=item C<b>

Ignore leading blank characters when determining the starting and ending
positions of a restricted sort key.  If the B<b> option is specified
before the first B<k> option, it is applied to all B<k> options. 
Otherwise, the B<b> option can be attached indepently to each
field_start or field_end option argument (see below).

=item C<t> I<STRING>

Use I<STRING> 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,
E<lt>charE<gt>E<lt>charE<gt> delimits an empty field).  If B<t> 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<X> I<STRING>

Same as B<t>, but I<STRING> 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<STRING> 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<perlre> and L<perlfunc/split>.

=item C<R> I<STRING>

Record separator, defaults to newline.

=item C<k> I<pos1[,pos2]>

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<d>, B<f>, B<i>, B<n>, B<r>.  The b modifier behaves like the
B<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<k> option are significant in command line order. 
If no B<k> 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<u> option is specified, lines that otherwise compare
equal are ordered as if none of the options B<d>, B<f>, B<i>, B<n>
or B<k> were present (but with B<r> 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 I<+pos1 [-pos2]>

Similar to B<k>, 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<k> 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<pos2> must immediately follow
corresponding B<+pos1>.  The rest should be the same as the B<k> option.

Mixing B<+pos1> B<pos2> with B<k> is allowed, but will result in all of
the B<+pos1> B<pos2> options being ordered AFTER the B<k> options.
It is best if you Don't Do That.  Pick one and stick with it.

Here are some equivalencies:

    +1 -2           =>  -k 2,2
    +1.1 -1.2       =>  -k 2.2,2.2
    +1 -2 +3 -5     =>  -k 2,2 -k 4,5
    +2 +0b -1       =>  -k 3 -k 1b,1
    +2.1 -2.4       =>  -k 3.2,3.4
    +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<T> and B<z>.


=head1 EXAMPLES

Sort file by straight string compare of each line.

    sort file

Sort contents of file by second key in file.

    sort -k 2 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 -r -k 2.2,2.2 -o outfile 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 -u -r -k 5.3,5.5rn -k 2.2,2.2 -o outfile file1 file2

Print passwd(4) file sorted by numeric user ID.

    sort -t : -k 3n /etc/passwd

For the anal sysadmin, check that passwd(4) file is sorted by numeric
user ID.

    sort -c -t : -k 3n /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<d>, B<f>, B<i> and B<n>
options.

=item MAX_SORT_RECORDS

Default is 200,000.  Maximum number of records to use before writing
to a temp file.  Overriden by B<y> option.

=item MAX_SORT_FILES

Maximum number of open temp files to use before merging open temp
files.  Overriden by B<F> option.

=back


=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.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.68, Saturday, February 12, 2000

Closed all files in test.pl so they could be unlinked on some
platforms.  (Hubert Toullec)

Documented C<I> option.  (Hubert Toullec)

Removed O_EXCL flag from C<sort_file>.

Fixed bug in sorting multiple files.  (Paul Eckert)


=item v0.67 Friday, April 30, 1999

Merged sources back into File::Sort module.

Fixed a few bugs, including accepting input via STDIN if
no input files given.


=item v0.66 Monday, April 5, 1999

Added B<+pos1> B<-pos2>, and B<X> (regex field separator).

More minor fixes to sort subs.


=item v0.65 Sunday, April 4, 1999

Added B<b> and B<R> (record separator).

Made more fixes to sort subs.  Seems to be getting pretty stable now,
after some serious rewriting.  Borrowed several ideas from Albert
Dvornik's implementation.

Tidied up docs.

Added usage() function.


=item v0.60 Saturday, April 3, 1999

Rewrote most of the sort sub stuff to be more efficient and in some 
cases to just make it work right.

Can now use multiple B<k> switches.  Need Getopt::Long 2.17 (comes with
perl 5.005_02).  Earlier versions of module work?

Still need to go back and implement B<+pos1> B<-pos2> if I feel like it.


=item v0.51 Tuesday, March 30, 1999

First round of fixes.


=item v0.50 Monday, March 29, 1999

Rewrote much of the code for the PPT project.  Will integrate changes
back into the original source, the File::Sort module.

=back

=head1 THANKS

Mike Blazer E<lt>blazer@mail.nevalink.ruE<gt>,
Vicki Brown E<lt>vlb@cfcl.comE<gt>,
Tom Christiansen E<lt>tchrist@perl.comE<gt>,
Albert Dvornik E<lt>bert@mit.eduE<gt>,
Paul Eckert E<lt>peckert@epicrealm.comE<gt>,
Gene Hsu E<lt>gene@moreinfo.comE<gt>,
Andrew M. Langmead E<lt>aml@world.std.comE<gt>,
Gael Marziou E<lt>gael_marziou@hp.comE<gt>,
Brian L. Matthews E<lt>blm@halcyon.comE<gt>,
Rich Morin E<lt>rdm@cfcl.comE<gt>,
Matthias Neeracher E<lt>neeri@iis.ee.ethz.chE<gt>,
Miko O'Sullivan E<lt>miko@idocs.comE<gt>,
Tom Phoneix E<lt>rootbeer@teleport.comE<gt>,
Marco A. Romero E<lt>mromero@iglou.comE<gt>,
Gurusamy Sarathy E<lt>gsar@activestate.comE<gt>,
Hubert Toullec E<lt>Hubert.Toullec@wanadoo.frE<gt>.


=head1 AUTHOR

Chris Nandor E<lt>pudge@pobox.comE<gt>, http://pudge.net/

Copyright (c) 1997-2001 Chris Nandor.  All rights reserved.  This program
is free software; you can redistribute it and/or modify it under the terms
of the Artistic License, distributed with Perl.


=head1 VERSION

v1.00, Tuesday, November 13, 2001


=head1 SEE ALSO

PPT project, <URL:http://sf.net/projects/ppt/>,
sort(1), File::Sort, locale.

=cut