summaryrefslogtreecommitdiffstats
path: root/perl_checker.src/perl_checker.ml
blob: 52eaaf57685a0af539da2a3cad85cda587d62b56 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
open Types
open Common
open Tree
open Global_checks

let search_basedir file_name nb =
  let dir = Filename.dirname file_name in
  let config = Config_file.read dir in
  let nb = some_or config.Config_file.basedir nb in
  updir dir nb

let basedir = ref ""
let set_basedir state package =
  if !basedir = "" then
    let nb = List.length (split_at2 ':'':' package.package_name) - 1 in
    let dir = search_basedir package.file_name nb in
    lpush Tree.use_lib dir ;
    Config_file.read_any dir 1 ;
    read_packages_from_cache state dir ;
    if !Flags.verbose then print_endline_flush ("basedir is " ^ dir);
    basedir := dir

let mtime f = int_of_float ((Unix.stat f).Unix.st_mtime)

let rec parse_file from_basedir state file =
  try
    if !Flags.verbose then print_endline_flush ("checking " ^ file) ;
    let build_time = int_of_float (Unix.time()) in
    let command = 
      match !Flags.expand_tabs with
      | Some width -> "expand -t " ^ string_of_int width
      | None -> "cat" in
    let channel = Unix.open_process_in (Printf.sprintf "%s \"%s\"" command file) in
    let lexbuf = Lexing.from_channel channel in
    try
      Info.start_a_new_file file ;
      let tokens = Lexer.get_token Lexer.token lexbuf in
      let _ = Unix.close_process_in channel in
      let t = Parser_helper.parse_tokens Parser.prog tokens (Some lexbuf) in
      let packages = get_global_info_from_package from_basedir build_time t in
      let required_packages =
	collect (fun package ->
	  get_vars_declaration state.global_vars_declared package ;
	  Global_checks.add_package_to_state state package ;
	  set_basedir state package ;
	  package.required_packages
        ) packages in
      required_packages, state
    with Failure s -> (
      print_endline_flush s ;
      exit 1
     )
  with 
  | Not_found -> internal_error "runaway Not_found"

and parse_package_if_needed state (package_name, pos) =
  if List.mem package_name !Config_file.ignored_packages then [], state else
  let splitted = split_at2 ':'':' package_name in
  let rel_file = String.concat "/" splitted ^ ".pm" in

  (*print_endline_flush ("wondering about " ^ package_name) ;*)
  try
    let dir = findfile (Build.fake_packages_dir :: !use_lib) rel_file in
    let file = dir ^ "/" ^ rel_file in
    Config_file.read_any (Filename.dirname file) (List.length splitted) ;
    let already_done =
      try
	let pkg = Hashtbl.find state.per_package package_name in
	if pkg.from_cache then
	  if pkg.build_time > mtime file then (
	    Hashtbl.replace state.per_package package_name { pkg with from_cache = false };
	    (*print_endline_flush (package_name ^ " wants " ^ String.concat " " (List.map fst pkg.required_packages)) ; *)
	    Some pkg.required_packages
	  ) else (
	    if !Flags.verbose then print_endline_flush (Printf.sprintf "cached version of %s is outdated, re-parsing" file);
	    Hashtbl.remove state.per_package package_name ; (* so that check on file name below doesn't need to check from_cache *)
	    None
	  )
	else Some []
      with Not_found -> None in
    match already_done with
    | Some required_packages -> required_packages, state
    | None ->
	if hashtbl_exists (fun _ pkg -> pkg.file_name = file) state.per_package
	then [], state (* already seen, it happens when many files have the same package_name *)
	else parse_file (dir = !basedir) state file
  with Not_found -> 
    warn_with_pos pos (Printf.sprintf "can't find package %s" package_name) ;
    [], state

let rec parse_required_packages state = function
  | [] -> state
  | e :: l ->
      let el, state = parse_package_if_needed state e in
      parse_required_packages state (el @ l)


let parse_options =
  let args_r = ref [] in
  let restrict_to_files = ref false in

  let pot_file = ref "" in
  let generate_pot_chosen file =
    Flags.generate_pot := true ;
    Flags.expand_tabs := None ;
    pot_file := file
  in
  let options = [
    "-v", Arg.Set Flags.verbose, "  be verbose" ;
    "-q", Arg.Set Flags.quiet, "  be quiet" ;
    "-t", Arg.Int (fun i -> Flags.expand_tabs := Some i), "  set the tabulation width (default is 8)" ;
    "--check-unused", Arg.Set Flags.check_unused_global_vars, "  check unused global functions & variables" ;
    "--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, "" ;
  ] in
  let usage = "Usage: perl_checker [-v] [-q] <files>\nOptions are:" in
  Arg.parse options (lpush args_r) usage;

  let files = if !args_r = [] then ["../t.pl"] else !args_r in

  let required_packages, state = collect_withenv (parse_file true) (default_state()) files in
  let required_packages = uniq_ (fun (a,_) (b,_) -> a = b) required_packages in

  if !Flags.generate_pot then Parser_helper.generate_pot !pot_file else (

  if !restrict_to_files then Common.print_endline_flush_quiet := true ;
  let state = parse_required_packages state required_packages in
  if !restrict_to_files then Common.print_endline_flush_quiet := false ;

  let state = arrange_global_vars_declared state in

  write_packages_cache state !basedir ;

  let state = Global_checks.get_methods_available state in

  let l = List.map snd (hashtbl_to_list state.per_package) in
  let l = List.filter (fun pkg -> not pkg.from_cache && pkg.from_basedir) l in
  (* HACK: skip ignored_packages. Some package may have appeared in ignored_packages due to the xs bootstrap hack *)
  let l = List.filter (fun pkg -> not (List.mem pkg.package_name !Config_file.ignored_packages)) l in

  let l = if !restrict_to_files then List.filter (fun pkg -> List.mem pkg.file_name files) l else l in

  List.iter (Global_checks.check_tree state) l;
  if !Flags.check_unused_global_vars then List.iter Global_checks.check_unused_vars l 
  )