------------------------------------------------------------------------------
--                                                                          --
--                      GNAT METRICS TOOLS COMPONENTS                       --
--                                                                          --
--                  M E T R I C S . E N V I R O N M E N T                   --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                     Copyright (C) 2002-2007, AdaCore                     --
--                                                                          --
-- GNAT Metrics Toolset  is free software;  you can  redistribute it and/or --
-- modify it under terms of the  GNU General Public License as published by --
-- the Free Software Foundation;  either version 2, or (at your option) any --
-- later version.  GNAT Metrics Toolset is  distributed in the hope that it --
-- will be useful, but  WITHOUT ANY WARRANTY; without even the implied war- --
-- ranty of  MERCHANTABILITY or  FITNESS FOR A PARTICULAR PURPOSE.  See the --
-- GNU General Public License for more details.  You should have received a --
-- copy of the  GNU General Public License distributed with  GNAT; see file --
-- COPYING.  If not,  write to the  Free Software  Foundation,  51 Franklin --
-- Street, Fifth Floor, Boston, MA 02110-1301, USA.                         --
--                                                                          --
-- GNAT Metrics Toolset is maintained by AdaCore (http://www.adacore.com).  --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Text_IO;                use Ada.Text_IO;

with GNAT.Command_Line;          use GNAT.Command_Line;
with GNAT.Directory_Operations;  use GNAT.Directory_Operations;

with Hostparm;

with Asis.Ada_Environments;      use Asis.Ada_Environments;

with ASIS_UL.Compiler_Options;   use ASIS_UL.Compiler_Options;
with ASIS_UL.Options;

with METRICS.Output;             use METRICS.Output;
with METRICS.Common;             use METRICS.Common;
with METRICS.Options;            use METRICS.Options;
with METRICS.Metric_Definitions; use METRICS.Metric_Definitions;

package body METRICS.Environment is

   -----------------------
   -- Local subprograms --
   -----------------------

   Parameter_Error : exception;
   --  Is raised if the initialization is impossible or fails down because of
   --  any reason

   procedure Scan_Parameters;
   --  Scans the command-line parameters and sets the metrics to compute and
   --  sources to process. Note that parameters of -I and -gnatec options are
   --  converted into the full paths names in absolute form to make it possible
   --  to use them from the temporary directory.

   procedure Read_Args_From_File (Par_File_Name : String);
   --  Reads argument files from the file. Performs the same checks as when
   --  file names are read from the command line. This procedure assumes that
   --  the file named by Par_File_Name contains argument file names separated
   --  by one or more spaces.

   procedure Check_Parameters;
   --  Checks that parameter settings are compatible. Raises Parameter_Error
   --  and generates the diagnostic message if the check fails.
   --  Makes some preparations such as computing derived settings (???)

   procedure Context_Clean_Up;
   --  Closes and dissociates the context, if needed

   procedure Create_Temp_Dir;
   --  Creates the temporary directory and stores its name in Temp_Dir.

   ----------------------
   -- Check_Parameters --
   ----------------------

   procedure Check_Parameters is
      Tmp : String_Access;
   begin

      if Last_Source < First_SF_Id then
         Report ("No input source file set");
         Brief_Help;
         raise Parameter_Error;
      end if;

      Total_Sources := Natural (Last_Source);
      Sources_Left  := Total_Sources;

      Set_New_SF_Record;
      Set_Arg_List;
      Init_Global_Statistics;

      --  If the output directory is set, check the name can be used as a
      --  directory name, create the output directory if needed and set
      --  Output_Dir to the full name of this directory

      if Output_Dir.all /= "" then

         if Is_Regular_File (Output_Dir.all) then
            Error ("gnatmetric: cannot create the output directory");
            raise Parameter_Error;

         elsif not Is_Directory (Output_Dir.all) then

            begin
               Make_Dir (Output_Dir.all);
            exception
               when Directory_Error =>
                  Error ("gnatmetric: cannot create the output directory");
                  raise Parameter_Error;
            end;

         end if;

         Tmp := new String'(Normalize_Pathname (Output_Dir.all));
         Free (Output_Dir);
         Output_Dir := new String'(Tmp.all);
         Free (Tmp);

      end if;

      --  Setting the default values:

      if Out_Suffix = null then

         if Hostparm.OpenVMS then
            Out_Suffix := new String'("$METRIX");
         else
            Out_Suffix := new String'(".metrix");
         end if;

      end if;

      if XML_File_Name = null and then
         Generate_XML_Output
      then
         XML_File_Name := new String'("metrix.xml");
      elsif XML_File_Name /= null then
         Generate_XML_Output := True;
      end if;

   end Check_Parameters;

   --------------
   -- Clean_Up --
   --------------

   procedure Clean_Up is
   begin
      Context_Clean_Up;

      if Global_File_Name /= null then

         if Global_Output /= null
           and then
            Is_Open (Global_Output.all)
         then
            Close (Global_Out_File);
         end if;

      end if;

      if Is_Open (XML_Out_File) then
         Close (XML_Out_File);
      end if;

      --  Cleaning up temporary dir

      if Temp_Dir /= null then

         if not Is_Directory (Temp_Dir.all) then
            --  We may be inside this temporary directory
            Change_Dir ("..");
         end if;

         begin
            Remove_Dir (Temp_Dir.all, Recursive => True);
         exception
            when Directory_Error =>
               Free (Temp_Dir);  -- to avoid cycling
               Error ("gnatmetric: cannot remove temporary directory");
               raise Fatal_Error;
         end;

         Free (Temp_Dir);

      end if;

   end Clean_Up;

   ----------------------
   -- Context_Clean_Up --
   ----------------------

   procedure Context_Clean_Up is
   begin

      if Is_Open (The_Context) then
         Close (The_Context);
      end if;

      if Has_Associations (The_Context) then
         Dissociate (The_Context);
      end if;

   end Context_Clean_Up;

   ---------------------
   -- Create_Temp_Dir --
   ---------------------

   procedure Create_Temp_Dir is
      FD        : File_Descriptor;
      Temp_Name : Temp_File_Name;
      Success   : Boolean;
   begin
      --  Here we use exactly the same approach as in gnatelim

      --  ??? We create the temp dir by first creating the temp file, then
      --  closing and deleting it, then creating a dir with the same name.
      --  This is not atomary as another program can sneak in between file
      --  deletion and dir creation and snatch this name for itself. This is
      --  quite unlikely and anyway we don't have any other system-independent
      --  way at the moment
      Create_Temp_File (FD, Temp_Name);
      Close (FD);
      Delete_File (Temp_Name, Success);

      if not Success then
         Error ("gnatmetric: cannot delete the temporary file that was "
              & "just created");

         raise Fatal_Error;
      end if;

      Make_Dir (Temp_Name);

      Temp_Dir :=
        new String'(Temp_Name (Temp_Name'First .. Temp_Name'Last - 1));

   exception
      when Directory_Error =>
         Error ("gnatmetric: cannot create the temporary directory");
         raise Fatal_Error;
   end Create_Temp_Dir;

   ----------------
   -- Initialize --
   ----------------

   procedure Initialize is
   begin
      Scan_Parameters;
      Check_Parameters;

      Set_XML_Out_File;

      Create_Temp_Dir;
      Change_Dir (Temp_Dir.all);

   exception
      when Parameter_Error =>
         --  The diagnosis is already generated
         raise Fatal_Error;
      when others =>
         Error ("gnatmetric: initialization failed");
         --  Exception info will be generated in main driver
         raise;
   end Initialize;

   -------------------------
   -- Read_Args_From_File --
   -------------------------

   procedure Read_Args_From_File (Par_File_Name : String) is
      No_More_Args : Boolean := False;

      Arg_File         : File_Type;
      File_Name_Buffer : String (1 .. 16 * 1024);
      File_Name_Len    : Natural := 0;
      Next_Ch          : Character;
      End_Of_Line      : Boolean;

      function Get_File_Name return String;
      --  Reads from Par_File_Name the name of the next file (the file to read
      --  from should exist and be opened). Returns an empty string if there is
      --  no file names in Par_File_Name any more

      function Get_File_Name return String is
      begin
         File_Name_Len := 0;

         if not End_Of_File (Arg_File) then
            Get (Arg_File, Next_Ch);

            while Next_Ch = ' ' loop
               exit when End_Of_File (Arg_File);
               Get (Arg_File, Next_Ch);
            end loop;

            while Next_Ch /= ' ' loop
               File_Name_Len := File_Name_Len + 1;
               File_Name_Buffer (File_Name_Len) := Next_Ch;

               Look_Ahead (Arg_File, Next_Ch, End_Of_Line);

               exit when End_Of_Line or else End_Of_File (Arg_File);

               Get (Arg_File, Next_Ch);
            end loop;

         end if;

         return File_Name_Buffer (1 .. File_Name_Len);
      end Get_File_Name;

   begin

      if not Is_Regular_File (Par_File_Name) then
         Error ("gnatmetric: " & Par_File_Name & " does not exist");
         return;
      end if;

      Open (Arg_File, In_File, Par_File_Name);

      loop
         Add_Source_To_Process (Get_File_Name, No_More_Args);
         exit when No_More_Args;
      end loop;

      Close (Arg_File);
   exception
      when others =>
         Error ("gnatmetric: cannot read arguments from " & Par_File_Name);
         --  Exception info will be generated in main driver
         raise;
   end Read_Args_From_File;

   ---------------------
   -- Scan_Parameters --
   ---------------------

   procedure Scan_Parameters is
      No_More_Args : Boolean := False;

      Line_Metrics_On    : Boolean := True;
      Element_Metrics_On : Boolean := True;
      --  The corresponding flag is set ON when the first specific metric
      --  option is processed and all the line or element metrics are turned
      --  off. It prevents from turning all the metric all again when the next
      --  specific metric is set on
   begin

      Initialize_Option_Scan
        (Stop_At_First_Non_Switch => True,
         Section_Delimiters       => "cargs");

      loop
         case GNAT.Command_Line.Getopt
           ("la lcode lcomm leol lb "        &
            "enu "                           &
            "es ed eps eas ept eat ec "      &
            "nocc noec nonl ne nolocal  "    &
            "d= o= files= og= ox= x nt sfn " &
            "gnat05 "                        & --  Ada 2005 mode
            "q v dv dd")
         is

            when ASCII.NUL =>
               exit;

            when  'd' =>

               if Full_Switch = "dd" then
                  Progress_Indicator_Mode := True;
               elsif Full_Switch = "dv" then
                  Debug_Output := True;
               elsif Full_Switch = "d" then
                  Free (Output_Dir);
                  Output_Dir := new String'(Parameter);
               end if;

            when  'e' =>

               if Element_Metrics_On then
                  Element_Metrics_Off;
                  Element_Metrics_On := False;
               end if;

               if Full_Switch = "es" then
                  Compute_All_Statements := True;
               elsif Full_Switch = "ed" then
                  Compute_All_Declarations := True;
               elsif Full_Switch = "eps" then
                  Compute_Public_Subprograms := True;
               elsif Full_Switch = "eas" then
                  Compute_All_Subprograms := True;
               elsif Full_Switch = "ept" then
                  Compute_Public_Types := True;
               elsif Full_Switch = "eat" then
                  Compute_All_Types := True;
               elsif Full_Switch = "enu" then
                  Compute_Progam_Unit_Nesting := True;
               elsif Full_Switch = "ec" then
                  Compute_Construct_Nesting := True;
               end if;

            when 'f' =>

               if Full_Switch = "files" then
                  Read_Args_From_File (Parameter);
               end if;

            when 'g' =>

               if Full_Switch = "gnat05" then
                  ASIS_UL.Options.ASIS_2005_Mode := True;
               end if;

            when 'l' =>

               if Line_Metrics_On then
                  Line_Metrics_Off;
                  Line_Metrics_On := False;
               end if;

               if Full_Switch = "la" then
                  Compute_All_Lines := True;
               elsif Full_Switch = "lcode" then
                  Compute_Code_Lines := True;
               elsif Full_Switch = "lcomm" then
                  Compute_Comment_Lines := True;
               elsif Full_Switch = "leol" then
                  Compute_EOL_Comments := True;
               elsif Full_Switch = "lb" then
                  Compute_Blank_Lines := True;
               end if;

            when 'n' =>

               if Full_Switch = "nocc" then
                  Compute_Cyclomatic_Complexity := False;
               elsif Full_Switch = "noec" then
                  Compute_Essential_Complexity := False;
               elsif Full_Switch = "ne" then
                  Treat_Exit_As_Goto := False;
               elsif Full_Switch = "nolocal" then
                  Compute_Local_Metrics := False;
               elsif Full_Switch = "nonl" then
                  Compute_Loop_Nesting := False;
               elsif Full_Switch = "nt" then
                  Generate_Text_Output := False;
                  Generate_XML_Output  := True;
               end if;

            when 'o' =>

               if Full_Switch = "o" then
                  Out_Suffix  := new String'(Parameter);
               elsif Full_Switch = "og" then
                  Global_File_Name := new String'(Parameter);
               elsif Full_Switch = "ox" then
                  Generate_XML_Output := True;
                  XML_File_Name       := new String'(Parameter);
               else
                  Brief_Help;
                  raise Parameter_Error;
               end if;

            when 'q' =>

               if Full_Switch = "q" then
                  Quiet_Mode := True;
               end if;

            when 's' =>

               if Full_Switch = "sfn" then
                  Short_SFN_In_Output := True;
               end if;

            when 'v' =>

               if Full_Switch = "v" then
                  Verbose_Mode := True;
               end if;

            when 'x' =>
               Generate_XML_Output := True;

            when others =>
               Brief_Help;
               raise Parameter_Error;
         end case;
      end loop;

      if Verbose_Mode then
         Version_Info;
      end if;

      loop
         Add_Source_To_Process (Get_Argument, No_More_Args);
         exit when No_More_Args;
      end loop;

      Process_cargs_Section;

   exception
      when GNAT.Command_Line.Invalid_Switch =>
         Error ("gnatmetric: invalid switch : " & Full_Switch);
         Brief_Help;

         raise Parameter_Error;

      when GNAT.Command_Line.Invalid_Parameter =>
         Error ("gnatmetric: parameter missed for : -" & Full_Switch);
         Brief_Help;

         raise Parameter_Error;
   end Scan_Parameters;

   ---------------------
   -- Source_Clean_Up --
   ---------------------

   procedure Source_Clean_Up (SF : SF_Id) is
      Success : Boolean;
   begin
      Context_Clean_Up;   --  ???

      if Is_Open (Source_Output_File) then
         Close (Source_Output_File);
      end if;

      Delete_File (Suffixless_Name (SF) & ".adt", Success); --  ???
      Delete_File (Suffixless_Name (SF) & ".ali", Success); --  ???

   end Source_Clean_Up;

end METRICS.Environment;
