-- music123 by
-- David Starner <dvdeug@debian.org>
-- Xavier Grave <xavier.grave@csnsm.in2p3.fr>
-- Nicolas Boulenguez <nicolas@debian.org>
with Ada.Characters.Latin_1;
with Ada.Command_Line;
with Ada.Containers.Indefinite_Hashed_Maps;
with Ada.Containers.Indefinite_Vectors;
with Ada.Directories;
use all type Ada.Directories.Directory_Entry_Type;
use all type Ada.Directories.File_Kind;
use all type Ada.Directories.Search_Type;
with Ada.Environment_Variables;
with Ada.Numerics.Float_Random;
use all type Ada.Numerics.Float_Random.Generator;
with Ada.Strings.Fixed;
with Ada.Strings.Hash;
with Ada.Strings.Maps;
use all type Ada.Strings.Maps.Character_Set;
with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
with Ada.Strings.Unbounded;
use all type Ada.Strings.Unbounded.Unbounded_String;
with Ada.Text_IO;
with Interfaces.C.Strings;
procedure Music123 is
Version_Number : constant String := "16.5";
System_Configuration : constant String := "/etc/music123rc";
User_Configuration : constant String := ".music123rc";
-- User_Configuration is relative to the HOME directory.
----------------------------------------------------------------------
-- Interface with C.
C_Error : exception;
-- Used to report errors at the C level.
LC_ALL : constant := 6;
-- Quite arbitrary, but has been working for years, and gcc is not
-- able to generate such values yet.
-- From locale.h:
procedure Setlocale (Category : Interfaces.C.int;
Locale : String);
-- From libintl.h:
procedure Textdomain (Domainname : String);
procedure Bindtextdomain (Domainname : String;
Dirname : String);
function "+" (Msgid : String) return String; -- gettext
-- From stdlib.h:
procedure System (Command : String);
----------------------------------------------------------------------
-- Error reporting
Error : exception; -- Report and set exit status.
procedure Warn (Message : String); -- Report but continue.
----------------------------------------------------------------------
-- Random numbers
Generator : Ada.Numerics.Float_Random.Generator;
function Random (Maximum : Positive) return Positive
with Post => Random'Result in 1 .. Maximum;
----------------------------------------------------------------------
-- Types
type An_Option_List is record
Catch_Q_In_Stdin : Boolean := False;
Delay_Length : Duration := 0.5;
Eternal_Random : Boolean := False;
Ignore_Extension_Case : Boolean := False;
List_Files_Only : Boolean := False;
Quiet : Boolean := False;
Random : Boolean := False;
Recurse : Boolean := False;
Repeat : Boolean := False;
end record;
package Tool_Maps is new Ada.Containers.Indefinite_Hashed_Maps
(Key_Type => String,
Element_Type => String,
Hash => Ada.Strings.Hash,
Equivalent_Keys => "=");
-- For each known extension, store to the first matching tool in
-- the configuration file. The element contains the name of the
-- program followed by the options.
package String_Vectors is new Ada.Containers.Indefinite_Vectors
(Index_Type => Positive,
Element_Type => String);
package String_Sorting is new String_Vectors.Generic_Sorting ("<");
procedure Parse_Command_Line (Paths : in out String_Vectors.Vector;
Options : in out An_Option_List;
Done : out Boolean);
-- The options are transmitted so that the extensions are
-- translated to lower case if necessary.
procedure Parse_Configuration (Tools : in out Tool_Maps.Map;
Options : An_Option_List);
-- Ignore directories (unless Options.Recurse), special files, or
-- files without matching command in Tools.
-- For selected paths, construct a shell script playing the song
-- and append it to Commands.
-- If Options.List_Files_Only, then Commands are not modified but
-- selected paths are printed instead.
procedure Add_Command (Commands : in out String_Vectors.Vector;
Path : String;
Tools : Tool_Maps.Map;
Options : An_Option_List);
procedure Randomize (Commands : in out String_Vectors.Vector);
procedure Play_Songs (Commands : String_Vectors.Vector;
Options : An_Option_List);
----------------------------------------------------------------------
-- Implementations
function "+" (Msgid : String) return String is
use Interfaces.C, Interfaces.C.Strings;
function F (A1 : char_array := To_C (Msgid)) return chars_ptr
with Import, Convention => C, External_Name => "gettext";
Ret : constant chars_ptr := F;
begin
if Ret = Null_Ptr then
raise C_Error with "gettext failed";
end if;
return Value (Ret);
end "+";
procedure Bindtextdomain (Domainname : String;
Dirname : String) is
use Interfaces.C, Interfaces.C.Strings;
function F (A1 : char_array := To_C (Domainname);
A2 : char_array := To_C (Dirname)) return chars_ptr
with Import, Convention => C, External_Name => "bindtextdomain";
begin
if F = Null_Ptr then
raise C_Error with "bindtextdomain failed";
end if;
end Bindtextdomain;
procedure Add_Command (Commands : in out String_Vectors.Vector;
Path : String;
Tools : Tool_Maps.Map;
Options : An_Option_List) is
procedure Process_Directory;
procedure Process_Ordinary_File;
procedure Process_Directory is
Search : Ada.Directories.Search_Type;
Directory_Entry : Ada.Directories.Directory_Entry_Type;
More_Paths : String_Vectors.Vector;
begin
begin
Start_Search (Search, Directory => Path, Pattern => "");
exception
when Ada.Directories.Name_Error =>
Warn (+"Empty directory: " & Path);
return;
when Ada.Directories.Use_Error =>
Warn (+"Not allowed to enter directory: " & Path);
return;
end;
while More_Entries (Search) loop
Get_Next_Entry (Search, Directory_Entry);
-- Ignore . .. and more generally hidden files.
declare
S : constant String := Simple_Name (Directory_Entry);
begin
if S /= "" and then S (S'First) /= '.' then
More_Paths.Append (Full_Name (Directory_Entry));
end if;
end;
end loop;
-- Make the order independant from the underlying file system.
String_Sorting.Sort (String_Vectors.Vector (More_Paths));
for New_Path of More_Paths loop
Add_Command (Commands, New_Path, Tools, Options);
end loop;
end Process_Directory;
procedure Process_Ordinary_File is
Ext : constant String := Ada.Directories.Extension (Path);
Key : constant String
:= (if Options.Ignore_Extension_Case
then Ada.Strings.Fixed.Translate (Ext, Lower_Case_Map)
else Ext);
Position : constant Tool_Maps.Cursor := Tools.Find (Key);
Buffer : Ada.Strings.Unbounded.Unbounded_String;
begin
if not Tool_Maps.Has_Element (Position) then
Warn (+"Unknown extension: " & Path);
elsif Options.List_Files_Only then
Ada.Text_IO.Put_Line (Path);
else
Set_Unbounded_String (Buffer, Tools (Position));
Append (Buffer, " '");
for Char of Path loop
if Char = ''' then
Append (Buffer, "'\''");
else
Append (Buffer, Char);
end if;
end loop;
Append (Buffer, ''');
if Options.Quiet then
Append (Buffer, " > /dev/null");
end if;
if Options.Catch_Q_In_Stdin then
Append (Buffer, " < /dev/null");
end if;
Commands.Append (To_String (Buffer));
end if;
end Process_Ordinary_File;
begin
if Ada.Directories.Exists (Path) then
case Kind (Path) is
when Special_File =>
Warn (+"Not an ordinary file: " & Path);
when Directory =>
if Options.Recurse then
Process_Directory;
else
Warn (+"Directory: " & Path);
end if;
when Ordinary_File =>
Process_Ordinary_File;
end case;
else
Warn (+"No such file: " & Path);
end if;
end Add_Command;
procedure Parse_Command_Line (Paths : in out String_Vectors.Vector;
Options : in out An_Option_List;
Done : out Boolean) is
procedure Display_Help;
procedure Display_Version;
procedure Read_Playlist (Path : String);
procedure Read_Playlist_Line (Line : String);
procedure Set_Delay (Value : String);
procedure Display_Help is
use Ada.Text_IO;
begin
Put_Line
(+"Usage: music123 [-DhiLlqrvZz] [-d ARG] [-@ ARG] [--] files ...");
Put_Line (+"-z Shuffle list before playing");
Put_Line (+"-l Loop when reaching end of playlist");
Put_Line (+"-Z Play randomly. Never stop");
New_Line;
Put_Line (+"-r Recurse over directories");
Put_Line (+"-@ ARG Add lines of ARG to files");
Put_Line (+"-- Following arguments are files, not options");
Put_Line (+"-i Ignore case of file extensions (.OGG = .ogg)");
Put_Line (+"-L List files and exit. No music");
New_Line;
Put_Line (+"-q Run quietly");
Put_Line (+"-d ARG Delay ARG seconds between songs (default: 0.5)");
Put_Line (+"-D Shortcut for -d 0");
Put_Line (+"-T Catch q key to quit after current song");
New_Line;
Put_Line (+"-v Print version information");
Put_Line (+"-h Print this help");
New_Line;
Put_Line (+"See the manpage for more options.");
end Display_Help;
procedure Display_Version is
-- Translate the format, then replace the major version.
Format : constant String := +"music123 version %d by David Starner";
I : constant Positive := Ada.Strings.Fixed.Index (Format, "%d");
begin
Ada.Text_IO.Put_Line
(Ada.Strings.Fixed.Replace_Slice (Source => Format,
Low => I,
High => I + 1,
By => Version_Number));
end Display_Version;
procedure Read_Playlist (Path : String) is
use Ada.Text_IO;
Playlist : Ada.Text_IO.File_Type;
begin
begin
Open (Playlist, In_File, Path);
exception
when others =>
raise Error with +"Playlist file not found.";
end;
while not End_Of_File (Playlist) loop
Read_Playlist_Line (Get_Line (Playlist));
end loop;
Close (Playlist);
exception
when others =>
if Is_Open (Playlist) then
Close (Playlist);
end if;
raise Error with +"unable to parse playlist: " & Path;
end Read_Playlist;
procedure Read_Playlist_Line (Line : String) is
Path : constant String
:= Ada.Strings.Fixed.Trim (Line, Ada.Strings.Both);
begin
if Path /= "" and then Path (Path'First) /= '#' then
Paths.Append (Path);
end if;
end Read_Playlist_Line;
procedure Set_Delay (Value : String) is
begin
Options.Delay_Length := Duration'Value (Value);
exception
when Constraint_Error =>
raise Error with +"Bad argument for -d.";
end Set_Delay;
use Ada.Command_Line;
Arg_Num : Positive := 1;
Ignore_Options : Boolean := False;
begin
while Arg_Num <= Argument_Count loop
declare
Arg : String renames Argument (Arg_Num);
-- The reference manual guarantees that Arg'First = 1.
begin
if Ignore_Options or else Arg'Last < 2 or else Arg (1) /= '-' then
Paths.Append (Arg);
else
Letters : for I in 2 .. Arg'Last loop
case Arg (I) is
when '-' =>
if Arg'Last /= 2 then
raise Error with +"Unknown option: -";
end if;
Ignore_Options := True;
when '@' =>
if I < Arg'Last then
Read_Playlist (Arg (I + 1 .. Arg'Last));
exit Letters;
elsif Arg_Num < Argument_Count then
Arg_Num := Arg_Num + 1;
Read_Playlist (Argument (Arg_Num));
else
raise Error with +"Missing argument for: -" & "@";
end if;
when 'D' =>
Options.Delay_Length := 0.0;
when 'd' =>
if I < Arg'Last then
Set_Delay (Arg (I + 1 .. Arg'Last));
exit Letters;
elsif Arg_Num < Argument_Count then
Arg_Num := Arg_Num + 1;
Set_Delay (Argument (Arg_Num));
else
raise Error with +"Missing argument for -" & "d";
end if;
when 'h' =>
Display_Version;
Display_Help;
Done := True;
return;
when 'i' =>
Options.Ignore_Extension_Case := True;
when 'L' =>
Options.List_Files_Only := True;
when 'l' =>
Options.Repeat := True;
when 'q' =>
Options.Quiet := True;
when 'r' =>
Options.Recurse := True;
when 'T' =>
Options.Catch_Q_In_Stdin := True;
when 'v' =>
Display_Version;
Done := True;
return;
when 'Z' =>
Options.Eternal_Random := True;
when 'z' =>
Options.Random := True;
when others =>
raise Error with +"Unknown option: " & Arg (I);
end case;
end loop Letters;
end if;
end;
Arg_Num := Arg_Num + 1;
end loop;
Done := False;
end Parse_Command_Line;
procedure Parse_Configuration (Tools : in out Tool_Maps.Map;
Options : An_Option_List) is
procedure Parse_File (Path : String);
procedure Parse_Line (Line : String);
procedure Parse_File (Path : String) is
use Ada.Text_IO;
File : File_Type;
begin
Open (File, In_File, Path);
while not End_Of_File (File) loop
Parse_Line (Get_Line (File));
end loop;
Close (File);
exception
when others =>
if Is_Open (File) then
Close (File);
end if;
Warn (+"error in configuration file: " & Path);
raise;
end Parse_File;
procedure Parse_Line (Line : String) is
HT : Character renames Ada.Characters.Latin_1.HT;
Outside : Ada.Strings.Membership renames Ada.Strings.Outside;
Whitespace : constant Ada.Strings.Maps.Character_Set
:= To_Set (Sequence => (' ', HT));
T_F, T_L, P_F, P_L, E_F, E_L, O_F, O_L : Integer;
use Ada.Strings.Fixed;
begin
Find_Token (Line, Whitespace, Outside, T_F, T_L);
if T_L = 0 -- Line only contains blanks.
or else Line (T_F) = '#' -- Comment.
then
return;
elsif Line (T_F .. T_L) /= "tool" -- Unexpected keyword.
or else T_L = Line'Last -- Only "tool"
then
Warn (+"suspicious configuration line: " & Line);
return;
end if;
Find_Token (Line, Whitespace, T_L + 1, Outside, P_F, P_L);
if P_L = 0 or else P_L = Line'Last then
Warn (+"suspicious configuration line::" & Line);
return;
end if;
Find_Token (Line, Whitespace, P_L + 1, Outside, E_F, E_L);
if E_L = 0 or else E_L = Line'Last then
Warn (+"suspicious configuration line::" & Line);
return;
end if;
O_F := Index (Line, Whitespace, E_L + 1, Outside);
if O_F = 0 or else O_F = Line'Last or else Line (O_F) /= '"' then
Warn (+"suspicious configuration line::" & Line);
return;
end if;
O_L := Index (Line, """", O_F + 1);
if O_L = 0
or else (for some I in O_L + 1 .. Line'Last =>
not Is_In (Line (I), Whitespace))
then
Warn (+"suspicious configuration line::" & Line);
return;
end if;
-- Now, split the extension list.
declare
Tool : constant String
:= Line (P_F .. P_L) & ' ' & Line (O_F + 1 .. O_L - 1);
Position : Tool_Maps.Cursor;
Inserted : Boolean;
First : Positive := E_F;
Last : Natural;
begin
loop
if E_L < First or else Line (First) = ',' then
Warn (+"suspicious configuration line::" & Line);
return;
end if;
Last := First;
while Last < E_L and then Line (Last + 1) /= ',' loop
Last := Last + 1;
end loop;
Tools.Insert
(Key => (if Options.Ignore_Extension_Case
then Translate (Line (First .. Last),
Lower_Case_Map)
else (Line (First .. Last))),
New_Item => Tool,
Position => Position,
Inserted => Inserted);
if not Inserted then
Warn (+"multiple tools given for extension: "
& Line (First .. Last));
end if;
exit when Last = E_L;
First := Last + 2;
end loop;
end;
end Parse_Line;
begin
if Ada.Environment_Variables.Exists ("HOME") then
declare
Home : constant String := Ada.Environment_Variables.Value ("HOME");
Path : constant String
:= Ada.Directories.Compose (Home, User_Configuration);
begin
if Ada.Directories.Exists (Path) then
Parse_File (Path);
return;
end if;
end;
else
Warn (+"variable HOME not found in the environment");
end if;
if Ada.Directories.Exists (System_Configuration) then
Parse_File (System_Configuration);
return;
end if;
raise Error with +"No configuration file found: " & User_Configuration
& ", " & System_Configuration;
end Parse_Configuration;
procedure Play_Songs (Commands : String_Vectors.Vector;
Options : An_Option_List) is
I : Positive := (if Options.Eternal_Random
then Random (Commands.Last_Index) else 1);
Available : Boolean;
Key : Character;
begin
Songs : loop
if not Options.Quiet then
Ada.Text_IO.New_Line;
Ada.Text_IO.Put_Line (+"music123 is running: " & Commands (I));
Ada.Text_IO.Put_Line (+"Control-c : quit immediately");
if Options.Catch_Q_In_Stdin then
Ada.Text_IO.Put_Line (+"q : quit after this song");
end if;
Ada.Text_IO.New_Line;
end if;
System (Commands (I));
if Options.Catch_Q_In_Stdin then
loop
Ada.Text_IO.Get_Immediate (Key, Available);
exit when not Available;
exit Songs when Key in 'q' | 'Q';
end loop;
end if;
if Options.Eternal_Random then
I := Random (Commands.Last_Index);
elsif I = Commands.Last_Index then
exit Songs when not Options.Repeat;
I := 1;
else
I := I + 1;
end if;
-- Only delay if there is a next song.
delay Options.Delay_Length;
end loop Songs;
end Play_Songs;
function Random (Maximum : Positive) return Positive is
-- From ARM A.5.2.51.
(Integer (Float (Maximum) * Random (Generator)) mod Maximum + 1);
procedure Randomize (Commands : in out String_Vectors.Vector) is
begin
-- From Knuth, TAOCP vol. 2, edition 3, page 146, 3.4.2, algorithm P
for J in reverse 2 .. Commands.Last_Index loop
Commands.Swap (J, Random (J - 1));
end loop;
end Randomize;
procedure Setlocale (Category : Interfaces.C.int;
Locale : String) is
use Interfaces.C, Interfaces.C.Strings;
function F (A1 : int := Category;
A2 : char_array := To_C (Locale)) return chars_ptr
with Import, Convention => C, External_Name => "setlocale";
begin
if F = Null_Ptr then
raise C_Error with "setlocale failed";
end if;
end Setlocale;
procedure System (Command : String) is
use Interfaces.C;
function F (A1 : char_array := To_C (Command)) return int
with Import, Convention => C, External_Name => "system";
begin
if F /= 0 then
raise C_Error with "subprocess failed: " & Command;
end if;
end System;
procedure Textdomain (Domainname : String) is
use Interfaces.C, Interfaces.C.Strings;
function F (A1 : char_array := To_C (Domainname)) return chars_ptr
with Import, Convention => C, External_Name => "textdomain";
begin
if F = Null_Ptr then
raise C_Error with "textdomain failed";
end if;
end Textdomain;
procedure Warn (Message : String) is
begin
Ada.Text_IO.Put_Line (Ada.Text_IO.Standard_Error, Message);
end Warn;
----------------------------------------------------------------------
Paths : String_Vectors.Vector;
Options : An_Option_List;
Done : Boolean;
Tools : Tool_Maps.Map;
Commands : String_Vectors.Vector;
begin
Setlocale (LC_ALL, "");
Textdomain ("music123");
Bindtextdomain ("music123", "/usr/share/locale");
Reset (Generator);
Parse_Command_Line (Paths, Options, Done);
if Done then
return;
end if;
Parse_Configuration (Tools, Options);
for Path of Paths loop
Add_Command (Commands, Path, Tools, Options);
end loop;
if Options.List_Files_Only then
return;
elsif Commands.Is_Empty then
raise Error with +"No valid filenames found.";
end if;
if Options.Random then
Randomize (Commands);
end if;
Play_Songs (Commands, Options);
end Music123;