blob: 78dc2d51e8ccd03ee162df50229d59b50dfde924 (
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
|
open Types
open Common
open Tree
let inc =
let inc_ref = ref [] in
let ignored_packages = ref [] in
let rec updir dir nb =
if nb = 0 then dir else
match dir with
| "." -> String.concat "/" (times ".." nb)
| _ -> updir (Filename.dirname dir) (nb-1)
in
fun file_name package_name has_package_name ->
if !inc_ref = [] then (
let reldir = if has_package_name then updir file_name (List.length(split_at2 ':'':' package_name)) else "." in
let default = readlines (Unix.open_process_in "perl -le 'print foreach @INC'") in
inc_ref := reldir :: default ;
try
ignored_packages := readlines (open_in (reldir ^ "/.perl_checker"))
with Sys_error _ -> ()
);
!inc_ref, !ignored_packages
let findfile dirs f = List.find Sys.file_exists (List.map (fun dir -> dir ^ "/" ^ f) dirs)
let rec parse_file state file =
try
if !Flags.verbose then prerr_endline ("checking " ^ file) ;
let lexbuf = Lexing.from_channel (Unix.open_process_in (Printf.sprintf "expand \"%s\"" file)) in
try
Info.start_a_new_file file ;
let tokens = Lexer.get_token Lexer.token lexbuf in
let t = Parser_helper.parse_tokens Parser.prog tokens (Some lexbuf) in
let package = get_global_info_from_package t in
Tree.get_global_vars_declaration state package ;
let state = { state with per_package = (package.package_name, package) :: state.per_package } in
let state = List.fold_left parse_package_if_needed state package.uses in
state
with Failure s -> (
prerr_endline s ;
exit 1
)
with _ -> failwith ("bad file " ^ file)
and parse_package_if_needed state (package_name, (_, pos)) =
if List.mem_assoc package_name state.per_package then state else
try
let package = snd (List.hd state.per_package) in
let inc, ignored_packages = inc package.file_name package.package_name package.has_package_name in
if List.mem package_name ignored_packages then state
else
let file = String.concat "/" (split_at2 ':'':' package_name) ^ ".pm" in
parse_file state (findfile inc file)
with Not_found ->
Tree.warn_with_pos pos (Printf.sprintf "can't find package %s" package_name) ;
state
let parse_options =
let args_r = ref [] in
let options = [
"-v", Arg.Set Flags.verbose, " be verbose" ;
"-q", Arg.Set Flags.quiet, " be quiet" ;
] in
let usage = "Usage: perl_checker [-v] [-q] <files>\nOptions are:" in
Arg.parse options (lpush args_r) usage;
let args = if !args_r = [] then ["../t.pl"] else !args_r in
let state = List.fold_left parse_file default_state args in
List.iter (check_tree state) (List.map snd state.per_package)
|
