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
147
148
|
open Types
open Common
open Tree
open Global_checks
let rec updir dir nb =
if nb = 0 then dir else
match dir with
| "." -> String.concat "/" (times ".." nb)
| _ -> updir (Filename.dirname dir) (nb-1)
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 =
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 ;
read_packages_from_cache state 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 dir (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" ;
"--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
)
|
