From mboxrd@z Thu Jan 1 00:00:00 1970 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=ham autolearn_force=no version=3.4.4 X-Google-Language: ENGLISH,ASCII-7-bit X-Google-Thread: 103376,d72dc559169a2d4d,start X-Google-Attributes: gid103376,public From: nabbasi@pacbell.net Subject: fyi: getopt package in Ada. Date: 1999/03/01 Message-ID: <7be4kn$6rc@drn.newsguy.com> X-Deja-AN: 449967694 Organization: Newsguy News Service [http://www.newsguy.com] Newsgroups: comp.lang.ada Date: 1999-03-01T00:00:00+00:00 List-Id: -- 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;