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 source file is here
------------------------------------------------------------------------------ -- -- -- 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. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- ------------------------------------------------------------------------------ -- change history: -- -- -- -- name changes -- -- ---------- -------------------------------------------------------------- -- NMA021899 created -- -- NMA030299 Made it modified GPL. chanegd header. -- -- -- -- 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 -- -- -- -- -- -- 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. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ -- -- -- change history: -- -- -- -- name changes -- -- ---------- -------------------------------------------------------------- -- NMA021899 created -- -- NMA030299 Changed header to make it modified GPL -- -- -- -- 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; -------------------- -- No_Optarg_Case -- -------------------- 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; ------------ -- Getopt -- ------------ 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;
This is a test program of the above package. source code
-- Test example showing how to use GETOPT Ada package -- Nasser M. 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;