summaryrefslogtreecommitdiffstats
path: root/perl_checker.src
diff options
context:
space:
mode:
Diffstat (limited to 'perl_checker.src')
-rw-r--r--perl_checker.src/global_checks.ml26
-rw-r--r--perl_checker.src/global_checks.mli3
-rw-r--r--perl_checker.src/perl_checker.ml8
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
)