Hello,
Here's a parser of arguments to a C/C++ application built using
Getopt::Declare and Convert::Binary::C. The code provided below not only demonstrates the scheme but also has lots of comments to explain it; and the key module, ip_parser.pm, can be re-used as-is for other applications.
The main application used in the demo, a.cc
#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;
}
The application specific parser script, a_cfg.pl
#!/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__
The generic argument parser module, ip_parser.pm
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__
File with arguments to the demo app, a.args
# comment
# -version # comment
b = -2.712
d = "The quick brown fox jumps \
over the lazy dog."
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.
|
|