package ip_parser;
use strict;
use warnings;
use diagnostics;
use Carp;
use Getopt::Declare;

my $my_name = 'ip_parser.pm'; # $0 is user of this package, a_cfg.pl in demo

our $VERSION = 0.50;

my $parser_args_format =<<SPEC_FOR_ARGS_FROM_APP_TO_PARSER;

    app_version = <app_version:s>_tb_Version of the application that requires 
                                        its args to be parsed

    arg_file = <arg_file:if>     _tb_File of arguments to configure the 
                                        runtime of the application.
                                        Optional, and values in this file can be 
                                        over-ridden by explicit command line 
                                        assignments

    ip_str = <ip_str:id>         _tb_Name of the C data structure that needs to 
                                        be filled with the parsed arguments (required)
                                     [ required ] 

    h_file = <h_file:if>         _tb_File that contains the definition of the 
                                        structure __ip_str (required)
                                     [ required ] 

    io_file = <io_file:if>       _tb_Binary file of the default contents of the 
                                        structure __ip_str.  When the perl script
                                        that parsers the arguments 
                                        for the C/C++ application ends, this file
                                        will have the parsed values assigned to the
                                        fields of the structure.  (required)
                                     [ required ] 

    -pv                          _tb_Show this parser's version
                                    { print "\n\t$0 of version ", get_callers_version(), " using $my_name of version $VERSION\n\n"; exit; }
    -pversion                    _tb_[ditto]
    --pversion                   _tb_[ditto]
    -pV                          _tb_[ditto]
    

    # version must be over-ridden since the user is asking 
    # for the version of the application (and not that of
    # either of the two parsers)
    # Unfortunately, usage summary ends up with incorrect info
    # regarding how to request for the version if we do not 
    # over-ride all variants of such request

    -v                           _tb_Show the application's version
                                     { asked_for_version(); }
    -version                     _tb_[ditto]
    -Version                     _tb_[ditto]
    -VERSION                     _tb_[ditto]
    --version                    _tb_[ditto]
    --Version                    _tb_[ditto]
    --VERSION                    _tb_[ditto]
    -V                           _tb_[ditto]

    # help must be over-ridden since usage information
    # must not come from this parser but must come from 
    # the second parser
    # Unfortunately, usage summary ends up with incorrect info
    # regarding how to request help if we do not over-ride
    # all variants of such request

    -h                           _tb_Show application's usage information
                                     { asked_for_help(); }
    -help                        _tb_[ditto]
    -Help                        _tb_[ditto]
    -HELP                        _tb_[ditto]
    --help                       _tb_[ditto]
    --Help                       _tb_[ditto]

    # there is some bug that requires that at least one 
    # default method of asking for help be available
    # If this is not made available, the call to \$self->usage(0)
    # in the second parser ends up showing the help for the
    # first parser!
    #   --HELP                       _tb_[ditto]

    -H                           _tb_[ditto]
    -usage                       _tb_[ditto]
    --usage                      _tb_[ditto]

    Optionally, more arguments (see help)

SPEC_FOR_ARGS_FROM_APP_TO_PARSER

my $callers_version = 'unknown';  # caller in demo is a_cfg.pl
my $app_version     = 'unknown';  # app in demo is a.cc
my $help            = 0;
my $version         = 0;

$parser_args_format =~ s/_tb_/\t/g;

my %parsing_context = ();

my $arg_file = '';
my $cfg_file = '';

sub parser_init
{
      $callers_version = shift;
   my $app_args_format = shift;
   # Use of [-BUILD] would result in messages from perl, so not being used
   #my $parser_args = new Getopt::Declare( $parser_args_format, [-BUILD] ) or croak "unable to build parser's parser";
   #my $app_args    = new Getopt::Declare( $app_args_format,    [-BUILD] ) or croak "unable to build app's parser";
   #$parser_args->parse() or croak "unable to parse parser's arguments";

   my $parser_args = new Getopt::Declare( $parser_args_format ) or croak "unable to parse parser's arguments";

   # Set up for handling any request by the user for help or version info on the application
   $help    and push @ARGV, '-h';  
   $version and push @ARGV, '-version';
   
   $parser_args->{ 'app_version' } and  $app_version = $parser_args->{ 'app_version' }{ '<app_version>' };

   $version and print"\n\tApp's version: $app_version\n\n" and exit( 2 );
   
   $parsing_context{ arg_file } = $parser_args->{ 'arg_file' }{ '<arg_file>' };

   read_arg_file( \%parsing_context );

   $parsing_context{ ip_str  } = $parser_args->{ 'ip_str'  }{ '<ip_str>'  } or croak "required name of data structure is missing!!!";
   $parsing_context{ h_file  } = $parser_args->{ 'h_file'  }{ '<h_file>'  } or croak "required data structure definition file is missing!!!";
   $parsing_context{ io_file } = $parser_args->{ 'io_file' }{ '<io_file>' } or croak "required io file name is missing!!!";

   $parsing_context{ parser_args } = \$parser_args;

   read_io_file( \%parsing_context );

   $app_args_format =~ s/_tb_/\t/g;
   $parsing_context{ app_args_format } = $app_args_format;

   return \%parsing_context;
}

sub show_version
{
   print "\n\tThe application's version:  $app_version\n\n";
}

sub get_callers_version
{
   return $callers_version;
}

sub asked_for_help
{
   $help = 1;
}

sub asked_for_version
{
   $version = 1;
}


sub read_arg_file
{
   my $pc = shift;
   my $arg_file = ${$pc}{ arg_file } or return;

   open( ARG_FILE,  "<$arg_file" ) or croak "Can't open $arg_file: $!";
   my $users_args = do { local $/;  <ARG_FILE> };
   close( ARG_FILE );

   $users_args =~ s/([^\\])#.*/$1/gm; # bug: un-escaped # in quoted strings
   $users_args =~ s,\\$/,,gm;  # concatination
   $users_args =~ s/^\s*//gm; 

   my @foo = split "\n", $users_args;  # use $/ rather than \n?

   ${$pc}{ users_args } = \@foo;
}

sub get_arguments
{
   my @foo = ();
      defined @{$parsing_context{ default_args }} and 
              @{$parsing_context{ default_args }} and 
              push @foo, @{$parsing_context{ default_args }};
      defined @{$parsing_context{ users_args }}   and 
              @{$parsing_context{ users_args }}   and 
              push @foo, @{$parsing_context{ users_args }};  
      @ARGV                               and push @foo, @ARGV;

      @ARGV = @foo;

   my $app_args = new Getopt::Declare( $parsing_context{ app_args_format } ) or croak "unable to parse apps's arguments";

   $help and $app_args->usage( 0 );

   $parsing_context{ app_args } = \$app_args;

   return \%parsing_context;
}

use Convert::Binary::C;

# reads a binary file containing the default values
sub read_io_file
{
   my $pc = shift;
 
   my $ip_str  = ${$pc}{ ip_str  };
   my $h_file  = ${$pc}{ h_file  };
   my $io_file = ${$pc}{ io_file };

   open( H_FILE,  "<$h_file" ) or croak "Can't open $h_file: $!";
   my $h_contents = do { local $/;  <H_FILE> };
   close( H_FILE );

   $h_contents =~ m/(^\s*typedef\s+struct\s+_?$ip_str.*?\}\s*$ip_str\s*;\s*)/gsm or croak "couldn't match";
   $h_contents =  $1;

   ${$pc}{ h_contents } = $h_contents;

my $c = new Convert::Binary::C;
   $c->parse( $h_contents );
   $c->def( $ip_str ) or croak "Unable to find $ip_str in $h_contents\n"; 

my $ip_size = $c->sizeof($ip_str);

   open( IO_FILE,  "<:raw",  $io_file ) or croak "Can't open $io_file: $! for reading";
   binmode IO_FILE;
   my $io_contents=0;
   my $bytes = read IO_FILE, $io_contents, $ip_size;
   close( IO_FILE );
   croak "Wrong length read ($bytes != expected $ip_size): $! ($^E)" if $bytes != $ip_size;

my $ip_val = $c->unpack( $ip_str, $io_contents );

   ${$pc}{ ip_val } = $ip_val;
}

sub write_io_file
{
   my $ip_val = $parsing_context{ ip_val };
   my $ip_str  = $parsing_context{ ip_str  };
   my $h_file  = $parsing_context{ h_file  };
   my $io_file = $parsing_context{ io_file };
   my $h_contents = $parsing_context{ h_contents };

my $c = new Convert::Binary::C;
   $c->parse( $h_contents );
   $c->def( $ip_str ) or croak "Unable to find $ip_str in $h_contents\n"; 
my $ip_size = $c->sizeof($ip_str);

   open(OUT, ">:raw", $io_file) or croak "Unable to open $io_file for writing:$!\n";
   binmode OUT;

my $data = $c->pack($ip_str, $ip_val);                                     
my $bytes = syswrite OUT, $data, $ip_size;                            
   croak "Wrong length written ($bytes != expected $ip_size): $! ($^E)" if $bytes != $ip_size;
}

1;       

__END__