|
|
 |
|
Ada Libraries - getopt
------------------------------------------------------------------------------
-- --
-- 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 --
-- 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. --
-- --
-- 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;
-- 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;
|
 |
|
