From: nabbasi@pacbell.net
Subject: fyi: getopt package in Ada.
Date: 1999/03/01
Date: 1999-03-01T00:00:00+00:00 [thread overview]
Message-ID: <7be4kn$6rc@drn.newsguy.com> (raw)
-- for GNAT users, save this file, and do gnatchop on it. This will create
-- 3 files. getopt.ads, getopt.adb, test_getopt.adb
------------------------------------------------------------------------------
-- --
-- G E T O P T --
-- --
-- S p e c --
-- --
--$Header: getopt.ads,v 1.1.1.1 1999/03/01 12:23:04 nabbasi Exp $ --
-- --
-- Copyright (C) 1998 Nasser Abbasi --
-- --
-- This is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GETOPT is distributed in the hope that it will be useful, but WITH --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. Free Software Foundation, 59 Temple Place - Suite --
-- 330, Boston, MA 02111-1307, USA. --
-- --
-- --
------------------------------------------------------------------------------
-- change history:
--
-- name changes
-- ---------- --------------------------------------------------------------
-- NMA021899 created
--
-- description:
--
-- This package is an Ada implementation of getopt() as specified by the
-- document "The Single UNIX Specification, Version 2", Copyright 1997 The
-- Open Group
--
-- Compiler used: GNAT 3.11p
-- Platform: Linux 2.0.36 ( Red hat 5.2)
--
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
package Getopt is
function Getopt(Optstring : String) return Integer;
Optind : Positive;
Optarg : Unbounded_String ;
Optopt : Character := ' ';
Opterr : Integer := 1;
end Getopt;
------------------------------------------------------------------------------
-- --
-- G E T O P T --
-- --
-- BODY --
-- --
--$Header: getopt.adb,v 1.2 1999/03/01 12:54:03 nabbasi Exp $ --
-- --
-- --
-- --
-- Copyright (C) 1998 Nasser Abbasi --
-- nabbasi@pacbell.net --
-- --
-- This is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GETOPT is distributed in the hope that it will be useful, but WITH --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. Free Software Foundation, 59 Temple Place - Suite --
-- 330, Boston, MA 02111-1307, USA. --
-- --
-- --
------------------------------------------------------------------------------
-- change history:
--
-- name changes
-- ---------- --------------------------------------------------------------
-- NMA021899 created
--
-- description:
--
-- This package is an Ada implementation of getopt() as specified by the
-- document "The Single UNIX Specification, Version 2", Copyright 1997 The
-- Open Group
--
-- This describes the items involveed using example
--
--
-- curopt
-- |
-- V
-- "-f foo -dbc -k"
-- ^
-- |
-- optind
--
-- optind is position (index) that tells which command line argument is being
-- processed now.
-- curopt tells which optchar is being processed within one command line
-- argument. This is needed only if more that one optchar are stuck
-- togother in one argument with no space, as in -df where both d and f
-- are valid optchar and d takes no optarg.
--
--
-- Compiler used: GNAT 3.11p
-- Platform: Linux 2.0.36 ( Red hat 5.2)
--
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Command_Line; use Ada.Command_Line;
with Ada.Text_Io; use Ada.Text_Io;
package body Getopt is
Curopt : Natural := 2;
procedure No_Optarg_Case is
begin
if( Curopt < Argument(Optind)'Length) then
Curopt := Curopt +1;
else
Curopt := 2;
Optind := Optind+1;
end if;
end No_Optarg_Case;
function Getopt(Optstring : String) return Integer is
begin
if ( Argument_Count = 0 or else optind > Argument_Count
or else ( Argument( optind )(1) /= '-') ) then
return -1;
end if;
if( Argument( optind )'Length = 1 ) then
return -1;
end if;
-- according to The Single UNIX Specification, Version 2, if "--"
-- is found, return -1 after ++optind.
if( Argument( Optind )(2) = '-' ) then
Optind := Optind + 1;
return -1;
end if;
-- if we get here, the command argument has "-X"
for I in Optstring'Range loop
if( Optstring(I) = Argument( optind )( Curopt ) ) then
if( I < Optstring'Length ) then
if (Optstring(I+1) = ':') then
-- see if optarg stuck to optchar
if( Argument(Optind)'Length - Curopt > 0 ) then
Optarg := To_Unbounded_String(
Argument( optind )(Curopt+1..Argument( optind )'Length));
Curopt := Curopt + 1;
optind := Optind + 1;
return character'pos(Optstring(I));
end if;
-- see if optarg on separate argument
if( Optind < Argument_Count ) then
Curopt := 2;
optind := optind + 1;
optarg := To_Unbounded_String (Argument(optind ));
optind := optind + 1;
return character'Pos(Optstring(I));
else
Optind := Optind+1;
Optopt := Optstring(I);
if( Opterr=1 and Optstring(1) /= ':' ) then
Put_Line(Standard_Error,
"Argument expected for the -"&
Optstring(I..I) & " option");
end if;
if( Optstring(1) = ':' ) then
return Character'Pos(':');
else
return Character'Pos('?');
end if;
end if;
else -- current optchar matches and has no arg option
No_Optarg_Case;
return character'pos(Optstring(I));
end if;
else -- last char in optstring, can't have argument
No_Optarg_Case;
return character'pos(Optstring(I));
end if;
end if;
End loop;
Optopt := Argument(Optind)( Curopt );
No_Optarg_Case;
-- we get here if current command argument not found in optstring
return character'pos('?');
end Getopt;
begin
Optarg := To_Unbounded_String("");
Optind := 1;
end Getopt;
-- Test example showing how to use GETOPT Ada package
-- Nasser Abbasi
with Ada.Text_Io; use Ada.Text_Io;
with Ada.Command_Line; use Ada.Command_Line;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Getopt;
procedure Test_Getopt is
Test_String : String := "c:di:n:p:u:V";
Optchar : character;
Value : Integer;
begin
Getopt.Opterr := 1;
loop
Value := Getopt.Getopt( Test_String );
exit when Value = -1;
optchar := Character'Val( Value );
case optchar is
when 'c' =>
Put_Line("commant is "& To_String(Getopt.Optarg));
when 'd' =>
Put_Line("debug on");
when 'i' =>
Put_line("got -i, its argument is:" & To_String(Getopt.Optarg) );
when 'n' =>
Put_line("got -n, its argument is:" & To_String(Getopt.Optarg));
when 'p' =>
Put_line("got -p, its argument is:" & To_String(Getopt.Optarg));
when 'u' =>
Put_line("got -u, its argument is:" & To_String(Getopt.Optarg));
when 'V' =>
Put_line("got -V");
when '?' =>
Put_Line("got ?, optopt is " & Getopt.Optopt);
when ':' =>
Put_Line("get :, optopt is "& Getopt.optopt);
when others => null;
end case;
end loop;
-- now lets print the remaining arguments if any
declare
Index : positive;
begin
Index := Getopt.Optind;
for I in Index..Argument_Count loop
Put_Line( Argument(I) );
end loop;
end;
end Test_Getopt;
next reply other threads:[~1999-03-01 0:00 UTC|newest]
Thread overview: 12+ messages / expand[flat|nested] mbox.gz Atom feed top
1999-03-01 0:00 nabbasi [this message]
1999-03-01 0:00 ` fyi: getopt package in Ada robert_dewar
1999-03-01 0:00 ` nabbasi
1999-03-02 0:00 ` robert_dewar
1999-03-02 0:00 ` Pascal Obry
1999-03-02 0:00 ` still Looking for GNAT modified GPL header nabbasi
1999-03-02 0:00 ` dewar
1999-03-02 0:00 ` Samuel Tardieu
1999-03-02 0:00 ` nabbasi
1999-03-02 0:00 ` dennison
1999-03-03 0:00 ` Pascal Obry
1999-03-02 0:00 ` fyi: getopt package in Ada nabbasi
replies disabled
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox