Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
[config] opam config -subst <file>+ work
The 'substs' file in .opam works as well (ie. it substitutes the right file before calling the build commands).
  • Loading branch information
samoht committed May 11, 2012
1 parent b6a3646 commit 8c20b57
Show file tree
Hide file tree
Showing 6 changed files with 108 additions and 17 deletions.
53 changes: 38 additions & 15 deletions src/client.ml
Expand Up @@ -337,6 +337,28 @@ let get_archive t nv =
Filename.link src dst;
dst

(* Return the contents of a fully qualified variable *)
let contents_of_variable t v =
let name = Full_variable.package v in
let var = Full_variable.variable v in
let _nv =
try find_package_from_name name t.installed
with Not_found ->
Globals.error_and_exit "Package %s is not installed" (N.to_string name) in
let c = File.Dot_config.safe_read (Path.C.config t.compiler name) in
try match Full_variable.section v with
| None -> File.Dot_config.variable c var
| Some s -> File.Dot_config.Sections.variable c s var
with Not_found ->
Globals.error_and_exit "%s is not defined" (Full_variable.to_string v)

(* Substitute the file contents *)
let substitute_file t f =
let src = Filename.add_extension f "in" in
let contents = File.Subst.read src in
let newcontents = File.Subst.replace contents (contents_of_variable t) in
File.Subst.write f newcontents

let proceed_tochange t nv_old nv =
(* First, uninstall any previous version *)
(match nv_old with
Expand All @@ -348,8 +370,15 @@ let proceed_tochange t nv_old nv =
Dirname.rmdir p_build;
Filename.extract (get_archive t nv) p_build;

(* Call the build script and copy the output files *)
(* OPAM files should be read in the right directory to get the
correct absolute path for the substitution files *)
Dirname.chdir (Path.C.build t.compiler nv);
let opam = File.OPAM.read (Path.G.opam t.global nv) in

(* Substitute the configuration files *)
List.iter (substitute_file t) (File.OPAM.substs opam);

(* Call the build script and copy the output files *)
let commands =
List.map
(fun cmd -> String.concat " " (List.map (Printf.sprintf "'%s'") cmd))
Expand Down Expand Up @@ -574,10 +603,12 @@ let upload upload repo =
Filename.remove upload_descr;
Filename.remove upload_archives

module FC = File.Dot_config

let config request =
log "config %s" (string_of_config request);
let t = load_state () in
let module FC = File.Dot_config in

match request with
(* List all the available variables *)
| List_vars ->
Expand Down Expand Up @@ -608,21 +639,13 @@ let config request =
(Full_variable.to_string fv)
(string_of_variable_contents contents)
) (List.rev variables)

| Variable v ->
let name = Full_variable.package v in
let var = Full_variable.variable v in
let _nv =
try find_package_from_name name t.installed
with Not_found ->
Globals.error_and_exit "Package %s is not installed" (N.to_string name) in
let c = FC.safe_read (Path.C.config t.compiler name) in
let contents =
try match Full_variable.section v with
| None -> FC.variable c var
| Some s -> FC.Sections.variable c s var
with Not_found ->
Globals.error_and_exit "%s is not defined" (Full_variable.to_string v) in
let contents = contents_of_variable t v in
Globals.msg "%s\n" (string_of_variable_contents contents)

| Subst fs -> List.iter (substitute_file t) fs

| _ -> failwith "TODO"

(*
Expand Down
47 changes: 47 additions & 0 deletions src/file.ml
Expand Up @@ -594,6 +594,48 @@ module Dot_config = struct
module Sections = MK (struct let get t = t.sections end)
end

module Subst = struct

let internal = "subst"

type t = Raw.t

let empty = Raw.of_string ""

let of_string filename str = str

let to_string filename t = t

let pcre_replace ~pat ~templ str =
let r = Re_perl.compile_pat pat in
let b = Buffer.create 1024 in
let rec loop pos =
if pos >= String.length str then
Buffer.contents b
else if Re.execp ~pos r str then (
let ss = Re.exec ~pos r str in
let start, fin = Re.get_ofs ss 0 in
let pat = Re.get ss 0 in
Buffer.add_substring b str pos (start - pos);
Buffer.add_string b (templ pat);
loop fin
) else (
Buffer.add_substring b str pos (String.length str - pos);
loop (String.length str)
)
in
loop 0

let replace t f =
let templ str =
let str = String.sub str 2 (String.length str - 4) in
let v = Full_variable.of_string str in
string_of_variable_contents (f v) in
let str = pcre_replace ~pat:"%\\{[^%]+\\}%" ~templ (Raw.to_string t) in
Raw.of_string str

end

end

module type F = sig
Expand Down Expand Up @@ -690,3 +732,8 @@ module Updated = struct
include Updated
include Make (Updated)
end

module Subst = struct
include Subst
include Make (Subst)
end
12 changes: 12 additions & 0 deletions src/file.mli
Expand Up @@ -176,3 +176,15 @@ module Repo_index: IO_FILE with type t = string N.Map.t

(** Repository config: [$opam/repo/$repo/config] *)
module Repo_config: IO_FILE with type t = repository

(** {2 Substitution files} *)

(** Substitution files *)
module Subst: sig

include IO_FILE

(** Substitute the variable appearing in a file *)
val replace: t -> (full_variable -> variable_contents) -> t

end
4 changes: 3 additions & 1 deletion src/opam.ml
Expand Up @@ -112,6 +112,7 @@ let specs = [
("-asmlink" , Arg.Unit (set `Asmlink) , " Display native link options");
("-list-vars", Arg.Unit (set `ListVars), " Display the contents of all available variables");
("-var" , Arg.Unit (set `Var) , " Display the content of a variable");
("-subst" , Arg.Unit (set `Subst) , " Substitute variables in files");
]
let args n =
(* XXX: big hack *)
Expand Down Expand Up @@ -142,7 +143,8 @@ let config = {
| Some `Var when List.length names = 1
-> Variable (Full_variable.of_string (List.hd names))
| Some `Var ->
bad_argument "config" "-var takes exactly one parameter" in
bad_argument "config" "-var takes exactly one parameter"
| Some `Subst -> Subst (List.map Filename.of_string names) in
Client.config config
}

Expand Down
6 changes: 5 additions & 1 deletion src/types.ml
Expand Up @@ -91,6 +91,7 @@ module Filename: sig
val write: t -> Raw.t -> unit
val exists: t -> bool
val check_suffix: t -> string -> bool
val add_extension: t -> string -> t
val list: dirname -> t list
val with_raw: (Raw.t -> 'a) -> t -> 'a
val copy_in: t -> dirname -> unit
Expand Down Expand Up @@ -140,6 +141,9 @@ end = struct
let check_suffix filename s =
F.check_suffix (to_string filename) s

let add_extension filename suffix =
of_string ((to_string filename) ^ "." ^ suffix)

let list d =
let fs = Run.files (Dirname.to_string d) in
List.map of_string fs
Expand Down Expand Up @@ -472,7 +476,7 @@ type config =
| List_vars
| Variable of full_variable
| Compil of rec_config_option
| Subst of Filename.t list
| Subst of filename list

let p msg l =
Printf.sprintf "%s %s"
Expand Down
3 changes: 3 additions & 0 deletions src/types.mli
Expand Up @@ -105,6 +105,9 @@ module Filename: sig
(** Check whether a file has a given suffix *)
val check_suffix: t -> string -> bool

(** Remove the file suffix *)
val add_extension: t -> string -> t

(** List all the filenames (ie. which are not directories) in a directory *)
val list: dirname -> t list

Expand Down

0 comments on commit 8c20b57

Please sign in to comment.