#!/opt/perl/bin/perl -w
# Display ASCII Character Set
# Options allow several formats of the output,
# execute with --help for more information
#
# This code copyright 2003 by
# D. W. Eaton, Artronic Development, Phoenix, AZ -- dwe@arde.com
#
# This software is made freely available under the provisions of the Perl
# "Artistic" license:  http://language.perl.com/misc/Artistic.html
#
# This code is not supported and is not warranteed to perform any particular
# function. Contact dwe@arde.com for aditional information.
# If you find bugs or make enhancements, it would be appreciated if you
# sent them on to the author at dwe@arde.com.
#
# Logical revision history:
#  1.0 -  DWE Initial version
#
# Pragmas
use strict;
#
# Environment
use Getopt::Long;

# Define local data
# Variables:
my (
$all,
$arg1,
$chr,
$colincr,
$defaultcol,
$ent,
$ercf_ok,
$ercf_user,
$false,
$hex,
$ichr,
$icol,
$ilin,
$maxchr,
$maxchrcod,
$maxlines,
$numargs,
$nxtlin,
$opt_columns,
$opt_entity,
$opt_help,
$opt_octal,
$opt_row,
$opt_showerror,
$opt_syntax,
$opt_verbose,
$opt_version,
$progname,
$true,
$userid,
$versn
);
# Arrays:
my (@opts);
# Hashes:
my (%chrswap,%ermcf,%htmlent,%opt);

# These should come from "Constants" utility module:
$true  = 1;  # truth values
$false = 0;
$all   = 2; # for Getopt ignore case
use vars ('$true','$false','$all');
#
# Program configuration 'constants':
$versn = '1.0 - 18 MAR 2003';
$maxchr = 128; # Max number of characters in the set
$maxchrcod = $maxchr - 1; # Maximum caracter code
#
# Exit status codes:
$ercf_ok = 0;$ermcf{$ercf_ok} = 'Exit OK';
$ercf_user = 99;$ermcf{$ercf_user} = 'User syntax error';
#
$| = $true; # Don't buffer output
#
# Some more-like configuration items:
$defaultcol = 4; # Default number of columns for output
#
# Define what to use for the non-printable characters
# (3 char or less so output will line up right)
%chrswap = (
 '0','NUL',
 '1','SOH',
 '2','STX',
 '3','ETX',
 '4','EOT',
 '5','ENQ',
 '6','ACK',
 '7','BEL',
 '8','BS',
 '9','HT',
 '10','LF',
 '11','VT',
 '12','FF',
 '13','CR',
 '14','SO',
 '15','SI',
 '16','DLE',
 '17','DC1',
 '18','DC2',
 '19','DC3',
 '20','DC4',
 '21','NAK',
 '22','SYN',
 '23','ETB',
 '24','CAN',
 '25','EM',
 '26','SUB',
 '27','ESC',
 '28','FS',
 '29','GS',
 '30','RS',
 '31','US',
 '32','SP',
 '127','DEL'
);
%htmlent = (
 '34','&quot;',
 '60','&lt;',
 '62','&gt;'
);
#
# Specific configurable values:
# (add your configuration items here)
# ---- end normal configuration items --------------------
#
# Specific initialization:
# (add your initialization items here)
#
# Try to determine user name
$userid = getlogin || getpwuid ($<) || $ENV{'USER'} || $ENV{'LOGNAME'};

if (! defined ($userid))
{
 die "Can't figure out the user name!\n";
}
#
chomp ($progname = `basename $0`); # Get our leaf name
#
# Process command line
$opt_columns = 'columns';
$opt_entity = 'entity';
$opt_help = 'help';
$opt_octal = 'octal';
$opt_row = 'row';
$opt_showerror = 'showerror';   
$opt_syntax = 'syntax';
$opt_verbose = 'verbose';
$opt_version = 'version';
#
# defaults
$opt{$opt_columns}     = '';
$opt{$opt_entity}      = $false;
$opt{$opt_help}        = $false;
$opt{$opt_octal}       = $false;
$opt{$opt_row}         = $false;
$opt{$opt_showerror}   = $false;
$opt{$opt_syntax}      = $false;
$opt{$opt_verbose}     = $false;
$opt{$opt_version}     = $false;
#
# Initialize accepted options:
@opts = qw(
  columns|c=n
  entity|html
  help|h
  octal|o
  row|r
  showerror|shoerr|se|e
  syntax
  verbose|v
  version
);
#
# Process command-line
$Getopt::Long::bundling = $true;  # perl 5.003 and earlier will complain about this
$Getopt::Long::ignorecase = $all;
GetOptions (\%opt, @opts);
#
# Check supplied options:
#
$numargs = scalar (@ARGV); # Number of non-option arguments left
if ($opt{$opt_version})
{
 print STDERR "$progname v$versn\n";
 exit ($ercf_user); # Quit after showing version
}
#
if ($opt{$opt_help} || $opt{$opt_syntax})
{
 &syntax_message ();
 exit ($ercf_user);
}
if ($opt{$opt_showerror})
{
 &show_error_codes(%ermcf); # Sho error codes
 exit ($ercf_user);
}
#
# ----------
#
# Check rest of arguments
#
# Look for a column max
# Get non-option arguments (one at most):
if ($numargs == 1)
{
 if ($opt{$opt_columns})
 {
  # Argh, we can't tollerate multiple column designations
  print STDERR "ERROR: use positional or specific column designation, use --$opt_help for assistance\n";
  exit ($ercf_user);
 }
 $arg1 = shift (@ARGV); # Get file ID
 $opt{$opt_columns} = $arg1; # Default this as the input
}
elsif ($numargs > 1)
{
 # Too many arguments specified
 print STDERR "ERROR: Too many arguments specified ($numargs), use --$opt_help for assistance\n";
 exit ($ercf_user);
}
if (! $opt{$opt_columns})
{
 $opt{$opt_columns} = $defaultcol; # default it
}
#
# Specific initialization following option gathering:
# (add your initialization items here)
#
# - - - - - - - - - - - - - -
# Main body of the code
#
# Do the real work

#
# Initialize
$ilin = 0; # Initialize line index (must be first character code value)
$ichr = $ilin; # Default to starting character codes at the same place
$nxtlin = ''; # Clear next line
#
$maxlines = $maxchr / $opt{$opt_columns}; # Compute maximum number of lines
$maxlines = int($maxlines + .5);
#
if ($opt{$opt_row})
{
 $colincr = 1; # Increment each column by 1
}
else
{
 $colincr = $maxlines; # Increment each column by numlines
}
#
# Heading (if desired)
if ($opt{$opt_verbose})
{
 print 'ASCII character set';
 if ($opt{$opt_octal})
 {
  print ', including octal codes';
 }
 print "\n";
}
#
# Loop through character possibilities
while ($ilin < $maxlines)
{
 $icol = 1; # Do first column
 if (! $opt{$opt_row})
 {
  # Doing vertical ... start this row character with next line number
  $ichr = $ilin;
 }
 while ($icol <= $opt{$opt_columns} &&
        $ichr <= $maxchrcod)
 {
  $hex = sprintf ("%02x",$ichr);
  if ($ichr < 33 || $ichr > 126)
  {
   # non-printable character, get replacement
   if (defined $chrswap{$ichr} && $chrswap{$ichr})
   {
    $chr = $chrswap{$ichr};
   }
   else
   {
    $chr = '???';
   }
  }
  else
  {
   # Use the character
   $chr = ' ' . chr($ichr) . ' '; 
  }
  $nxtlin .= sprintf ("%3.0f  ",$ichr);
  if ($opt{$opt_octal})
  {
   # Add octal field
   $nxtlin .= sprintf ("/%03o  ",$ichr);
  }
  $nxtlin .= sprintf ("%2s  %-3s",uc($hex),$chr);
  if ($opt{$opt_entity})
  {
   $ent = ''; # Clear
   if (defined $htmlent{$ichr} && $htmlent{$ichr})
   {
    $ent = $htmlent{$ichr};
   }
   $nxtlin .= sprintf ("  %-8s",$ent); # HTML entity
  }
  $nxtlin .= sprintf ("%7s",' '); # Column spacer
  #
  $ichr += $colincr; # Next value
  $icol++; # Next column
  if ($icol > $opt{$opt_columns} ||
     $ichr > $maxchrcod )
  {
   $nxtlin =~ s/\s*$//; # Clear any trailing spaces
   if ($nxtlin)
   {
    print "$nxtlin\n"; # Print next line
   }
   $nxtlin = ''; # Clear line again
   $ilin++; # Process next line
  }
 }
 $icol = 1; # Reset column count for next row
}
#
# - - - - - - - - - - - - - -
#
exit ($ercf_ok); # Whew, must be OK
###
# - - - - - - - - - - - subroutines - - - - - - -
# Local subroutines
# ----------
# Standard subroutines
# ----------
# Print syntax message
sub syntax_message
{
 my ($progname);
 my ($key);
 my ($toolid);

 chomp ($progname = `basename $0`);
 if (! $opt{$opt_syntax})
 {
  print STDERR  qq+
Version $versn

Name: $progname
   Display ASCII character set.+;
 }
 if (! $opt{$opt_syntax})
 {
  print STDERR  qq+

Syntax:

+;
 }
 # Always show this line:
 print STDERR "   $progname  [ options ]  [columns]\n";
 if ($opt{$opt_syntax} && $opt{$opt_verbose})
 {
  print STDERR  qq+
   Operational options:
   --$opt_columns=c,--$opt_entity,--$opt_octal,--$opt_row
   Assistance options:
   --$opt_help,--$opt_showerror,--$opt_syntax,--$opt_verbose,--$opt_version
+;
 }
 if (! $opt{$opt_syntax})
 {
  print STDERR  qq+
The positional argument 'columns' is optional, and may be replaced with
a specific optional argument below.+;
 }
 if (! $opt{$opt_syntax})
 {
  print STDERR  qq+
If present, the positional argument is assumed to be:

 *  number of columns to be used for the output (default is $defaultcol)

Only one positional argument is permitted.+;
 }
 if (! $opt{$opt_syntax})
 {
  print STDERR  qq+

Where 'options' are:
+;

  print STDERR  qq+
   --$opt_columns=c
       Number of columns to be used for the output (default is $defaultcol)
       (If '0' is specified, the default number of columns is used)
   --$opt_entity, --html
       Include the HTML entity code for the character, if there is one
   --$opt_octal, -o
       Include a column showing a slash (/) and the character code in octal
   --$opt_row, -r
       Characters increment horizontally across the row rather than vertically
       down the column in the result matrix

  Help and assistance options:

   --$opt_help, -h
       Print this help message
   --$opt_showerror, --shoerr, --se, -e
       Show brief descriptions of error exit codes from this routine
   --$opt_syntax
       Only show the syntax line of this help, not all the other info
       (use with --$opt_verbose for slightly more syntax info)
   --$opt_verbose, -v
       Verbose mode, show heading and possibly more information
   --$opt_version
       Display the version number of this routine
+;
 }
 if (! $opt{$opt_syntax})
 {
  print STDERR  qq+
Additional information:

 Format of each group of output data is as follows:
    dd  /OOO  XX  chr  eeeeeeee
 where
    "dd"       = the decimal character value
    "/OOO"     = the octal character value
                 (with --$opt_octal option)
    "XX"       = the Hexidecimal character value
    "chr"      = the printable character or a definition of the
                 function for which the character code is used
    "eeeeeeee" = the HTML entity for the character value
                 (with --$opt_entity option)
+;
 }

 if (! $opt{$opt_syntax})
 {
  print STDERR  qq+
EXAMPLES

 Display output in $defaultcol columns:
   $progname
   $progname $defaultcol
   $progname --$opt_columns=$defaultcol
 Include the octal character code and HTML entity code:
   $progname --$opt_octal --$opt_entity
+;
 }
}

# ----------
# Sho error codes
#  &show_error_codes(%ermcf);
# where: %ermcf is a hash of the error exits and reasons
sub show_error_codes
{
 my (%ermcf) = @_;
 my ($key);

 print STDERR  qq+
Error exit codes:
+;
 foreach $key (sort keys %ermcf)
 {
  printf STDERR ("%5s  =  %s\n",$key,$ermcf{$key});
 }
}
# ----------
