optional graph of dependencies (doesn't handle methods yet)

3 files changed, 33 insertions, 4 deletions

diff --git a/perl_checker.src/global_checks.ml b/perl_checker.src/global_checks.ml
index 2b43152..64b9b71 100644
--- a/perl_checker.src/global_checks.ml
+++ b/perl_checker.src/global_checks.ml
@@ -11,6 +11,7 @@ type state = {
     methods : (string, (pos * variable_used ref * prototype option) list) Hashtbl.t ;
     global_vars_used : ((context * string * string) * pos) list ref ;
     packages_being_classes : (string, unit) Hashtbl.t ;
+    packages_dependencies : (string * string, unit) Hashtbl.t ;
   }
 
 type vars = { 
@@ -105,6 +106,11 @@ let check_para_comply_with_prototype para proto =
 
 let is_anonymous_variable_name s = String.length s > 1 && s.[0] = '_'
 
+let add_to_packages_really_used state current_package used_name =
+  Hashtbl.replace state.packages_dependencies (current_package.package_name, used_name) () ;
+  (*List.iter (fun (p1, p2) -> prerr_endline (Printf.sprintf "%s -> %s" p1 p2)) (hashtbl_keys state.packages_dependencies);*)
+  ()
+
 let variable_used write_only used =
   if !used != Access_various then
     used := if write_only then Access_write_only else Access_various
@@ -124,7 +130,8 @@ let is_var_declared_raw write_only state package var para =
       let _, used, proto = Hashtbl.find package.vars_declared var in
       Some(used, proto)
     with Not_found -> try
-      let _, used, proto = List.assoc var (get_imports state package) in
+      let package_name, used, proto = List.assoc var (get_imports state package) in
+      add_to_packages_really_used state package package_name ;
       Some(used, proto)
     with Not_found ->
       None
@@ -143,6 +150,7 @@ let is_var_declared vars var para =
 let is_global_var_declared vars (context, fq, name) para =
   try
     let package = Hashtbl.find vars.state.per_packages fq in
+    add_to_packages_really_used vars.state vars.current_package package.package_name ;
     is_var_declared_raw vars.write_only vars.state package (context, name) para
   with Not_found -> false
  
@@ -558,7 +566,14 @@ let get_methods_available state =
 
 
 let default_per_files() = Hashtbl.create 16
-let default_state per_files = { per_files = per_files; per_packages = Hashtbl.create 16; methods = Hashtbl.create 256 ; global_vars_used = ref []; packages_being_classes = Hashtbl.create 16 }
+let default_state per_files = { 
+  per_files = per_files;
+  per_packages = Hashtbl.create 16;
+  methods = Hashtbl.create 256;
+  global_vars_used = ref []; 
+  packages_being_classes = Hashtbl.create 16;
+  packages_dependencies = Hashtbl.create 16
+}
 
 let cache_cache = Hashtbl.create 16
 
@@ -600,3 +615,10 @@ let write_packages_cache per_files dir =
     close_out fh ;
     if !Flags.verbose then print_endline_flush (sprintf "saving cached files\n%sin %s" (pkgs2s "   " l) file)
   with Sys_error _ -> ()
+
+let generate_package_dependencies_graph packages_dependencies file =
+  let fh = open_out file in
+  output_string fh "digraph pgks {\n" ;
+  Hashtbl.iter (fun (p1, p2) _ -> output_string fh ("\"" ^ p1 ^ "\" -> \"" ^ p2 ^ "\"\n")) packages_dependencies ;
+  output_string fh "}\n" ;
+  close_out fh
diff --git a/perl_checker.src/global_checks.mli b/perl_checker.src/global_checks.mli
index 2e60613..197ba3e 100644
--- a/perl_checker.src/global_checks.mli
+++ b/perl_checker.src/global_checks.mli
@@ -7,6 +7,7 @@ type state = {
     methods : (string, (pos * variable_used ref * prototype option) list) Hashtbl.t ;
     global_vars_used : ((context * string * string) * pos) list ref ;
     packages_being_classes : (string, unit) Hashtbl.t ;
+    packages_dependencies : (string * string, unit) Hashtbl.t ;
   }
 
 val default_per_files : unit -> (string, per_file) Hashtbl.t
@@ -20,3 +21,5 @@ val get_methods_available : state -> state
 
 val read_packages_from_cache : (string, per_file) Hashtbl.t -> string -> unit
 val write_packages_cache : (string, per_file) Hashtbl.t -> string -> unit
+
+val generate_package_dependencies_graph : (string * string, unit) Hashtbl.t -> string -> unit
diff --git a/perl_checker.src/perl_checker.ml b/perl_checker.src/perl_checker.ml
index 98664e0..aa8c1f8 100644
--- a/perl_checker.src/perl_checker.ml
+++ b/perl_checker.src/perl_checker.ml
@@ -85,6 +85,7 @@ let parse_options =
   let restrict_to_files = ref false in
 
   let pot_file = ref "" in
+  let package_dependencies_graph_file = ref "" in
   let generate_pot_chosen file =
     Flags.generate_pot := true ;
     Flags.expand_tabs := None ;
@@ -96,7 +97,8 @@ let parse_options =
     "-t", Arg.Int (fun i -> Flags.expand_tabs := Some i), "  set the tabulation width (default is 8)" ;
     "--restrict-to-files", Arg.Set restrict_to_files, "  only display warnings concerning the file(s) given on command line" ;
     "--no-cache", Arg.Set Flags.no_cache, "  do not use cache" ;
-    "--generate-pot", Arg.String generate_pot_chosen, 
+    "--generate-pot", Arg.String generate_pot_chosen, "" ;
+    "--generate-package-dependencies-graph", Arg.String (fun f -> package_dependencies_graph_file := f),
     "\n" ;
 
     "--check-unused-global-vars", Arg.Set Flags.check_unused_global_vars, "  disable unused global functions & variables check" ^
@@ -174,6 +176,8 @@ let parse_options =
 
   List.iter (Global_checks.check_tree state) l;
 
-  if !Flags.check_unused_global_vars then List.iter Global_checks.check_unused_vars l 
+  if !Flags.check_unused_global_vars then List.iter Global_checks.check_unused_vars l;
+
+  if !package_dependencies_graph_file <> "" then generate_package_dependencies_graph state.packages_dependencies !package_dependencies_graph_file 
 
   )