1------------------------------------------------------------------------------
2--                                                                          --
3--                            Matreshka Project                             --
4--                                                                          --
5--         Localization, Internationalization, Globalization for Ada        --
6--                                                                          --
7--                        Runtime Library Component                         --
8--                                                                          --
9------------------------------------------------------------------------------
10--                                                                          --
11-- Copyright © 2011-2013, Vadim Godunko <vgodunko@gmail.com>                --
12-- All rights reserved.                                                     --
13--                                                                          --
14-- Redistribution and use in source and binary forms, with or without       --
15-- modification, are permitted provided that the following conditions       --
16-- are met:                                                                 --
17--                                                                          --
18--  * Redistributions of source code must retain the above copyright        --
19--    notice, this list of conditions and the following disclaimer.         --
20--                                                                          --
21--  * Redistributions in binary form must reproduce the above copyright     --
22--    notice, this list of conditions and the following disclaimer in the   --
23--    documentation and/or other materials provided with the distribution.  --
24--                                                                          --
25--  * Neither the name of the Vadim Godunko, IE nor the names of its        --
26--    contributors may be used to endorse or promote products derived from  --
27--    this software without specific prior written permission.              --
28--                                                                          --
29-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS      --
30-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT        --
31-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR    --
32-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT     --
33-- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,   --
34-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED --
35-- TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR   --
36-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF   --
37-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING     --
38-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS       --
39-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.             --
40--                                                                          --
41------------------------------------------------------------------------------
42--  $Revision: 4326 $ $Date: 2013-11-30 22:12:51 +0400 (Sat, 30 Nov 2013) $
43------------------------------------------------------------------------------
44--  This version of subprogram intended to be used on POSIX systems.
45------------------------------------------------------------------------------
46with Ada.Characters.Conversions;
47with Ada.Strings.Fixed;
48with Interfaces.C.Strings;
49
50separate (League.Text_Codecs)
51function Codec_For_Application_Locale return Text_Codec is
52
53   function Determine_Encoding return League.Strings.Universal_String;
54   --  Determines application locale encoding and returns its name.
55
56   function Encoding_Component
57    (Locale : String) return League.Strings.Universal_String;
58   --  Returns encoding/character set component of locale specification, or
59   --  empty string when there are no such component specified.
60   --
61   --  language[_territory][.codeset][@variant]
62
63   function Get_Environment_Variable (Name : String) return String;
64   --  Returns value of the specified environment variable, or empty string
65   --  if variable is not defined.
66
67   ------------------------
68   -- Determine_Encoding --
69   ------------------------
70
71   function Determine_Encoding return League.Strings.Universal_String is
72      LC_CTYPE_Encoding : constant League.Strings.Universal_String
73        := Encoding_Component (Get_Environment_Variable ("LC_TYPE"));
74      LC_ALL_Encoding   : constant League.Strings.Universal_String
75        := Encoding_Component (Get_Environment_Variable ("LC_ALL"));
76      LANG_Encoding     : constant League.Strings.Universal_String
77        := Encoding_Component (Get_Environment_Variable ("LANG"));
78
79   begin
80      --  Analyze LC_CTYPE, LC_ALL, LANG for codeset part, use first found,
81      --  otherwise fallback to ISO-8859-1.
82
83      if not LC_CTYPE_Encoding.Is_Empty then
84         return LC_CTYPE_Encoding;
85
86      elsif not LC_ALL_Encoding.Is_Empty then
87         return LC_ALL_Encoding;
88
89      elsif not LANG_Encoding.Is_Empty then
90         return LANG_Encoding;
91
92      else
93         return League.Strings.To_Universal_String ("ISO-8859-1");
94      end if;
95   end Determine_Encoding;
96
97   ------------------------
98   -- Encoding_Component --
99   ------------------------
100
101   function Encoding_Component
102    (Locale : String) return League.Strings.Universal_String
103   is
104      Dot_Index : constant Natural := Ada.Strings.Fixed.Index (Locale, ".");
105      At_Index  : constant Natural := Ada.Strings.Fixed.Index (Locale, "@");
106
107   begin
108      if Dot_Index = 0 then
109         return League.Strings.Empty_Universal_String;
110
111      else
112         if At_Index = 0 then
113            return
114              League.Strings.To_Universal_String
115               (Ada.Characters.Conversions.To_Wide_Wide_String
116                 (Locale (Dot_Index + 1 .. Locale'Last)));
117
118         else
119            return
120              League.Strings.To_Universal_String
121               (Ada.Characters.Conversions.To_Wide_Wide_String
122                 (Locale (Dot_Index + 1 .. At_Index - 1)));
123         end if;
124      end if;
125   end Encoding_Component;
126
127   ------------------------------
128   -- Get_Environment_Variable --
129   ------------------------------
130
131   function Get_Environment_Variable (Name : String) return String is
132      use type Interfaces.C.Strings.chars_ptr;
133
134      function getenv
135       (Name : Interfaces.C.Strings.chars_ptr)
136          return Interfaces.C.Strings.chars_ptr;
137      pragma Import (C, getenv);
138
139      C_Name  : Interfaces.C.Strings.chars_ptr
140        := Interfaces.C.Strings.New_String (Name);
141      C_Value : constant Interfaces.C.Strings.chars_ptr := getenv (C_Name);
142
143   begin
144      Interfaces.C.Strings.Free (C_Name);
145
146      if C_Value = Interfaces.C.Strings.Null_Ptr then
147         return "";
148
149      else
150         return Interfaces.C.Strings.Value (C_Value);
151      end if;
152   end Get_Environment_Variable;
153
154begin
155   return Codec (Determine_Encoding);
156end Codec_For_Application_Locale;
157