File-Sort-1.01/Makefile.PL100666 000000 000000 363 7423375625 15763 0ustar00unknownunknown 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/MANIFEST100666 000000 000000 144 7423375625 15137 0ustar00unknownunknown 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/README100666 000000 000000 2275 7423375625 14715 0ustar00unknownunknown 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.pm100666 000000 000000 75160 7423375625 15345 0ustar00unknownunknown 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.txt100666 000000 000000 75160 7423375625 17725 0ustar00unknownunknown 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.txt100666 000000 000000 75160 7423375625 17543 0ustar00unknownunknown 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 () { while () { while (keys %fh) { } } } } } } } } } } } } } else { } else { } else { } else { } else { } else { } elsif (!ref $file) { } elsif ($opts->{'m'}) { } keys %oth; }); }); OPTION => VALUE OPTION => [VALUE1, VALUE2] sort_file('file1', 'file1.sorted'); sort_file({ use File::Sort qw(sort_file); }); # plus optional arrayref of sorted scalars # take optional arrayref of handles of sorted files, $VERSION = '1.01'; =back =back =back =back =back =cut =head1 AUTHOR =head1 DESCRIPTION =head1 ENVIRONMENT =head1 EXAMPLES =head1 EXPORT =head1 HISTORY =head1 NAME =head1 SEE ALSO =head1 SYNOPSIS =head1 THANKS =head1 TODO =head1 VERSION =head2 Not Implemented =head2 Options =item Better debugging and error reporting =item Better test suite =item C =item C I =item C I =item C I =item C I =item C =item C =item C =item C =item C =item C I =item C =item C =item C I =item C I<+pos1 [-pos2]> =item C =item C I =item C =item C I =item Do bytes instead of lines =item LC_COLLATE =item LC_CTYPE =item MAX_SORT_FILES =item MAX_SORT_RECORDS =item Performance hit with -u =item Switch for turning off locale ... ? =item v0.01 (18 December 1997) =item v0.02 (19 December 1997) =item v0.03 (23 December 1997) =item v0.10 (03 January 1998) =item v0.11 (04 January 1998) =item v0.16 (24 December 1998) =item v0.17 (30 December 1998) =item v0.18 (31 January 1998) =item v0.20 =item v0.90, Friday, April 30, 1999 =item v0.91, Saturday, February 12, 2000 =item v1.00, Tuesday, November 13, 2001 =item v1.01, Monday, January 14, 2002 =over 4 =over 4 =over 4 =over 4 =over 4 @EXPORT_OK = 'sort_file'; @ISA = 'Exporter'; Add O_TRUNC to output open (D'oh!). Added c option to check sorting. Added reverse and numeric sorting options. Added unique and merge-only options. Albert Dvornik Ebert@mit.eduE, Also now use C to create temp files, so the TMPDIR option is Andrew M. Langmead Eaml@world.std.comE, B option, but applies only to the field_start or field_end to which B, B, B, B, B, B. The b modifier behaves like the B overrides B. Brian L. Matthews Eblm@halcyon.comE, C object. Change license to be that of Perl. Check that single input fle is ordered as specified by the arguments and Chris Nandor Epudge@pobox.comE, http://pudge.net/ Closed all files in test.pl so they could be unlinked on some Complete rewrite. Took the code from this module to write sort Consider all lower-case characters that have upper-case equivalents, Copyright (c) 1997-2002 Chris Nandor. All rights reserved. This program Default is 200,000. Maximum number of records to use before writing Default is 200,000. This may eventually change to be kbytes instead of Determine the locale for ordering rules. Determine the locale for the interpretation of sequences of bytes of Documented C option. (Hubert Toullec) Does numeric instead of string compare, using whatever perl considers to EcharEEcharE delimits an empty field). If B is not Except when the B option is specified, lines that otherwise compare Exports C on request. File::Sort - Sort a file or merge sort multiple files First release. Fix filehandle close test of STDOUT (Gael Marziou). Fixed bug in C<_merge_files> that tried to C a passed Fixed bug in sorting multiple files. (Paul Eckert) Fixed bug with unique option (didn't work :). Fixed up docs and did some more tests and benchmarks. For the anal sysadmin, check that passwd(4) file is sorted by numeric Gael Marziou Egael_marziou@hp.comE, Gene Hsu Egene@moreinfo.comE, Gurusamy Sarathy Egsar@activestate.comE, Here are some equivalencies: Hubert Toullec EHubert.Toullec@wanadoo.frE. If any modifier is attached to a field_start or a field_end, no option If no B option is specified, a default sort key of the entire line If the options are not listed as implemented above, or are not If used with the B option check that there are no lines with If you need the old interface, the old module will remain on CPAN, but Ignore leading blank characters when determining the starting and ending Ignores all characters that are non-printable, according to the current It is best if you Don't Do That. Pick one and stick with it. Long overdue release. MAX_SORT_RECORDS environment variable. Made CHUNK default a lot larger, which improves performance. On Marco A. Romero Emromero@iglou.comE, Matthias Neeracher Eneeri@iis.ee.ethz.chE, Maximum number of lines (records) read before writing to temp file. Maximum number of open temp files to use before merging open temp Maximum number of temp files to be held open at once. Default to 40, Merge only; the input files are assumed to already be sorted. Mike Blazer Eblazer@mail.nevalink.ruE, Miko O'Sullivan Emiko@idocs.comE, Mixing B<+pos1> B with B is allowed, but will result in all of More cleanup; fixed special case of no linebreak on last line; wrote test Note that if you change the locale settings after the program has started Occurrences of the B option are significant in command line order. One year between releases was too long. I made changes Miko O'Sullivan Otherwise, the B option can be attached indepently to each Pass in the input file(s). This can be either a single string with the Paul Eckert Epeckert@epicrealm.comE, Played with somem of the -k options (Marco A. Romero). Print passwd(4) file sorted by numeric user ID. Print to STDOUT if no output file supplied. Record separator, defaults to newline. Removed O_EXCL flag from C. Reverse the sense of the comparisons. Rich Morin Erdm@cfcl.comE, Same as B, but I is interpreted as a Perl regular expression Same sort but sorting numerically on characters 3 through 5 of Send debugging information to STDERR. Behavior subject to change. Similar to B, these are mostly obsolete switches, but some people Some cleanup. Some cleanup; made it not subject to system file limitations; separated Sort contents of file by second key in file. Sort file by straight string compare of each line, sending Sort, in reverse order, contents of file1 and file2, placing Specify that only blank characters and alphanumeric characters, Specify the name of an I file to be used instead of the standard Switched to sysopen for better portability. Tests 3 and 4 failed because we hit the open file limit in the The following options are available, and are passed in the hash The following options override the default ordering rules. When ordering The good news is that it should not be too difficult to update your The keydef argument is a restricted sort key field definition. The The string matched by I is not included in the fields This includes B and B. This interface will always be supported, though a more perlish This module sorts text files by lines (or records). Comparisons Tom Christiansen Etchrist@perl.comE, Tom Phoneix Erootbeer@teleport.comE, Unique: Suppresses all but one in each set of lines having equal keys. Use I as the field separator character; char is not considered Vicki Brown Evlb@cfcl.comE, Where an option can take multiple values (like C, C, and C), Where field_end in B specified the last position to be included, Where the OPTION is a switch, it should be passed a boolean VALUE __END__ according to the current locale setting, are significant in comparisons. according to the current locale setting, to be the upper-case equivalent and are performed lexicographically. By default, if keys are not given, applies to either. are based on one or more sort keys extracted from each line of input, are counted from 0 instead of 1. B must immediately follow are used for options, but there are also some key behavioral differences. as older Windows ports had quite a small limit. Can also specify as the sort key. at all if MAX_SORT_RECORDS is never reached. be a number in numeric comparisons. before the first B option, it is applied to all B options. character classification for the B, B, B, B and B character is a field separator. characters in arguments and input files) and the behaviour of code to use the new interface. comparison. The order in which lines that still compare equal are consecutive lines with duplicate keys, in addition to checking that the corresponding B<+pos1>. The rest should be the same as the B option. equal are ordered as if none of the options B, B, B, B escaped internally, and will be escaped for you). example: faster, while supporting more options for sorting, including delimited field ordering rules are applied globally to all sort keys. When attached field). See L and L. field_start or field_end option argument (see below). filename, or an array reference containing multiple filename strings. files), changed docs. (Mike Blazer, Gurusamy Sarathy) files. Overriden by B option. for the purposes of comparison. for total number of temp files from 50 to 40 (leave room for other open format of this definition is: global ordering options for that key. input file is sorted. instead. Do not escape any characters (C characters need to be interface may be offered in the future, as well. This interface is basically a mapping of the command-line options to the Unix is free software; you can redistribute it and/or modify it under the same is used. When there are multiple keys fields, later keys are compared it is attached. The other modifiers behave like the corresponding it specifes the last position to NOT be included. Also, numbers like them and want to use them. Usage is: lines. Lines was easier to implement. Can also specify with listed in TODO below, they are not in the plan for implementation. locale setting. low-memory systems, or where (e.g.) the MacPerl binary is not allocated many parts out into separate functions. maximal non-empty sequence of blank characters that follows a non-blank much RAM, it might need to be lowered. no longer supported. Hopefully made the whole thing more robust and occurrence of char is significant (for example, of 1 or 0. only after all earlier keys compare equal. only the exit code is affected. options appear independent of any key field specifications, the requested options, but apply only to the key field to which they are attached; options. or B were present (but with B still in effect, if it was output in outfile and using second character of second field output to STDOUT. output. package File::Sort; platforms. (Hubert Toullec) portion of the line, and type is a modifier from the list of characters positions of a restricted sort key. If the B option is specified reference passed to the function in the format: regexes in parentheses will add that matched expression as an extra require Exporter; sort regards each input line as a single field. The sort is a merge sort utility. sort(1), locale, PPT project, . sort. If you don't like that, feel free to change it. sorts, and arbitrary sorts. specified) and with all bytes in the lines significant to the specified, blank characters are used as default field separators; each standard Windows port of perl5.004_02 (50). Adjusted the default sub _are_uniq { sub _check_last { sub _debug { sub _get_temp { # nice and simple sub _make_sort_sub { sub _merge_files { sub _parse_keydef { sub _sort_file { sub _write_temp { sub sort_file { sub usage { suite; fixed warning for redefined subs (sort1 and sort2). terms as Perl itself. text data as characters (for example, single- versus multi-byte the B<+pos1> B options being ordered AFTER the B options. the collating sequence of the current locale. No output is produced; the fifth field first, and only return records with unique keys. the interface has changed slightly, mostly in regard to what letters themselves, unless demanded by perl's regex and split semantics (e.g., they have this effect if specified with field_start, field_end, or both. to a specific key (see B), the specified ordering options override all to a temp file. Overriden by B option. to be part of a field (although it can be included in a sort key). Each up, you must call setlocale() for the new settings to take effect. For use Carp; use Fcntl qw(O_RDONLY O_WRONLY O_CREAT O_TRUNC); use Symbol qw(gensym); use locale; use strict; use vars qw($VERSION *sortsub *sort1 *sort2 *map1 *map2 %fh); use vars qw(@ISA @EXPORT_OK); user ID. utility for PPT project, then brought changes back over. As a result v1.01, Monday, January 14, 2002 values may be passed via an anonymous array: wanted, and I didn't even know I had made them. where field_start and field_end define a key field restricted to a will not be supported. Sorry for any inconvenience this may cause. with MAX_SORT_FILES environment variable. No temp files will be used written is unspecified. } } } } } } } } } } } File-Sort-1.01/test.pl100666 000000 000000 7772 7423375625 15360 0ustar00unknownunknown 0 0 #!perl -w use diagnostics; # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) BEGIN { # turn off locales for test use POSIX 'locale_h'; $ENV{LC_ALL} = $ENV{LANG} = ''; setlocale(LC_CTYPE, ""); setlocale(LC_COLLATE, ""); } BEGIN { $| = 1; print "1..8\n"; } END {print "not ok 1\n" unless $loaded;} use lib 'lib', 'blib'; use File::Sort 0.90 qw(sort_file); $loaded = 1; print "ok 1\n"; my $D = 0; my $i = 1; ######################### End of black magic. # Insert your test code below (better if it prints "ok 13" # (correspondingly "not ok 13") depending on the success of chunk 13 # of the test code): if (1) { local(*F0, *F1, *F2, *F3); my $fail1 = 0; my $fail2 = 0; my @files = qw( Sort.pm_sorted Sort.pm_sorted.txt Sort.pm_rsorted Sort.pm_rsorted.txt ); sort_file({ I => 'Sort.pm', o => $files[0], D => $D }); sort_file({ I => 'Sort.pm', o => $files[2], r => 1, D => $D }); open F0, $files[0] or $fail1++; open F1, $files[1] or $fail1++; open F2, $files[2] or $fail2++; open F3, $files[3] or $fail2++; while () { chomp; defined(my $l = ) or ($fail1++, last); chomp $l; $fail1++ if $l ne $_; } while () { chomp; defined(my $l = ) or ($fail2++, last); chomp $l; $fail2++ if $l ne $_; } close F0; close F1; close F2; close F3; printf "%s %d\n", ($fail1 ? 'not ok' : 'ok'), ++$i; printf "%s %d\n", ($fail2 ? 'not ok' : 'ok'), ++$i; unlink $files[0] unless $fail1; unlink $files[2] unless $fail2; open F1, $files[1] or $fail1++; open F3, $files[3] or $fail1++; my $temp = join '', sort , ; close F1; close F3; sort_file({ I => [@files[1, 3]], o => $files[0], D => $D }); open F0, $files[0] or $fail1++; { local $/; $fail1 ||= ne $temp; printf "%s %d\n", ($fail1 ? 'not ok' : 'ok'), ++$i; } close F0; unlink $files[0] unless $fail1; } if (1) { local(*F0, *F1, *F2); my $fail1 = 0; my $fail2 = 0; my @lines; my @files = qw( test10 test20 test30 ); for (0 .. 99) { (rand() > .5) ? push(@lines, $_) : unshift(@lines, $_); } open F0, ">$files[0]" or $fail1++ && $fail2++; print F0 join "\n", @lines; close F0; sort_file({ I => $files[0], o => $files[1], n => 1, 'y' => 2, D => $D }); sort_file({ I => $files[0], o => $files[2], n => 1, r => 1, 'y' => 2, D => $D }); open F1, $files[1] or $fail1++; open F2, $files[2] or $fail2++; for (0 .. 99) { defined(my $l = ) or ($fail1++, last); chomp $l; $fail1++ if $l != $_; } for (reverse (0 .. 99)) { defined(my $l = ) or ($fail2++, last); chomp $l; $fail2++ if $l != $_; } close F1; close F2; printf "%s %d\n", ($fail1 ? 'not ok' : 'ok'), ++$i; printf "%s %d\n", ($fail2 ? 'not ok' : 'ok'), ++$i; unlink @files unless $fail1 || $fail2; } if (1) { my $fail1 = 0; my $fail2 = 0; my @lines; my @files = qw( test11 test21 test31 ); for (0 .. 99) { (rand() > .5) ? push(@lines, sprintf "%s|$_", $_ % 2) : unshift(@lines, sprintf "%s|$_", $_ % 2); } open F0, ">$files[0]" or $fail1++ && $fail2++; print F0 join "\n", @lines; close F0; sort_file({ I => $files[0], o => $files[1], n => 1, t => '|', k => 2, Y => 3, D => $D }); sort_file({ I => $files[0], o => $files[2], n => 1, r => 1, t => '|', k => 2, Y =>3 , D => $D }); open F1, $files[1] or $fail1++; open F2, $files[2] or $fail2++; for (0 .. 99) { defined(my $l = ) or ($fail1++ or last); chomp $l; $_ = sprintf "%s|$_", $_ % 2; $fail1++ if $l ne $_; } for (reverse (0 .. 99)) { defined(my $l = ) or ($fail2++, last); chomp $l; $_ = sprintf "%s|$_", $_ % 2; $fail2++ if $l ne $_; } close F1; close F2; printf "%s %d\n", ($fail1 ? 'not ok' : 'ok'), ++$i; printf "%s %d\n", ($fail2 ? 'not ok' : 'ok'), ++$i; unlink @files unless $fail1 || $fail2; } File-Sort-1.01/eg/sort.pudge.PL100666 000000 000000 72371 7423375626 17004 0ustar00unknownunknown 0 0 #!perl use Config; use File::Basename qw(&basename &dirname); use Cwd; $origdir = cwd; chdir dirname($0); $file = basename($0, '.PL'); $file .= '.com' if $^O eq 'VMS'; open OUT,">$file" or die "Can't create $file: $!"; print "Extracting $file (with variable substitutions)\n"; print OUT <<"!GROK!THIS!"; $Config{startperl} -w- !GROK!THIS! # In the following, perl variables are not expanded during extraction. print OUT <<'!NO!SUBS!'; # 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 = )) { # 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 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 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 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: +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 and B. =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, 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 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 option. (Hubert Toullec) Removed O_EXCL flag from C. 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 (regex field separator). More minor fixes to sort subs. =item v0.65 Sunday, April 4, 1999 Added B and B (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 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 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-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, , sort(1), File::Sort, locale. =cut !NO!SUBS! close OUT or die "Can't close $file: $!"; chmod 0755, $file or die "Can't reset permissions for $file: $!\n"; exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':'; chdir $origdir;