#include <stdio.h>
#include <stdlib.h>
#include <string>
#include <malloc.h>
#include <assert.h>
#include <iostream>
#include <sys/time.h>
#include <errno.h>
#include <math.h>

// Demo has been tested on Windows XP Professional in bash shell 
// and MinGW compiler, g++;  perl 5.8.8 build 822.  This file was 
// compiled by just doing "g++ a.cc". 
//
// Some commands to try out:
//
// a "normal" usage of this (demo) application
//     a.exe    arg_file = a.args  e = \"blah and blee, 'indeed'\"  c 
+= 123 
// version of the application
//    a.exe  --version
// help on using the application (usage information)
//    a.exe  --help
//    a.exe  --usage
// version of the perl based parsers (a_cfg.pl and ip_parser.pm)
//    a.exe  -pv
// help on using ip_parser.pm
//     a.exe  --HELP
// in the following commands, note the right-most argument
//     a.exe    arg_file = a.args  e = \"blah and blee, 'indeed'\"  c 
+= 123  --version 
//     a.exe    arg_file = a.args  e = \"blah and blee, 'indeed'\"  c 
+= 123  --help    
//     a.exe    arg_file = a.args  e = \"blah and blee, 'indeed'\"  c 
+= 123  --usage    
//     a.exe    arg_file = a.args  e = \"blah and blee, 'indeed'\"  c 
+= 123  -pv       
//

// There are three versions:  the version of the applicatino
// (below), the verion of the application specific perl script,
// a_cfg.pl, and the version of the generic module, ip_parser.pm 
char *the_version()
{
   return "the_apps_version_is_0123";
}

// The data structure related to the arguments The contents of this
// data start with default values and end with the parsed values.
// The contents are exchanged with the perl scripts via
// Convert::Binary::C
typedef struct _a_str_
{
    int     a;
    float   b;
    int     c;
    char    d[ 256 ];
    char    e[ 128 ];
    char    f[ 128 ];
    float   g;

} a_str;


int main( int argc __attribute__ ((unused)),  const char **argv __attr
+ibute__ ((unused)) )
{
    std::string  a_args;
    std::string  a_io;

    if( argc == 1 ) 
    {
        // Just process as per default values
        // This demo app has nothing to do with default values
        exit( 0 );
    }

    a_str  a;

    // initialize to default values
    {
       a.a = 1;
       a.b = -2.0;
       snprintf( a.d, 256, "this is a default string value" );
       snprintf( a.e, 128, "a default string 'value' with \"quotes\"" 
+);
       snprintf( a.f, 128, "default_symbol" );
       a.g = 1.23e-5;

       // write out default values -- these will be read by 
       // the perl script that parsers this app's arguments
       FILE *fp;
       a_io = "a.io";
       if( ! ( fp = fopen( a_io.c_str(), "wb") ) )
       {
           printf("Unable to open %s for writing binary stuff\n", a_io
+.c_str());
           exit(-1);
       }
       int rc;
       rc = (int)fwrite( &a,  1,  sizeof( a ),  fp );
       if( rc != (int)sizeof( a ) )
       {
           printf("Wrote %d instead of %d to %s\n", rc, sizeof( a ), a
+_io.c_str() );
           exit(-1);
       }
       if( fclose( fp ) )
       {
           printf("Unable to close %s\n", a_io.c_str());
           exit(-1);
       }
    }

    // Build up the command used to call the perl script that
    // parses the arguments.  Distinguish between arguments 
    // to this application and arguments to the perl based parser!
    a_args = "perl a_cfg.pl ";

    for( int i = 1;  i < argc;  i++ )
    {
        a_args += ( argv[ i ] ) + (std::string)" ";
    }
    // next four args are purely for parsing arguments (menaing, they
    // are not part of the application as such)
    //
    // In case the user wanted to know the version of this 
    // application, ther perl script will provide it to him
    // by means of argument named app_version
    a_args += "app_version = " + (std::string) the_version() + " ";
    // io_file is the file used to exchange data between this C
    // application the perl script -- this is the file into 
    // which the default arguments have already been written
    // to in the code block above
    a_args += "io_file = " + a_io + " ";
    // ip_str is the name of the data structure that contains 
    // the arguments of this application
    a_args += "ip_str = a_str  ";
    // h_file is the file that contains the definition of ip_str;
    // for this demo, it is just this file
    a_args += "h_file = a.cc ";

    // use system command to launch the perl script and 
    // get the return code (rc)
    int rc = system( a_args.c_str() );
    // I could not make successful parsing return 0 since
    // Getopt::Declare returns 0 on encountering the user's request
    // for usage information!  So I made successful parsing 
    // for non-trivial arguments (meaning not requests for help
    // or for version) return 1
    if( rc < 0 )
    {
       printf("Error processing arguments\n");
       exit(-1);
    }
    if( rc != 1 )
    {
       // user wanted version or usage information 
       // which was provided by the perl script;
       // and so we are now done
       return( 0 );
    }
    // rc == 1 is the only case in which the 
    // application continues processing
    {
       a.a = 0;
       a.b = 0.0;
       a.g = 0.0;

       // Read in the parsed arguments
       FILE *fp;
       a_io = "a.io";
       if( ! ( fp = fopen( a_io.c_str(), "rb") ) )
       {
           printf("Unable to open %s for reading binary stuff\n", a_io
+.c_str());
           exit(-1);
       }
       int rc;
       rc = (int)fread( &a,  1,  sizeof( a ),  fp );
       if( rc != (int)sizeof( a ) )
       {
           printf("Wrote %d instead of %d to %s\n", rc, sizeof( a ), a
+_io.c_str() );
           exit(-1);
       }
       if( fclose( fp ) )
       {
           printf("Unable to close %s\n", a_io.c_str());
           exit(-1);
       }
    }
    // This demo ends by printing the parsed
    // arguments gotten from the perl script
    printf("Read values:\n\t\t|a:%d\n\t\t|b:%e\n\t\t|c:%d\n\t\t|d:%s\n
+\t\t|e:%s\n\t\t|f:%s\n\t\t|g:%e\n\n", a.a, a.b, a.c, a.d, a.e, a.f, a
+.g); 

    return 0;
}
[download]

#!/c/opt/perl/bin/perl
BEGIN {(*STDERR = *STDOUT) || die;}
use warnings;
use strict;
use diagnostics;
use Carp;
$| = 1;
use Data::Dumper;

# Use the generic module ip_parser.pm
use ip_parser;

# version number of this application specific file
my $version = 0.1;

#
# Application specific routine that returns reference to array 
# of default argv.  The hash ip_val is the counterpart of the
# application's data structure ip_str;  Convert::Binary::C
# forms the bridge between this hash and the ip_str.
#
sub make_default_args
{
  my $ip_val = shift;

  my ($d, $e, $f) = ();

  foreach my $foo ( @{${$ip_val}{d}} ) { ( $foo and $d .= chr( $foo ) 
+) or last ; }
  foreach my $foo ( @{${$ip_val}{e}} ) { ( $foo and $e .= chr( $foo ) 
+) or last ; }
  foreach my $foo ( @{${$ip_val}{f}} ) { ( $foo and $f .= chr( $foo ) 
+) or last ; }

# no need to escape quotes
# $d =~ s/"/\\"/g; 
# $e =~ s/"/\\"/g;
  
  return  [
             "a = ${$ip_val}{a}", 
             "b = ${$ip_val}{b}", 
           # "c = ${$ip_val}{c}",  no default value
             "d =   $d  ", # no need to use quotes 
             "e =   $e  ", 
             "f =   $f  ", 
             "g = ${$ip_val}{g}", 
          ];
}

#
# Application specific specification of arguments Getopt::Declare
# requires tabs in the specification; We write the specification
# using _tb_ instead of tabs, then, before use, we globally
# substitue _tb_ by \t
#
my $app_args_format =<<SPEC_FOR_THE_APPS_ARGS;

    a = <a:+i>    _tb_A counter
 
    b = <b:n>     _tb_The downward floater

    c = <c:i>     _tb_A teenager

    d = <d>       _tb_The long message

    e = <e>       _tb_A shorter message

    f = <f:id>    _tb_The identifier

    g = <g:0+n>   _tb_The floater going up
 

SPEC_FOR_THE_APPS_ARGS

# Application specific routine that takes the parsed information
# from ip_parser.pm and puts it into the counterpart of the
# application's structure ip_str;  ip_parser.pm will pass this hash
# to the application using Convert::Binary::C
#
sub fill_args
{
   my $ip_val   = shift;
   my $app_args = shift;

   my $d = ${$app_args}->{ 'd' }{ '<d>' }; 
   my $e = ${$app_args}->{ 'e' }{ '<e>' }; 
   my $f = ${$app_args}->{ 'f' }{ '<f>' }; 

   my @ad = map ord, split '', $d;
   my @ae = map ord, split '', $e;
   my @af = map ord, split '', $f;
      
      ${$ip_val}{a} = ${$app_args}->{ 'a' }{ '<a>' }; 
      ${$ip_val}{b} = ${$app_args}->{ 'b' }{ '<b>' }; 
      ${$ip_val}{c} = ${$app_args}->{ 'c' }{ '<c>' }; 
      ${$ip_val}{d} = \@ad;
      ${$ip_val}{e} = \@ae;
      ${$ip_val}{f} = \@af;
      ${$ip_val}{g} = ${$app_args}->{ 'g' }{ '<g>' }; 
}

my $h = ip_parser::parser_init( $version, $app_args_format );
  
   $h or exit( -1 );

   # The default arguments are made using the default values
   # written out by the application before calling this perl
   # script
   ${$h}{ default_args } = make_default_args( ${$h}{ ip_val } );
 
   # The arguments are processing in this order:  default 
   # values, values in any file, values specified in the
   # command line. 
   ip_parser::get_arguments() or exit( 0 );

   # Load the parsed arguments into the hash that will 
   # soon be transfered to the calling applicaiton 
   fill_args( ${$h}{ ip_val },  ${$h}{ app_args } );

   # Transfer the hash to the calling application  
   ip_parser::write_io_file( );
   
   # Successful exit;  I could not make successful parsing
   # return 0 since Getopt::Declare returns 0 on encountering 
   # the user's request for usage information!  So I made 
   # successful parsing for non-trivial (meaning not requests 
   # for help or version) parsing 1
   exit( 1 );

__END__
[download]

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 i
+n 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 r
+equires 
                                        its args to be parsed

    arg_file = <arg_file:if>     _tb_File of arguments to configure th
+e 
                                        runtime of the application.
                                        Optional, and values in this f
+ile can be 
                                        over-ridden by explicit comman
+d line 
                                        assignments

    ip_str = <ip_str:id>         _tb_Name of the C data structure that
+ needs to 
                                        be filled with the parsed argu
+ments (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 conten
+ts 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 as
+signed to the
                                        fields of the structure.  (req
+uired)
                                     [ 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 informat
+ion
                                     { 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, [-BUIL
+D] ) or croak "unable to build parser's parser";
   #my $app_args    = new Getopt::Declare( $app_args_format,    [-BUIL
+D] ) 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 cro
+ak "unable to parse parser's arguments";

   # Set up for handling any request by the user for help or version i
+nfo 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_fil
+e>' } 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 st
+rings
   $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_form
+at } ) 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)" i
+f $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__
[download]