[Pkg-ocaml-maint-commits] r1003 - tools/show-ocaml-depends

[Sven Luther]

Author: luther
Date: 2005-03-17 16:41:58 +0100 (Thu, 17 Mar 2005)
New Revision: 1003

Added:
   tools/show-ocaml-depends/snapshot.ml
Log:
Added basic debian package snapshoting tool. Only outputs the description for
a given package right now.


Added: tools/show-ocaml-depends/snapshot.ml
===================================================================
--- tools/show-ocaml-depends/snapshot.ml	2005-03-17 15:33:13 UTC (rev 1002)
+++ tools/show-ocaml-depends/snapshot.ml	2005-03-17 15:41:58 UTC (rev 1003)
@@ -0,0 +1,152 @@
+let status_file = "/var/lib/dpkg/status"
+
+let status_fd = open_in status_file
+
+(*
+let line = input_line status_fd
+
+let () = Printf.printf "Line was : <%s>\n" line
+*)
+
+type field = {
+	name : string;
+	short : string;
+	long : string list;
+}
+
+type lines = Empty | Field of string * string list | Error of int * string
+
+(* Printing entries *)
+let rec print_field_multi_content = function 
+  | [] -> ()
+  | c::cs -> Printf.printf " %s\n" c; print_field_multi_content cs
+
+let print_field_content = function 
+  | [] -> Printf.printf "<Empty>"
+  | cs -> print_field_multi_content cs
+
+let print_entry e =
+  let rec print = function
+  | [] -> ()
+  | (f,cs)::es ->
+    Printf.printf "%s:" f;
+    print_field_content cs; 
+    print es
+  in
+  print e;
+  Printf.printf "\n"
+    
+(* Reading entries *)
+let read_field_name line =
+  try
+    let rec get_field pos =
+      match line.[pos] with
+      | ':' -> pos
+      | _ -> get_field (pos+1)
+    in
+    let pos = get_field 0 in
+    String.sub line 0 pos, pos+1
+  with e ->
+    Printf.printf "Line Field : <%s> \n Failed with exception %s\n" line (Printexc.to_string e);
+    raise e
+
+let read_field_content line pos =
+  let len = String.length line - pos - 1 in
+  if len > 0 then String.sub line (pos + 1) len
+  else ""
+
+let read_entry fd l =
+  let rec entry e l = 
+    let line = input_line fd in
+    try
+      match line.[0] with
+      | ' ' -> begin
+        let content = read_field_content line 0 in
+	match e with
+	| (f,cs)::es -> entry ((f,content::cs)::es) (l+1)
+	| [] ->
+	  Printf.eprintf "Line %d : Malformed line <%s>\n" l line;
+	  e, (l + 1)
+	end
+      | _ ->
+        let field, pos = read_field_name line in
+        let content = read_field_content line pos in
+        entry ((field,[content])::e) (l+1)
+    with Invalid_argument ("index out of bounds") ->
+      e, (l + 1)
+    | e ->
+      Printf.printf "Line %d : <%s>\n Failed with exception %s\n"
+        l line (Printexc.to_string e);
+      raise e
+  in
+  let e,l = entry [] l in
+  let e = List.map (function f,cs -> f, List.rev cs) e in
+  List.rev e, (l + 1)
+  
+(* Selective pqrsing *)
+let apply_to_entries f empty fd =
+  let rec all_entries l acc =
+    try 
+      let e,l = read_entry fd l in
+      all_entries l (f e acc)
+    with End_of_file -> acc
+  in
+  all_entries 0 empty
+
+let ref_counter = ref 0
+
+let print_first n e () =
+  if !ref_counter < n then begin
+    incr ref_counter;
+    print_entry e
+  end else ()
+  
+let print_package name e () =
+  match List.assoc "Package" e with
+  | ["ocaml"] -> print_entry e
+  | _ -> ()
+
+(* Main calling function *)
+let () =
+  (*apply_to_entries (print_first 5) () status_fd;*)
+  apply_to_entries (print_package "zlib1g") () status_fd
+
+(*
+  let l = 0 in
+  let e,l = read_entry status_fd l in
+  print_entry e;
+  let e,l = read_entry status_fd l in
+  print_entry e;
+  ()
+*)
+
+(*
+let rec read_line fd l = 
+  if l > 40 then () else 
+  let line = input_line fd in
+  begin
+    try Printf.printf "Line %d starts with %c : %s\n" l line.[0] line
+    with Invalid_argument ("index out of bounds") -> Printf.printf "Line %d is empty\n" l
+  end;
+  read_line fd (l+1)
+
+let readline fd =
+  let line = input_line fd in
+  try
+    let field, pos = read_field_name line in
+    let content = read_field_content line pos in
+    Printf.printf "Field is <%s>, pos is %d, content is <%s>\n" field pos content
+  with _ -> Printf.printf "Failed to read field\n"
+
+let () = readline status_fd
+
+let () = read_line status_fd 0
+*)
+
+(*
+
+1) We read lines.
+2) We carry an accumulator of fields, as well as an accumulator of lines.
+
+
+*)