#!/usr/bin/perl
#
#  $Id: hex2bin.pl,v 1.4 2004/07/04 08:44:48 jaalto Exp $
#
#  File id
#
#       .Copyright (C)  Jari Aalto
#       .Keywords:      Perl file conversion bin hex
#
#       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 2 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, write to the Free Software Foundation,
#       Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
#   About program layout
#
#       Code written with Emacs and indentation controlled with
#       Emacs package tinytab.el, a generic tab minor mode for programming.
#
#       The {{ }}} marks you see in this file are party of file "fold"
#       control package called folding.el (Unix Emacs lisp package).
#
#   Change Log (none)

use 5.004;
use strict;

#       A U T O L O A D
#
#       The => operator quotes only words, and characte ':' is not
#       part of a Perl "word"

use autouse 'Pod::Text' => qw( pod2text );

#   Standard perl modules

use Env;
use English;
use File::Basename;
use Getopt::Long;

GLOBALS:
{
    use vars qw ( $VERSION );

    #   This is for use of Makefile.PL and ExtUtils::MakeMaker
    #   So that it puts the tardist number in format YYYY.MMDD
    #   The REAL version number is defined later

    #   The following variable is updated by Emacs setup whenever
    #   this file is saved

    $VERSION = '2004.1215';
}

# {{{ init

# ****************************************************************************
#
#   DESCRIPTION
#
#       Set global variables for the program
#
#   INPUT PARAMETERS
#
#       none
#
#   RETURN VALUES
#
#       none
#
# ****************************************************************************

sub Initialize ()
{
    use vars qw
    (
        $CONTACT
        $LIB
        $PROGNAME
        $RCS_ID
        $URL
        $VERSION
    );

    $LIB        = basename $PROGRAM_NAME;
    $PROGNAME   = $LIB;

    $RCS_ID   = '$Id: hex2bin.pl,v 1.4 2004/07/04 08:44:48 jaalto Exp $';
    $VERSION  = (split (' ', $RCS_ID))[2];   # version number in format N.NN+
    $CONTACT  = "";
    $URL      = "http://cpan.perl.org/modules/by-authors/id/J/JA/JARIAALTO/";

    $OUTPUT_AUTOFLUSH = 1;
}

# }}}
# {{{ Help

# ***************************************************************** &help ****
#
#   DESCRIPTION
#
#       Print help and exit.
#
#   INPUT PARAMETERS
#
#       $msg    [optional] Reason why function was called.
#
#   RETURN VALUES
#
#       none
#
# ****************************************************************************

=pod

=head1 NAME

hex2bin.pl - Convert hex string file into binary file

=head1 SYNOPSIS

    hex2bin.pl --file out.bin input.hex
    hex2bin.pl --Eval 's,\.bin,\.hex,' input.hex

=head1 OPTIONS

=head2 General options

=over 4

=item B<--beg-column COL>

Ignore N characters from the beginning. Start reading at column COL.
Together with B<--end-column> you can slice the portion from the text file
E.g. if input contains constant indentation and garbage after column N.

=item B<--end-column COL>

Read until column COL and discard everything after that.

=item B<-e|--extension EXTENSION>

Append EXTENSION to each outputted file. Use along with B<--File> to change
the default extension

=item B<-E|--Eval PERL-CODE>

Evaluate PERL-CODE to make output the filename. The input filename is
in $ARG which you can modify with standard perl commands.

=item B<-F|--File>

Dump the binary to file with extension .bin

=item B<-f|--file FILE>

Dump the binary to FILE.

=item B<-D|--input-decimal>

Input data is represented in decimal format

=item B<-H|--input-hex>

Input data is represented in hex format. This the default.

=item B<-O|--input-octal>

Input data is represented in octal format

=item B<--raw>

Rip only the hex data from file and don't generate binary.

=back

=head2 Miscellaneous options

=over 4

=item B<-d|--debug LEVEL>

Turn on debug with positive LEVEL number. Zero means no debug.

=item B<--help> B<-h>

Print help page.

=item B<--Version -V>

Print program's version information.

=back

=head1 README

This program makes a binary file out of HEX input data. The default
input format is:

    XXXX: 00 00 01 01 01 # This is comment
    XXXX: 00 00 00 00 00   Deletes eveythinbg after 3 spaces

I.e. there must be line numbers at the beginning of hex lines.
The line numbers are stripped and the hex numbers are read to
form the file. Input can also be in this format

    8B/00/45/19/10/00/01/00/FF/35/49/44/58/16/17/03/
    00/07/39/17/00/0D/1E/09/60/13/FF/FF/FF/FF/6D/00/

This program is quite forgiving, any extra lines that don't look
like hexdump will be skipped, so you can have the data in following
format too and program will only pick the hexdump out of it.

    00000200  A3 03 AD B6 10 00 01 00 FF 35 49 44 58 01 04 05   .....
    00000210  00 07 19 21 05 09 13 0B 61 13 FF FF FF FF 85 03   ...!.

=head1 EXAMPLES

To output to a file that is derived from the filename

    hex2bin.pl --extension ".bin" fileh.hex # output to file.hex.bin

This changes all .hex names into .bin while composing the output filename:

    hex2bin.pl --Eval 's,\.hex,\.bin,' file.hex

To give explicit filename where output is put:

    hex2bin --file out.bin file.hex          # output to out.bin

=head1 ENVIRONMENT

No environment variables used.

=head1 SEE ALSO

od(1)

=head1 AVAILABILITY

CPAN entry is http://cpan.perl.org/modules/by-authors/id/J/JA/JARIAALTO/

=head1 SCRIPT CATEGORIES

CPAN/Administrative

=head1 PREREQUISITES

No CPAN modules required.

=head1 COREQUISITES

No optional CPAN modules needed.

=head1 OSNAMES

C<any>

=head1 VERSION

$Id: hex2bin.pl,v 1.4 2004/07/04 08:44:48 jaalto Exp $

=head1 AUTHOR

Copyright (C) Jari Aalto
This is free software; you can redistribute it and/or modify it under the
same terms as Perl itself or in terms of Gnu General Public licence v2 or
later.

=cut

sub Help (;$)
{
    my $id  = "$LIB.Help";
    my $msg = shift;  # optional arg, why are we here...

    pod2text $PROGRAM_NAME;

    exit 1;
}

# }}}
# {{{ args

# ************************************************************** &args *******
#
#   DESCRIPTION
#
#       Read and interpret command line arguments
#
#   INPUT PARAMETERS
#
#       none
#
#   RETURN VALUES
#
#       none
#
# ****************************************************************************

sub HandleCommandLineArgs ()
{
    my $id = "$LIB.HandleCommandLineArgs";

    my ( $ver, $help );

    # .......................................... command line options ...

    use vars qw
    (
        $FILE

        $debug
        $HELP_OPTION
        $VERSION_OPTION
        $verb

        $OCTAL
        $DECIMAL
        $HEX

        $EXTENSION
        $EVAL_CODE

        $RAW
        $DUMP
        $BEG_COL
        $END_COL
    );

    # .................................................... read args ...

    Getopt::Long::config( qw
    (
        ignore_case
        require_order
    ));

    GetOptions      # Getopt::Long
    (
          "Eval=s"          => \$EVAL_CODE
        , "beg-column"      => \$BEG_COL
        , "d"               => \$debug
        , "debug:i"         => \$debug
        , "end-column"      => \$END_COL
        , "e|extension=s"   => \$EXTENSION
        , "file=s"          => \$FILE
        , "help"            => \$help
        , "input-decimal"   => \$DECIMAL
        , "input-hex"       => \$HEX
        , "input-octal"     => \$DECIMAL
        , "raw"             => \$RAW
        , "verbose"         => \$verb
        , "Version"         => \$ver

    );

    $ver        and die "$VERSION $PROGNAME $CONTACT $URL\n";
    $help       and Help();

    $OCTAL      and $DECIMAL=0,     $HEX=0;
    $DECIMAL    and $OCTAL=0,       $HEX=0;
    $HEX        and $OCTAL=0,       $DECIMAL=0;

    unless
    (
           defined $FILE
        or defined $EXTENSION
        or defined $RAW
        or defined $EVAL_CODE
    )
    {
        die "$id: --file --File or --extension option missing";
    }

    if ( defined $EXTENSION )
    {
        local $ARG = $EXTENSION;
        m,/,    and warn "$id: odd Extension request: $EXTENSION\n";
        m,^--,  and warn "$id: odd Extension request: $EXTENSION\n";
    }

    if ( defined $BEG_COL  and  $BEG_COL + 0 < 1)
    {
          die "$id: Must give positive number for --beg-column";
    }

    if ( defined $END_COL  and  $END_COL + 0 < 1)
    {
          die "$id: Must give positive number for --end-column";
    }
}

# }}}
# {{{ Main

# ............................................................ &main ...

sub Main ()
{
    Initialize();
    HandleCommandLineArgs();

    my $id   = "$LIB.main";

    my   $ARGC  = @ARGV;
    push @ARGV, "-" unless @ARGV;                               # pipe

    for my $in ( @ARGV )
    {
        #   If the file is stdin, then write to "tmp.bin", otherwise
        #   derive name from input file.

        my $out = "$in";
        $out    = "outfile"    if  $in eq "-";

        #   However, explicit name overrides all.
        #   BUT the ARGV array must only contain one filename,
        #   otherwise we must derive the name from each file.

        if ( defined $FILE   and   $ARGC == 1)
        {
            # Do nothing, file name already given
        }
        elsif ( defined $EVAL_CODE )
        {
            local $ARG = $out;

            eval  $EVAL_CODE;

            $EVAL_ERROR     and die   "$id: [$EVAL_CODE]  $EVAL_ERROR";
            $debug          and print "$id: [$EVAL_CODE]  $out --> $ARG\n";

            $FILE = $ARG;
        }
        elsif ( defined $EXTENSION )
        {
            $FILE = $out . $EXTENSION;
        }

        # ................................................ write to file ...

        my $OUT = \*STDOUT;

        if ( defined $FILE )
        {
            $FILE eq $in         and die "$id: IN $in and OUT $out are the same." ;

            open STREAM, "> $FILE"  or  die "$id: Can't open [ $FILE ] $ERRNO";
            binmode STREAM;

            $OUT = *STREAM;
        }

        my $stat = open my $IN, "$in";

        unless ( $stat )
        {
            warn "Can't open [$in]";
            next;
        }

        binmode $IN;

        # .................................................... read-file ...

        my $count;

        while ( <$IN> )
        {
            $debug  and print  "READING:>$ARG";

            # .................................................. fixing line ...

            if ( defined $BEG_COL  and   $BEG_COL > 0  and  $END_COL > 0 )
            {
                $ARG = substr $ARG, $BEG_COL, $END_COL;
            }
            elsif ( defined $BEG_COL   and  $BEG_COL > 0  )
            {
                $ARG = substr $ARG, $BEG_COL, length $ARG ;
            }
            elsif (  defined $END_COL  and $END_COL > 0  )
            {
                $ARG = substr $ARG, 0, $END_COL;
            }

            # ............................................... detecting line ...

            #   Must be left flushed number, otherwise skip

            next if ! m,^[0-9a-f][0-9a-f][0-9a-f]+[: ]|^[0-9a-f][0-9a-f]/,i;

            #   NNN: 0a 0b      remove these from the beginning.
            #   NNN  0a 0b

            s/^[0-9]+:\s*//;

            #   00000300  00 00 00 00
            #   The memory address must have at least 3 numbers, otherwise
            #   its "a0" (plain data)

            s/^[0-9a-f][0-9a-f][0-9a-f]+\s*//i;

            #   FF/FF/FF/FF ==> FF FF FF FF

            s,/, ,g;

            #   Remove everything after 3 spaces

            s/ {3}.*//;

            #   Remove anything after item that is not a HEX value
            #
            #   NNN: FF FF FF FF   ................
            #

            s/\s*[^0-9A-Fa-f ].*//;

            #   If this line does not look like hex after cleaning, skip.

            next unless /^[0-9a-f][0-9a-f]/i;

            # ................................................ splitting line ...

            my @fields = split ' ';

            $debug  and print  "\nLOOP:> @fields\n\n";

            for my $i ( @fields )
            {
                #  Either "0a" or "124" octal or "255" decimal,
                #  No other values accepted

                if ( $i =~ /^[0-9A-F][0-9A-F]$|^[0-9][0-9][0-9]?$/i )
                {
                    $count++;

                    print "$i " if $RAW;

                    if ( defined $FILE )
                    {
                        my $val = hex $i;
                        $val = oct $i    if $OCTAL;
                        $val = $i        if $DECIMAL;

                        $out = pack 'C', $val;

                        print $OUT $out;
                    }
                }
            }

            print "\n" if $RAW;
        }

        close IN;

        if ( defined $FILE )
        {
            close OUT;
            print "Wrote $count bytes to $FILE\n";
        }
    }
}

Main();

# }}}

__END__