Register playlists parsers before executing playlist.parse. (#3561) (#…

…3564)
savonet · Nov 27, 2023 · f44be68 · f44be68
1 parent bbd89ba
commit f44be68
Show file tree

Hide file tree

Showing 9 changed files with 188 additions and 58 deletions.
diff --git a/CHANGES.md b/CHANGES.md
@@ -6,6 +6,12 @@ New:
   prevent telnet commands registration (#3545)
 - Added `file.touch`
 
+Changed:
+
+- BREAKING: `setting.playlists` has been renamed
+  `setting.playlist`, `settings.playlist.mime_types`
+  now refers to a full list of records (#3561)
+
 Fixed:
 
 - Cleanup telnet commands on output shutdown,
@@ -14,6 +20,8 @@ Fixed:
 - Allow overwrite in youtube-dl/yt-dlp call,
   remove use of unix-specific process call.
   (#3563)
+- Fixed playlist parsers not being registered
+  when evaluatin top-level script (#3553)
 
 ---
 

diff --git a/src/core/builtins/builtins_resolvers.ml b/src/core/builtins/builtins_resolvers.ml
@@ -58,6 +58,28 @@ let _ =
       Plug.register Request.mresolvers format ~doc:"" resolver;
       Lang.unit)
 
+let add_playlist_parser ~format name (parser : Playlist_parser.parser) =
+  let return_t = Lang.list_t (Lang.product_t Lang.metadata_t Lang.string_t) in
+  Lang.add_builtin ~base:Builtins_sys.playlist_parse name ~category:`Liquidsoap
+    ~descr:(Printf.sprintf "Parse %s playlists" format)
+    [
+      ("", Lang.string_t, None, Some "Playlist file");
+      ( "pwd",
+        Lang.nullable_t Lang.string_t,
+        Some Lang.null,
+        Some "Current directory to use for relative file path." );
+    ]
+    return_t
+    (fun p ->
+      let uri = Lang.to_string (List.assoc "" p) in
+      let pwd = Lang.to_valued_option Lang.to_string (List.assoc "pwd" p) in
+      let entries = parser ?pwd uri in
+      Lang.list
+        (List.map
+           (fun (metadata, uri) ->
+             Lang.product (Lang.metadata_list metadata) (Lang.string uri))
+           entries))
+
 let _ =
   let playlist_t = Lang.list_t (Lang.product_t Lang.metadata_t Lang.string_t) in
   let parser_t =

diff --git a/src/core/dune b/src/core/dune
@@ -198,7 +198,6 @@
   pipe
   pipe_output
   pitch
-  playlist_basic
   playlist_parser
   plug
   pool
@@ -285,6 +284,7 @@
   builtins_process
   builtins_request
   builtins_resolvers
+  playlist_basic
   builtins_runtime
   builtins_server
   builtins_settings
@@ -725,7 +725,7 @@
 
 (library
  (name liquidsoap_xmlplaylist)
- (libraries xmlplaylist liquidsoap_core)
+ (libraries xmlplaylist liquidsoap_core liquidsoap_builtins)
  (library_flags -linkall)
  (wrapped false)
  (optional)

diff --git a/src/core/playlist_parser.ml b/src/core/playlist_parser.ml
@@ -24,26 +24,12 @@
 
 let log = Log.make ["playlist parser"]
 
-let conf_playlists =
-  Dtools.Conf.void ~p:(Configure.conf#plug "playlists") "Playlist formats"
-
-let conf_mime_types =
-  Dtools.Conf.void
-    ~p:(conf_playlists#plug "mime_types")
-    "Mime-types used for guessing playlist formats."
-    ~comments:
-      [
-        "When a mime-type is available (e.g. with input.http), it can be used";
-        "to guess which playlist format to use.";
-        "This section contains the listings used for that detection, which you";
-        "might want to tweak if you encounter a new mime-type.";
-        "If you feel that new mime-types should be permanently added, please";
-        "contact the developers.";
-      ]
+let conf_playlist =
+  Dtools.Conf.void ~p:(Configure.conf#plug "playlist") "Playlist formats"
 
 let conf_cue_in_metadata =
   Dtools.Conf.string
-    ~p:(conf_playlists#plug "cue_in_metadata")
+    ~p:(conf_playlist#plug "cue_in_metadata")
     ~d:"liq_cue_in" "Cue in metadata for playlists with track index."
     ~comments:
       [
@@ -59,7 +45,7 @@ let conf_cue_in_metadata =
 
 let conf_cue_out_metadata =
   Dtools.Conf.string
-    ~p:(conf_playlists#plug "cue_out_metadata")
+    ~p:(conf_playlist#plug "cue_out_metadata")
     ~d:"liq_cue_out" "Cue out metadata for playlists with track index."
     ~comments:
       [
@@ -76,13 +62,15 @@ let conf_cue_out_metadata =
 (** A playlist is list of metadatas,uri *)
 type playlist = ((string * string) list * string) list
 
+type parser = ?pwd:string -> string -> playlist
+
 (** A plugin is a boolean and a parsing function *)
 type plugin = {
+  (* true if the format can be automatically detected *)
   strict : bool;
-  (* true is the format can be detected *)
-  parser : ?pwd:string -> string -> playlist;
-      (* The parser is expected to respect the order
-         of the files in the playlist. *)
+  (* The parser is expected to respect the order
+     of the files in the playlist. *)
+  parser : parser;
 }
 
 (** Parsers are given a string and return a list of metadatas,uri, if possible. *)

diff --git a/src/core/playlists/playlist_basic.ml b/src/core/playlists/playlist_basic.ml
@@ -289,14 +289,8 @@ let parse_cue ?pwd string =
   in
   export_tracks [] sheet.tracks
 
-let () =
-  Plug.register Playlist_parser.parsers "audio/x-scpls" ~doc:""
-    { Playlist_parser.strict = true; Playlist_parser.parser = parse_scpls };
-  Plug.register Playlist_parser.parsers "application/x-cue" ~doc:""
-    { Playlist_parser.strict = true; Playlist_parser.parser = parse_cue };
-  Plug.register Playlist_parser.parsers "audio/x-mpegurl" ~doc:""
-    { Playlist_parser.strict = false; Playlist_parser.parser = parse_mpegurl };
-  Plug.register Playlist_parser.parsers "audio/mpegurl" ~doc:""
-    { Playlist_parser.strict = false; Playlist_parser.parser = parse_mpegurl };
-  Plug.register Playlist_parser.parsers "application/x-mpegURL" ~doc:""
-    { Playlist_parser.strict = false; Playlist_parser.parser = parse_mpegurl }
+let _ =
+  Builtins_resolvers.add_playlist_parser ~format:"SCPLS" "scpls" parse_scpls
+
+let _ = Builtins_resolvers.add_playlist_parser ~format:"CUE" "cue" parse_cue
+let _ = Builtins_resolvers.add_playlist_parser ~format:"M3U" "m3u" parse_mpegurl
diff --git a/src/core/playlists/playlist_xml.ml b/src/core/playlists/playlist_xml.ml
@@ -22,22 +22,6 @@
 
 let log = Log.make ["playlist"; "xml"]
 
-let conf_xml =
-  Dtools.Conf.list
-    ~p:(Playlist_parser.conf_mime_types#plug "xml")
-    ~d:
-      [
-        "video/x-ms-asf";
-        "audio/x-ms-asx";
-        "text/xml";
-        "application/xml";
-        "application/smil";
-        "application/smil+xml";
-        "application/xspf+xml";
-        "application/rss+xml";
-      ]
-    "Mime types associated to XML-based playlist formats"
-
 let tracks ?pwd s =
   try
     let recode_metas m =
@@ -51,10 +35,4 @@ let tracks ?pwd s =
     log#debug "Parsing failed: %s" (Xmlplaylist.string_of_error e);
     raise (Xmlplaylist.Error e)
 
-let register mimetype =
-  Plug.register Playlist_parser.parsers mimetype ~doc:""
-    { Playlist_parser.strict = true; Playlist_parser.parser = tracks }
-
-let () =
-  Lifecycle.on_start ~name:"playlist parsers registration" (fun () ->
-      List.iter register conf_xml#get)
+let _ = Builtins_resolvers.add_playlist_parser ~format:"XML" "xml" tracks
diff --git a/src/libs/playlist.liq b/src/libs/playlist.liq
@@ -1,3 +1,74 @@
+let settings.playlist.mime_types =
+  settings.make.void(
+    "Mime-types used for guessing playlist formats."
+  )
+
+let settings.playlist.mime_types.basic =
+  settings.make(
+    description=
+      "Mime-types used for guessing text-based playlists.",
+    [
+      {mime="audio/x-scpls", strict=true, parser=playlist.parse.scpls},
+      {mime="application/x-cue", strict=true, parser=playlist.parse.cue},
+      {mime="audio/x-mpegurl", strict=false, parser=playlist.parse.m3u},
+      {mime="audio/mpegurl", strict=false, parser=playlist.parse.m3u},
+      {mime="application/x-mpegURL", strict=false, parser=playlist.parse.m3u}
+    ]
+  )
+
+%ifdef playlist.parse.xml
+let settings.playlist.mime_types.xml =
+  settings.make(
+    description=
+      "Mime-types used for guessing xml-based playlists.",
+    list.map(
+      (fun (mime) -> {mime=mime, strict=true, parser=playlist.parse.xml}),
+      [
+        "video/x-ms-asf",
+        "audio/x-ms-asx",
+        "text/xml",
+        "application/xml",
+        "application/smil",
+        "application/smil+xml",
+        "application/xspf+xml",
+        "application/rss+xml"
+      ]
+    )
+  )
+%endif
+
+# @flag hidden
+let register_playlist_parsers =
+  begin
+    registered = ref(false)
+    fun () ->
+      begin
+        if
+          not registered()
+        then
+          parsers = settings.playlist.mime_types.basic()
+%ifdef playlist.parse.xml
+          parsers = [...parsers, ...settings.playlist.mime_types.xml()]
+%endif
+          list.iter(
+            fun (entry) ->
+              playlist.parse.register(
+                format=entry.mime, strict=entry.strict, entry.parser
+              ),
+            parsers
+          )
+        end
+        registered := true
+      end
+  end
+on_start(register_playlist_parsers)
+
+# @docof playlist.parse
+def replaces playlist.parse(%argsof(playlist.parse), uri) =
+  register_playlist_parsers()
+  playlist.parse(%argsof(playlist.parse), uri)
+end
+
 # Default id assignment for playlists (the identifier is generated from the
 # filename).
 # @category Liquidsoap

diff --git a/tests/regression/3553.liq b/tests/regression/3553.liq
@@ -0,0 +1,55 @@
+playlist_content =
+  '<?xml version="1.0" encoding="UTF-8"?>
+<playlist xmlns="http://xspf.org/ns/0/" xmlns:vlc="http://www.videolan.org/vlc/playlist/ns/0/" version="1">
+        <title>Playlist</title>
+        <trackList>
+                <track>
+                        <location>file:///C:/Users/user/Music/testing/test-file-1.ogg</location>
+                        <title>Very good song</title>
+                        <annotation>Other</annotation>
+                        <duration>61445</duration>
+                </track>
+                <track>
+                        <location>file:///C:/Users/user/Music/testing/test-file-2.ogg</location>
+                        <duration>1240</duration>
+                </track>
+        </trackList>
+</playlist>'
+
+expected_content =
+  [
+    (
+      [
+        ("location", "file:///C:/Users/user/Music/testing/test-file-1.ogg"),
+        (
+          "title",
+          "Very good song"
+        ),
+        ("annotation", "Other"),
+        ("duration", "61445")
+      ],
+      "file:///C:/Users/user/Music/testing/test-file-1.ogg"
+    ),
+    (
+      [
+        ("location", "file:///C:/Users/user/Music/testing/test-file-2.ogg"),
+        ("duration", "1240")
+      ],
+      "file:///C:/Users/user/Music/testing/test-file-2.ogg"
+    )
+  ]
+
+playlist_file = file.temp("playlist", ".xspf")
+
+file.write(data=playlist_content, playlist_file)
+
+on_cleanup({file.remove(playlist_file)})
+
+playlist_content = playlist.parse(playlist_file)
+
+def f() =
+  test.equals(playlist_content, expected_content)
+  test.pass()
+end
+
+test.check(f)
diff --git a/tests/regression/dune.inc b/tests/regression/dune.inc
@@ -25,6 +25,20 @@
   (:run_test ../run_test.exe))
  (action (run %{run_test} 115-2.liq liquidsoap %{test_liq} 115-2.liq)))
 
+(rule
+ (alias citest)
+ (package liquidsoap)
+ (deps
+  3553.liq
+  ../media/all_media_files
+  ../../src/bin/liquidsoap.exe
+  ../streams/file1.png
+  (package liquidsoap)
+  (:stdlib ../../src/libs/stdlib.liq)
+  (:test_liq ../test.liq)
+  (:run_test ../run_test.exe))
+ (action (run %{run_test} 3553.liq liquidsoap %{test_liq} 3553.liq)))
+
 (rule
  (alias citest)
  (package liquidsoap)