----------------------------------------------------------- --------------------- -- -- -- OCARINA COMPONENTS -- -- -- -- O C A R I N A . P N . U T I L S -- -- -- -- B o d y -- -- -- -- Copyright (C) 2005-2006, GET-Telecom Paris. -- -- -- -- Ocarina 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. Ocarina is distributed in the hope that it will be -- -- useful, but WITHOUT ANY WARRANTY; without even the implied warranty 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 Ocarina; see file COPYING. -- -- If not, write to the Free Software Foundation, 51 Franklin Street, Fifth -- -- Floor, Boston, MA 02111-1301, 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. -- -- -- -- Ocarina is maintained by the Ocarina team -- -- (ocarina-users@listes.enst.fr) -- -- -- ------------------------------------------------------------------------------ with Ocarina.PN.Messages; with GNAT.OS_Lib; with GNAT.Directory_Operations; with GNAT.Table; with Namet; use Namet; package body Ocarina.PN.Utils is -- The entered directodies stack package Directories_Stack is new GNAT.Table (Name_Id, Int, 1, 5, 10); ---------------------- -- Create_Directory -- ---------------------- procedure Create_Directory (Dir_Full_Name : Name_Id) is use GNAT.OS_Lib; use GNAT.Directory_Operations; use Ocarina.PN.Messages; Dir_Full_String : constant String := Get_Name_String (Dir_Full_Name); begin if Is_Regular_File (Dir_Full_String) or else Is_Symbolic_Link (Dir_Full_String) then Display_Error ("Cannot create " & Dir_Full_String & " because there is a file with the same name", Fatal => True); return; end if; if Is_Directory (Dir_Full_String) then Display_Error (Dir_Full_String & " already exists", Fatal => False, Warning => True); return; end if; -- The directory name does not clash with anything, create it Make_Dir (Dir_Full_String); end Create_Directory; --------------------- -- Enter_Directory -- --------------------- procedure Enter_Directory (Dirname : Name_Id) is use Directories_Stack; use GNAT.Directory_Operations; use Ocarina.PN.Messages; Current_Directory : constant Name_Id := Get_String_Name (Get_Current_Dir); begin Increment_Last; Table (Last) := Current_Directory; Display_Message ("Left : " & Get_Name_String (Current_Directory)); Change_Dir (Get_Name_String (Dirname)); Display_Message ("Entered : " & Get_Name_String (Dirname)); end Enter_Directory; --------------------- -- Leave_Directory -- --------------------- procedure Leave_Directory is use Directories_Stack; use GNAT.Directory_Operations; use Ocarina.PN.Messages; Last_Directory : constant Name_Id := Table (Last); begin Decrement_Last; Display_Message ("Left : " & Get_Current_Dir); Change_Dir (Get_Name_String (Last_Directory)); Display_Message ("Entered : " & Get_Name_String (Last_Directory)); end Leave_Directory; ----------------------------- -- Add_Directory_Separator -- ----------------------------- function Add_Directory_Separator (Path : Name_Id) return Name_Id is use GNAT.OS_Lib; begin Get_Name_String (Path); if Name_Buffer (Name_Len) /= Directory_Separator then Add_Char_To_Name_Buffer (Directory_Separator); end if; return Name_Find; end Add_Directory_Separator; -------------------------------- -- Remove_Directory_Separator -- -------------------------------- function Remove_Directory_Separator (Path : Name_Id) return Name_Id is use GNAT.OS_Lib; begin Get_Name_String (Path); if Name_Buffer (Name_Len) = Directory_Separator then Name_Len := Name_Len - 1; end if; return Name_Find; end Remove_Directory_Separator; --------------------- -- Get_String_Name -- --------------------- function Get_String_Name (The_String : String) return Types.Name_Id is pragma Assert (The_String'Length > 0); Result : Name_Id; begin Set_Str_To_Name_Buffer (The_String); Result := Name_Find; return Result; end Get_String_Name; ------------------------ -- Add_Prefix_To_Name -- ------------------------ function Add_Prefix_To_Name (Prefix : String; Name : Name_Id) return Name_Id is begin Set_Str_To_Name_Buffer (Prefix); Get_Name_String_And_Append (Name); return Name_Find; end Add_Prefix_To_Name; ------------------------ -- Add_Suffix_To_Name -- ------------------------ function Add_Suffix_To_Name (Suffix : String; Name : Name_Id) return Name_Id is begin Get_Name_String (Name); Add_Str_To_Name_Buffer (Suffix); return Name_Find; end Add_Suffix_To_Name; ----------------------------- -- Remove_Suffix_From_Name -- ----------------------------- function Remove_Suffix_From_Name (Suffix : String; Name : Name_Id) return Name_Id is Length : Natural; Temp_Str : String (1 .. Suffix'Length); begin Set_Str_To_Name_Buffer (Suffix); Length := Name_Len; Get_Name_String (Name); if Name_Len > Length then Temp_Str := Name_Buffer (Name_Len - Length + 1 .. Name_Len); if Suffix = Temp_Str then Set_Str_To_Name_Buffer (Name_Buffer (1 .. Name_Len - Length)); return Name_Find; end if; end if; return Name; end Remove_Suffix_From_Name; ------------------ -- Call_Program -- ------------------ procedure Call_Program (Prog_Name : String; Success : out Boolean; Argument_1 : String := ""; Argument_2 : String := ""; Argument_3 : String := "") is use GNAT.OS_Lib; Executable : String_Access := Locate_Exec_On_Path (Prog_Name); Arg_List : Argument_List (1 .. 3); Arg_Count : Integer := 0; Status : Integer; begin if Executable = null then Success := False; return; end if; if Argument_1 /= "" then Arg_List (1) := new String'(Argument_1); Arg_Count := Arg_Count + 1; end if; if Argument_2 /= "" then Arg_List (2) := new String'(Argument_2); Arg_Count := Arg_Count + 1; end if; if Argument_3 /= "" then Arg_List (3) := new String'(Argument_3); Arg_Count := Arg_Count + 1; end if; -- Call the program Status := Spawn (Executable.all, Arg_List (1 .. Arg_Count)); if Status /= 0 then Success := False; end if; -- Deallocation Free (Executable); for Index in Arg_List'Range loop Free (Arg_List (Index)); end loop; end Call_Program; end Ocarina.PN.Utils;