File : adagio-guid.adb
------------------------------------------------------------------------------
-- ADAGIO - ADALID - AENEA. --
-- --
-- Copyright (C) 2003 --
-- A. Mosteo. --
-- --
-- Authors: A. Mosteo. (adagio@mosteo.com) --
-- --
-- If you have any questions in regard to this software, please address --
-- them to the above email. --
-- --
-- This program is free software; you can redistribute it and/or modify --
-- it under the terms of the GNU General Public License as published by --
-- the Free Software Foundation; either version 2 of the License, or (at --
-- your option) any later version. --
-- --
-- This program 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 --
-- along with this library; if not, write to the Free Software Foundation, --
-- Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. --
-- --
-- You are not allowed to use any part of this code to develop a program --
-- whose output would be used to harass or prosecute other users of the --
-- networks Adagio connects with. All data collected with Adagio or a tool --
-- containing Adagio code about other network users must remain --
-- confidential and cannot be made public by any mean, nor be used to --
-- harass or legally prosecute these users. --
------------------------------------------------------------------------------
-- $Id: adagio-guid.adb,v 1.3 2004/01/21 21:05:27 Jano Exp $
with Adagio.Misc;
with Adagio.Monitor;
with Gnat.Os_lib; use Gnat;
with Text_io; use Text_io;
with Ada.Numerics.Discrete_random;
package body Adagio.GUID is
------------------------------------------------------------------------
-- To_char_array --
------------------------------------------------------------------------
-- Return it as a series of 16 chars.
function To_char_array (This : Adagio.GUID.GUID) return String is
begin
return String (This);
end To_char_array;
------------------------------------------------------------------------
-- Init --
------------------------------------------------------------------------
procedure Init is
F : File_type;
S : String (1 .. 100);
Last : Integer;
File : Constant String := "adagio.guid";
begin
-- Check existence:
if Os_lib.Is_regular_file (File) then
-- Load it
Open (F, Name => File, Mode => In_file);
Get_line (F, S, Last);
My_GUID := To_GUID (S (1 .. Last));
else
-- Create it
My_GUID := Create_GUID;
Create (F, Name => File, Mode => Out_file);
Put_line (F, To_string (My_GUID));
end if;
Close (F);
exception
when others =>
if Is_open (F) then
Close (F);
end if;
raise;
end Init;
------------------------------------------------------------------------
-- To_hex --
------------------------------------------------------------------------
-- Returns the hex representation of the raw GUID.
function To_hex (this : Adagio.GUID.GUID) return String is
Raw : String := To_char_array (this);
S : String (1 .. Raw'Length * 2);
begin
for N in Raw'Range loop
S ((N - 1) * 2 + 1 .. N * 2) := Misc.To_hex (Raw (N));
end loop;
return S;
end To_hex;
------------------------------------------------------------------------
-- To_string --
------------------------------------------------------------------------
-- Returns the standard string representation of a GUID
-- {xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxxxx}
function To_string (this : in Adagio.GUID.GUID) return String is
S : constant String := String (This);
begin
return
"{" &
Misc.To_hex (S (S'First .. S'First + 3)) & "-" &
Misc.To_hex (S (S'First + 4 .. S'First + 5)) & "-" &
Misc.To_hex (S (S'First + 6 .. S'First + 7)) & "-" &
Misc.To_hex (S (S'First + 8 .. S'First + 9)) & "-" &
Misc.To_hex (S (S'First + 10 .. S'First + 15)) &
"}";
end To_string;
------------------------------------------------------------------------
-- To_GUID --
------------------------------------------------------------------------
-- Converts a standard GUID string representation to a guid
function To_GUID (this : in String) return Adagio.GUID.GUID is
X : String renames This;
function V (S : in String) return String renames Misc.From_hex;
begin
return
Adagio.GUID.GUID (
V (X (X'First + 1 .. X'First + 8)) &
V (X (X'First + 10 .. X'First + 13)) &
V (X (X'First + 15 .. X'First + 18)) &
V (X (X'First + 20 .. X'First + 23)) &
V (X (X'First + 25 .. X'First + 36)));
end To_GUID;
package Char_rand is new Ada.Numerics.Discrete_random (Character);
Char_generator : Char_rand.Generator;
------------------------------------------------------------------------
-- Create_GUID --
------------------------------------------------------------------------
Mutex : aliased Monitor.Semaphore;
function Create_GUID return Adagio.GUID.GUID is
Result : Adagio.GUID.GUID;
M : Monitor.Object (Mutex'Access);
pragma Unreferenced (M);
begin
for N in Result'Range loop
Result (N) := Char_rand.Random (Char_generator);
end loop;
return Result;
end Create_GUID;
------------------------------------------------------------------------
-- Init_rand --
------------------------------------------------------------------------
procedure Init_rand is
begin
-- Careful! This initialization time dependent should be replaced with
-- a stronger seed generation:
Char_rand.Reset (Char_generator);
end Init_rand;
begin
Init_rand;
end Adagio.GUID;