(* Copyright 2005-2008 Jaap BOENDER.

This file is part of Dose2.

Dose2 is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
the Free Software Foundation; either version 3 of the License, or
(at your option) any later version.

Dose2 is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public License
along with Dose2; if not, write to the Free Software
Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
*)

open Napkin

let compare_versions (v1: string) (v2: string): int =
let split_version (v: string): string * string * string =
let split_epoch (v: string): string * string =
begin
	try
		let colon_index = String.index v ':' in
			(String.sub v 0 colon_index, String.sub v (colon_index+1) ((String.length v)-colon_index-1)) 
	with
		Not_found -> ("0", v)
end
and split_release (v: string): string * string =
begin
	try
		let hyphen_index = String.rindex v '-' in
			(String.sub v 0 hyphen_index, String.sub v (hyphen_index+1) ((String.length v)-hyphen_index-1))
	with
		Not_found -> (v, "")
end in
begin
	let (epoch, rest) = split_epoch v in
	let (upstream, release) = split_release rest in
		(epoch, upstream, release)
end in
let rec get_chunk (s: string): string * string =
let chunk = ref "" 
and rest = ref "" in
begin
	Scanf.sscanf s "%_[^0-9a-zA-Z]%[0-9]%s%!" (fun x y -> chunk := x; rest := y);
	if !chunk = "" then (* no numeric chunk *)
		Scanf.sscanf s "%_[^0-9a-zA-Z]%[a-zA-Z]%s%!" (fun x y -> chunk := x; rest := y);
	(!chunk, !rest)
end in
let compare_ztrange (s1: string) (s2: string): int =
begin
  if String.contains "0123456789" s1.[0] then (* s1 is numeric *)
    1 (* s2 cannot be numeric *)
  else (* s1 is NOT numeric *)
  begin
    if String.contains "0123456789" s2.[0] then (* s2 is numeric *)
      -1
    else
      compare s1 s2
  end
end in
let rec compare_chunky (s1: string) (s2: string): int =
let (c1, r1) = get_chunk s1
and (c2, r2) = get_chunk s2 in
begin
	if c1 = "" && r1 = "" && c2 = "" && r2 = "" then 0
	else if c1 = "" && c2 <> "" then -1 
	else if c1 <> "" && c2 = "" then 1
	else if c1 = c2 then compare_chunky r1 r2
	else
		let res = try
			compare (int_of_string c1) (int_of_string c2)
		with Failure _ -> compare_ztrange c1 c2 in
		if res = 0 then compare_chunky r1 r2
		else res
end in
let (e1, u1, r1) = split_version v1
and (e2, u2, r2) = split_version v2 in
begin
	let epochs = compare (int_of_string e1) (int_of_string e2) in
	if epochs = 0 then
	begin
		let upstreams = compare_chunky u1 u2 in
		if upstreams = 0 then
		begin
			if r1 = "" then 0
			else if r2 = "" then 0
			else compare_chunky r1 r2
		end
		else upstreams
	end
	else
	  epochs
end;;

let add_file_provides (progress: Progress.indicator) (pkgs: package_with_files list): package_with_files list =
let is_file_dependency p = p.[0] = '/' in
let i = ref 0
and n = 2 * (List.length pkgs) in
begin
	progress#set_label "Adding file provides...";
	let filedep_ht = Hashtbl.create (List.length pkgs) in
	(* Scour packages for file dependencies *)
	List.iter (fun pkg ->
		progress#display (!i, n);
		List.iter (fun disj ->
			List.iter (fun dep ->
				match dep with
				| Unit_version (target, _) -> if is_file_dependency target then
						Hashtbl.add filedep_ht target (pkg.pk_unit, pkg.pk_version)
				| Glob_pattern _ -> raise (Failure "RPM does not support glob patterns")
			) disj
		) pkg.pk_depends;
		List.iter (fun disj ->
			List.iter (fun dep ->
				match dep with
				| Unit_version (target, _) -> if is_file_dependency target then
						Hashtbl.add filedep_ht target (pkg.pk_unit, pkg.pk_version)
				| Glob_pattern _ -> raise (Failure "RPM does not support glob patterns")
			) disj
		) pkg.pk_pre_depends;
		List.iter (fun disj ->
			List.iter (fun dep ->
				match dep with
				| Unit_version (target, _) -> if is_file_dependency target then
						Hashtbl.add filedep_ht target (pkg.pk_unit, pkg.pk_version)
				| Glob_pattern _ -> raise (Failure "RPM does not support glob patterns")
			) disj
		) pkg.pk_recommends;
		List.iter (fun disj ->
			List.iter (fun dep ->
				match dep with
				| Unit_version (target, _) -> if is_file_dependency target then
						Hashtbl.add filedep_ht target (pkg.pk_unit, pkg.pk_version)
				| Glob_pattern _ -> raise (Failure "RPM does not support glob patterns")
			) disj
		) pkg.pk_suggests;
		List.iter (fun disj ->
			List.iter (fun dep ->
				match dep with
				| Unit_version (target, _) -> if is_file_dependency target then
						Hashtbl.add filedep_ht target (pkg.pk_unit, pkg.pk_version)
				| Glob_pattern _ -> raise (Failure "RPM does not support glob patterns")
			) disj
		) pkg.pk_enhances;
		List.iter (fun dep ->
			match dep with
			| Unit_version (target, _) -> if is_file_dependency target then
					Hashtbl.add filedep_ht target (pkg.pk_unit, pkg.pk_version)
			| Glob_pattern _ -> raise (Failure "RPM does not support glob patterns")
		) pkg.pk_replaces;
		List.iter (fun dep ->
			match dep with
			| Unit_version (target, _) -> if is_file_dependency target then
					Hashtbl.add filedep_ht target (pkg.pk_unit, pkg.pk_version)
			| Glob_pattern _ -> raise (Failure "RPM does not support glob patterns")
		) pkg.pk_conflicts;
		incr i;
	) pkgs;
	(* Now add explicit file provides, but only for files that are needed *)
	List.map (fun pkg ->
		progress#display (!i, n);
		let extra_provides = List.flatten (List.map (fun (fn, _) ->
			let providers = Hashtbl.find_all filedep_ht fn in
			match providers with
			| [] -> []
			| _ -> [Unit_version (fn, Sel_ANY)]
		) pkg.pk_extra) in
		(incr i; { pkg with pk_provides = pkg.pk_provides @ extra_provides })
	) pkgs 
end;;

let add_file_conflicts (progress: Progress.indicator) (pkgs: package_with_files list): package_with_files list
=
let f_ht = Hashtbl.create (List.length pkgs * 12) in
let i = ref 0
and n = List.length pkgs in
begin
	progress#set_label "Adding file conflicts...";
	List.map (fun pkg ->
		progress#display (!i, n);
		let cfl = ref [] in
		List.iter (fun (fn, _) ->
			if fn.[String.length fn - 1] <> '/' then
			begin
				match Hashtbl.find_all f_ht fn with
				| [] -> Hashtbl.add f_ht fn pkg
				| l -> 
					begin
						cfl := List.map (fun pkg' ->
							(* Printf.eprintf "[RPM] Adding file conflict for %s between %s and %s\n%!" fn pkg.pk_unit pkg'.pk_unit; *)
							Unit_version (pkg'.pk_unit, Sel_EQ pkg'.pk_version)
						) l;
						Hashtbl.add f_ht fn pkg
					end
			end
		) pkg.pk_extra;
		(incr i; { pkg with pk_conflicts = !cfl @ pkg.pk_conflicts })
	) pkgs;
end;;

external read_package: string -> string -> package_with_files =
	"ocamlrpm_read_package"
external read_hdlist: string -> string -> package_with_files list =
	"ocamlrpm_read_hdlist"

let read_synthesis_hdlist (file: string): package_with_files list =
let fc = open_in file in
let res = ref [] in
let at_regex = Pcre.regexp "@" in
  let get_package () =
  let fields = Hashtbl.create 10 in
    let treat_dependency s =
    begin
      try
        let ln = Pcre.split ~rex:at_regex (Hashtbl.find fields s) in
        List.map (fun d ->
          try
            Scanf.sscanf d "%[^[][%[^]]]" (fun n sel ->
              Unit_version (n,
              if sel = "*" then Sel_ANY
              else Scanf.sscanf sel "%s %s" (fun op req ->
                if op = "==" then Sel_EQ req
                else if op = "<" then Sel_LT req
                else if op = ">" then Sel_GT req
                else if op = "<=" then Sel_LEQ req
                else if op = ">=" then Sel_GEQ req
                else failwith (Printf.sprintf "Unknown version operator %s" op))
              )
            )
          with End_of_file -> Unit_version (d, Sel_ANY)
        ) ln;
      with Not_found -> []
    end in
  let line = ref (input_line fc) in
  let field = ref "" in
  let data = ref "" in
  begin
    let first_at = String.index_from !line 1 '@' in
    field := String.sub !line 1 (first_at-1);
    data := String.sub !line (first_at+1) (String.length !line-first_at-1);
    while !field <> "info"
    do
      Hashtbl.add fields !field !data;
      line := input_line fc;
      let first_at = String.index_from !line 1 '@' in
      field := String.sub !line 1 (first_at-1);
      data := String.sub !line (first_at+1) (String.length !line-first_at-1);
    done;
    Scanf.sscanf !data "%s@@%d@@%Ld%s"
      (fun nvra epoch size _ ->
        let ra = String.rindex nvra '.' in
        let vr = String.rindex_from nvra (ra-1) '-' in
        let nv = String.rindex_from nvra (vr-1) '-' in
        let name = String.sub nvra 0 nv
        and version = String.sub nvra (nv+1) (vr-nv-1)
        and release = String.sub nvra (vr+1) (ra-vr-1)
        and arch = String.sub nvra (ra+1) (String.length nvra-ra-1) in
        { pk_unit = name;
          pk_version =
            (if epoch <> 0 then Printf.sprintf "%d:%s-%s" epoch version release
            else Printf.sprintf "%s-%s" version release);
          pk_architecture = arch;
          pk_source = (name, "");
          pk_size = 
            (try
              Int64.of_string (Hashtbl.find fields "filesize")
            with Not_found -> 0L);
          pk_installed_size = size;
          pk_provides = treat_dependency "provides";
          pk_depends = 
            List.map (fun x -> [x]) (treat_dependency "requires");
          pk_pre_depends = [];
          pk_conflicts = treat_dependency "conflicts";
          pk_breaks = [];
          pk_replaces = treat_dependency "obsoletes";
          pk_suggests = 
            List.map (fun x -> [x]) (treat_dependency "suggests");
          pk_recommends = [];
          pk_enhances = [];
          pk_essential = false;
          pk_build_essential = false;
          pk_extra = []
        }
      )
  end in
begin
  try
    while true
    do
      res := (get_package ())::!res
    done;
    !res
  with End_of_file -> !res
end;;
