#!/usr/bin/perl -wC
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
#NAME
#  cstest - charset test program
#
#SYNOPSIS
#  cstest [file]..
#
#REQUIRES
	use utf8;
#
#DESCRIPTION
#  This little program does a simple dump of one or more files, one char  per
#  line.   Each  line  shows  the  decimal  and  hex values of one character,
#  followed by the character itself.  Some of the common ASCII control  chars
#  are displayed with the usual \-notation, or by the char's ASCII acronym.
#
#  We set a "verbose" level from the environment variables V_cstest,  and  if
#  it is 2 or greater, we echo the input lines to the output, followed by the
#  usual 1-line-per-char output.
#
#ENVIRONMENT
#  You may need this in the environment:
#     LANG=en_US.UTF-8
#
#OPTIONS
#  None yet.  Give me time ...
#
#EXAMPLES
#  cstest foo.txt bar.txt
#
#
#FILES
#
#BUGS
#
#SEE ALSO
#
#AUTHOR
#  John Chambers <jc@trillian.mit.edu>
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #

$| = 1;
$exitstat = 0;
($P = $0) =~ s".*/"";
$V = $ENV{"V_$P"} || 2;	# Verbose level.

while ($line = <>) {
	++$lines;
	printf("-- %5d $line",$lines) if $V>1;
	while ($line) {
		($char,$rest) = ($line =~ /^(.)(.*)$/s);
		$code = ord($char);
		$hexc = sprintf(" %06X",$code);
		while ($hexc =~ ' 00') {$hexc =~ s/ 00/   /}
		printf("%8d$hexc %s\n",$code,&dspch($char));
		$line = $rest;
	}
}

print "$P: Exit with status $exitstat.\n" if $V>2;
exit $exitstat;
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #

sub dspch {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Return a "display" version of a character. Printable characters should just #
# be returned.  Unprintables should return something that indicates what they #
# are.                                                                        #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	local($a) = @_;
	return '   SP'  if $a eq " ";
	return '\t TAB' if $a eq "\t";
	return '\n LF'  if $a eq "\n";
	return '\r CR'  if $a eq "\r";
	return '\b BS'  if $a eq "\b";
	return '\0 NUL' if $a eq "\0";
	return $a;
}