#!/afs/athena/contrib/perl/p

### MSORT
### A Better Sort of Sort
### (c) 1991 by Bob Glickstein

@_ = split(/\/+/, $0);
$ProgramName = pop(@_);
$Version = '1.0';

$SIG{'HUP'} = 'interrupthandler';
$SIG{'INT'} = 'interrupthandler';
$SIG{'QUIT'} = 'interrupthandler';
$SIG{'PIPE'} = 'interrupthandler';
$SIG{'TERM'} = 'interrupthandler';

$[ = 0;

$Analyze = 0;
$MaxChunkBytes = ($ENV{'MSORTCHUNKBYTES'} || 8192);
$MaxChunkLines = ($ENV{'MSORTCHUNKLINES'} || 256);
$MaxChunks = $ENV{'MSORTCHUNKS'};
$FieldSepRegexp = '\s+';
$MultiFieldSep = '';

@SortList = ();

$ChosenSort = 'ascii';
$Reverse = 0;
$CaseMatters = 1;

$TmpDir = ($ENV{'MSORTTMPDIR'} || '/tmp');

$Verbose = 0;

$" = '';

@MsortPath = ();
@OrigINC = @INC;

if ($_ = $ENV{'MSORTPATH'}) {
    @MsortPath = split(/:/, $_);
    @INC = (@MsortPath, @OrigINC);
}

if ($_ = $ENV{'MSORTLIBS'}) {
    @libs = split(/:/, $_);
    foreach $lib (@libs) {
	require $lib || require "$lib.pl"
	    || die "Cannot preload library $libname ($!)\n";
    }
}

$Usage  = "[options] [--] [file] ...\n";
$Usage .= "Options are:\n";
$Usage .= "    -v[v[v...]]         Verbose\n";
$Usage .= "    -a                  Analyze input\n";
$Usage .= "    -mc chunks          Max chunks (with -a)\n";
$Usage .= "    -I dir (or -L dir)  Add dir to library search path\n";
$Usage .= "    -l lib              Load library lib\n";
$Usage .= "    -s sortname         Select a sort (ascii,bib,num,name,date)\n";
$Usage .= "    -r                  Reverse sort\n";
$Usage .= "    -c, +c              Case-sensitivity off/on\n";
$Usage .= "    [-+]num1[,num2]     Sort on num2 fields starting at num1\n";
$Usage .= "    -f regexp           Field-separator\n";
$Usage .= "    -mf string          Multi-field join delimiter\n";
$Usage .= "    -irs string         Input record separator\n";
$Usage .= "    -mb num             Max bytes per chunk\n";
$Usage .= "    -ml num             Max lines per chunk\n";
$Usage .= "    -t dir              Directory for temp files";

$chosesort = 0;
$chosefield = 0;
while ($_ = $ARGV[0], /^[-+]/) {
    shift;
    last if /^--$/;
    if (/^-(v+)$/) {
	$Verbose += length($1); 
    } elsif (/^-a$/) {
	$Analyze = 1;
    } elsif (/^-[IL](.*)$/) {
	push(@MsortPath, ($1 || shift));
	@INC = (@MsortPath, @OrigINC);
    } elsif (/^-l(.*)$/) {
	$libname = ($1 || shift);
	require $libname || require "$libname.pl"
	    || die "Cannot load library $libname ($!)\n";
    } elsif (/^-s(.*)$/) {
	if ($chosesort && !$chosefield) {
	    push(@SortList, 0, 0, 0, $ChosenSort, $Reverse, $CaseMatters);
	}
	$ChosenSort = ($1 || shift);
	$Reverse = 0;
	$CaseMatters = 1;
	$chosesort = 1;
	$chosefield = 0;
	next;
    } elsif (/^-r$/) {
	$Reverse = 1 - $Reverse;
    } elsif (/^-f(.*)$/) {
	$FieldSepRegexp = ($1 || shift);
    } elsif (/^-mf(.*)$/) {
	$MultiFieldSep = ($1 || shift);
    } elsif (/^-irs(.*)$/) {
	$/ = ($1 || shift);
    } elsif (/^-mb(.*)$/) {
	$MaxChunkBytes = ($1 || shift);
    } elsif (/^-ml(.*)$/) {
	$MaxChunkLines = ($1 || shift);
    } elsif (/^-mc(.*)$/) {
	$MaxChunks = ($1 || shift);
    } elsif (/^-t(.*)$/) {
	$TmpDir = ($1 || shift);
    } elsif (/^-c$/) {
	$CaseMatters = 0;
    } elsif (/^\+c$/) {
	$CaseMatters = 1;
    } elsif (/^-([0-9]+)(,([0-9]+))?$/) {
	$chosefield = 1;
	push(@SortList,
	     1, $1, ($3 || 1), $ChosenSort, $Reverse, $CaseMatters);
    } elsif (/^\+([0-9]+)(,([0-9]+))?$/) {
	$chosefield = 1;
	push(@SortList,
	     0, $1, ($3 || 1), $ChosenSort, $Reverse, $CaseMatters);
    } elsif (/^-V$/) {
	print "$ProgramName version $Version\n";
	exit 0;
    } elsif (/^-h(elp)?$/) {
	print "Usage: $ProgramName $Usage\n";
	exit 0;
    } else {
	die "Unknown option '$_'\nUsage: $ProgramName $Usage\n";
    }
}

ANALYSIS: {
if ($Analyze) {
    if (@ARGV) {
	warn "[analyzing size of input]\n" if $Verbose;
	$lines = 0;
	$bytes = 0;
	foreach $file (@ARGV) {
	    warn "[analyzing $file...]\n" if $Verbose > 2;
	    if ($file eq '-') {
		warn "$ProgramName: cannot analyze standard input\n";
		last ANALYSIS;	# Yuk yuk yuk
	    }
	    open(_, "<$file") || die "Cannot open input file $file ($!)\n";
	    while (<_>) {
		++ $lines;
		$bytes += length($_);
	    }
	    close(_);
	    warn "[analysis so far: $lines lines, $bytes bytes]\n"
		if $Verbose > 1;
	}
	$maxfiles = &MaxDescriptors;
	$maxfiles = $MaxChunks if ($MaxChunks && ($MaxChunks < $maxfiles));
	$maxfiles -= 10;
	$MaxChunkBytes = $bytes / $maxfiles;
	$MaxChunkLines = $lines / $maxfiles;
	$MaxChunkBytes = 1024 if $MaxChunkBytes <1024;
	$MaxChunkLines = 32 if $MaxChunkLines < 32;
	warn "[analysis complete, chose $MaxChunkLines/$MaxChunkBytes]\n"
	    if $Verbose;
    } else {
	warn "$ProgramName: cannot analyze standard input\n";
    }
}
}	

@NamePrefixes = (
		 'adm',
		 'admiral',
		 'ambassador',
		 'archbishop',
		 'archduke',
		 'bishop',
		 'capt',
		 'captain',
		 'cardinal',
		 'cdr',
		 'chief',
		 'cmdr',
		 'commander',
		 'col',
		 'colonel',
		 'deputy',
		 'det',
		 'detective',
		 'director',
		 'dr',
		 'duke',
		 'eminence',
		 'father',
		 'fraulein',
		 'friar',
		 'gen',
		 'general',
		 'gov',
		 'governor',
		 'her',
		 'herr',
		 'highness',
		 'his',
		 'holy',
		 'hon',
		 'honorable',
		 'judge',
		 'lady',
		 'lieutenant',
		 'lord',
		 'lt',
		 'madame',
		 'mademoiselle',
		 'maj',
		 'majesty',
		 'major',
		 'mayor',
		 'miss',
		 'mme',
		 'mmle',	# Is this the right abbrev for mademoiselle?
		 'monsieur',
		 'monsignor',	# What's the abbreviation for this?
		 'mr',
		 'mrs',
		 'ms',
		 'officer',
		 'pres',
		 'president',
		 'private',
		 'pvt',
		 'rabbi',
		 'rear',
		 'rev',
		 'reverend',
		 'royal',
		 'senator',
		 'senor',
		 'senora',
		 'senorita',
		 'sergeant',
		 'sgt',
		 'signor',
		 'signora',
		 'signorina',
		 'sir',
		 'sr',
		 'sra',
		 'the'
		 );

@NameSuffixes = (
		 'b',
		 'd',
		 'dds',
		 'e',
		 'esq',
		 'esquire',
		 'ii',
		 'iii',
		 'iv',
		 'ix',
		 'jr',
		 'm',
		 'md',
		 'o',
		 'obe',
		 'ph',
		 'phd',
		 's',
		 'sr',
		 'the',
		 'v',
		 'vi',
		 'vii',
		 'viii',
		 'x',
		 'xi',
		 'xii',
		 'xiii',
		 'xiv',
		 'xv',
		 'xvi',
		 'xvii',
		 'xviii'
		 );


@ChunkFiles = ();

@chunk = ();
$chunkbytes = 0;

while (<>) {
    push(@chunk, $_);
    $chunkbytes += length($_);
    if (($chunkbytes >= $MaxChunkBytes)
	|| (@chunk >= $MaxChunkLines)) {
	printf(STDERR "[sorting chunk %d (%d/%d)]\n",
	       1 + @ChunkFiles, 0 + @chunk, $chunkbytes) if $Verbose;
	@chunk = sort SortPredicate @chunk;
	$chunkfile = sprintf("$TmpDir/mschunk.$$.%d", 1 + @ChunkFiles);
	open(_, ">$chunkfile") ||
	    die "Cannot open temp file $chunkfile ($!)\n";
	print _ @chunk;
	close _;
	printf(STDERR "[stored chunk %d in %s]\n", 1 + @ChunkFiles, $chunkfile)
	    if $Verbose > 1;
	push(@ChunkFiles, $chunkfile);
	$chunkbytes = 0;
	@chunk = ();
    }
}
if (@chunk) {
    printf(STDERR "[sorting chunk %d (%d/%d)]\n",
	   1 + @ChunkFiles, 0 + @chunk, $chunkbytes) if $Verbose;
    @chunk = sort SortPredicate @chunk;
    unless (@ChunkFiles) {
	print @chunk, "\n";
	exit 0;
    }
    $chunkfile = sprintf("$TmpDir/mschunk.$$.%d", 1 + @ChunkFiles);
    open(_, ">$chunkfile") ||
	die "Cannot open temp file $chunkfile ($!)\n";
    print _ @chunk;
    close _;
    printf(STDERR "[stored chunk %d in %s]\n", 1 + @ChunkFiles, $chunkfile)
	if $Verbose > 1;
    push(@ChunkFiles, $chunkfile);
    @chunk = ();
} elsif (@ChunkFiles == 1) {
    open(<_>, "<$ChunkFiles[0]")
	|| die "Cannot read temp file $ChunkFiles[0] ($!)\n";
    while (<_>) {
	print;
    }
    close _;
    unlink $ChunkFiles[0];
    exit 0;
}

@ChunkHandles = ();

$i = 1;
foreach $chunkfile (@ChunkFiles) {
    $handlename = "CHUNK$i";
    ++ $i;
    open($handlename, "<$chunkfile")
	|| die "Cannot read temp file $chunkfile ($!)\n";
    push(@ChunkHandles, $handlename);
}

@Heads = ();

foreach $chunkhandle (@ChunkHandles) {
    $_ = <$chunkhandle>;
    push(@Heads, $_);
}

while (@Heads) {
    $best = $Heads[0];
    $besti = 0;
    foreach $i (1 .. $#Heads) {
	if (&ComparePredicate($Heads[$i], $best) < 0) {
	    $best = $Heads[$i];
	    $besti = $i;
	}
    }
    print $best;
    $chunkhandle = $ChunkHandles[$besti];
    $_ = <$chunkhandle>;
    if ($_) {
	splice(@Heads, $besti, 1, $_);
    } else {
	splice(@Heads, $besti, 1);
	close($ChunkHandles[$besti]);
	splice(@ChunkHandles, $besti, 1);
	unlink $ChunkFiles[$besti];
	splice(@ChunkFiles, $besti, 1);
    }
}

exit 0;

##############################################################################

sub interrupthandler {
    local($sig) = @_;

    warn "$ProgramName: received signal $sig, cleaning up temp files...\n";
    foreach (@ChunkFiles) {
	unlink;
    }
    exit 1;
}

sub SortPredicate {
    &ComparePredicate($a, $b);
}

sub ComparePredicate {
    local($x, $y) = @_;
    local(@x, @y);
    local(@sorts) = @SortList;
    local($xfield, $yfield);
    local($xfrom, $yfrom);
    local($result);

    if (@sorts) {
	@x = split(/$FieldSepRegexp/o, $x);
	@y = split(/$FieldSepRegexp/o, $y);
	while (@sorts) {
	    ($fromend, $fieldnum, $numfields,
	     $sortname, $Reverse, $CaseMatters) = @sorts;
	    splice(@sorts, 0, 6);
	    $xfrom = ($fromend ? ($#x - $fieldnum) : $fieldnum);
	    $xfield = join($MultiFieldSep,
			   @x[$xfrom .. ($numfields ?
					 ($xfrom + $numfields - 1) :
					 $#x)]);
	    $yfrom = ($fromend ? ($#y - $fieldnum) : $fieldnum);
	    $yfield = join($MultiFieldSep,
			   @y[$yfrom .. ($numfields ?
					 ($yfrom + $numfields - 1) :
					 $#y)]);
	    $result = $Reverse ?
		&$sortname($yfield, $xfield) : &$sortname($xfield, $yfield);
	    return $result if $result;
	}
	@x = @x[1 + ($fromend ? ($#x - $fieldnum) : $fieldnum) .. $#x];
	@y = @y[1 + ($fromend ? ($#y - $fieldnum) : $fieldnum) .. $#y];
	while (@x && @y) {
	    $result = $Reverse ?
		&$sortname($y[0], $x[0]) : &$sortname($x[0], $y[0]);
	    return $result if $result;
	    shift @x;
	    shift @y;
	}
	if (@x) {
	    return -1 if $Reverse;
	    return 1;
	}
	if (@y) {
	    return 1 if $Reverse;
	    return -1;
	}
	return 0;
    } else {
	return &$ChosenSort($y, $x) if $Reverse;
	return &$ChosenSort($x, $y);
    }
}

sub ascii {
    local($x, $y) = @_;

    return $x cmp $y if $CaseMatters;
    $x =~ tr/A-Z/a-z/;
    $y =~ tr/A-Z/a-z/;
    $x cmp $y;
}

sub num {
    local($x, $y) = @_;

    ($x < $y) ? -1 : (($y < $x) ? 1 : 0);
}

sub bib {
    local($x, $y) = @_;
    local(@x_words,@y_words);

    $x =~ tr/A-Za-z0-9 \t//cd;
    $x =~ tr/A-Z/a-z/;
    $y =~ tr/A-Za-z0-9 \t//cd;
    $y =~ tr/A-Z/a-z/;

    @x_words = split(/\s+/, $x);
    @y_words = split(/\s+/, $y);

    shift @x_words if (($x_words[0] eq 'the')
		       || ($x_words[0] eq 'a')
		       || ($x_words[0] eq 'an'));
    shift @y_words if (($y_words[0] eq 'the')
		       || ($y_words[0] eq 'a')
		       || ($y_words[0] eq 'an'));
    join('', @x_words) cmp join('', @y_words);
}

sub name {
    local($x, $y) = @_;
    local(@x, @y);
    local(@xprefixes) = ();
    local(@xsuffixes) = ();
    local(@yprefixes) = ();
    local(@ysuffixes) = ();

    $x =~ tr/.,/ /;
    $y =~ tr/.,/ /;
    $x =~ tr/A-Za-z \t//cd;
    $x =~ tr/A-Z/a-z/;
    $y =~ tr/A-Za-z \t//cd;
    $y =~ tr/A-Z/a-z/;

    @x = split(/\s+/, $x);
    @y = split(/\s+/, $y);

    while ((@x >= 3)
	   && &AnyMatch($x[0], @NamePrefixes)) {
	push(@xprefixes, shift(@x));
    }
    while ((@x >= 3)
	   && &AnyMatch($x[$#x], @NameSuffixes)) {
	unshift(@xsuffixes, pop(@x));
    }
    unshift(@x, pop(@x));
    while ((@y >= 3)
	   && &AnyMatch($y[0], @NamePrefixes)) {
	push(@yprefixes, shift(@y));
    }
    while ((@y >= 3)
	   && &AnyMatch($y[$#y], @NameSuffixes)) {
	unshift(@xsuffixes, pop(@y));
    }
    unshift(@y, pop(@y));

    join(' ', @x, @xsuffixes) cmp join(' ', @y, @ysuffixes);
}

sub date {
    local($x, $y) = @_;
    local($xday, $xmonth, $xyear);
    local($yday, $ymonth, $yyear);

    $_ = $x;
    s/^\s+//;
    s/\s+$//;
    tr/A-Z/a-z/;
    if (/([0-9]+)[^0-9]+([0-9]+)[^0-9]+([0-9]+)/) {
	if ($1 > 31) {
	    $xday = $3;
	    $xmonth = $2;
	    $xyear = $1;
	} elsif ($1 > 12) {
	    $xday = $1;
	    $xmonth = $2;
	    $xyear = $3;
	} else {
	    $xday = $2;
	    $xmonth = $1;
	    $xyear = $3;
	}
    } elsif (/([a-z]+)[^0-9]*([0-9]+)[^0-9]*([0-9]+)/) {
	$xday = $2;
	$xmonth = $1;
	$xyear = $3;
    } elsif (/([0-9]+)[^0-9a-z]*([a-z]+)[^0-9]*([0-9]+)/) {
	$xday = $1;
	$xmonth = $2;
	$xyear = $3;
    } elsif (/([0-9]+)[^0-9]+([0-9]+)/) {
	$xmonth = $1;
	$xyear = $2;
    } elsif (/([a-z]+)[^0-9a-z]*([0-9]+)/) {
	$xmonth = $1;
	$xyear = $2;
    } elsif (/([0-9]+)/) {
	$xyear = $1;
    } else {
	$xday = 0;
	$xmonth = 0;
	$xyear = 0;
    }
    if ($xyear < 100) {
	$xyear += 1900;
    }
  xm: {
      if ($xmonth =~ /[a-z]/) {
	  $_ = $xmonth;
	  /^ja/ && ($xmonth = 1, last xm);
	  /^f/ && ($xmonth = 2, last xm);
	  /^mar/ && ($xmonth = 3, last xm);
	  /^ap/ && ($xmonth = 4, last xm);
	  /^may/ && ($xmonth = 5, last xm);
	  /^jun/ && ($xmonth = 6, last xm);
	  /^jul/ && ($xmonth = 7, last xm);
	  /^au/ && ($xmonth = 8, last xm);
	  /^s/ && ($xmonth = 9, last xm);
	  /^o/ && ($xmonth = 10, last xm);
	  /^n/ && ($xmonth = 11, last xm);
	  /^d/ && ($xmonth = 12, last xm);
	  $xmonth = 0;
      }
  }
    $_ = $y;
    s/^\s+//;
    s/\s+$//;
    tr/A-Z/a-z/;
    if (/([0-9]+)[^0-9]+([0-9]+)[^0-9]+([0-9]+)/) {
	if ($1 > 31) {
	    $yday = $3;
	    $ymonth = $2;
	    $yyear = $1;
	} elsif ($1 > 12) {
	    $yday = $1;
	    $ymonth = $2;
	    $yyear = $3;
	} else {
	    $yday = $2;
	    $ymonth = $1;
	    $yyear = $3;
	}
    } elsif (/([a-z]+)[^0-9]*([0-9]+)[^0-9]*([0-9]+)/) {
	$yday = $2;
	$ymonth = $1;
	$yyear = $3;
    } elsif (/([0-9]+)[^0-9a-z]*([a-z]+)[^0-9]*([0-9]+)/) {
	$yday = $1;
	$ymonth = $2;
	$yyear = $3;
    } elsif (/([0-9]+)[^0-9]+([0-9]+)/) {
	$ymonth = $1;
	$yyear = $2;
    } elsif (/([a-z]+)[^0-9a-z]*([0-9]+)/) {
	$ymonth = $1;
	$yyear = $2;
    } elsif (/([0-9]+)/) {
	$yyear = $1;
    } else {
	$yday = 0;
	$ymonth = 0;
	$yyear = 0;
    }
    if ($yyear < 100) {
	$yyear += 1900;
    }
  ym: {
      if ($ymonth =~ /[a-z]/) {
	  $_ = $ymonth;
	  /^ja/ && ($ymonth = 1, last ym);
	  /^f/ && ($ymonth = 2, last ym);
	  /^mar/ && ($ymonth = 3, last ym);
	  /^ap/ && ($ymonth = 4, last ym);
	  /^may/ && ($ymonth = 5, last ym);
	  /^jun/ && ($ymonth = 6, last ym);
	  /^jul/ && ($ymonth = 7, last ym);
	  /^au/ && ($ymonth = 8, last ym);
	  /^s/ && ($ymonth = 9, last ym);
	  /^o/ && ($ymonth = 10, last ym);
	  /^n/ && ($ymonth = 11, last ym);
	  /^d/ && ($ymonth = 12, last ym);
	  $ymonth = 0;
      }
  }
    ($xyear - $yyear) || ($xmonth - $ymonth) || ($xday - $yday);
}

sub AnyMatch {
    local($str, @strs) = @_;

    foreach (@strs) {
	($str eq $_) && return 1;
    }
    0;
}

sub MaxDescriptors {
    local($result) = '';

    warn "[trying to determine per-process file-descriptor limit...]\n"
	if $Verbose > 1;
    warn "[looking for OPEN_MAX in /usr/include/sys/limits.h]\n"
	if $Verbose > 2;
    if (open(_, "/usr/include/sys/limits.h")) {
	while (<_>) {
	    if (/^#\s*define\s+OPEN_MAX\s+[^0-9]*([0-9]+)/) {
		$result = $1;
		close(_);
		warn "[...looks like it's $result]\n"
		if $Verbose > 1;
		return ($result);
	    }
	}
	close(_);
    }
    warn "[looking for NOFILE/NOFILES in /usr/include/sys/param.h]\n"
	if $Verbose > 2;
    if (open(_, "/usr/include/sys/param.h")) {
	while (<_>) {
	    if (/^\#\s*define\s+NOFILES?\s+[^0-9]*([0-9]+)/) {
		$result = $1;
		close(_);
		warn "[...looks like it's $result]\n"
		    if $Verbose > 1;
		return ($result);
	    }
	}
	close(_);
    }
    warn "[...guessing it's 16]\n" if $Verbose > 1;
    16;
}
