[Pkg-ocaml-maint-commits] r2337 - trunk/projects/backport

[Stefano Zacchiroli]

Author: zack
Date: 2005-12-28 13:51:16 +0000 (Wed, 28 Dec 2005)
New Revision: 2337

Modified:
   trunk/projects/backport/
   trunk/projects/backport/backport.ml
   trunk/projects/backport/deblib_Files.ml
   trunk/projects/backport/deblib_Files.mli
   trunk/projects/backport/deblib_Get.ml
Log:
snapshot



Property changes on: trunk/projects/backport
___________________________________________________________________
Name: svn:ignore
   + *.a
*.annot
backport
backport.opt
bpo_version
bpo_version.opt
*.cma
*.cmi
*.cmo
*.cmx
*.cmxa
*.sw*


Modified: trunk/projects/backport/backport.ml
===================================================================
--- trunk/projects/backport/backport.ml	2005-12-27 22:53:29 UTC (rev 2336)
+++ trunk/projects/backport/backport.ml	2005-12-28 13:51:16 UTC (rev 2337)
@@ -67,7 +67,7 @@
   let suffixes = [ ".dsc"; ".tar.gz"; ".diff.gz" ] in
   let ic = Unix.open_process_in (sprintf "apt-cache showsrc %s" pkg) in
   let lexbuf = Lexing.from_channel ic in
-  let showsrc = Deblib_Utils.parse822 lexbuf in
+  let showsrc = Deblib_Utils.parse_822 lexbuf in
   ignore (Unix.close_process_in ic);
   match showsrc with
   | [ entry ] ->

Modified: trunk/projects/backport/deblib_Files.ml
===================================================================
--- trunk/projects/backport/deblib_Files.ml	2005-12-27 22:53:29 UTC (rev 2336)
+++ trunk/projects/backport/deblib_Files.ml	2005-12-28 13:51:16 UTC (rev 2337)
@@ -4,7 +4,7 @@
 
 open Printf
 
-exception Malformed of string
+exception Malformed of string * string
 
 let underscore_regexp = Str.regexp "_"
 
@@ -14,10 +14,10 @@
       Filename.chop_suffix s suffix,
       Filename.check_suffix s alt_suffix
     else
-      raise (Malformed s) in
+      raise (Malformed (suffix, s)) in
   match Str.split underscore_regexp s with
   | [name; version] -> name, version, alt
-  | _ -> raise (Malformed s)
+  | _ -> raise (Malformed (suffix, s))
 
 let to_string_gen suffix alt_suffix source version alt =
   sprintf "%s_%s%s" source (Deblib_Version.to_string version)
@@ -68,3 +68,35 @@
     to_string_gen ".tar.gz" ".orig.tar.gz" t.source t.version (not t.native)
 end
 
+module Debcontrol =
+struct
+  type t = {
+    source: Deblib_Types.stanza;
+    packages: Deblib_Types.stanza list;
+  }
+
+  let malformed fname = raise (Malformed ("debian/control", fname))
+
+  let parse_file fname =
+    let stanzas = Deblib_Utils.parse_822_file fname in
+    let rec aux src pkgs =
+      function
+        | [] -> src, List.rev pkgs
+        | stanza :: tl when Hashtbl.mem stanza "Source" ->
+            (match src with
+            | Some _ -> malformed fname
+            | None -> aux (Some stanza) pkgs tl)
+        | stanza :: tl when Hashtbl.mem stanza "Package" ->
+            aux src (stanza :: pkgs) tl
+        | _ -> malformed fname in
+    match aux None [] stanzas with
+    | Some src, (_ :: _ as pkgs) -> { source = src; packages = pkgs }
+    | _ -> malformed fname
+
+  let find_package t name =
+    List.find
+      (fun stanza ->
+        try Hashtbl.find stanza "Package" = name with Not_found -> false)
+      t.packages
+end
+

Modified: trunk/projects/backport/deblib_Files.mli
===================================================================
--- trunk/projects/backport/deblib_Files.mli	2005-12-27 22:53:29 UTC (rev 2336)
+++ trunk/projects/backport/deblib_Files.mli	2005-12-28 13:51:16 UTC (rev 2337)
@@ -2,9 +2,11 @@
  * License: GUN GPL 2
  *)
 
-exception Malformed of string
+  (** entity type, raw value
+   * examples of entity types: ".dsc", ".diff.gz", "debian/control", ... *)
+exception Malformed of string * string
 
-(** {2 .dsc files} *)
+(** {2 .dsc file names} *)
 
 module Dsc:
 sig
@@ -17,7 +19,7 @@
   val to_string: t -> string
 end
 
-(** {2 .tar.gz files} *)
+(** {2 .tar.gz file names} *)
 
 module Tar:
 sig
@@ -31,7 +33,7 @@
   val to_string: t -> string
 end
 
-(** {2 .diff.gz files} *)
+(** {2 .diff.gz file names} *)
 
 module Diff:
 sig
@@ -44,3 +46,26 @@
   val to_string: t -> string
 end
 
+(** {2 debian/control files} *)
+
+module Debcontrol:
+sig
+  type t = {
+    (* TODO both fields may be refined according to the policy description of
+     * debian/control format *)
+    source: Deblib_Types.stanza;
+    packages: Deblib_Types.stanza list;
+  }
+
+  val parse_file : string -> t
+
+(*   val to_string : t -> string *)
+  (* TODO
+   * the annoying part: pretty printing of Descritpion according to debian
+   * policy rules ... *)
+
+    (** lookup by name (i.e. "Package" field)
+     * @raise Not_found *)
+  val find_package: t -> string -> Deblib_Types.stanza
+end
+

Modified: trunk/projects/backport/deblib_Get.ml
===================================================================
--- trunk/projects/backport/deblib_Get.ml	2005-12-27 22:53:29 UTC (rev 2336)
+++ trunk/projects/backport/deblib_Get.ml	2005-12-28 13:51:16 UTC (rev 2337)
@@ -16,7 +16,7 @@
   close_out oc;
   name
 
-let parse822url url =
+let parse_822_url url =
   let tempfile = retrieve_to_tmp url in
   let ic, close_fun =
     match url with
@@ -28,11 +28,11 @@
         (fun ic -> ignore (Unix.close_process_in ic))
     | url -> open_in tempfile, close_in in
   let lexbuf = Lexing.from_channel ic in
-  let res = Deblib_Utils.parse822 lexbuf in
+  let res = Deblib_Utils.parse_822 lexbuf in
   close_fun ic;
   Sys.remove tempfile;
   res
 
-let src_tbl_of_url url = Deblib_Utils.src_tbl_of_stanza_list (parse822url url)
-let bin_tbl_of_url url = Deblib_Utils.bin_tbl_of_stanza_list (parse822url url)
+let src_tbl_of_url url = Deblib_Utils.src_tbl_of_stanza_list (parse_822_url url)
+let bin_tbl_of_url url = Deblib_Utils.bin_tbl_of_stanza_list (parse_822_url url)