#!/usr/bin/perl

=head1 NAME

2search - binary search through sorted text files

2grep - binary search+grep through sorted text files

=head1 SYNOPSIS

B<2search> [-nrfHB] inputfile string [string...]

B<2search> --grep [-nrfH] inputfile string [string...]

B<2grep> [-nrfH] inputfile string [string...]

... | B<2search> [-nrfHB] inputfile

... | B<2search> --grep [-nrfH] inputfile

... | B<2grep> [-nrfH] inputfile

=head1 DESCRIPTION

B<2search> searches a sorted file for lines starting with a string. It
outputs the following line or the byte position of this line, which is
where the string would have been if it had been in the sorted file.

B<2grep> output all lines starting with a given string. The file must
be sorted.

By using B<-k> the same way as in B<sort> you can instead search for
strings in columns, if the file is sorted using the B<-k> syntax.


=over 9

=item B<--ignore-leading-blanks>

=item B<-b>

Ignore leading blanks. Used if I<inputfile> is sorted with B<sort
--ignore-leading-blanks>.


=item B<--byte-offset>

=item B<-B>

Print byte position where string would have been.


=item B<--dictionary-order> (not implemented)

=item B<-d>

Consider only blanks and alphanumeric characters. Used if I<inputfile>
is sorted with B<sort --dictionary-order>.


=item B<--debug>

=item B<-D>

Show debugging information.


=item B<--ignore-case>

=item B<-f>

Fold lower case to upper case characters. Used if I<inputfile> is
sorted with B<sort --ignore-case>.


=item B<-F>

Fixed string. The search string 'foo' will not match 'foobar'.


=item B<--file> I<file>

Search for all lines in I<file>.


=item B<--general-numeric-sort> (not implemented)

=item B<-g>

Compare according to general numerical value. Used if I<inputfile> is
sorted with B<sort --general-numeric-sort>.


=item B<--header>

=item B<-H>

Treat the first line in I<file> as a header. Ignore it when searching
and print it once in the output.


=item B<--ignore-nonprinting> (not implemented)

=item B<-i>

Consider only printable characters. Used if I<inputfile> is
sorted with B<sort --ignore-nonprinting>.


=item B<--month-sort>

=item B<-M>

Compare (unknown) < 'JAN' < ... < 'DEC'. Used if I<inputfile> is
sorted with B<sort --month-sort>.


=item B<--human-numeric-sort>

=item B<-h>

Compare human readable numbers (e.g., 2K 1G). Used if I<inputfile> is
sorted with B<sort --human-numeric-sort>.


=item B<--key=KEYDEF>

=item B<-k>

Sort via a key; KEYDEF gives location and type. Used if I<inputfile>
is sorted with B<sort --key=KEYDEF>.


=item B<--numeric-sort>

=item B<-n>

Compare according to string numerical value. If numerical values are
the same: compare as strings. Used if I<inputfile> is sorted with
B<sort --numeric-sort>.


=item B<--numascii>

=item B<-N>

split the string into blocks of numbers and non-numbers. For each
block compare the block as numbers, if the numerical values are the
same: compare the block as strings.

This will sort like this: 3chr 11chr chr3 chr11

This is simiar to B<--version-sort>, but without the exceptions.


=item B<--random-sort>

=item B<-R>

Sort by random hash of keys.


=item B<--reverse>

=item B<-r>

Reverse the result of comparisons. Used if I<inputfile> is sorted with
B<sort --reverse>.


=item B<--sort=WORD> (not implemented)

Sort according to WORD: general-numeric B<-g>, human-numeric B<-h>, month
B<-M>, numeric B<-n>, random B<-R>, version B<-V>


=item B<-t>

=item B<--field-separator=SEP>

Use I<SEP> instead of blanks (\s+). I<SEP> is a regexp.


=item B<-z>

=item B<--zero-terminated>

End lines with 0 (NUL) byte, not newline.


=back

=head1 EXAMPLES

=head2 Single key

Given sorted I<input.txt> like:

  A_number B_number Date                Duration  CellID
  12893827 21034191 2020-03-21T13:38:13 P00:00:20 CPH382
  12893827 80012345 2020-03-20T12:34:23 P00:00:20 CPH382
  12893827 80012345 2020-03-20T12:45:03 P00:05:20 CPH382
  22355591 47827750 2020-03-20T11:28:33 P00:32:27 ALB923
  22355591 81382631 2020-03-21T21:28:33 P00:12:48 CPH382
  22356142 45701514 2020-03-20T22:41:23 P00:02:48 CPH022
  22356142 56818446 2020-03-21T08:38:34 P00:31:24 CPH645

To get all records with 22355591 you can run:

  grep ^22355591 input.txt

But if I<input.txt> is several TB big, it can be very slow. B<2grep>
uses binary search which only works if the file is sorted, but takes
less than 1 second to run:

  2grep -H input.txt 22355591

You can also search for a shorter string to get all records starting
with 2235:

  2grep -H input.txt 2235

Or you can search for multiple search strings:

  2grep -H input.txt 12893827 22356142

=head2 Multiple keys

Input is sorted by SampleID, Chromosome, Position (in that order):

  SampleID Chromosome Position Data
  PatientA chr3       10002123 CCGTCTAATGGCTTGATTGGTACACCATGACATTGA
  PatientA chr3       10003125 TCCATCGTCGGCGAGAAGGTACCAGGTAA
  PatientA chr11      9999998  AATTCACAGTATGGCTGACGGTGTCGTAGCTACACG
  PatientA chr11      10001240 TCCAGAAGTTTGA
  PatientA chr11      10001260 ATAACGAGAACTTACGTTTTAAAAGGCCTA
  PatientB chr3       10000125 GTCTTCACTTTATAAATGGATGATAGCCTTCA

SampleID is sorted as text. Chromosome is sorted by text first and
numerically for the number. Position is sorted by number.

To find all chr3 for PatientA:

  2grep -H -k1,2N inputfile PatientA chr3

-N will split 'chr3' into 'chr' which is compared asciibetically and
'3' which is compared numerically.

To find all chr3 for PatientA and all chr3 for PatientB:

  2grep -H -k1,2N inputfile PatientA chr3 PatientB chr3


=head1 PERFORMANCE

Binary search requires seeks from the disk. But B<2search> is designed
so that multiple searches will reuse cached data. This means searches
will be faster the more you run.

You can improve the speed even more by sorting the input strings. This
will make it possible to reuse cached data more.

It can be even faster if you run multiple searches in parallel.

This is due to magnetic drives' elevator sorting of requests when
seeking and due to NVMe drives working faster with more queues in
parallel.

  cat searchstrings | parallel -n50 -j10 2grep inputfile


=head1 BUGS

B<2search> does not respect your locale setting. It assumes the input
is sorted with LC_ALL=C. If it is not B<2search> may give the wrong
result.

To solve this sort the input with B<LC_ALL=C sort ...>.


=head1 REPORTING BUGS

B<2search> and B<2grep> are part of tangetools. Report bugs on
https://gitlab.com/ole.tange/tangetools/-/issues


=head1 AUTHOR

Copyright (C) 2016-2020 Ole Tange http://ole.tange.dk


=head1 LICENSE

Copyright (C) 2013 Free Software Foundation, Inc.

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 3 of the License, or
at your option any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>.

=head2 Documentation license I

Permission is granted to copy, distribute and/or modify this documentation
under the terms of the GNU Free Documentation License, Version 1.3 or
any later version published by the Free Software Foundation; with no
Invariant Sections, with no Front-Cover Texts, and with no Back-Cover
Texts.  A copy of the license is included in the file fdl.txt.

=head2 Documentation license II

You are free:

=over 9

=item B<to Share>

to copy, distribute and transmit the work

=item B<to Remix>

to adapt the work

=back

Under the following conditions:

=over 9

=item B<Attribution>

You must attribute the work in the manner specified by the author or
licensor (but not in any way that suggests that they endorse you or
your use of the work).

=item B<Share Alike>

If you alter, transform, or build upon this work, you may distribute
the resulting work only under the same, similar or a compatible
license.

=back

With the understanding that:

=over 9

=item B<Waiver>

Any of the above conditions can be waived if you get permission from
the copyright holder.

=item B<Public Domain>

Where the work or any of its elements is in the public domain under
applicable law, that status is in no way affected by the license.

=item B<Other Rights>

In no way are any of the following rights affected by the license:

=over 9

=item *

Your fair dealing or fair use rights, or other applicable
copyright exceptions and limitations;

=item *

The author's moral rights;

=item *

Rights other persons may have either in the work itself or in
how the work is used, such as publicity or privacy rights.

=back

=item B<Notice>

For any reuse or distribution, you must make clear to others the
license terms of this work.

=back

A copy of the full license is included in the file as cc-by-sa.txt.

=head1 DEPENDENCIES

B<2search>/B<2grep> uses Perl.


=head1 SEE ALSO

B<grep>(1), B<sort>(1).

=cut

use strict;
use Getopt::Long;

Getopt::Long::Configure("bundling","require_order");

GetOptions(
    "debug|D" => \$opt::D,
    "version" => \$opt::version,
    "verbose|v" => \$opt::verbose,
    "B|byte-offset" => \$opt::byte_offset,
    "b|ignore-leading-blanks" => \$opt::ignore_leading_blanks,
    "d|dictionary-order" => \$opt::dictionary_order,
    "f|ignore-case" => \$opt::ignore_case,
    "g|general-numeric-sort" => \$opt::general_numeric_sort,
    "G|grep" => \$opt::grep,
    "F|fixed-strings" => \$opt::fixed_strings,
    "file=s" => \$opt::file,
    "i|ignore-nonprinting" => \$opt::ignore_nonprinting,
    "M|month-sort" => \$opt::month_sort,
    "h|human-numeric-sort" => \$opt::human_numeric_sort,
    "n|numeric-sort" => \$opt::numeric_sort,
    "N|numascii" => \$opt::numascii,
    "r|reverse" => \$opt::reverse,
    "R|random-sort" => \$opt::random_sort,
    "sort=s" => \$opt::sort,
    "V|version-sort" => \$opt::version_sort,
    "k|key=s" => \@opt::key,
    "H|header" => \$opt::header,
    "t|field-separator=s" => \$opt::field_separator,
    "recend|record-end=s" => \$opt::record_end,
    "recstart|record-start=s" => \$opt::record_start,
    "z|zero-terminated" => \$opt::zero_terminated,
    ) || exit(255);
$Global::progname = ($0 =~ m:(^|/)([^/]+)$:)[1];
$Global::version = 20200328;
if($opt::version) { version(); exit 0; }
if($opt::zero_terminated) { $/ = "\0"; }
if(@opt::key) {
    # Default separator if --key = whitespace
    $Global::fieldsep = '\s+';
    if(defined $opt::field_separator) { $Global::fieldsep = $opt::field_separator; }
}
if($Global::progname eq "2grep") { $opt::grep = 1; }
$Global::debug = $opt::D;
if(defined $opt::record_end or defined $opt::record_start) {
    if(not defined $opt::record_end) { $opt::record_end = ""; }
    if(not defined $opt::record_start) { $opt::record_start = ""; }
    $/ = unquote_printf($opt::record_end).unquote_printf($opt::record_start);
} else {
    # Default = \n
    $opt::record_end = "\n";
    $/ = $opt::record_end;
}

parse_keydef();

debug(my_dump(\@Global::keydefs),"\n");

my $file = shift;
if(@ARGV) {
    $opt::argv = 1;
} elsif(defined $opt::file) {
    # skip
} else {
    $opt::stdin = 1;
}

$Global::headersize = 0;
if($opt::header) {
    if(not open (my $fh, "<", $file)) {
	error("Cannot open '$file'");
	exit 1;
    } else {
	my $header = <$fh>;
	$header =~ s/\Q$opt::record_start\E$//;
	$Global::headersize = length $header;
	print $header;
    }
}

 round:
    while(1) {
	my @search_vals;
	for(@Global::keydefs) {
	    my $val = get();
	    if(not defined $val) {
		last round;
	    }
	    push @search_vals, $val;
	}
	if($opt::grep) {
	    bgrep($file,@search_vals);
	} else {
	    print bsearch($file,@search_vals);
	}
}

{
    my $fh;

    sub get {
	if($opt::argv) {
	    # Search for strings on the command line
	    return shift @ARGV;
	}
	if($opt::file) {
	    # Search for strings given with --file
	    if(not $fh) {
		if(not open(my $fh, "<", $opt::file)) {
		    error("Cannot open $opt::file");
		    exit(255);
		}
	    }
	    my $val = <$fh>;
	    chomp $val;
	    return $val;
	}
	if($opt::stdin) {
	    # Search for strings on stdin
	    my $val = <>;
	    chomp $val;
	    return $val;
	}
	die;
    }
}

sub bgrep {
    my $file = shift;
    my @search_vals = @_;
    $opt::byte_offset = 1;
    my $startpos = bsearch($file,@search_vals);
    my $fh;
    if(not open ($fh, "<", $file)) {
	error("Cannot open '$file'");
	exit 1;
    }
    seek($fh,$startpos,0) or die;
    if(not $opt::fixed_strings) {
	# Allow for partial matches in grep (4 mathes 40, A matches Aaa)
	for my $keydef (@Global::keydefs) {
	    $keydef->{'partial_match'} = 1;
	}
    }
    my $line;
    while($line = <$fh>
	  and
	  not compare($line,@search_vals)) {
	    print $line;
    }
    close $fh;
    for my $keydef (@Global::keydefs) {
	$keydef->{'partial_match'} = 0;
    }
}

sub bsearch {
    my $file = shift;
    my @search_vals = @_;
    my $min = $Global::headersize;
    my $max = -s $file;
    my $fh;
    if(not open ($fh, "<", $file)) {
	error("Cannot open '$file'");
	exit 1;
    }
    my($line,$middle);
    my $minnl = $min;
    my $maxnl = $max;
    while($max - $min > 1) {
	$middle = int(($max + $min)/2);
	seek($fh,$middle,0) or die("Cannot seek to $middle");
	if($middle > 0) {
	    # Read last half of a line
	    <$fh>;
	}
	my $newline_pos = tell($fh);
	debug("$min <= $middle <= $newline_pos <= $max\n");
	debug("$minnl <= $newline_pos <= $maxnl\n");
	if($newline_pos == $maxnl
	   or
	   eof($fh)
	   or
	   compare(($line = <$fh>),@search_vals) >= 0) {
	    # We have see this newline position before
	    # or we are at the end of the file
	    # or we should search the lower half
	    $max = $middle;
	    $maxnl = $newline_pos;
	} else {
	    # We should search the upper half
	    $min = $middle;
	    $minnl = $newline_pos;
	}
    }
    seek($fh,$minnl,0) or die("Cannot seek to $minnl");
    $line = <$fh>;
    my $len = length $opt::record_start;
    my $retpos;
    if(compare($line,@search_vals) >= 0) {
	# Adjust for length of $recstart
	$retpos = $minnl - $len;
    } else {
	$retpos = tell($fh) - $len;
    }
    $retpos = $retpos < 0 ? 0 : $retpos;
    if($opt::byte_offset) {
	return $retpos."\n";
    } else {
	seek($fh,$retpos,0) or die("Cannot seek to $minnl");
	if(length $opt::record_end) {
	    # read record: A...BA
	    # Remove $opt::record_start if it is at the end
	    # (might not be only record)
	    $line = <$fh>;
	    $line =~ s/\Q$opt::record_start\E$//;
	} else {
	    # --recend == ''
	    if(length $opt::record_start) {
		# read record: A...A
		# Remove $opt::record_start if it is at the end
		# (might not be only record)
		$line = <$fh>; # Read: A
		$line .= <$fh>; # Read: ...A
		$line =~ s/\Q$opt::record_start\E$//;
	    } else {
		# Len recstart == Len recend = 0. Does this ever happen?
		# read record.
		# Remove $opt::record_start if it is there (might be only record)
		$line = <$fh>;
		$line =~ s/\Q$opt::record_start\E$//;
	    }
	}
	return $line;
    }
}

sub parse_keydef {
    # parse keydef F[.C][OPTS][,F[.C][OPTS]]
    my %defaultorder = (
	"b" => $opt::ignore_leading_blanks,
	"d" => $opt::dictionary_order,
	"f" => $opt::ignore_case,
	"g" => $opt::general_numeric_sort,
	"i" => $opt::ignore_nonprinting,
	"M" => $opt::month_sort,
	"h" => $opt::human_numeric_sort,
	"n" => $opt::numeric_sort,
	"N" => $opt::numascii,
	"r" => $opt::reverse,
	"R" => $opt::random_sort,
	"V" => $opt::version_sort,
	);
    my %ordertbl = (
	"b" => 'ignore_leading_blanks',
	"d" => 'dictionary_order',
	"f" => 'ignore_case',
	"g" => 'general_numeric_sort',
	"i" => 'ignore_nonprinting',
	"M" => 'month_sort',
	"h" => 'human_numeric_sort',
	"n" => 'numeric_sort',
	"N" => 'numascii',
	"r" => 'reverse',
	"R" => 'random_sort',
	"V" => 'version_sort',
	);

    if(@opt::key) {
	# skip
    } else {
	# Convert -n -r to -k1rn
	# with sep = undef
	$Global::fieldsep = undef;
	my $opt;
	$opt->{'field'} = 1;
	$opt->{'char'} = 1;
	for (keys %defaultorder) {
	    $opt->{$ordertbl{$_}} = $defaultorder{$_};
	}
	push(@Global::keydefs,$opt);
    }

    for my $keydefs (@opt::key) {
	for my $keydef (split /,/, $keydefs) {
	    my $opt;
	    if($keydef =~ /^(\d+)(\.(\d+))?([bdfgiMhnNRrV]+)?$/) {
		# parse keydef F[.C][OPTS][,F[.C][OPTS]]
		$opt->{'field'} = $1;
		$opt->{'char'} = $3 || 1;
		for (keys %defaultorder) {
		    $opt->{$ordertbl{$_}} = $defaultorder{$_};
		}
		for my $o (split //, $4) {
		    $opt->{$ordertbl{$o}} = 1;
		}
	    } else {
		error("Keydef $keydef does not match F[.C][OPTS]");
		exit(255);
	    }
	    push(@Global::keydefs,$opt);
	}
    }
}

sub compare {
    # One key to search for per search column
    my($line,@search_vals) = @_;
    chomp($line);
    debug("Compare: $line <=> @search_vals; ");
    my @field;
    if($Global::fieldsep) {
	# Split line
	@field = split /$Global::fieldsep/o, $line;
    } else {
	@field = ($line);
    }
    my @tmp_vals = @search_vals;
    for my $keydef (@Global::keydefs) {
	# keydef = F[.C][OPTS][,F[.C][OPTS]]
	my $f = $keydef->{'field'};
	my $c = $keydef->{'char'};
	my $cmp = compare_single(substr($field[$f-1],$c-1),shift @tmp_vals,$keydef);
	# They differ on this key
	debug("== $cmp\n");
	if($cmp) { return $cmp; }
    }
    # No difference on any keydefs
    return 0;
}

sub compare_single {
    # Compare two lines based on order options
    my ($a,$b,$opt) = @_;
    debug("$a <=> $b");
    debug(my_dump($opt),"\n");
    if($opt->{'random_sort'}) {
	return rand() <=> rand();
    }
    if($opt->{'ignore_leading_blanks'}) {
	$a =~ s/^\s+//;
	$b =~ s/^\s+//;
    }
    if($opt->{'ignore_case'}) {
	$a = uc($a);
	$b = uc($b);
    }
    if($opt->{'partial_match'}) {
	# String 'foo' matches 'foobar'
	$a = substr($a,0,length $b);
    }
    if($opt->{'reverse'}) {
	($a,$b) = ($b,$a);
    }
    if($opt->{'human_numeric_sort'}) {
	return multiply_binary_prefix($a) <=> multiply_binary_prefix($b);
    }
    if($opt->{'month_sort'}) {
	my %m;
	my @mon = qw(JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC);
	@m{@mon}={1..12};
	return ($m{$a} || 0) <=> ($m{$b} || 0);
    }
    if($opt->{'numeric_sort'}) {
	return($a <=> $b or $a cmp $b);
    } elsif($opt->{'numascii'}) {
	# Split on digit boundary
	my @a = split /(?<=\d)(?=\D)|(?<=\D)(?=\d)/i, $a;
	my @b = split /(?<=\d)(?=\D)|(?<=\D)(?=\d)/i, $b;
	my $c;
	for(my $t = 0;
	    defined $a[$t] and defined $b[$t];
	    $t++) {
	    $c = ($a[$t] <=> $b[$t] or $a[$t] cmp $b[$t]);
	    $c and return $c;
	}
	# All parts match, maybe one is longer
	return $#a <=> $#b;
    } else {
	return $a cmp $b;
    }
}

sub multiply_binary_prefix(@) {
    # Evalualte numbers with binary prefix
    # Ki=2^10, Mi=2^20, Gi=2^30, Ti=2^40, Pi=2^50, Ei=2^70, Zi=2^80, Yi=2^80
    # ki=2^10, mi=2^20, gi=2^30, ti=2^40, pi=2^50, ei=2^70, zi=2^80, yi=2^80
    # K =2^10, M =2^20, G =2^30, T =2^40, P =2^50, E =2^70, Z =2^80, Y =2^80
    # k =10^3, m =10^6, g =10^9, t=10^12, p=10^15, e=10^18, z=10^21, y=10^24
    # 13G = 13*1024*1024*1024 = 13958643712
    # Input:
    #   $s = string with prefixes
    # Returns:
    #   $value = int with prefixes multiplied
    my @v = @_;
    for(@v) {
	# 1E3=1000, 1E-3=0.001
	s/e([+-]?\d+)/*10**$1/gi;
    }
    for(@v) {
	defined $_ or next;
	s/ki/*1024/gi;
	s/mi/*1024*1024/gi;
	s/gi/*1024*1024*1024/gi;
	s/ti/*1024*1024*1024*1024/gi;
	s/pi/*1024*1024*1024*1024*1024/gi;
	s/ei/*1024*1024*1024*1024*1024*1024/gi;
	s/zi/*1024*1024*1024*1024*1024*1024*1024/gi;
	s/yi/*1024*1024*1024*1024*1024*1024*1024*1024/gi;
	s/xi/*1024*1024*1024*1024*1024*1024*1024*1024*1024/gi;

	s/K/*1024/g;
	s/M/*1024*1024/g;
	s/G/*1024*1024*1024/g;
	s/T/*1024*1024*1024*1024/g;
	s/P/*1024*1024*1024*1024*1024/g;
	s/E/*1024*1024*1024*1024*1024*1024/g;
	s/Z/*1024*1024*1024*1024*1024*1024*1024/g;
	s/Y/*1024*1024*1024*1024*1024*1024*1024*1024/g;
	s/X/*1024*1024*1024*1024*1024*1024*1024*1024*1024/g;

	s/k/*1000/g;
	s/m/*1000*1000/g;
	s/g/*1000*1000*1000/g;
	s/t/*1000*1000*1000*1000/g;
	s/p/*1000*1000*1000*1000*1000/g;
	s/e/*1000*1000*1000*1000*1000*1000/g;
	s/z/*1000*1000*1000*1000*1000*1000*1000/g;
	s/y/*1000*1000*1000*1000*1000*1000*1000*1000/g;
	s/x/*1000*1000*1000*1000*1000*1000*1000*1000*1000/g;

	$_ = eval $_;
    }
    return wantarray ? @v : $v[0];
}

sub status {
    my @w = @_;
    my $fh = $Global::status_fd || *STDERR;
    print $fh map { ($_, "\n") } @w;
    flush $fh;
}

sub status_no_nl {
    my @w = @_;
    my $fh = $Global::status_fd || *STDERR;
    print $fh @w;
    flush $fh;
}

sub warning {
    my @w = @_;
    my $prog = $Global::progname || "parallel";
    status_no_nl(map { ($prog, ": Warning: ", $_, "\n"); } @w);
}

sub error {
    my @w = @_;
    my $prog = $Global::progname || "parallel";
    status(map { ($prog.": Error: ". $_); } @w);
}

sub die_bug {
    my $bugid = shift;
    print STDERR
	("$Global::progname: This should not happen. You have found a bug.\n",
	 "Please submit a bug at https://gitlab.com/ole.tange/tangetools/-/issues\n",
	 "and include:\n",
	 "* The version number: $Global::version\n",
	 "* The bugid: $bugid\n",
	 "* The command line being run\n",
	 "* The files being read (put the files on a webserver if they are big)\n",
	 "\n",
	 "If you get the error on smaller/fewer files, please include those instead.\n");
    exit(255);
}

sub version {
    # Returns: N/A
    print join("\n",
               "$Global::progname $Global::version",
               "Copyright (C) 2016-2020",
	       "Ole Tange and Free Software Foundation, Inc.",
               "License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html>",
               "This is free software: you are free to change and redistribute it.",
               "$Global::progname comes with no warranty.",
               "",
               "Web site: https://gitlab.com/ole.tange/tangetools/\n",
        );
}

sub my_dump(@) {
    # Returns:
    #   ascii expression of object if Data::Dump(er) is installed
    #   error code otherwise
    my @dump_this = (@_);
    eval "use Data::Dump qw(dump);";
    if ($@) {
        # Data::Dump not installed
        eval "use Data::Dumper;";
        if ($@) {
            my $err =  "Neither Data::Dump nor Data::Dumper is installed\n".
                "Not dumping output\n";
            ::status($err);
            return $err;
        } else {
            return Dumper(@dump_this);
        }
    } else {
	# Create a dummy Data::Dump:dump as Hans Schou sometimes has
	# it undefined
	eval "sub Data::Dump:dump {}";
        eval "use Data::Dump qw(dump);";
        return (Data::Dump::dump(@dump_this));
    }
}

sub debug(@) {
    # Returns: N/A
    $Global::debug or return;
    print @_;
}

sub unquote_printf() {
    # Convert \t \n \r \000 \0
    # Inputs:
    # $string = string with \t \n \r \num \0
    # Returns:
    # $replaced = string with TAB NEWLINE CR <ascii-num> NUL
    $_ = shift;
    s/\\t/\t/g;
    s/\\n/\n/g;
    s/\\r/\r/g;
    s/\\(\d\d\d)/eval 'sprintf "\\'.$1.'"'/ge;
    s/\\(\d)/eval 'sprintf "\\'.$1.'"'/ge;
    return $_;
}