-----------------------------------------------------------------------
--  ADO Sessions -- Sessions Management
--  Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Util.Log;
with Util.Log.Loggers;
with Ada.Unchecked_Deallocation;

with ADO.Drivers;
with ADO.Sequences;
package body ADO.Sessions is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("ADO.Sessions");

   procedure Check_Session (Database : in Session'Class;
                            Message  : in String := "") is
   begin
      if Database.Impl = null then
         Log.Error ("Session is closed or not initialized");
         raise NOT_OPEN;
      end if;
      if Message'Length > 0 then
         Log.Info (Message, Database.Impl.Database.Get_Ident);
      end if;
   end Check_Session;

   --  ---------
   --  Session
   --  ---------

   --  ------------------------------
   --  Get the session status.
   --  ------------------------------
   function Get_Status (Database : in Session) return ADO.Databases.Connection_Status is
   begin
      if Database.Impl = null then
         return ADO.Databases.CLOSED;
      end if;
      return Database.Impl.Database.Get_Status;
   end Get_Status;

   --  ------------------------------
   --  Close the session.
   --  ------------------------------
   procedure Close (Database : in out Session) is

      procedure Free is new
        Ada.Unchecked_Deallocation (Object => Session_Record,
                                    Name   => Session_Record_Access);

      Is_Zero : Boolean;
   begin
      Log.Info ("Closing session");
      if Database.Impl /= null then
         ADO.Objects.Release_Proxy (Database.Impl.Proxy);
         Database.Impl.Database.Close;
         Util.Concurrent.Counters.Decrement (Database.Impl.Counter, Is_Zero);
         if Is_Zero then
            Free (Database.Impl);
         end if;
         Database.Impl := null;
      end if;
   end Close;

   --  ------------------------------
   --  Get the database connection.
   --  ------------------------------
   function Get_Connection (Database : in Session) return ADO.Databases.Connection'Class is
   begin
      Check_Session (Database);
      return Database.Impl.Database;
   end Get_Connection;

   --  ------------------------------
   --  Attach the object to the session.
   --  ------------------------------
   procedure Attach (Database : in out Session;
                     Object   : in ADO.Objects.Object_Ref'Class) is
      pragma Unreferenced (Object);
   begin
      Check_Session (Database);
   end Attach;

   --  ------------------------------
   --  Check if the session contains the object identified by the given key.
   --  ------------------------------
   function Contains (Database : in Session;
                      Item     : in ADO.Objects.Object_Key) return Boolean is
   begin
      Check_Session (Database);
      return ADO.Objects.Cache.Contains (Database.Impl.Cache, Item);
   end Contains;

   --  ------------------------------
   --  Remove the object from the session cache.
   --  ------------------------------
   procedure Evict (Database : in out Session;
                    Item     : in ADO.Objects.Object_Key) is
   begin
      Check_Session (Database);
      ADO.Objects.Cache.Remove (Database.Impl.Cache, Item);
   end Evict;

   --  ------------------------------
   --  Create a query statement.  The statement is not prepared
   --  ------------------------------
   function Create_Statement (Database : in Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement is
   begin
      Check_Session (Database);
      return Database.Impl.Database.Create_Statement (Table);
   end Create_Statement;

   --  ------------------------------
   --  Create a query statement.  The statement is not prepared
   --  ------------------------------
   function Create_Statement (Database : in Session;
                              Query    : in String)
                              return Query_Statement is
   begin
      Check_Session (Database);
      return Database.Impl.Database.Create_Statement (Query);
   end Create_Statement;

   --  ------------------------------
   --  Create a query statement.  The statement is not prepared
   --  ------------------------------
   function Create_Statement (Database : in Session;
                              Query    : in ADO.Queries.Context'Class)
                              return Query_Statement is
   begin
      Check_Session (Database);
      declare
         SQL  : constant String := Query.Get_SQL (Database.Impl.Database.Get_Driver_Index);
         Stmt : Query_Statement := Database.Impl.Database.Create_Statement (SQL);
      begin
         Stmt.Set_Parameters (Query);
         return Stmt;
      end;
   end Create_Statement;

   --  ------------------------------
   --  Create a query statement and initialize the SQL statement with the query definition.
   --  ------------------------------
   function Create_Statement (Database : in Session;
                              Query    : in ADO.Queries.Query_Definition_Access)
                              return Query_Statement is
   begin
      Check_Session (Database);
      declare
         Index : constant ADO.Drivers.Driver_Index := Database.Impl.Database.Get_Driver_Index;
         SQL   : constant String := ADO.Queries.Get_SQL (Query, Index, False);
      begin
         return Database.Impl.Database.Create_Statement (SQL);
      end;
   end Create_Statement;

   --  ------------------------------
   --  Create a query statement.  The statement is not prepared
   --  ------------------------------
   function Create_Statement (Database : in Session;
                              Query    : in ADO.SQL.Query'Class;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement is
   begin
      Check_Session (Database);
      declare
         Stmt : Query_Statement := Database.Impl.Database.Create_Statement (Table);
      begin
         if Query in ADO.Queries.Context'Class then
            declare
               Pos : constant ADO.Drivers.Driver_Index := Database.Impl.Database.Get_Driver_Index;
               SQL : constant String := ADO.Queries.Context'Class (Query).Get_SQL (Pos);
            begin
               ADO.SQL.Append (Stmt.Get_Query.SQL, SQL);
            end;
         end if;
         Stmt.Set_Parameters (Query);
         return Stmt;
      end;
   end Create_Statement;

   --  ---------
   --  Master Session
   --  ---------

   --  ------------------------------
   --  Start a transaction.
   --  ------------------------------
   procedure Begin_Transaction (Database : in out Master_Session) is
   begin
      Check_Session (Database, "Begin transaction {0}");
      Database.Impl.Database.Begin_Transaction;
   end Begin_Transaction;

   --  ------------------------------
   --  Commit the current transaction.
   --  ------------------------------
   procedure Commit (Database : in out Master_Session) is
   begin
      Check_Session (Database, "Commit transaction {0}");
      Database.Impl.Database.Commit;
   end Commit;

   --  ------------------------------
   --  Rollback the current transaction.
   --  ------------------------------
   procedure Rollback (Database : in out Master_Session) is
   begin
      Check_Session (Database, "Rollback transaction {0}");
      Database.Impl.Database.Rollback;
   end Rollback;

   --  ------------------------------
   --  Allocate an identifier for the table.
   --  ------------------------------
   procedure Allocate (Database : in out Master_Session;
                       Id       : in out ADO.Objects.Object_Record'Class) is
   begin
      Check_Session (Database);
      ADO.Sequences.Allocate (Database.Sequences.all, Id);
   end Allocate;

   --  ------------------------------
   --  Flush the objects that were modified.
   --  ------------------------------
   procedure Flush (Database : in out Master_Session) is
   begin
      Check_Session (Database);
   end Flush;

   overriding
   procedure Adjust (Object : in out Session) is
   begin
      if Object.Impl /= null then
         Util.Concurrent.Counters.Increment (Object.Impl.Counter);
      end if;
   end Adjust;

   overriding
   procedure Finalize (Object : in out Session) is
      procedure Free is
         new Ada.Unchecked_Deallocation (Object => Session_Record,
                                         Name   => Session_Record_Access);
      Is_Zero : Boolean;
   begin
      if Object.Impl /= null then
         Util.Concurrent.Counters.Decrement (Object.Impl.Counter, Is_Zero);
         if Is_Zero then
            ADO.Objects.Release_Proxy (Object.Impl.Proxy);
            Object.Impl.Database.Close;
            Free (Object.Impl);
         end if;
         Object.Impl := null;
      end if;
   end Finalize;

   --  ------------------------------
   --  Create a delete statement
   --  ------------------------------
   function Create_Statement (Database : in Master_Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Delete_Statement is
   begin
      Check_Session (Database);
      return Database.Impl.Database.Create_Statement (Table);
   end Create_Statement;

   --  ------------------------------
   --  Create an update statement
   --  ------------------------------
   function Create_Statement (Database : in Master_Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Update_Statement is
   begin
      Check_Session (Database);
      return Database.Impl.Database.Create_Statement (Table);
   end Create_Statement;

   --  ------------------------------
   --  Create an insert statement
   --  ------------------------------
   function Create_Statement (Database : in Master_Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Insert_Statement is
   begin
      Check_Session (Database);
      return Database.Impl.Database.Create_Statement (Table);
   end Create_Statement;

   --  ------------------------------
   --  Internal method to get the session proxy associated with the given database session.
   --  The session proxy is associated with some ADO objects to be able to retrieve the database
   --  session for the implementation of lazy loading.  The session proxy is kept until the
   --  session exist and at least one ADO object is refering to it.
   --  ------------------------------
   function Get_Session_Proxy (Database : in Session) return ADO.Objects.Session_Proxy_Access is
      use type ADO.Objects.Session_Proxy_Access;
   begin
      Check_Session (Database);
      if Database.Impl.Proxy = null then
         Database.Impl.Proxy := ADO.Objects.Create_Session_Proxy (Database.Impl);
      end if;
      return Database.Impl.Proxy;
   end Get_Session_Proxy;

end ADO.Sessions;

-----------------------------------------------------------------------
--  ADO Sessions -- Sessions Management
--  Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014, 2015 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Util.Log;
with Util.Log.Loggers;
with Ada.Unchecked_Deallocation;

with ADO.Drivers;
with ADO.Sequences;
package body ADO.Sessions is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("ADO.Sessions");

   procedure Check_Session (Database : in Session'Class;
                            Message  : in String := "") is
   begin
      if Database.Impl = null then
         Log.Error ("Session is closed or not initialized");
         raise NOT_OPEN;
      end if;
      if Message'Length > 0 then
         Log.Info (Message, Database.Impl.Database.Get_Ident);
      end if;
   end Check_Session;

   --  ---------
   --  Session
   --  ---------

   --  ------------------------------
   --  Get the session status.
   --  ------------------------------
   function Get_Status (Database : in Session) return ADO.Databases.Connection_Status is
   begin
      if Database.Impl = null then
         return ADO.Databases.CLOSED;
      end if;
      return Database.Impl.Database.Get_Status;
   end Get_Status;

   --  ------------------------------
   --  Close the session.
   --  ------------------------------
   procedure Close (Database : in out Session) is

      procedure Free is new
        Ada.Unchecked_Deallocation (Object => Session_Record,
                                    Name   => Session_Record_Access);

      Is_Zero : Boolean;
   begin
      Log.Info ("Closing session");
      if Database.Impl /= null then
         ADO.Objects.Release_Proxy (Database.Impl.Proxy);
         Database.Impl.Database.Close;
         Util.Concurrent.Counters.Decrement (Database.Impl.Counter, Is_Zero);
         if Is_Zero then
            Free (Database.Impl);
         end if;
         Database.Impl := null;
      end if;
   end Close;

   --  ------------------------------
   --  Get the database connection.
   --  ------------------------------
   function Get_Connection (Database : in Session) return ADO.Databases.Connection'Class is
   begin
      Check_Session (Database);
      return Database.Impl.Database;
   end Get_Connection;

   --  ------------------------------
   --  Attach the object to the session.
   --  ------------------------------
   procedure Attach (Database : in out Session;
                     Object   : in ADO.Objects.Object_Ref'Class) is
      pragma Unreferenced (Object);
   begin
      Check_Session (Database);
   end Attach;

   --  ------------------------------
   --  Check if the session contains the object identified by the given key.
   --  ------------------------------
   function Contains (Database : in Session;
                      Item     : in ADO.Objects.Object_Key) return Boolean is
   begin
      Check_Session (Database);
      return ADO.Objects.Cache.Contains (Database.Impl.Cache, Item);
   end Contains;

   --  ------------------------------
   --  Remove the object from the session cache.
   --  ------------------------------
   procedure Evict (Database : in out Session;
                    Item     : in ADO.Objects.Object_Key) is
   begin
      Check_Session (Database);
      ADO.Objects.Cache.Remove (Database.Impl.Cache, Item);
   end Evict;

   --  ------------------------------
   --  Create a query statement.  The statement is not prepared
   --  ------------------------------
   function Create_Statement (Database : in Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement is
   begin
      Check_Session (Database);
      return Database.Impl.Database.Create_Statement (Table);
   end Create_Statement;

   --  ------------------------------
   --  Create a query statement.  The statement is not prepared
   --  ------------------------------
   function Create_Statement (Database : in Session;
                              Query    : in String)
                              return Query_Statement is
   begin
      Check_Session (Database);
      return Database.Impl.Database.Create_Statement (Query);
   end Create_Statement;

   --  ------------------------------
   --  Create a query statement.  The statement is not prepared
   --  ------------------------------
   function Create_Statement (Database : in Session;
                              Query    : in ADO.Queries.Context'Class)
                              return Query_Statement is
   begin
      Check_Session (Database);
      declare
         SQL  : constant String := Query.Get_SQL (Database.Impl.Database.Get_Driver_Index);
         Stmt : Query_Statement := Database.Impl.Database.Create_Statement (SQL);
      begin
         Stmt.Set_Parameters (Query);
         return Stmt;
      end;
   end Create_Statement;

   --  ------------------------------
   --  Create a query statement and initialize the SQL statement with the query definition.
   --  ------------------------------
   function Create_Statement (Database : in Session;
                              Query    : in ADO.Queries.Query_Definition_Access)
                              return Query_Statement is
   begin
      Check_Session (Database);
      declare
         Index : constant ADO.Drivers.Driver_Index := Database.Impl.Database.Get_Driver_Index;
         SQL   : constant String := ADO.Queries.Get_SQL (Query, Index, False);
      begin
         return Database.Impl.Database.Create_Statement (SQL);
      end;
   end Create_Statement;

   --  ------------------------------
   --  Create a query statement.  The statement is not prepared
   --  ------------------------------
   function Create_Statement (Database : in Session;
                              Query    : in ADO.SQL.Query'Class;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement is
   begin
      Check_Session (Database);
      declare
         Stmt : Query_Statement := Database.Impl.Database.Create_Statement (Table);
      begin
         if Query in ADO.Queries.Context'Class then
            declare
               Pos : constant ADO.Drivers.Driver_Index := Database.Impl.Database.Get_Driver_Index;
               SQL : constant String := ADO.Queries.Context'Class (Query).Get_SQL (Pos);
            begin
               ADO.SQL.Append (Stmt.Get_Query.SQL, SQL);
            end;
         end if;
         Stmt.Set_Parameters (Query);
         return Stmt;
      end;
   end Create_Statement;

   --  ------------------------------
   --  Load the database schema definition for the current database.
   --  ------------------------------
   procedure Load_Schema (Database : in Session;
                          Schema   : out ADO.Schemas.Schema_Definition) is
   begin
      Check_Session (Database, "Loading schema {0}");
      Database.Impl.Database.Load_Schema (Schema);
   end Load_Schema;

   --  ---------
   --  Master Session
   --  ---------

   --  ------------------------------
   --  Start a transaction.
   --  ------------------------------
   procedure Begin_Transaction (Database : in out Master_Session) is
   begin
      Check_Session (Database, "Begin transaction {0}");
      Database.Impl.Database.Begin_Transaction;
   end Begin_Transaction;

   --  ------------------------------
   --  Commit the current transaction.
   --  ------------------------------
   procedure Commit (Database : in out Master_Session) is
   begin
      Check_Session (Database, "Commit transaction {0}");
      Database.Impl.Database.Commit;
   end Commit;

   --  ------------------------------
   --  Rollback the current transaction.
   --  ------------------------------
   procedure Rollback (Database : in out Master_Session) is
   begin
      Check_Session (Database, "Rollback transaction {0}");
      Database.Impl.Database.Rollback;
   end Rollback;

   --  ------------------------------
   --  Allocate an identifier for the table.
   --  ------------------------------
   procedure Allocate (Database : in out Master_Session;
                       Id       : in out ADO.Objects.Object_Record'Class) is
   begin
      Check_Session (Database);
      ADO.Sequences.Allocate (Database.Sequences.all, Id);
   end Allocate;

   --  ------------------------------
   --  Flush the objects that were modified.
   --  ------------------------------
   procedure Flush (Database : in out Master_Session) is
   begin
      Check_Session (Database);
   end Flush;

   overriding
   procedure Adjust (Object : in out Session) is
   begin
      if Object.Impl /= null then
         Util.Concurrent.Counters.Increment (Object.Impl.Counter);
      end if;
   end Adjust;

   overriding
   procedure Finalize (Object : in out Session) is
      procedure Free is
         new Ada.Unchecked_Deallocation (Object => Session_Record,
                                         Name   => Session_Record_Access);
      Is_Zero : Boolean;
   begin
      if Object.Impl /= null then
         Util.Concurrent.Counters.Decrement (Object.Impl.Counter, Is_Zero);
         if Is_Zero then
            ADO.Objects.Release_Proxy (Object.Impl.Proxy);
            Object.Impl.Database.Close;
            Free (Object.Impl);
         end if;
         Object.Impl := null;
      end if;
   end Finalize;

   --  ------------------------------
   --  Create a delete statement
   --  ------------------------------
   function Create_Statement (Database : in Master_Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Delete_Statement is
   begin
      Check_Session (Database);
      return Database.Impl.Database.Create_Statement (Table);
   end Create_Statement;

   --  ------------------------------
   --  Create an update statement
   --  ------------------------------
   function Create_Statement (Database : in Master_Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Update_Statement is
   begin
      Check_Session (Database);
      return Database.Impl.Database.Create_Statement (Table);
   end Create_Statement;

   --  ------------------------------
   --  Create an insert statement
   --  ------------------------------
   function Create_Statement (Database : in Master_Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Insert_Statement is
   begin
      Check_Session (Database);
      return Database.Impl.Database.Create_Statement (Table);
   end Create_Statement;

   --  ------------------------------
   --  Internal method to get the session proxy associated with the given database session.
   --  The session proxy is associated with some ADO objects to be able to retrieve the database
   --  session for the implementation of lazy loading.  The session proxy is kept until the
   --  session exist and at least one ADO object is refering to it.
   --  ------------------------------
   function Get_Session_Proxy (Database : in Session) return ADO.Objects.Session_Proxy_Access is
      use type ADO.Objects.Session_Proxy_Access;
   begin
      Check_Session (Database);
      if Database.Impl.Proxy = null then
         Database.Impl.Proxy := ADO.Objects.Create_Session_Proxy (Database.Impl);
      end if;
      return Database.Impl.Proxy;
   end Get_Session_Proxy;

end ADO.Sessions;

Implement the Load_Schema procedure

Implement the Load_Schema procedure


-----------------------------------------------------------------------
--  util-dates-formats -- Date Format ala strftime
--  Copyright (C) 2011, 2018 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Ada.Strings.Unbounded;
with Util.Properties;

--  == Localized date formatting ==
--  The `Util.Dates.Formats` provides a date formatting and parsing operation similar to the
--  Unix `strftime`, `strptime` or the `GNAT.Calendar.Time_IO`.  The localization of month
--  and day labels is however handled through `Util.Properties.Bundle` (similar to
--  the Java world).  Unlike `strftime` and `strptime`, this allows to have a multi-threaded
--  application that reports dates in several languages.  The `GNAT.Calendar.Time_IO` only
--  supports English and this is the reason why it is not used here.
--
--  The date pattern recognizes the following formats:
--
--  | Format | Description |
--  | --- | ---------- |
--  | %a  | The abbreviated weekday name according to the current locale.
--  | %A  | The full weekday name according to the current locale.
--  | %b  | The abbreviated month name according to the current locale.
--  | %h  | Equivalent to %b. (SU)
--  | %B  | The full month name according to the current locale.
--  | %c  | The preferred date and time representation for the current locale.
--  | %C  | The century number (year/100) as a 2-digit integer. (SU)
--  | %d  | The day of the month as a decimal number (range 01 to 31).
--  | %D  | Equivalent to %m/%d/%y
--  | %e  | Like %d, the day of the month as a decimal number,
--  |     | but a leading zero is replaced by a space. (SU)
--  | %F  | Equivalent to %Y\-%m\-%d (the ISO 8601 date format). (C99)
--  | %G  | The ISO 8601 week-based year
--  | %H  | The hour as a decimal number using a 24-hour clock (range 00 to 23).
--  | %I  | The hour as a decimal number using a 12-hour clock (range 01 to 12).
--  | %j  | The day of the year as a decimal number (range 001 to 366).
--  | %k  | The hour (24 hour clock) as a decimal number (range 0 to 23);
--  | %l  | The hour (12 hour clock) as a decimal number (range 1 to 12);
--  | %m  | The month as a decimal number (range 01 to 12).
--  | %M  | The minute as a decimal number (range 00 to 59).
--  | %n  | A newline character. (SU)
--  | %p  | Either "AM" or "PM"
--  | %P  | Like %p but in lowercase: "am" or "pm"
--  | %r  | The time in a.m. or p.m. notation.
--  |     | In the POSIX locale this is equivalent to %I:%M:%S %p. (SU)
--  | %R  | The time in 24 hour notation (%H:%M).
--  | %s  | The number of seconds since the Epoch, that is,
--  |     | since 1970\-01\-01 00:00:00 UTC. (TZ)
--  | %S  | The second as a decimal number (range 00 to 60).
--  | %t  | A tab character. (SU)
--  | %T  | The time in 24 hour notation (%H:%M:%S). (SU)
--  | %u  | The day of the week as a decimal, range 1 to 7,
--  |     | Monday being 1. See also %w. (SU)
--  | %U  | The week number of the current year as a decimal
--  |     | number, range 00 to 53
--  | %V  | The ISO 8601 week number
--  | %w  | The day of the week as a decimal, range 0 to 6,
--  |     | Sunday being 0. See also %u.
--  | %W  | The week number of the current year as a decimal number,
--  |     | range 00 to 53
--  | %x  | The preferred date representation for the current locale
--  |     | without the time.
--  | %X  | The preferred time representation for the current locale
--  |     | without the date.
--  | %y  | The year as a decimal number without a century (range 00 to 99).
--  | %Y  | The year as a decimal number including the century.
--  | %z  | The timezone as hour offset from GMT.
--  | %Z  | The timezone or name or abbreviation.
--
--  The following strftime flags are ignored:
--
--  | Format | Description |
--  | --- | ---------- |
--  | %E  |  Modifier: use alternative format, see below. (SU)
--  | %O  |  Modifier: use alternative format, see below. (SU)
--
--  SU:  Single Unix Specification
--  C99: C99 standard, POSIX.1-2001
--
--  See strftime (3) and strptime (3) manual page
--
--  To format and use the localize date, it is first necessary to get a bundle
--  for the `dates` so that date elements are translated into the given locale.
--
--     Factory     : Util.Properties.Bundles.Loader;
--     Bundle      : Util.Properties.Bundles.Manager;
--     ...
--        Load_Bundle (Factory, "dates", "fr", Bundle);
--
--  The date is formatted according to the pattern string described above.
--  The bundle is used by the formatter to use the day and month names in the
--  expected locale.
--
--     Date : String := Util.Dates.Formats.Format (Pattern => Pattern,
--                                                 Date    => Ada.Calendar.Clock,
--                                                 Bundle  => Bundle);
--
--  To parse a date according to a pattern and a localization, the same pattern string
--  and bundle can be used and the `Parse` function will return the date in split format.
--
--     Result : Date_Record := Util.Dates.Formats.Parse (Date    => Date,
--                                                       Pattern => Pattern,
--                                                       Bundle  => Bundle);
--
package Util.Dates.Formats is

   --  Month labels.
   MONTH_NAME_PREFIX         : constant String := "util.month";

   --  Day labels.
   DAY_NAME_PREFIX           : constant String := "util.day";

   --  Short month/day suffix.
   SHORT_SUFFIX              : constant String := ".short";

   --  Long month/day suffix.
   LONG_SUFFIX               : constant String := ".long";

   --  The date time pattern name to be used for the %x representation.
   --  This property name is searched in the bundle to find the localized date time pattern.
   DATE_TIME_LOCALE_NAME     : constant String := "util.datetime.pattern";

   --  The default date pattern for %c (English).
   DATE_TIME_DEFAULT_PATTERN : constant String := "%a %b %_d %T %Y";

   --  The date pattern to be used for the %x representation.
   --  This property name is searched in the bundle to find the localized date pattern.
   DATE_LOCALE_NAME          : constant String := "util.date.pattern";

   --  The default date pattern for %x (English).
   DATE_DEFAULT_PATTERN      : constant String := "%m/%d/%y";

   --  The time pattern to be used for the %X representation.
   --  This property name is searched in the bundle to find the localized time pattern.
   TIME_LOCALE_NAME          : constant String := "util.time.pattern";

   --  The default time pattern for %X (English).
   TIME_DEFAULT_PATTERN      : constant String := "%T %Y";

   AM_NAME                   : constant String := "util.date.am";
   PM_NAME                   : constant String := "util.date.pm";

   AM_DEFAULT                : constant String := "AM";
   PM_DEFAULT                : constant String := "PM";

   --  Format the date passed in Date using the date pattern specified in Pattern.
   --  The date pattern is similar to the Unix strftime operation.
   --
   --  For month and day of week strings, use the resource bundle passed in Bundle.
   --  Append the formatted date in the Into string.
   procedure Format (Into      : in out Ada.Strings.Unbounded.Unbounded_String;
                     Pattern   : in String;
                     Date      : in Date_Record;
                     Bundle    : in Util.Properties.Manager'Class);

   --  Format the date passed in Date using the date pattern specified in Pattern.
   --  For month and day of week strings, use the resource bundle passed in Bundle.
   --  Append the formatted date in the Into string.
   procedure Format (Into      : in out Ada.Strings.Unbounded.Unbounded_String;
                     Pattern   : in String;
                     Date      : in Ada.Calendar.Time;
                     Bundle    : in Util.Properties.Manager'Class);

   function Format (Pattern   : in String;
                    Date      : in Ada.Calendar.Time;
                    Bundle    : in Util.Properties.Manager'Class) return String;

   --  Append the localized month string in the Into string.
   --  The month string is found in the resource bundle under the name:
   --    util.month<month number>.short
   --    util.month<month number>.long
   --  If the month string is not found, the month is displayed as a number.
   procedure Append_Month (Into   : in out Ada.Strings.Unbounded.Unbounded_String;
                           Month  : in Ada.Calendar.Month_Number;
                           Bundle : in Util.Properties.Manager'Class;
                           Short  : in Boolean := True);

   --  Append the localized month string in the Into string.
   --  The month string is found in the resource bundle under the name:
   --    util.month<month number>.short
   --    util.month<month number>.long
   --  If the month string is not found, the month is displayed as a number.
   procedure Append_Day (Into   : in out Ada.Strings.Unbounded.Unbounded_String;
                         Day    : in Ada.Calendar.Formatting.Day_Name;
                         Bundle : in Util.Properties.Manager'Class;
                         Short  : in Boolean := True);

   --  Append a number with padding if necessary
   procedure Append_Number (Into    : in out Ada.Strings.Unbounded.Unbounded_String;
                            Value   : in Natural;
                            Padding : in Character;
                            Length  : in Natural := 2);

   --  Append the timezone offset
   procedure Append_Time_Offset (Into      : in out Ada.Strings.Unbounded.Unbounded_String;
                                 Offset    : in Ada.Calendar.Time_Zones.Time_Offset);

   --  Parse the date according to the pattern and the given locale bundle and
   --  return the data split record.
   --  A `Constraint_Error` exception is raised if the date string is not in the correct format.
   function Parse (Date      : in String;
                   Pattern   : in String;
                   Bundle    : in Util.Properties.Manager'Class) return Date_Record;

end Util.Dates.Formats;

-----------------------------------------------------------------------
--  util-dates-formats -- Date Format ala strftime
--  Copyright (C) 2011, 2018, 2022 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Ada.Strings.Unbounded;
with Util.Properties;

--  == Localized date formatting ==
--  The `Util.Dates.Formats` provides a date formatting and parsing operation similar to the
--  Unix `strftime`, `strptime` or the `GNAT.Calendar.Time_IO`.  The localization of month
--  and day labels is however handled through `Util.Properties.Bundle` (similar to
--  the Java world).  Unlike `strftime` and `strptime`, this allows to have a multi-threaded
--  application that reports dates in several languages.  The `GNAT.Calendar.Time_IO` only
--  supports English and this is the reason why it is not used here.
--
--  The date pattern recognizes the following formats:
--
--  | Format | Description |
--  | --- | ---------- |
--  | %a  | The abbreviated weekday name according to the current locale.
--  | %A  | The full weekday name according to the current locale.
--  | %b  | The abbreviated month name according to the current locale.
--  | %h  | Equivalent to %b. (SU)
--  | %B  | The full month name according to the current locale.
--  | %c  | The preferred date and time representation for the current locale.
--  | %C  | The century number (year/100) as a 2-digit integer. (SU)
--  | %d  | The day of the month as a decimal number (range 01 to 31).
--  | %D  | Equivalent to %m/%d/%y
--  | %e  | Like %d, the day of the month as a decimal number,
--  |     | but a leading zero is replaced by a space. (SU)
--  | %F  | Equivalent to %Y\-%m\-%d (the ISO 8601 date format). (C99)
--  | %G  | The ISO 8601 week-based year
--  | %H  | The hour as a decimal number using a 24-hour clock (range 00 to 23).
--  | %I  | The hour as a decimal number using a 12-hour clock (range 01 to 12).
--  | %j  | The day of the year as a decimal number (range 001 to 366).
--  | %k  | The hour (24 hour clock) as a decimal number (range 0 to 23);
--  | %l  | The hour (12 hour clock) as a decimal number (range 1 to 12);
--  | %m  | The month as a decimal number (range 01 to 12).
--  | %M  | The minute as a decimal number (range 00 to 59).
--  | %n  | A newline character. (SU)
--  | %p  | Either "AM" or "PM"
--  | %P  | Like %p but in lowercase: "am" or "pm"
--  | %r  | The time in a.m. or p.m. notation.
--  |     | In the POSIX locale this is equivalent to %I:%M:%S %p. (SU)
--  | %R  | The time in 24 hour notation (%H:%M).
--  | %s  | The number of seconds since the Epoch, that is,
--  |     | since 1970\-01\-01 00:00:00 UTC. (TZ)
--  | %S  | The second as a decimal number (range 00 to 60).
--  | %t  | A tab character. (SU)
--  | %T  | The time in 24 hour notation (%H:%M:%S). (SU)
--  | %u  | The day of the week as a decimal, range 1 to 7,
--  |     | Monday being 1. See also %w. (SU)
--  | %U  | The week number of the current year as a decimal
--  |     | number, range 00 to 53
--  | %V  | The ISO 8601 week number
--  | %w  | The day of the week as a decimal, range 0 to 6,
--  |     | Sunday being 0. See also %u.
--  | %W  | The week number of the current year as a decimal number,
--  |     | range 00 to 53
--  | %x  | The preferred date representation for the current locale
--  |     | without the time.
--  | %X  | The preferred time representation for the current locale
--  |     | without the date.
--  | %y  | The year as a decimal number without a century (range 00 to 99).
--  | %Y  | The year as a decimal number including the century.
--  | %z  | The timezone as hour offset from GMT.
--  | %Z  | The timezone or name or abbreviation.
--
--  The following strftime flags are ignored:
--
--  | Format | Description |
--  | --- | ---------- |
--  | %E  |  Modifier: use alternative format, see below. (SU)
--  | %O  |  Modifier: use alternative format, see below. (SU)
--
--  SU:  Single Unix Specification
--  C99: C99 standard, POSIX.1-2001
--
--  See strftime (3) and strptime (3) manual page
--
--  To format and use the localize date, it is first necessary to get a bundle
--  for the `dates` so that date elements are translated into the given locale.
--
--     Factory     : Util.Properties.Bundles.Loader;
--     Bundle      : Util.Properties.Bundles.Manager;
--     ...
--        Load_Bundle (Factory, "dates", "fr", Bundle);
--
--  The date is formatted according to the pattern string described above.
--  The bundle is used by the formatter to use the day and month names in the
--  expected locale.
--
--     Date : String := Util.Dates.Formats.Format (Pattern => Pattern,
--                                                 Date    => Ada.Calendar.Clock,
--                                                 Bundle  => Bundle);
--
--  To parse a date according to a pattern and a localization, the same pattern string
--  and bundle can be used and the `Parse` function will return the date in split format.
--
--     Result : Date_Record := Util.Dates.Formats.Parse (Date    => Date,
--                                                       Pattern => Pattern,
--                                                       Bundle  => Bundle);
--
package Util.Dates.Formats is

   --  Month labels.
   MONTH_NAME_PREFIX         : constant String := "util.month";

   --  Day labels.
   DAY_NAME_PREFIX           : constant String := "util.day";

   --  Short month/day suffix.
   SHORT_SUFFIX              : constant String := ".short";

   --  Long month/day suffix.
   LONG_SUFFIX               : constant String := ".long";

   --  The date time pattern name to be used for the %x representation.
   --  This property name is searched in the bundle to find the localized date time pattern.
   DATE_TIME_LOCALE_NAME     : constant String := "util.datetime.pattern";

   --  The default date pattern for %c (English).
   DATE_TIME_DEFAULT_PATTERN : constant String := "%a %b %_d %T %Y";

   --  The date pattern to be used for the %x representation.
   --  This property name is searched in the bundle to find the localized date pattern.
   DATE_LOCALE_NAME          : constant String := "util.date.pattern";

   --  The default date pattern for %x (English).
   DATE_DEFAULT_PATTERN      : constant String := "%m/%d/%y";

   --  The time pattern to be used for the %X representation.
   --  This property name is searched in the bundle to find the localized time pattern.
   TIME_LOCALE_NAME          : constant String := "util.time.pattern";

   --  The default time pattern for %X (English).
   TIME_DEFAULT_PATTERN      : constant String := "%T %Y";

   AM_NAME                   : constant String := "util.date.am";
   PM_NAME                   : constant String := "util.date.pm";

   AM_DEFAULT                : constant String := "AM";
   PM_DEFAULT                : constant String := "PM";

   --  Format the date passed in Date using the date pattern specified in Pattern.
   --  The date pattern is similar to the Unix strftime operation.
   --
   --  For month and day of week strings, use the resource bundle passed in Bundle.
   --  Append the formatted date in the Into string.
   procedure Format (Into      : in out Ada.Strings.Unbounded.Unbounded_String;
                     Pattern   : in String;
                     Date      : in Date_Record;
                     Bundle    : in Util.Properties.Manager'Class);

   --  Format the date passed in Date using the date pattern specified in Pattern.
   --  For month and day of week strings, use the resource bundle passed in Bundle.
   --  Append the formatted date in the Into string.
   procedure Format (Into      : in out Ada.Strings.Unbounded.Unbounded_String;
                     Pattern   : in String;
                     Date      : in Ada.Calendar.Time;
                     Bundle    : in Util.Properties.Manager'Class);

   function Format (Pattern   : in String;
                    Date      : in Ada.Calendar.Time;
                    Bundle    : in Util.Properties.Manager'Class) return String;

   --  Format the date passed in `Date` with a simple format pattern.
   --  The pattern is composed of minimalist sequences that are replaced by
   --  values, unrecognized characters are passed as is:
   --  YYYY : year     MM : month     dd: day    HH: hour   mm: minute   ss: second
   function Simple_Format (Pattern : in String;
                           Date    : in Ada.Calendar.Time) return String;

   --  Append the localized month string in the Into string.
   --  The month string is found in the resource bundle under the name:
   --    util.month<month number>.short
   --    util.month<month number>.long
   --  If the month string is not found, the month is displayed as a number.
   procedure Append_Month (Into   : in out Ada.Strings.Unbounded.Unbounded_String;
                           Month  : in Ada.Calendar.Month_Number;
                           Bundle : in Util.Properties.Manager'Class;
                           Short  : in Boolean := True);

   --  Append the localized month string in the Into string.
   --  The month string is found in the resource bundle under the name:
   --    util.month<month number>.short
   --    util.month<month number>.long
   --  If the month string is not found, the month is displayed as a number.
   procedure Append_Day (Into   : in out Ada.Strings.Unbounded.Unbounded_String;
                         Day    : in Ada.Calendar.Formatting.Day_Name;
                         Bundle : in Util.Properties.Manager'Class;
                         Short  : in Boolean := True);

   --  Append a number with padding if necessary
   procedure Append_Number (Into    : in out Ada.Strings.Unbounded.Unbounded_String;
                            Value   : in Natural;
                            Padding : in Character;
                            Length  : in Natural := 2);

   --  Append the timezone offset
   procedure Append_Time_Offset (Into      : in out Ada.Strings.Unbounded.Unbounded_String;
                                 Offset    : in Ada.Calendar.Time_Zones.Time_Offset);

   --  Parse the date according to the pattern and the given locale bundle and
   --  return the data split record.
   --  A `Constraint_Error` exception is raised if the date string is not in the correct format.
   function Parse (Date      : in String;
                   Pattern   : in String;
                   Bundle    : in Util.Properties.Manager'Class) return Date_Record;

end Util.Dates.Formats;

Declare the Simple_Format function to provide a simple date format à la SimpleDateFormat in Java


-----------------------------------------------------------------------
--  Gen -- Code Generator
--  Copyright (C) 2009, 2010, 2011 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

package Gen is

   --  Library SVN identification
   SVN_URL : constant String := "https://ada-gen.googlecode.com/svn/trunk";

   --  Revision used (must run 'make version' to update)
   SVN_REV : constant Positive := 313;

end Gen;

-----------------------------------------------------------------------
--  Gen -- Code Generator
--  Copyright (C) 2009, 2010, 2011 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

package Gen is

   --  Library SVN identification
   SVN_URL : constant String := "https://ada-gen.googlecode.com/svn/trunk";

   --  Revision used (must run 'make version' to update)
   SVN_REV : constant Positive := 339;

end Gen;

Update the revision

Update the revision


-----------------------------------------------------------------------
--  ADO Dialects -- Driver support for basic SQL Generation
--  Copyright (C) 2010, 2011, 2012, 2015, 2018 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

--  The ADO.Drivers.Dialects package controls the database specific SQL dialects.
package ADO.Drivers.Dialects is

   --  --------------------
   --  SQL Dialect
   --  --------------------
   --  The Dialect defines the specific characteristics that must be
   --  taken into account when building the SQL statement.  This includes:
   --

   --
The definition of reserved keywords that must be escaped

   --
How to escape those keywords

   --
How to escape special characters

   --

   type Dialect is abstract tagged private;
   type Dialect_Access is access all Dialect'Class;

   --  Check if the string is a reserved keyword.
   function Is_Reserved (D    : Dialect;
                         Name : String) return Boolean is abstract;

   --  Get the quote character to escape an identifier.
   function Get_Identifier_Quote (D : in Dialect) return Character;

   --  Append the item in the buffer escaping some characters if necessary.
   --  The default implementation only escapes the single quote ' by doubling them.
   procedure Escape_Sql (D      : in Dialect;
                         Buffer : in out Unbounded_String;
                         Item   : in String);

   --  Append the item in the buffer escaping some characters if necessary
   procedure Escape_Sql (D      : in Dialect;
                         Buffer : in out Unbounded_String;
                         Item   : in ADO.Blob_Ref);

   --  Append the boolean item in the buffer.
   procedure Escape_Sql (D      : in Dialect;
                         Buffer : in out Unbounded_String;
                         Item   : in Boolean);

private

   type Dialect is abstract tagged null record;

end ADO.Drivers.Dialects;

-----------------------------------------------------------------------
--  ADO Dialects -- Driver support for basic SQL Generation
--  Copyright (C) 2010, 2011, 2012, 2015, 2018 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

--  The ADO.Drivers.Dialects package controls the database specific SQL dialects.
package ADO.Drivers.Dialects is

   --  --------------------
   --  SQL Dialect
   --  --------------------
   --  The Dialect defines the specific characteristics that must be
   --  taken into account when building the SQL statement.  This includes:
   --

   --
The definition of reserved keywords that must be escaped

   --
How to escape those keywords

   --
How to escape special characters

   --

   type Dialect is abstract tagged private;
   type Dialect_Access is access all Dialect'Class;

   --  Check if the string is a reserved keyword.
   function Is_Reserved (D    : Dialect;
                         Name : String) return Boolean is abstract;

   --  Get the quote character to escape an identifier.
   function Get_Identifier_Quote (D : in Dialect) return Character is abstract;

   --  Append the item in the buffer escaping some characters if necessary.
   --  The default implementation only escapes the single quote ' by doubling them.
   procedure Escape_Sql (D      : in Dialect;
                         Buffer : in out Unbounded_String;
                         Item   : in String);

   --  Append the item in the buffer escaping some characters if necessary
   procedure Escape_Sql (D      : in Dialect;
                         Buffer : in out Unbounded_String;
                         Item   : in ADO.Blob_Ref);

   --  Append the boolean item in the buffer.
   procedure Escape_Sql (D      : in Dialect;
                         Buffer : in out Unbounded_String;
                         Item   : in Boolean);

private

   type Dialect is abstract tagged null record;

end ADO.Drivers.Dialects;

Change Get_Identifier_Quote to be an abstract function


-----------------------------------------------------------------------
--  gen-commands-distrib -- Distrib command for dynamo
--  Copyright (C) 2012, 2013, 2014, 2017, 2018 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Ada.Text_IO;
package body Gen.Commands.Distrib is

   --  ------------------------------
   --  Execute the command with the arguments.
   --  ------------------------------
   overriding
   procedure Execute (Cmd       : in out Command;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Name);
   begin
      if Args.Get_Count = 0 or Args.Get_Count > 2 then
         Generator.Error ("Missing target directory");
         return;
      end if;
      Generator.Read_Project ("dynamo.xml", True);

      --  Setup the target directory where the distribution is created.
      Generator.Set_Result_Directory (Args.Get_Argument (1));

      --  Read the package description.
      if Args.Get_Count = 2 then
         Gen.Generator.Read_Package (Generator, Args.Get_Argument (2));
      else
         Gen.Generator.Read_Package (Generator, "package.xml");
      end if;

      --  Run the generation.
      Gen.Generator.Prepare (Generator);
      Gen.Generator.Generate_All (Generator);
      Gen.Generator.Finish (Generator);
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Cmd       : in out Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Generator);
      use Ada.Text_IO;
   begin
      Put_Line ("dist: Build the distribution files to prepare the server installation");
      Put_Line ("Usage: dist target-dir [package.xml]");
      New_Line;
      Put_Line ("  The dist command reads the XML package description to build the"
                & " distribution tree.");
      Put_Line ("  This command is intended to be used after the project is built.  It prepares");
      Put_Line ("  the files for their installation on the target server in a "
                & "production environment.");
      Put_Line ("  The package.xml describes what files are necessary on the server.");
      Put_Line ("  It allows to make transformations such as compressing Javascript, CSS and "
                & "images");
   end Help;

end Gen.Commands.Distrib;

-----------------------------------------------------------------------
--  gen-commands-distrib -- Distrib command for dynamo
--  Copyright (C) 2012, 2013, 2014, 2017, 2018 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Ada.Text_IO;
package body Gen.Commands.Distrib is

   --  ------------------------------
   --  Execute the command with the arguments.
   --  ------------------------------
   overriding
   procedure Execute (Cmd       : in out Command;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Name);
   begin
      if Args.Get_Count = 0 or Args.Get_Count > 2 then
         Generator.Error ("Missing target directory");
         return;
      end if;
      Generator.Read_Project ("dynamo.xml", True);

      --  Setup the target directory where the distribution is created.
      Generator.Set_Result_Directory (Args.Get_Argument (1));

      --  Read the package description.
      if Args.Get_Count = 2 then
         Gen.Generator.Read_Package (Generator, Args.Get_Argument (2));
      else
         Gen.Generator.Read_Package (Generator, "package.xml");
      end if;

      --  Run the generation.
      Gen.Generator.Prepare (Generator);
      Gen.Generator.Generate_All (Generator);
      Gen.Generator.Finish (Generator);
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Cmd       : in out Command;
                   Name      : in String;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Name, Generator);
      use Ada.Text_IO;
   begin
      Put_Line ("dist: Build the distribution files to prepare the server installation");
      Put_Line ("Usage: dist target-dir [package.xml]");
      New_Line;
      Put_Line ("  The dist command reads the XML package description to build the"
                & " distribution tree.");
      Put_Line ("  This command is intended to be used after the project is built.  It prepares");
      Put_Line ("  the files for their installation on the target server in a "
                & "production environment.");
      Put_Line ("  The package.xml describes what files are necessary on the server.");
      Put_Line ("  It allows to make transformations such as compressing Javascript, CSS and "
                & "images");
   end Help;

end Gen.Commands.Distrib;

Add Name parameter to the Help procedure


--  Copyright (c) 2017 onox <denkpadje@gmail.com>
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.

with Orka.Transforms.Singles.Matrices;

package Orka.Behaviors is
   pragma Preelaborate;

   package Transforms renames Orka.Transforms.Singles.Matrices;

   type Visibility is (Invisible, Visible);

   type Behavior is limited interface;

   type Behavior_Ptr is not null access Behavior'Class;

   function Position (Object : Behavior) return Transforms.Vector4 is abstract;

   procedure Fixed_Update (Object : in out Behavior; Delta_Time : Duration) is null;
   --  Called zero to multiple times per frame and before Update
   --
   --  Fixed_Update can be used to perform physics or other computations
   --  that require a stable Delta_Time that does not depend on the frame
   --  rate. If the game needs to catch up then Fixed_Update is called
   --  multiple times. If the game renders at a very high frame rate then
   --  Fixed_Update will not be called at all.

   procedure Update (Object : in out Behavior; Delta_Time : Duration) is null;
   --  Called once per frame and after any calls to Fixed_Update

   procedure After_Update
     (Object : in out Behavior;
      Delta_Time    : Duration;
      View_Position : Transforms.Vector4) is null;
   --  Called once per frame and after Update

   procedure Visibility_Changed (Object : in out Behavior; State : Visibility) is null;

   procedure Render (Object : in out Behavior) is null;

   procedure After_Render (Object : in out Behavior) is null;

   type Behavior_Array is array (Positive range <>) of Behaviors.Behavior_Ptr;

   type Behavior_Array_Access is access Behavior_Array;

   Null_Behavior : constant Behavior_Ptr;

   Empty_Behavior_Array : constant Behavior_Array_Access;

private

   type Origin_Behavior is new Behavior with null record;

   overriding
   function Position (Object : Origin_Behavior) return Transforms.Vector4 is
     ((0.0, 0.0, 0.0, 1.0));

   Null_Behavior : constant Behavior_Ptr := new Origin_Behavior;

   Empty_Behavior_Array : constant Behavior_Array_Access := new Behavior_Array (1 .. 0);

end Orka.Behaviors;

--  Copyright (c) 2017 onox <denkpadje@gmail.com>
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.

with Orka.Transforms.Singles.Matrices;

package Orka.Behaviors is
   pragma Preelaborate;

   package Transforms renames Orka.Transforms.Singles.Matrices;

   type Visibility is (Invisible, Visible);

   type Behavior is limited interface;

   type Behavior_Ptr is not null access Behavior'Class;

   function Position (Object : Behavior) return Transforms.Vector4 is abstract;

   procedure Fixed_Update (Object : in out Behavior; Delta_Time : Duration) is null;
   --  Called zero to multiple times per frame and before Update
   --
   --  Fixed_Update can be used to perform physics or other computations
   --  that require a stable Delta_Time that does not depend on the frame
   --  rate. If the game needs to catch up then Fixed_Update is called
   --  multiple times. If the game renders at a very high frame rate then
   --  Fixed_Update will not be called at all.

   procedure Update (Object : in out Behavior; Delta_Time : Duration) is null;
   --  Called once per frame and after any calls to Fixed_Update

   procedure After_Update
     (Object : in out Behavior;
      Delta_Time    : Duration;
      View_Position : Transforms.Vector4) is null;
   --  Called once per frame and after Update

   procedure Visibility_Changed (Object : in out Behavior; State : Visibility) is null;

   procedure Render (Object : in out Behavior) is null;

   procedure After_Render (Object : in out Behavior) is null;

   type Behavior_Array is array (Positive range <>) of Behaviors.Behavior_Ptr;

   type Behavior_Array_Access is access Behavior_Array;

   Null_Behavior : constant Behavior_Ptr;

   function Empty_Behavior_Array return Behavior_Array_Access;

private

   type Origin_Behavior is new Behavior with null record;

   overriding
   function Position (Object : Origin_Behavior) return Transforms.Vector4 is
     ((0.0, 0.0, 0.0, 1.0));

   Null_Behavior : constant Behavior_Ptr := new Origin_Behavior;

   function Empty_Behavior_Array return Behavior_Array_Access is
     (new Behavior_Array'(1 .. 0 => Null_Behavior));

end Orka.Behaviors;

Fix compile error with GNAT CE 2018

Fix compile error with GNAT CE 2018

Signed-off-by: onox <34c1d3d2d1347bea60a26f46574de21a7a79b6d5@gmail.com>


-----------------------------------------------------------------------
--  util-processes-os -- System specific and low level operations
--  Copyright (C) 2011, 2012, 2017, 2018, 2019 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Ada.Directories;
with Ada.Unchecked_Deallocation;

package body Util.Processes.Os is

   use Util.Systems.Os;
   use type Interfaces.C.size_t;
   use type Util.Systems.Types.File_Type;
   use type Ada.Directories.File_Kind;

   type Pipe_Type is array (0 .. 1) of File_Type;
   procedure Close (Pipes : in out Pipe_Type);

   --  ------------------------------
   --  Create the output stream to read/write on the process input/output.
   --  Setup the file to be closed on exec.
   --  ------------------------------
   function Create_Stream (File : in File_Type)
                           return Util.Streams.Raw.Raw_Stream_Access is
      Stream : constant Util.Streams.Raw.Raw_Stream_Access := new Util.Streams.Raw.Raw_Stream;
      Status : constant Integer := Sys_Fcntl (File, F_SETFL, FD_CLOEXEC);
      pragma Unreferenced (Status);
   begin
      Stream.Initialize (File);
      return Stream;
   end Create_Stream;

   --  ------------------------------
   --  Wait for the process to exit.
   --  ------------------------------
   overriding
   procedure Wait (Sys     : in out System_Process;
                   Proc    : in out Process'Class;
                   Timeout : in Duration) is
      pragma Unreferenced (Sys, Timeout);

      use type Util.Streams.Output_Stream_Access;

      Result : Integer;
      Wpid   : Integer;
   begin
      --  Close the input stream pipe if there is one.
      if Proc.Input /= null then
         Util.Streams.Raw.Raw_Stream'Class (Proc.Input.all).Close;
      end if;

      Wpid := Sys_Waitpid (Integer (Proc.Pid), Result'Address, 0);
      if Wpid = Integer (Proc.Pid) then
         Proc.Exit_Value := Result / 256;
         if Result mod 256 /= 0 then
            Proc.Exit_Value := (Result mod 256) * 1000;
         end if;
      end if;
   end Wait;

   --  ------------------------------
   --  Terminate the process by sending a signal on Unix and exiting the process on Windows.
   --  This operation is not portable and has a different behavior between Unix and Windows.
   --  Its intent is to stop the process.
   --  ------------------------------
   overriding
   procedure Stop (Sys    : in out System_Process;
                   Proc   : in out Process'Class;
                   Signal : in Positive := 15) is
      pragma Unreferenced (Sys);
      Result : Integer;
      pragma Unreferenced (Result);
   begin
      Result := Sys_Kill (Integer (Proc.Pid), Integer (Signal));
   end Stop;

   --  ------------------------------
   --  Close both ends of the pipe (used to cleanup in case or error).
   --  ------------------------------
   procedure Close (Pipes : in out Pipe_Type) is
      Result : Integer;
      pragma Unreferenced (Result);
   begin
      if Pipes (0) /= NO_FILE then
         Result := Sys_Close (Pipes (0));
         Pipes (0) := NO_FILE;
      end if;
      if Pipes (1) /= NO_FILE then
         Result := Sys_Close (Pipes (1));
         Pipes (1) := NO_FILE;
      end if;
   end Close;

   procedure Prepare_Working_Directory (Sys : in out System_Process;
                                        Proc : in out Process'Class) is
      Dir : constant String := Ada.Strings.Unbounded.To_String (Proc.Dir);
   begin
      Interfaces.C.Strings.Free (Sys.Dir);
      if Dir'Length > 0 then
         if not Ada.Directories.Exists (Dir)
           or else Ada.Directories.Kind (Dir) /= Ada.Directories.Directory
         then
            raise Ada.Directories.Name_Error with "Invalid directory: " & Dir;
         end if;
         Sys.Dir := Interfaces.C.Strings.New_String (Dir);
      end if;
   end Prepare_Working_Directory;

   --  ------------------------------
   --  Spawn a new process.
   --  ------------------------------
   overriding
   procedure Spawn (Sys  : in out System_Process;
                    Proc : in out Process'Class;
                    Mode : in Pipe_Mode := NONE) is
      use Interfaces.C.Strings;
      use type Interfaces.C.int;

      procedure Cleanup;

      --  Suppress all checks to make sure the child process will not raise any exception.
      pragma Suppress (All_Checks);

      Result : Integer;

      Stdin_Pipes   : aliased Pipe_Type := (others => NO_FILE);
      Stdout_Pipes  : aliased Pipe_Type := (others => NO_FILE);
      Stderr_Pipes  : aliased Pipe_Type := (others => NO_FILE);

      procedure Cleanup is
      begin
         Close (Stdin_Pipes);
         Close (Stdout_Pipes);
         Close (Stderr_Pipes);
      end Cleanup;

   begin
      Sys.Prepare_Working_Directory (Proc);

      --  Since checks are disabled, verify by hand that the argv table is correct.
      if Sys.Argv = null or else Sys.Argc < 1 or else Sys.Argv (0) = Null_Ptr then
         raise Program_Error with "Invalid process argument list";
      end if;

      --  Setup the pipes.
      if Mode = READ or Mode = READ_WRITE or Mode = READ_ALL then
         if Sys_Pipe (Stdout_Pipes'Address) /= 0 then
            raise Process_Error with "Cannot create stdout pipe";
         end if;
      end if;
      if Mode = WRITE or Mode = READ_WRITE or Mode = READ_WRITE_ALL then
         if Sys_Pipe (Stdin_Pipes'Address) /= 0 then
            Cleanup;
            raise Process_Error with "Cannot create stdin pipe";
         end if;
      end if;
      if Mode = READ_ERROR then
         if Sys_Pipe (Stderr_Pipes'Address) /= 0 then
            Cleanup;
            raise Process_Error with "Cannot create stderr pipe";
         end if;
      end if;

      --  Create the new process by using vfork instead of fork.  The parent process is blocked
      --  until the child executes the exec or exits.  The child process uses the same stack
      --  as the parent.
      Proc.Pid := Sys_VFork;
      if Proc.Pid = 0 then

         --  Do not use any Ada type while in the child process.

         if Proc.To_Close /= null then
            for Fd of Proc.To_Close.all loop
               Result := Sys_Close (Fd);
            end loop;
         end if;

         if Mode = READ_ALL or Mode = READ_WRITE_ALL then
            Result := Sys_Dup2 (Stdout_Pipes (1), STDERR_FILENO);
         end if;

         if Stderr_Pipes (1) /= NO_FILE then
            if Stderr_Pipes (1) /= STDERR_FILENO then
               Result := Sys_Dup2 (Stderr_Pipes (1), STDERR_FILENO);
               Result := Sys_Close (Stderr_Pipes (1));
            end if;
            Result := Sys_Close (Stderr_Pipes (0));

         elsif Sys.Err_File /= Null_Ptr then
            --  Redirect the process error to a file.
            declare
               Fd : File_Type;
            begin
               if Sys.Err_Append then
                  Fd := Sys_Open (Sys.Err_File, O_CREAT + O_WRONLY + O_APPEND, 8#644#);
               else
                  Fd := Sys_Open (Sys.Err_File, O_CREAT + O_WRONLY + O_TRUNC, 8#644#);
               end if;
               if Fd < 0 then
                  Sys_Exit (254);
               end if;
               Result := Sys_Dup2 (Fd, STDOUT_FILENO);
               Result := Sys_Close (Fd);
            end;
         end if;

         if Stdout_Pipes (1) /= NO_FILE then
            if Stdout_Pipes (1) /= STDOUT_FILENO then
               Result := Sys_Dup2 (Stdout_Pipes (1), STDOUT_FILENO);
               Result := Sys_Close (Stdout_Pipes (1));
            end if;
            Result := Sys_Close (Stdout_Pipes (0));

         elsif Sys.Out_File /= Null_Ptr then
            --  Redirect the process output to a file.
            declare
               Fd : File_Type;
            begin
               if Sys.Out_Append then
                  Fd := Sys_Open (Sys.Out_File, O_CREAT + O_WRONLY + O_APPEND, 8#644#);
               else
                  Fd := Sys_Open (Sys.Out_File, O_CREAT + O_WRONLY + O_TRUNC, 8#644#);
               end if;
               if Fd < 0 then
                  Sys_Exit (254);
               end if;
               Result := Sys_Dup2 (Fd, STDOUT_FILENO);
               Result := Sys_Close (Fd);
            end;
         end if;

         if Stdin_Pipes (0) /= NO_FILE then
            if Stdin_Pipes (0) /= STDIN_FILENO then
               Result := Sys_Dup2 (Stdin_Pipes (0), STDIN_FILENO);
               Result := Sys_Close (Stdin_Pipes (0));
            end if;
            Result := Sys_Close (Stdin_Pipes (1));

         elsif Sys.In_File /= Null_Ptr then
            --  Redirect the process input from a file.
            declare
               Fd : File_Type;
            begin
               Fd := Sys_Open (Sys.In_File, O_RDONLY, 8#644#);
               if Fd < 0 then
                  Sys_Exit (254);
               end if;
               Result := Sys_Dup2 (Fd, STDIN_FILENO);
               Result := Sys_Close (Fd);
            end;
         end if;

         if Sys.Dir /= Null_Ptr then
            Result := Sys_Chdir (Sys.Dir);
            if Result < 0 then
               Sys_Exit (253);
            end if;
         end if;

         Result := Sys_Execvp (Sys.Argv (0), Sys.Argv.all);
         Sys_Exit (255);
      end if;

      --  Process creation failed, cleanup and raise an exception.
      if Proc.Pid < 0 then
         Cleanup;
         raise Process_Error with "Cannot create process";
      end if;

      if Stdin_Pipes (1) /= NO_FILE then
         Result := Sys_Close (Stdin_Pipes (0));
         Proc.Input := Create_Stream (Stdin_Pipes (1)).all'Access;
      end if;

      if Stdout_Pipes (0) /= NO_FILE then
         Result := Sys_Close (Stdout_Pipes (1));
         Proc.Output := Create_Stream (Stdout_Pipes (0)).all'Access;
      end if;

      if Stderr_Pipes (0) /= NO_FILE then
         Result := Sys_Close (Stderr_Pipes (1));
         Proc.Error := Create_Stream (Stderr_Pipes (0)).all'Access;
      end if;

   end Spawn;

   procedure Free is
     new Ada.Unchecked_Deallocation (Name => Ptr_Ptr_Array, Object => Ptr_Array);

   --  ------------------------------
   --  Append the argument to the process argument list.
   --  ------------------------------
   overriding
   procedure Append_Argument (Sys : in out System_Process;
                              Arg : in String) is
   begin
      if Sys.Argv = null then
         Sys.Argv := new Ptr_Array (0 .. 10);
      elsif Sys.Argc = Sys.Argv'Last - 1 then
         declare
            N : constant Ptr_Ptr_Array := new Ptr_Array (0 .. Sys.Argc + 32);
         begin
            N (0 .. Sys.Argc) := Sys.Argv (0 .. Sys.Argc);
            Free (Sys.Argv);
            Sys.Argv := N;
         end;
      end if;

      Sys.Argv (Sys.Argc) := Interfaces.C.Strings.New_String (Arg);
      Sys.Argc := Sys.Argc + 1;
      Sys.Argv (Sys.Argc) := Interfaces.C.Strings.Null_Ptr;
   end Append_Argument;

   --  ------------------------------
   --  Set the process input, output and error streams to redirect and use specified files.
   --  ------------------------------
   overriding
   procedure Set_Streams (Sys           : in out System_Process;
                          Input         : in String;
                          Output        : in String;
                          Error         : in String;
                          Append_Output : in Boolean;
                          Append_Error  : in Boolean;
                          To_Close      : in File_Type_Array_Access) is
   begin
      if Input'Length > 0 then
         Sys.In_File := Interfaces.C.Strings.New_String (Input);
      end if;
      if Output'Length > 0 then
         Sys.Out_File   := Interfaces.C.Strings.New_String (Output);
         Sys.Out_Append := Append_Output;
      end if;
      if Error'Length > 0 then
         Sys.Err_File   := Interfaces.C.Strings.New_String (Error);
         Sys.Err_Append := Append_Error;
      end if;
      Sys.To_Close := To_Close;
   end Set_Streams;

   --  ------------------------------
   --  Deletes the storage held by the system process.
   --  ------------------------------
   overriding
   procedure Finalize (Sys : in out System_Process) is
   begin
      if Sys.Argv /= null then
         for I in Sys.Argv'Range loop
            Interfaces.C.Strings.Free (Sys.Argv (I));
         end loop;
         Free (Sys.Argv);
      end if;
      Interfaces.C.Strings.Free (Sys.In_File);
      Interfaces.C.Strings.Free (Sys.Out_File);
      Interfaces.C.Strings.Free (Sys.Err_File);
      Interfaces.C.Strings.Free (Sys.Dir);
   end Finalize;

end Util.Processes.Os;

-----------------------------------------------------------------------
--  util-processes-os -- System specific and low level operations
--  Copyright (C) 2011, 2012, 2017, 2018, 2019 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Ada.Directories;
with Ada.Unchecked_Deallocation;

package body Util.Processes.Os is

   use Util.Systems.Os;
   use type Interfaces.C.size_t;
   use type Util.Systems.Types.File_Type;
   use type Ada.Directories.File_Kind;

   type Pipe_Type is array (0 .. 1) of File_Type;
   procedure Close (Pipes : in out Pipe_Type);

   --  ------------------------------
   --  Create the output stream to read/write on the process input/output.
   --  Setup the file to be closed on exec.
   --  ------------------------------
   function Create_Stream (File : in File_Type)
                           return Util.Streams.Raw.Raw_Stream_Access is
      Stream : constant Util.Streams.Raw.Raw_Stream_Access := new Util.Streams.Raw.Raw_Stream;
      Status : constant Integer := Sys_Fcntl (File, F_SETFL, FD_CLOEXEC);
      pragma Unreferenced (Status);
   begin
      Stream.Initialize (File);
      return Stream;
   end Create_Stream;

   --  ------------------------------
   --  Wait for the process to exit.
   --  ------------------------------
   overriding
   procedure Wait (Sys     : in out System_Process;
                   Proc    : in out Process'Class;
                   Timeout : in Duration) is
      pragma Unreferenced (Sys, Timeout);

      use type Util.Streams.Output_Stream_Access;

      Result : Integer;
      Wpid   : Integer;
   begin
      --  Close the input stream pipe if there is one.
      if Proc.Input /= null then
         Util.Streams.Raw.Raw_Stream'Class (Proc.Input.all).Close;
      end if;

      Wpid := Sys_Waitpid (Integer (Proc.Pid), Result'Address, 0);
      if Wpid = Integer (Proc.Pid) then
         Proc.Exit_Value := Result / 256;
         if Result mod 256 /= 0 then
            Proc.Exit_Value := (Result mod 256) * 1000;
         end if;
      end if;
   end Wait;

   --  ------------------------------
   --  Terminate the process by sending a signal on Unix and exiting the process on Windows.
   --  This operation is not portable and has a different behavior between Unix and Windows.
   --  Its intent is to stop the process.
   --  ------------------------------
   overriding
   procedure Stop (Sys    : in out System_Process;
                   Proc   : in out Process'Class;
                   Signal : in Positive := 15) is
      pragma Unreferenced (Sys);
      Result : Integer;
      pragma Unreferenced (Result);
   begin
      Result := Sys_Kill (Integer (Proc.Pid), Integer (Signal));
   end Stop;

   --  ------------------------------
   --  Close both ends of the pipe (used to cleanup in case or error).
   --  ------------------------------
   procedure Close (Pipes : in out Pipe_Type) is
      Result : Integer;
      pragma Unreferenced (Result);
   begin
      if Pipes (0) /= NO_FILE then
         Result := Sys_Close (Pipes (0));
         Pipes (0) := NO_FILE;
      end if;
      if Pipes (1) /= NO_FILE then
         Result := Sys_Close (Pipes (1));
         Pipes (1) := NO_FILE;
      end if;
   end Close;

   procedure Prepare_Working_Directory (Sys : in out System_Process;
                                        Proc : in out Process'Class) is
      Dir : constant String := Ada.Strings.Unbounded.To_String (Proc.Dir);
   begin
      Interfaces.C.Strings.Free (Sys.Dir);
      if Dir'Length > 0 then
         if not Ada.Directories.Exists (Dir)
           or else Ada.Directories.Kind (Dir) /= Ada.Directories.Directory
         then
            raise Ada.Directories.Name_Error with "Invalid directory: " & Dir;
         end if;
         Sys.Dir := Interfaces.C.Strings.New_String (Dir);
      end if;
   end Prepare_Working_Directory;

   --  ------------------------------
   --  Spawn a new process.
   --  ------------------------------
   overriding
   procedure Spawn (Sys  : in out System_Process;
                    Proc : in out Process'Class;
                    Mode : in Pipe_Mode := NONE) is
      use Interfaces.C.Strings;
      use type Interfaces.C.int;

      procedure Cleanup;

      --  Suppress all checks to make sure the child process will not raise any exception.
      pragma Suppress (All_Checks);

      Result : Integer;

      Stdin_Pipes   : aliased Pipe_Type := (others => NO_FILE);
      Stdout_Pipes  : aliased Pipe_Type := (others => NO_FILE);
      Stderr_Pipes  : aliased Pipe_Type := (others => NO_FILE);

      procedure Cleanup is
      begin
         Close (Stdin_Pipes);
         Close (Stdout_Pipes);
         Close (Stderr_Pipes);
      end Cleanup;

   begin
      Sys.Prepare_Working_Directory (Proc);

      --  Since checks are disabled, verify by hand that the argv table is correct.
      if Sys.Argv = null or else Sys.Argc < 1 or else Sys.Argv (0) = Null_Ptr then
         raise Program_Error with "Invalid process argument list";
      end if;

      --  Setup the pipes.
      if Mode = WRITE or Mode = READ_WRITE or Mode = READ_WRITE_ALL then
         if Sys_Pipe (Stdin_Pipes'Address) /= 0 then
            Cleanup;
            raise Process_Error with "Cannot create stdin pipe";
         end if;
      end if;
      if Mode = READ or Mode = READ_WRITE or Mode = READ_ALL then
         if Sys_Pipe (Stdout_Pipes'Address) /= 0 then
            Cleanup;
            raise Process_Error with "Cannot create stdout pipe";
         end if;
      end if;
      if Mode = READ_ERROR then
         if Sys_Pipe (Stderr_Pipes'Address) /= 0 then
            Cleanup;
            raise Process_Error with "Cannot create stderr pipe";
         end if;
      end if;

      --  Create the new process by using vfork instead of fork.  The parent process is blocked
      --  until the child executes the exec or exits.  The child process uses the same stack
      --  as the parent.
      Proc.Pid := Sys_VFork;
      if Proc.Pid = 0 then

         --  Do not use any Ada type while in the child process.

         if Proc.To_Close /= null then
            for Fd of Proc.To_Close.all loop
               Result := Sys_Close (Fd);
            end loop;
         end if;

         --  Handle stdin/stdout/stderr pipe redirections unless they are file-redirected.

         if Sys.Err_File = Null_Ptr and Stdout_Pipes (1) /= NO_FILE then
            Result := Sys_Dup2 (Stdout_Pipes (1), STDERR_FILENO);
         end if;

         --  Redirect stdin to the pipe unless we use file redirection.
         if Sys.In_File = Null_Ptr and Stdin_Pipes (0) /= NO_FILE then
            if Stdin_Pipes (0) /= STDIN_FILENO then
               Result := Sys_Dup2 (Stdin_Pipes (0), STDIN_FILENO);
            end if;
         end if;
         if Stdin_Pipes (0) /= NO_FILE and Stdin_Pipes (0) /= STDIN_FILENO then
            Result := Sys_Close (Stdin_Pipes (0));
         end if;
         if Stdin_Pipes (1) /= NO_FILE then
            Result := Sys_Close (Stdin_Pipes (1));
         end if;

         --  Redirect stdout to the pipe unless we use file redirection.
         if Sys.Out_File = Null_Ptr and Stdout_Pipes (1) /= NO_FILE then
            if Stdout_Pipes (1) /= STDOUT_FILENO then
               Result := Sys_Dup2 (Stdout_Pipes (1), STDOUT_FILENO);
            end if;
         end if;
         if Stdout_Pipes (1) /= NO_FILE and Stdout_Pipes (1) /= STDOUT_FILENO then
            Result := Sys_Close (Stdout_Pipes (1));
         end if;
         if Stdout_Pipes (0) /= NO_FILE then
            Result := Sys_Close (Stdout_Pipes (0));
         end if;

         if Sys.Err_File = Null_Ptr and Stderr_Pipes (1) /= NO_FILE then
            if Stderr_Pipes (1) /= STDERR_FILENO then
               Result := Sys_Dup2 (Stderr_Pipes (1), STDERR_FILENO);
               Result := Sys_Close (Stderr_Pipes (1));
            end if;
            Result := Sys_Close (Stderr_Pipes (0));
         end if;

         if Sys.In_File /= Null_Ptr then
            --  Redirect the process input from a file.
            declare
               Fd : File_Type;
            begin
               Fd := Sys_Open (Sys.In_File, O_RDONLY, 8#644#);
               if Fd < 0 then
                  Sys_Exit (254);
               end if;
               if Fd /= STDIN_FILENO then
                  Result := Sys_Dup2 (Fd, STDIN_FILENO);
                  Result := Sys_Close (Fd);
               end if;
            end;
         end if;

         if Sys.Out_File /= Null_Ptr then
            --  Redirect the process output to a file.
            declare
               Fd : File_Type;
            begin
               if Sys.Out_Append then
                  Fd := Sys_Open (Sys.Out_File, O_CREAT + O_WRONLY + O_APPEND, 8#644#);
               else
                  Fd := Sys_Open (Sys.Out_File, O_CREAT + O_WRONLY + O_TRUNC, 8#644#);
               end if;
               if Fd < 0 then
                  Sys_Exit (254);
               end if;
               if Fd /= STDOUT_FILENO then
                  Result := Sys_Dup2 (Fd, STDOUT_FILENO);
                  Result := Sys_Close (Fd);
               end if;
            end;
         end if;

         if Sys.Err_File /= Null_Ptr then
            --  Redirect the process error to a file.
            declare
               Fd : File_Type;
            begin
               if Sys.Err_Append then
                  Fd := Sys_Open (Sys.Err_File, O_CREAT + O_WRONLY + O_APPEND, 8#644#);
               else
                  Fd := Sys_Open (Sys.Err_File, O_CREAT + O_WRONLY + O_TRUNC, 8#644#);
               end if;
               if Fd < 0 then
                  Sys_Exit (254);
               end if;
               if Fd /= STDERR_FILENO then
                  Result := Sys_Dup2 (Fd, STDERR_FILENO);
                  Result := Sys_Close (Fd);
               end if;
            end;
         end if;

         if Sys.Dir /= Null_Ptr then
            Result := Sys_Chdir (Sys.Dir);
            if Result < 0 then
               Sys_Exit (253);
            end if;
         end if;

         Result := Sys_Execvp (Sys.Argv (0), Sys.Argv.all);
         Sys_Exit (255);
      end if;

      --  Process creation failed, cleanup and raise an exception.
      if Proc.Pid < 0 then
         Cleanup;
         raise Process_Error with "Cannot create process";
      end if;

      if Stdin_Pipes (1) /= NO_FILE then
         Result := Sys_Close (Stdin_Pipes (0));
         Proc.Input := Create_Stream (Stdin_Pipes (1)).all'Access;
      end if;

      if Stdout_Pipes (0) /= NO_FILE then
         Result := Sys_Close (Stdout_Pipes (1));
         Proc.Output := Create_Stream (Stdout_Pipes (0)).all'Access;
      end if;

      if Stderr_Pipes (0) /= NO_FILE then
         Result := Sys_Close (Stderr_Pipes (1));
         Proc.Error := Create_Stream (Stderr_Pipes (0)).all'Access;
      end if;

   end Spawn;

   procedure Free is
     new Ada.Unchecked_Deallocation (Name => Ptr_Ptr_Array, Object => Ptr_Array);

   --  ------------------------------
   --  Append the argument to the process argument list.
   --  ------------------------------
   overriding
   procedure Append_Argument (Sys : in out System_Process;
                              Arg : in String) is
   begin
      if Sys.Argv = null then
         Sys.Argv := new Ptr_Array (0 .. 10);
      elsif Sys.Argc = Sys.Argv'Last - 1 then
         declare
            N : constant Ptr_Ptr_Array := new Ptr_Array (0 .. Sys.Argc + 32);
         begin
            N (0 .. Sys.Argc) := Sys.Argv (0 .. Sys.Argc);
            Free (Sys.Argv);
            Sys.Argv := N;
         end;
      end if;

      Sys.Argv (Sys.Argc) := Interfaces.C.Strings.New_String (Arg);
      Sys.Argc := Sys.Argc + 1;
      Sys.Argv (Sys.Argc) := Interfaces.C.Strings.Null_Ptr;
   end Append_Argument;

   --  ------------------------------
   --  Set the process input, output and error streams to redirect and use specified files.
   --  ------------------------------
   overriding
   procedure Set_Streams (Sys           : in out System_Process;
                          Input         : in String;
                          Output        : in String;
                          Error         : in String;
                          Append_Output : in Boolean;
                          Append_Error  : in Boolean;
                          To_Close      : in File_Type_Array_Access) is
   begin
      if Input'Length > 0 then
         Sys.In_File := Interfaces.C.Strings.New_String (Input);
      end if;
      if Output'Length > 0 then
         Sys.Out_File   := Interfaces.C.Strings.New_String (Output);
         Sys.Out_Append := Append_Output;
      end if;
      if Error'Length > 0 then
         Sys.Err_File   := Interfaces.C.Strings.New_String (Error);
         Sys.Err_Append := Append_Error;
      end if;
      Sys.To_Close := To_Close;
   end Set_Streams;

   --  ------------------------------
   --  Deletes the storage held by the system process.
   --  ------------------------------
   overriding
   procedure Finalize (Sys : in out System_Process) is
   begin
      if Sys.Argv /= null then
         for I in Sys.Argv'Range loop
            Interfaces.C.Strings.Free (Sys.Argv (I));
         end loop;
         Free (Sys.Argv);
      end if;
      Interfaces.C.Strings.Free (Sys.In_File);
      Interfaces.C.Strings.Free (Sys.Out_File);
      Interfaces.C.Strings.Free (Sys.Err_File);
      Interfaces.C.Strings.Free (Sys.Dir);
   end Finalize;

end Util.Processes.Os;

Fix handling redirecting stdin/stdout/stderr to a file at the same time as using pipes


--  This file is covered by the Internet Software Consortium (ISC) License
--  Reference: ../License.txt

package Definitions is

   pragma Pure;

   synth_version_major : constant String := "1";
   synth_version_minor : constant String := "68";
   copyright_years     : constant String := "2015-2017";
   host_localbase      : constant String := "/usr/local";
   host_make           : constant String := "/usr/bin/make";
   host_pkg8           : constant String := host_localbase & "/sbin/pkg";
   host_bmake          : constant String := host_localbase & "/bin/bmake";
   host_make_program   : constant String := host_make;
   chroot_make         : constant String := "/usr/bin/make";
   chroot_bmake        : constant String := "/usr/pkg/bin/bmake -m /usr/pkg/share/mk";
   chroot_make_program : constant String := chroot_make;
   jobs_per_cpu        : constant := 2;

   type cpu_range is range 1 .. 32;
   type scanners  is range cpu_range'First .. cpu_range'Last;
   type builders  is range cpu_range'First .. cpu_range'Last * jobs_per_cpu;
   type package_system is (ports_collection, pkgsrc);

   software_framework : constant package_system := ports_collection;

   --  Notes for tailoring Synth.  Use sed to:
   --  1. Modify host_localbase to value of LOCALBASE
   --  2. Change software_framework to "pkgsrc" for pkgsrc version
   --  3. Change host_make_program to "host_bmake" for Non-NetBSD pkgsrc platforms
   --  4. Change chroot_make_program to "chroot_bmake" for pkgsrc version
   --  5. On replicant.ads, change "/usr/local" to "/usr/pkg" on pkgsrc

end Definitions;

--  This file is covered by the Internet Software Consortium (ISC) License
--  Reference: ../License.txt

package Definitions is

   pragma Pure;

   synth_version_major : constant String := "1";
   synth_version_minor : constant String := "69";
   copyright_years     : constant String := "2015-2017";
   host_localbase      : constant String := "/usr/local";
   host_make           : constant String := "/usr/bin/make";
   host_pkg8           : constant String := host_localbase & "/sbin/pkg";
   host_bmake          : constant String := host_localbase & "/bin/bmake";
   host_make_program   : constant String := host_make;
   chroot_make         : constant String := "/usr/bin/make";
   chroot_bmake        : constant String := "/usr/pkg/bin/bmake -m /usr/pkg/share/mk";
   chroot_make_program : constant String := chroot_make;
   jobs_per_cpu        : constant := 2;

   type cpu_range is range 1 .. 32;
   type scanners  is range cpu_range'First .. cpu_range'Last;
   type builders  is range cpu_range'First .. cpu_range'Last * jobs_per_cpu;
   type package_system is (ports_collection, pkgsrc);

   software_framework : constant package_system := ports_collection;

   --  Notes for tailoring Synth.  Use sed to:
   --  1. Modify host_localbase to value of LOCALBASE
   --  2. Change software_framework to "pkgsrc" for pkgsrc version
   --  3. Change host_make_program to "host_bmake" for Non-NetBSD pkgsrc platforms
   --  4. Change chroot_make_program to "chroot_bmake" for pkgsrc version
   --  5. On replicant.ads, change "/usr/local" to "/usr/pkg" on pkgsrc

end Definitions;

Bump version to 1.69

Bump version to 1.69

Items addressed since release 1.68
* Extend base multiplier for build_depends phase from 5 to 11 minutes
This is primarily for textlive for which the extraction time on an
older machine with a spinning disk was measured at 7 minutes.  On that
machine the watchdog could kick on ports requiring texlive.
* Increase internal allocation of 28,000 maximum ports to 32,000.  The
FreeBSD ports tree went over 28k ports recently.  Apparently nobody
tried to use Synth to build every port on FreeBSD recently because it
should have failed.
* Fix an incorrect command exception handler (noticed during the
development of ravenadm).
* Augment package architecture determination to recognize ARM and ARM64
packages.  Synth builds natively on ARM64.
* Add FAQ entry explaining how to use Synth to crossbuild armv6 (and
aarch64 for that matter) packages on FreeBSD/ARM64 (contributed by
Jonathan Chen)
* Update copyright years on the ISC license