AdaPower Logged in as Guest
Ada Tools and Resources

Ada 95 Reference Manual
Ada Source Code Treasury
Bindings and Packages
Ada FAQ


Join >
Articles >
Ada FAQ >
Getting Started >
Home >
Books & Tutorials >
Source Treasury >
Packages for Reuse >
Latest Additions >
Ada Projects >
Press Releases >
Ada Audio / Video >
Home Pages >
Links >
Contact >
About >
Login >
Back
Ada Libraries - getopt
Libraries of Ada Code

------------------------------------------------------------------------------
--                                                                          --
--                               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;


(c) 1998-2004 All Rights Reserved David Botton