diff --git a/index/alire-index-gnatcoll.ads b/index/alire-index-gnatcoll.ads index 5b967a67..fee21617 100644 --- a/index/alire-index-gnatcoll.ads +++ b/index/alire-index-gnatcoll.ads @@ -1,3 +1,5 @@ +with Ada.Directories; + package Alire.Index.GNATCOLL is function Project is new Catalogued_Project @@ -9,32 +11,41 @@ package Alire.Index.GNATCOLL is Repo_Alire : constant URL := "https://github.com/alire-project/gnatcoll-core.git"; -- For slim picks - Base : constant Release := - Project.Unreleased - (Properties => - Author ("AdaCore") and - Maintainer ("alejandro@mosteo.com") and - License (GPL_3_0) and + Base : constant Release := Project.Unreleased + (Properties => + Author ("AdaCore") + and Maintainer ("alejandro@mosteo.com") + and License (GPL_3_0) + and GPR_Scenario ("GNATCOLL_ATOMICS", + "intrinsic" or "mutex") + and GPR_Scenario ("GNATCOLL_OS", + "windows" or "unix" or "osx") + and GPR_Scenario ("BUILD", + "DEBUG" or "PROD") + and GPR_Scenario ("LIBRARY_TYPE", + "relocatable" or "static" or "static-pic"), + Private_Properties => + GPR_External ("BUILD", "PROD") and + GPR_External ("LIBRARY_TYPE", "static-pic") and + Case_Operating_System_Is + ((GNU_Linux => GPR_External ("GNATCOLL_OS", "unix"), + OSX => GPR_External ("GNATCOLL_OS", "osx"), + Windows => GPR_External ("GNATCOLL_OS", "windows"), + OS_Unknown => GPR_External ("GNATCOLL_OS", "ERROR")))); - Project_File ("gnatcoll.gpr") and - GPR_Scenario ("GNATCOLL_ATOMICS", - "intrinsic" or "mutex") and - GPR_Scenario ("GNATCOLL_OS", - "windows" or "unix" or "osx") and - GPR_Scenario ("BUILD", - "DEBUG" or "PROD") and - GPR_Scenario ("LIBRARY_TYPE", - "relocatable" or "static" or "static-pic"), + package Regular is - Private_Properties => - GPR_External ("BUILD", "PROD") and - GPR_External ("LIBRARY_TYPE", "static-pic") and - Case_Operating_System_Is - ((GNU_Linux => GPR_External ("GNATCOLL_OS", "unix"), - OSX => GPR_External ("GNATCOLL_OS", "osx"), - Windows => GPR_External ("GNATCOLL_OS", "windows"), - OS_Unknown => GPR_External ("GNATCOLL_OS", "ERROR"))) - ); + package V_2018 is new Project_Release + (Base + .Renaming (GNATCOLL.Project) + .Replacing (Source_Archive + ("http://mirrors.cdn.adacore.com/art/5b0819dfc7a447df26c27a99", + "gnatcoll-core-gpl-2018-20180524-src.tar.gz")) + .Extending + (Properties => Project_File (Ada.Directories.Compose + ("gnatcoll-core-gpl-2018-src", "gnatcoll.gpr")))); + + end Regular; package Slim is diff --git a/index/alire-index-ini_files.ads b/index/alire-index-ini_files.ads new file mode 100644 index 00000000..ff79823a --- /dev/null +++ b/index/alire-index-ini_files.ads @@ -0,0 +1,18 @@ +package Alire.Index.Ini_Files is + + function Project is new Catalogued_Project + ("A standalone, portable Ada package for configuration files"); + + Base : constant Release := Project.Unreleased + (Version => V ("08"), + Properties => Project_File ("ini_files_gnat.gpr") + and Author ("Gautier de Montmollin & Rolf Ebert") + and Website ("https://sourceforge.net/p/ini-files/") + and License (MIT)); + + package V_8 is new Project_Release + (Base + .Renaming (Project) + .Replacing (SVN ("https://svn.code.sf.net/p/ini-files/code/", "28"))); + +end Alire.Index.Ini_Files; diff --git a/index/alire-index-png_io.ads b/index/alire-index-png_io.ads index c9020ff8..65fb0e0c 100644 --- a/index/alire-index-png_io.ads +++ b/index/alire-index-png_io.ads @@ -3,7 +3,7 @@ with Alire.Index.Zlib_Ada; package Alire.Index.PNG_IO is function Project is new Catalogued_Project - ("ZLib for Ada thick binding"); + ("Ada95 coder/decoder for Portable Network Graphics"); Repo : constant URL := "https://github.com/alire-project/png_io.git"; diff --git a/src/alire-index.ads b/src/alire-index.ads index 6345b024..4212aeac 100644 --- a/src/alire-index.ads +++ b/src/alire-index.ads @@ -163,6 +163,7 @@ package Alire.Index is function Git (URL : Alire.URL; Commit : Origins.Git_Commit) return Origins.Origin renames Origins.New_Git; function Hg (URL : Alire.URL; Commit : Origins.Hg_Commit) return Origins.Origin renames Origins.New_Hg; + function SVN (URL : Alire.URL; Commit : String) return Origins.Origin renames Origins.New_SVN; function Packaged_As (S : String) return Origins.Package_Names renames Origins.Packaged_As; @@ -170,6 +171,9 @@ package Alire.Index is function Native (Distros : Origins.Native_Packages) return Origins.Origin renames Origins.New_Native; + function Source_Archive (URL : Alire.URL; Name : String := "") return Origins.Origin + renames Origins.New_Source_Archive; + ------------------ -- Dependencies -- ------------------ diff --git a/src/alire-origins.adb b/src/alire-origins.adb new file mode 100644 index 00000000..aaf6957d --- /dev/null +++ b/src/alire-origins.adb @@ -0,0 +1,94 @@ +package body Alire.Origins is + + function Ends_With (S : String; Suffix : String) return Boolean is + (S'Length >= Suffix'Length + and then S (S'Last - Suffix'Length + 1 .. S'Last) = Suffix); + -- Return whether the S string ends with the given Suffix sub-string + + function URL_Basename (URL : Alire.URL) return String; + -- Try to get a basename for the given URL. Return an empty string on + -- failure. + + function Archive_Format (Name : String) return Source_Archive_Format; + -- Guess the format of a source archive from its file name + + ------------------ + -- URL_Basename -- + ------------------ + + function URL_Basename (URL : Alire.URL) return String is + Separator : Positive; + -- Index of the first URL separator we can find ('#' or '?') in URL + + Last_Slash : Natural; + -- Index of the last slash character in URL before the first URL + -- separator. + begin + Last_Slash := 0; + Separator := URL'Last + 1; + for I in URL'Range loop + case URL (I) is + when '?' | '#' => + Separator := I; + exit; + + when '/' => + Last_Slash := I; + + when others => + null; + end case; + end loop; + + return URL (Last_Slash + 1 .. Separator); + end URL_Basename; + + -------------------- + -- Archive_Format -- + -------------------- + + function Archive_Format (Name : String) return Source_Archive_Format is + begin + if Ends_With (Name, ".zip") then + return Zip_Archive; + + elsif Ends_With (Name, ".tar") + or else Ends_With (Name, ".tar.gz") + or else Ends_With (Name, ".tgz") + or else Ends_With (Name, ".tar.bz2") + or else Ends_With (Name, ".tbz2") + or else Ends_With (Name, ".tar.xz") + then + return Tarball; + + else + return Unknown; + end if; + end Archive_Format; + + ------------------------ + -- New_Source_Archive -- + ------------------------ + + function New_Source_Archive + (URL : Alire.URL; Name : String := "") return Origin + is + Archive_Name : constant String := + (if Name'Length = 0 then URL_Basename (URL) else Name); + Format : Source_Archive_Format; + begin + if Archive_Name'Length = 0 then + raise Unknown_Source_Archive_Name_Error with + "Unable to determine archive name: please specify one"; + end if; + + Format := Archive_Format (Archive_Name); + if Format not in Known_Source_Archive_Format then + raise Unknown_Source_Archive_Format_Error with + "Unable to determine archive format from file extension"; + end if; + + return (Data => (Source_Archive, +URL, +Archive_Name, Format)); + end New_Source_Archive; + +end Alire.Origins; diff --git a/src/alire-origins.ads b/src/alire-origins.ads index 3d56bf1a..1d20c248 100644 --- a/src/alire-origins.ads +++ b/src/alire-origins.ads @@ -27,12 +27,22 @@ package Alire.Origins with Preelaborate is type Native_Packages is array (Platforms.Distributions) of Package_Names; -- The name of a package in every distro for a given version - type Kinds is (Filesystem, -- Not really an origin, but a working copy of a project - Git, -- Remote git repo - Hg, -- Remote hg repo - Native -- Native platform package + type Kinds is (Filesystem, -- Not really an origin, but a working copy of a project + Git, -- Remote git repo + Hg, -- Remote hg repo + SVN, -- Remote svn repo + Source_Archive, -- Remote source archive + Native -- Native platform package ); + subtype VCS_Kinds is Kinds range Git .. SVN; + + type Source_Archive_Format is (Unknown, Tarball, Zip_Archive); + subtype Known_Source_Archive_Format is + Source_Archive_Format range Tarball .. Source_Archive_Format'Last; + + Unknown_Source_Archive_Format_Error : exception; + type Origin is new Interfaces.Codifiable with private; function Kind (This : Origin) return Kinds; @@ -41,11 +51,18 @@ package Alire.Origins with Preelaborate is -- member data -- ------------------- - function Commit (This : Origin) return String with Pre => This.Kind in Git | Hg; - function URL (This : Origin) return Alire.URL with Pre => This.Kind in Git | Hg; + function Commit (This : Origin) return String with Pre => This.Kind in VCS_Kinds; + function URL (This : Origin) return Alire.URL with Pre => This.Kind in VCS_Kinds; function Path (This : Origin) return String with Pre => This.Kind = Filesystem; + function Archive_URL (This : Origin) return Alire.URL + with Pre => This.Kind = Source_Archive; + function Archive_Name (This : Origin) return String + with Pre => This.Kind = Source_Archive; + function Archive_Format (This : Origin) return Known_Source_Archive_Format + with Pre => This.Kind = Source_Archive; + function Is_Native (This : Origin) return Boolean is (This.Kind = Native); function Package_Name (This : Origin; Distribution : Platforms.Distributions) @@ -69,6 +86,22 @@ package Alire.Origins with Preelaborate is Commit : Hg_Commit) return Origin; + function New_SVN (URL : Alire.URL; Commit : String) return Origin; + + Unknown_Source_Archive_Name_Error : exception; + + function New_Source_Archive + (URL : Alire.URL; Name : String := "") return Origin; + -- Create a reference to a source archive to be downloaded and extracted. + -- URL is the address of the archive to download. Name is the name of the file to download. + -- + -- This raises an Unknown_Source_Archive_Format_Error exception when we + -- either cannot deduce the archive format from its filename or when the + -- archive format is unknown. + -- + -- If Name is omitted, it is tentatively inferred from URL. If it cannot be + -- inferred, this raises a Unknown_Source_Archive_Name_Error exception. + function New_Native (Packages : Native_Packages) return Origin; function Image (This : Origin) return String; @@ -90,63 +123,86 @@ private function Unavailable return Package_Names is (Name => Null_Unbounded_String); function Packaged_As (Name : String) return Package_Names is (Name => +Name); - type Origin is new Interfaces.Codifiable with record - Kind : Kinds; + type Origin_Data (Kind : Kinds := Kinds'First) is record + case Kind is + when Filesystem => + Path : Unbounded_String; - Commit : Unbounded_String; - URL : Unbounded_String; + when VCS_Kinds => + Repo_URL : Unbounded_String; + Commit : Unbounded_String; - Packages : Native_Packages; + when Source_Archive => + Archive_URL : Unbounded_String; + Archive_Name : Unbounded_String; + Archive_Format : Known_Source_Archive_Format; - Path : Unbounded_String; + when Native => + Packages : Native_Packages; + end case; end record; + type Origin is new Interfaces.Codifiable with record + Data : Origin_Data; + end record; + function New_Filesystem (Path : String) return Origin is - (Filesystem, - Path => +Path, - others => <>); + (Data => (Filesystem, Path => +Path)); function New_Git (URL : Alire.URL; Commit : Git_Commit) return Origin is - (Git, - URL => +URL, - Commit => +Commit, - others => <>); + (Data => (Git, +URL, +Commit)); function New_Hg (URL : Alire.URL; Commit : Hg_Commit) return Origin is - (Hg, - URL => +URL, - Commit => +Commit, - others => <>); + (Data => (Hg, +URL, +Commit)); + + function New_SVN (URL : Alire.URL; Commit : String) return Origin is + (Data => (SVN, +URL, +Commit)); function New_Native (Packages : Native_Packages) return Origin is - (Native, - Packages => Packages, - others => <>); + (Data => (Native, Packages)); - function Kind (This : Origin) return Kinds is (This.Kind); + function Kind (This : Origin) return Kinds is (This.Data.Kind); - function URL (This : Origin) return Alire.URL is (Alire.URL (+This.URL)); - function Commit (This : Origin) return String is (+This.Commit); + function URL (This : Origin) return Alire.URL is + (Alire.URL (+This.Data.Repo_URL)); + function Commit (This : Origin) return String is + (+This.Data.Commit); - function Path (This : Origin) return String is (+This.Path); + function Path (This : Origin) return String is (+This.Data.Path); + + function Archive_URL (This : Origin) return Alire.URL is + (+This.Data.Archive_URL); + function Archive_Name (This : Origin) return String is + (+This.Data.Archive_Name); + function Archive_Format (This : Origin) return Known_Source_Archive_Format + is (This.Data.Archive_Format); function Package_Name (This : Origin; Distribution : Platforms.Distributions) - return String is (+This.Packages (Distribution).Name); + return String is + (+This.Data.Packages (Distribution).Name); - function All_Native_Names (This : Origin) return Native_Packages is (This.Packages); + function All_Native_Names (This : Origin) return Native_Packages is + (This.Data.Packages); function S (Str : Unbounded_String) return String is (To_String (Str)); function Image (This : Origin) return String is (case This.Kind is - when Git | Hg => "commit " & S (This.Commit) & " from " & S (This.URL), - when Native => "native package from platform software manager", - when Filesystem => "path " & S (This.Path)); + when VCS_Kinds => + "commit " & S (This.Data.Commit) + & " from " & S (This.Data.Repo_URL), + when Source_Archive => + "source archive " & S (This.Data.Archive_Name) + & " at " & S (This.Data.Archive_URL), + when Native => + "native package from platform software manager", + when Filesystem => + "path " & S (This.Data.Path)); overriding function To_Code (This : Origin) return Utils.String_Vector is (if This.Kind = Filesystem diff --git a/src/alire-releases.ads b/src/alire-releases.ads index 765b3927..ebdacec0 100644 --- a/src/alire-releases.ads +++ b/src/alire-releases.ads @@ -276,11 +276,14 @@ private (Utils.Head (+R.Project, Extension_Separator) & "_" & Image (R.Version) & "_" & (case R.Origin.Kind is - when Filesystem => "filesystem", - when Native => "native", - when Git | Hg => (if R.Origin.Commit'Length <= 8 - then R.Origin.Commit - else R.Origin.Commit (R.Origin.Commit'First .. R.Origin.Commit'First + 7)))); + when Filesystem => "filesystem", + when Native => "native", + when Source_Archive => "archive", + when Git | Hg => + (if R.Origin.Commit'Length <= 8 + then R.Origin.Commit + else R.Origin.Commit (R.Origin.Commit'First .. R.Origin.Commit'First + 7)), + when SVN => R.Origin.Commit)); function On_Platform_Actions (R : Release; P : Alire.Properties.Vector) return Alire.Properties.Vector is (R.On_Platform_Properties (P, Actions.Action'Tag));