Le mardi 23 mars 2010 04:29:21, David Baelde a écrit :
> Hi,
Hi !
> Thanks for the patch, I think it's a good way to go.
Thanks for the review !
> I read it, a
> couple remarks:
>
> - The main remark is that I would have thought that post-processors
> can be kept local to the resolution loop, no need to store them in the
> request. This could be done perhaps more easily (and more elegantly
> than accumulating continuations in a list ref) by using a recursive
> function instead of a while.
I have done this.
> - Forcing temporary to false in annotate is useless, and meaningless
> if the argument URI is not a file.
I do not understand very well this parameter, it seems it describe wether the
request can be kept or should be revoled each time one need it. Can you
describe a bit more ?
> - In the Lang API I would prefer two functions, add_protocol as
> before and the new post-process: this would avoid the string
> (possibility of a typo hard to catch) and allow different types (e.g.
> tell the post-processor if it's working on a temporary file or not).
I have done:
- add_file_resolver
- add_post_processor
I believe it is more relevant that way..
> - Same thing in the ML API (i.e. in Request), where it would seem
> better to start with type protocol = (Resolver of ... | Post-processor
> of ...).
I am not sure to undertand this very well..
> - I'm not sure about the addition of new status: post-proc could be
> part of Resolving. This seems harmless, but note that it indirectly
> changes the server API, since it introduces non-destroyed non-idle
> requests that won't be found in "request.resolving" for a while
> (post-proc could be long).
Done as well..
Please find an updated patch attached.
Romain
Index: scripts/utils.liq
===================================================================
--- scripts/utils.liq (révision 7225)
+++ scripts/utils.liq (copie de travail)
@@ -487,13 +487,48 @@
extract_replaygain = "#{configure.libdir}/extract-replaygain"
x = get_process_lines("#{extract_replaygain} #{quote(arg)}")
if list.hd(x) != "" then
- ["annotate:replay_gain=\"#{list.hd(x)}\":#{arg}"]
+ ([arg],[("replay_gain",list.hd(x))])
else
- [arg]
+ ([arg],[])
end
end
-add_protocol("replay_gain", replaygain_protocol)
+add_post_processor("replay_gain", temporary = false, replaygain_protocol)
+# Register the cut protocol
+def cut_protocol(arg,delay)
+ # The extraction program
+ cut_file = "#{configure.libdir}/cut-file"
+ # Parse args
+ ret = string.extract(pattern="cut_start=(\d+)",arg)
+ start =
+ if list.length(ret) == 0 then
+ "0"
+ else
+ ret["1"]
+ end
+ ret = string.extract(pattern="cut_stop=(\d+)",arg)
+ stop =
+ if list.length(ret) == 0 then
+ "0"
+ else
+ ret["1"]
+ end
+ ret = string.extract(pattern=":(.*)$",arg)
+ uri =
+ if list.length(ret) == 0 then
+ ""
+ else
+ ret["1"]
+ end
+ x = get_process_lines("#{cut_file} #{quote(uri)} #{start} #{stop}")
+ if list.hd(x) != "" then
+ ([list.hd(x)],[])
+ else
+ ([uri],[])
+ end
+end
+add_post_processor("cut_file", temporary=true, cut_protocol)
+
# Enable replay gain metadata resolver. This resolver will
# process any file decoded by liquidsoap and add a @replay_gain@
# metadata when this value could be computed. For a finer-grained
Index: scripts/cut-file
===================================================================
--- scripts/cut-file (révision 0)
+++ scripts/cut-file (révision 0)
@@ -0,0 +1,87 @@
+#!/usr/bin/perl -w
+
+use strict ;
+
+my $file = $ARGV[0] || die ;
+
+my $start = $ARGV[1] || "0" ;
+
+my $stop = $ARGV[2] || "0" ;
+
+sub mktemp {
+ my $file = `mktemp --tmpdir --suffix=".osb" "liqXXXX"`;
+ $file =~ s/\n//;
+ $file;
+}
+
+my $out_file = mktemp();
+
+sub test_mime {
+ my $file = shift ;
+ if (`which file`) {
+ return `file -b --mime-type "$file"`;
+ }
+}
+
+if (($file =~ /\.mp3$/i) || (test_mime($file) =~ /audio\/mpeg/)) {
+
+ if (`which cutmp3`) {
+
+ my $start_option = "00:00";
+ my $stop_option = "99999:0";
+
+ if ($start ne "0") {
+ $start_option = "00:$start"
+ }
+
+ if ($stop ne "0") {
+ $stop_option = "00:$stop"
+ }
+
+ system("nice -n 20 cutmp3 -c -q -a $start_option -b $stop_option -O \"$out_file\" -i \"$file\" >/dev/null 2>\&1");
+
+ } else {
+
+ print STDERR "Cannot find cutmp3 binary!\n";
+ system("cp \"$file\" \"$out_file\"");
+
+ }
+
+} elsif (($file =~ /\.ogg$/i) || (test_mime($file) =~ /application\/ogg/)) {
+
+ if (`which vcut`) {
+
+ my $start_file = $file;
+
+ # Cut beginning
+ if ($start ne "0") {
+ $start_file = mktemp();
+ system("nice -n 20 vcut \"$file\" /dev/null \"$start_file\" +$start >/dev/null 2>\&1");
+ }
+
+ # Cut end
+ if ($stop ne "0") {
+ system("nice -n 20 vcut \"$start_file\" \"$out_file\" /dev/null +$stop >/dev/null 2>\&1");
+ system("rm -f \"$start_file\"");
+ } else {
+ if ("$start_file" ne "$file") {
+ system("mv $start_file $out_file");
+ }
+ }
+
+ } else {
+
+ print STDERR "Cannot find vcut binary!\n";
+ system("cp \"$file\" \"$out_file\"");
+
+ }
+
+} else {
+
+ print STDERR "File format not supported...\n";
+ system("cp \"$file\" \"$out_file\"");
+
+}
+
+print "$out_file\n";
+
Modification de propriétés sur scripts/cut-file
___________________________________________________________________
Ajouté : svn:executable
+ *
Index: scripts/Makefile
===================================================================
--- scripts/Makefile (révision 7221)
+++ scripts/Makefile (copie de travail)
@@ -1,6 +1,6 @@
DISTFILES = $(wildcard *.in) Makefile ask-liquidsoap.rb ask-liquidsoap.pl \
- $(wildcard *.liq) extract-replaygain
+ $(wildcard *.liq) extract-replaygain cut-file
top_srcdir = ..
include $(top_srcdir)/Makefile.rules
Index: src/protocols/annotate.ml
===================================================================
--- src/protocols/annotate.ml (révision 7226)
+++ src/protocols/annotate.ml (copie de travail)
@@ -55,7 +55,8 @@
| _ -> raise Error
in
let metadata,uri = parse [] in
- [Request.indicator ~metadata:(Utils.hashtbl_of_list metadata) uri]
+ [Request.indicator ~temporary:false
+ ~metadata:(Utils.hashtbl_of_list metadata) uri]
with
| Error
| Stream.Failure | Stream.Error _ -> log "annotate: syntax error" ; []
@@ -64,4 +65,6 @@
Request.protocols#register "annotate"
~sdoc:("[annotate:key=\"val\",key2=\"val2\",...:uri] adds "^
"the metadata to the request and is then resolved into uri")
- { Request.resolve = annotate ; Request.static = false }
+ { Request.resolve = annotate ;
+ Request.static = false ;
+ Request.protocol_type = Request.Post_processor }
Index: src/protocols/say.ml
===================================================================
--- src/protocols/say.ml (révision 7226)
+++ src/protocols/say.ml (copie de travail)
@@ -83,7 +83,9 @@
Request.protocols#register
~sdoc:"Speech synthesis, with optional voice choice using say:voice/blah."
"say"
- { Request.resolve = say ; Request.static = true }
+ { Request.resolve = say ;
+ Request.static = true ;
+ Request.protocol_type = Request.Resolver }
let time arg ~log timeout =
let tm = Unix.localtime (Unix.gettimeofday ()) in
@@ -101,4 +103,6 @@
"time"
~sdoc:("Speech synthesis of a message where $(time) is replaced by "^
"the current time")
- { Request.resolve = time ; Request.static = false }
+ { Request.resolve = time ;
+ Request.static = false ;
+ Request.protocol_type = Request.Resolver }
Index: src/protocols/lastfm_req.ml
===================================================================
--- src/protocols/lastfm_req.ml (révision 7226)
+++ src/protocols/lastfm_req.ml (copie de travail)
@@ -38,4 +38,6 @@
let () =
Request.protocols#register "lastfm"
~sdoc:("Play a song on last.fm.")
- { Request.resolve = lastfm ; Request.static = false }
+ { Request.resolve = lastfm ;
+ Request.static = false ;
+ Request.protocol_type = Request.Resolver }
Index: src/protocols/mpd.ml
===================================================================
--- src/protocols/mpd.ml (révision 7226)
+++ src/protocols/mpd.ml (copie de travail)
@@ -160,4 +160,6 @@
Request.protocols#register "mpd"
~sdoc:("[mpd:tag=\"value\"] finds all files with a tag equal " ^
"to a given value using mpd.")
- { Request.resolve = mpd ; Request.static = false }
+ { Request.resolve = mpd ;
+ Request.static = false ;
+ Request.protocol_type = Request.Resolver }
Index: src/protocols/extproto.ml
===================================================================
--- src/protocols/extproto.ml (révision 7226)
+++ src/protocols/extproto.ml (copie de travail)
@@ -89,7 +89,8 @@
~sdoc:(Printf.sprintf "Fetch files using %S." prog)
proto
{ Request.resolve = resolve proto prog command ;
- Request.static = false })
+ Request.static = false ;
+ Request.protocol_type = Request.Resolver })
protos
with
| Not_found ->
Index: src/request.mli
===================================================================
--- src/request.mli (révision 7226)
+++ src/request.mli (copie de travail)
@@ -92,9 +92,20 @@
* At each step [protocol.resolve first_uri timeout] is called,
* and the function is expected to push the new URIs in the request. *)
+(** A protocol is one of:
+ * - Resolver: returns a fresh local file, e.g. file:, ftp:, http: ...
+ * - Post_processor: operates on a fresh file, possibly creating a
+ * new file. URIs for post_processors are of the form:
+ * protocol:(args:)next_uri where next_uri defines the file
+ * on which the post_processor will operate. A post-processing
+ * operator should return a temporary indicator iff it creates
+ * a new file. In this case, it *must* always create a new file. *)
+type protocol_type = Resolver | Post_processor
+
type protocol = {
- resolve : string -> log:(string->unit) -> float -> indicator list ;
- static : bool
+ resolve : string -> log:(string->unit) -> float -> indicator list ;
+ static : bool ;
+ protocol_type : protocol_type
}
(** A static request [r] is such that every resolving leads to the same file.
Index: src/lang/lang_builtins.ml
===================================================================
--- src/lang/lang_builtins.ml (révision 7226)
+++ src/lang/lang_builtins.ml (copie de travail)
@@ -216,13 +216,13 @@
Request.mresolvers#register format resolver ;
Lang.unit)
-let () =
+let protocol_op name descr protocol_type =
let protocol_t =
Lang.fun_t
[false,"",Lang.string_t ; false,"",Lang.float_t]
- (Lang.list_t Lang.string_t)
+ (Lang.product_t (Lang.list_t Lang.string_t) Lang.metadata_t)
in
- add_builtin "add_protocol" ~cat:Liq ~descr:"Register a new protocol."
+ add_builtin name ~cat:Liq ~descr
["temporary",Lang.bool_t,Some (Lang.bool false),
Some "if true, file removed when it is finished.";
"",Lang.string_t,None,None ;
@@ -234,6 +234,7 @@
let temporary = Lang.to_bool (List.assoc "temporary" p) in
Request.protocols#register name
{ Request.static = false ;
+ Request.protocol_type = protocol_type ;
Request.resolve =
fun arg ~log timeout ->
let l =
@@ -241,12 +242,24 @@
f ["",Lang.string arg;
"",Lang.float timeout]
in
+ let indicators,metadata =
+ Lang.to_product l
+ in
+ let metadata = Lang.to_metadata metadata in
List.map
(fun s ->
- Request.indicator ~temporary (Lang.to_string s))
- (Lang.to_list l) } ;
+ Request.indicator ~temporary ~metadata (Lang.to_string s))
+ (Lang.to_list indicators) } ;
Lang.unit)
+let () =
+ protocol_op "add_file_resolver"
+ "Register a new protocol to resolve new files."
+ Request.Resolver ;
+ protocol_op "add_post_processor"
+ "Register a new protocol to process resolved files."
+ Request.Post_processor
+
let () =
let t = "",Lang.int_t,None,None in
add_builtin "time_in_mod" ~cat:Other ~flags:[Lang.Hidden]
Index: src/request.ml
===================================================================
--- src/request.ml (révision 7226)
+++ src/request.ml (copie de travail)
@@ -184,6 +184,12 @@
metadata : metadata
}
+type post_processor = {
+ protocol : string ;
+ parameters : string ;
+ handler : string -> log:(string->unit) -> float -> indicator list
+}
+
type status = Idle | Resolving | Ready | Playing | Destroyed
type t = {
@@ -336,13 +342,7 @@
let hd = List.hd l in
add_log t (Printf.sprintf "Pushed [%S;...]." hd.string) ;
t.indicators <- l::t.indicators ;
- t.decoder <- None ;
- (* Performing a local check is quite fast and allows the request
- * to be instantly available if it is only made of valid local files,
- * without any need for a resolution process. *)
- (* TODO sometimes it's not that fast actually, and it'd be nice
- * to be able to disable this check in some cases, like playlist.safe. *)
- local_check t
+ t.decoder <- None
let is_ready t =
t.indicators <> [] &&
@@ -512,9 +512,12 @@
(** Plugins registration. *)
+type protocol_type = Resolver | Post_processor
+
type protocol = {
- resolve : string -> log:(string->unit) -> float -> indicator list ;
- static : bool ;
+ resolve : string -> log:(string->unit) -> float -> indicator list ;
+ static : bool ;
+ protocol_type : protocol_type
}
let protocols_doc =
@@ -543,41 +546,121 @@
t.resolving <- Some (Unix.time ()) ;
t.status <- Resolving ;
let maxtime = (Unix.time ()) +. timeout in
- let resolve_step () =
- let i = peek_indicator t in
- (* If the file is local we only need to check that it's valid,
- * we'll actually do that in a single local_check for all local indicators
- * on the top of the stack. *)
- if Sys.file_exists i.string then local_check t else
- let proto,arg = parse_uri i.string in
- match protocols#get proto with
- | Some handler ->
- add_log t
- (Printf.sprintf
- "Resolving %S (timeout %.fs)..."
- i.string timeout) ;
- let production = handler.resolve ~log:(add_log t) arg maxtime in
+ let rec resolve_step post_processors =
+ let timeleft = maxtime -. (Unix.time ()) in
+ if timeleft > 0. then
+ begin
+ let i = peek_indicator t in
+ (* If the file is local we only need to check that it's valid,
+ * we'll actually do that in a single local_check for all local indicators
+ * on the top of the stack. *)
+ if Sys.file_exists i.string then post_processors else
+ let proto,arg = parse_uri i.string in
+ match protocols#get proto with
+ | Some handler ->
+ begin
+ match handler.protocol_type with
+ | Resolver ->
+ add_log t
+ (Printf.sprintf
+ "Resolving %S (timeout %.fs)..."
+ i.string timeout) ;
+ let production = handler.resolve ~log:(add_log t) arg
+ maxtime
+ in
+ if production = [] then begin
+ log#f 4
+ "Failed to resolve %S! \
+ For more info, see server command 'trace %d'."
+ i.string t.id ;
+ ignore (pop_indicator t)
+ end else
+ push_indicators t production ;
+ resolve_step post_processors
+ | Post_processor ->
+ (* Retrieve parameters *)
+ let params,next =
+ let x = parse_uri arg in
+ if x = ("","") then
+ "",arg
+ else
+ x
+ in
+ let parameters =
+ if params = "" then "no parameters"
+ else Printf.sprintf "parameters %s" params
+ in
+ add_log t
+ (Printf.sprintf
+ "Adding post-process %s with %s..."
+ proto parameters) ;
+ (* Push the next part *)
+ push_indicators t [ { string = next ;
+ temporary = false ;
+ metadata = Hashtbl.create 0 }] ;
+ resolve_step ({ protocol = proto ;
+ parameters = params ;
+ handler = handler.resolve }
+ :: post_processors)
+ end
+ | None ->
+ add_log t "Unknown protocol!" ;
+ pop_indicator t ;
+ post_processors
+ end
+ else
+ ( add_log t "Global timeout." ; raise ExnTimeout )
+ in
+ let rec post_process post_processors =
+ let timeleft = maxtime -. (Unix.time ()) in
+ if timeleft > 0. then
+ begin
+ let i = peek_indicator t in
+ match post_processors with
+ | [] -> local_check t
+ | processor::rem ->
+ let uri =
+ if processor.parameters <> "" then
+ (Printf.sprintf "%s:%s") processor.parameters i.string
+ else
+ i.string
+ in
+ add_log t
+ (Printf.sprintf
+ "Post-processing %s with post_processor %s..."
+ uri processor.protocol) ;
+ let production = processor.handler ~log:(add_log t) uri maxtime in
+ begin
if production = [] then begin
log#f 4
- "Failed to resolve %S! \
+ "Failed to post-process %s:%s! \
For more info, see server command 'trace %d'."
- i.string t.id ;
- ignore (pop_indicator t)
+ processor.protocol uri t.id ;
end else
- push_indicators t production
- | None ->
- add_log t "Unknown protocol!" ;
- pop_indicator t
+ begin
+ (* Merge old metadata with new metadata *)
+ let merge x y =
+ Hashtbl.iter (Hashtbl.add x) y ;
+ x
+ in
+ let production =
+ List.map
+ (fun x -> { x with metadata = merge x.metadata i.metadata })
+ production
+ in
+ push_indicators t production
+ end
+ end ;
+ post_process rem
+ end
+ else
+ ( add_log t "Global timeout." ; raise ExnTimeout )
in
let result =
try
- while not (is_ready t) do
- let timeleft = maxtime -. (Unix.time ()) in
- if timeleft > 0. then
- resolve_step ()
- else
- ( add_log t "Global timeout." ; raise ExnTimeout )
- done ;
+ let post_processors = resolve_step [] in
+ (* Apply post_processors *)
+ post_process post_processors ;
Resolved
with
| ExnTimeout -> Timeout
Index: Makefile
===================================================================
--- Makefile (révision 7221)
+++ Makefile (copie de travail)
@@ -76,6 +76,7 @@
$(INSTALL_DIRECTORY) $(libdir)/liquidsoap/$(libs_dir_version)
$(INSTALL_PROGRAM) scripts/liquidtts $(libdir)/liquidsoap/$(libs_dir_version)
$(INSTALL_PROGRAM) scripts/extract-replaygain $(libdir)/liquidsoap/$(libs_dir_version)
+ $(INSTALL_PROGRAM) scripts/cut-file $(libdir)/liquidsoap/$(libs_dir_version)
$(INSTALL_DATA) scripts/utils.liq $(libdir)/liquidsoap/$(libs_dir_version)
$(INSTALL_DIRECTORY) ${sysconfdir}/liquidsoap
$(INSTALL_DATA) examples/radio.liq \
------------------------------------------------------------------------------
Download Intel® Parallel Studio Eval
Try the new software tools for yourself. Speed compiling, find bugs
proactively, and fine-tune applications for parallel performance.
See why Intel Parallel Studio got high marks during beta.
http://p.sf.net/sfu/intel-sw-dev
_______________________________________________
Savonet-devl mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/savonet-devl
