diff options
| -rw-r--r-- | perl-MDK-Common.spec | 5 | ||||
| -rw-r--r-- | perl_checker.src/common.ml | 9 | ||||
| -rw-r--r-- | perl_checker.src/common.mli | 1 | ||||
| -rw-r--r-- | perl_checker.src/flags.ml | 3 | ||||
| -rw-r--r-- | perl_checker.src/flags.mli | 2 | ||||
| -rw-r--r-- | perl_checker.src/lexer.mll | 21 | ||||
| -rw-r--r-- | perl_checker.src/parser.mly | 4 | ||||
| -rw-r--r-- | perl_checker.src/parser_helper.ml | 41 | ||||
| -rw-r--r-- | perl_checker.src/parser_helper.mli | 5 | ||||
| -rw-r--r-- | perl_checker.src/perl_checker.ml | 16 |
10 files changed, 95 insertions, 12 deletions
diff --git a/perl-MDK-Common.spec b/perl-MDK-Common.spec index 9133064..4b5dac8 100644 --- a/perl-MDK-Common.spec +++ b/perl-MDK-Common.spec @@ -2,7 +2,7 @@ # do not change the version here, change in MDK/Common.pm.pl %define version THEVERSION -%define release 7mdk +%define release 8mdk Summary: Various simple functions Name: perl-MDK-Common @@ -50,6 +50,9 @@ rm -rf $RPM_BUILD_ROOT # MODIFY IN THE CVS: cvs.mandrakesoft.com:/cooker soft/perl-MDK-Common %changelog +* Tue Dec 10 2002 Pixel <pixel@mandrakesoft.com> 1.0.4-8mdk +- perl_checker: new --generate-pot feature + * Fri Dec 6 2002 Pixel <pixel@mandrakesoft.com> 1.0.4-7mdk - perl_checker: print on stdout, not stderr - perl_checker: add option --restrict-to-files (mainly for perl_checko the Clean Keeper) diff --git a/perl_checker.src/common.ml b/perl_checker.src/common.ml index a938ffb..f84e027 100644 --- a/perl_checker.src/common.ml +++ b/perl_checker.src/common.ml @@ -692,6 +692,15 @@ let rec explode_string = function | "" -> [] | s -> (String.get s 0) :: explode_string (String.sub s 1 (String.length s - 1)) +let count_matching_char s c = + let rec count_matching_char_ nb i = + try + let i' = String.index_from s i c in + count_matching_char_ (nb+1) (i'+1) + with Not_found -> nb + in + count_matching_char_ 0 0 + let is_uppercase c = Char.lowercase c <> c let is_lowercase c = Char.uppercase c <> c diff --git a/perl_checker.src/common.mli b/perl_checker.src/common.mli index 162b6bd..f3a66c7 100644 --- a/perl_checker.src/common.mli +++ b/perl_checker.src/common.mli @@ -187,6 +187,7 @@ val non_index : string -> char -> int val non_rindex_from : string -> int -> char -> int val non_rindex : string -> char -> int val explode_string : string -> char list +val count_matching_char : string -> char -> int val is_uppercase : char -> bool val is_lowercase : char -> bool val char_is_alphanumerical : char -> bool diff --git a/perl_checker.src/flags.ml b/perl_checker.src/flags.ml index 5256831..6f0949b 100644 --- a/perl_checker.src/flags.ml +++ b/perl_checker.src/flags.ml @@ -2,3 +2,6 @@ open Common let verbose = ref false let quiet = ref false +let generate_pot = ref false +let expand_tabs = ref false + diff --git a/perl_checker.src/flags.mli b/perl_checker.src/flags.mli index 9f17f55..81045b1 100644 --- a/perl_checker.src/flags.mli +++ b/perl_checker.src/flags.mli @@ -1,2 +1,4 @@ val verbose : bool ref val quiet : bool ref +val generate_pot : bool ref +val expand_tabs : bool ref diff --git a/perl_checker.src/lexer.mll b/perl_checker.src/lexer.mll index 448d0c9..c9ce890 100644 --- a/perl_checker.src/lexer.mll +++ b/perl_checker.src/lexer.mll @@ -20,6 +20,7 @@ type raw_token = | BAREWORD_PAREN of (string * raw_pos) | REVISION of (string * raw_pos) | PERL_CHECKER_COMMENT of (string * raw_pos) + | PO_COMMENT of (string * raw_pos) | POD of (string * raw_pos) | LABEL of (string * raw_pos) | COMMAND_STRING of (raw_interpolated_string * raw_pos) @@ -75,6 +76,7 @@ let rec raw_token_to_pos_and_token spaces = function | BAREWORD_PAREN(s, pos) -> pos, Parser.BAREWORD_PAREN(s, (spaces, pos)) | REVISION(s, pos) -> pos, Parser.REVISION(s, (spaces, pos)) | PERL_CHECKER_COMMENT(s, pos) -> pos, Parser.PERL_CHECKER_COMMENT(s, (spaces, pos)) + | PO_COMMENT(s, pos) -> pos, Parser.PO_COMMENT(s, (spaces, pos)) | POD(s, pos) -> pos, Parser.POD(s, (spaces, pos)) | LABEL(s, pos) -> pos, Parser.LABEL(s, (spaces, pos)) | PRINT(s, pos) -> pos, Parser.PRINT(s, (spaces, pos)) @@ -327,12 +329,13 @@ let ident = ident_start ['0'-'9' 'A'-'Z' 'a'-'z' '_'] * let pattern_separator = [ '/' '!' ',' '|' ] rule token = parse -| ' '+ { +| [' ' '\t']+ { (* propagate not_ok_for_match when it was set by the previous token *) if lexeme_start lexbuf = !not_ok_for_match then not_ok_for_match := lexeme_end lexbuf; SPACE(lexeme_end lexbuf - lexeme_start lexbuf) } | "# perl_checker: " [^ '\n']* { PERL_CHECKER_COMMENT(skip_n_char 16 (lexeme lexbuf), pos lexbuf) } +| "#-PO: " [^ '\n']* { PO_COMMENT(skip_n_char 1 (lexeme lexbuf), pos lexbuf) } | '#' [^ '\n']* { SPACE(1) } | "\n=" { @@ -623,7 +626,6 @@ and string = parse add_a_new_line(lexeme_end lexbuf); next string lexbuf } - | [^ '\n' '\\' '"' '$' '@']+ { next string lexbuf } | eof { die_in_string lexbuf "Unterminated_string" } @@ -716,6 +718,8 @@ and string_escape = parse | '0' { next_s "\000" (Stack.pop next_rule) lexbuf } | '"' { next_s "\"" (Stack.pop next_rule) lexbuf } | ''' { next_s "'" (Stack.pop next_rule) lexbuf } +| ':' { next_s ":" (Stack.pop next_rule) lexbuf } +| '\\'{ next_s "\\" (Stack.pop next_rule) lexbuf } | 'n' { next_s "\n" (Stack.pop next_rule) lexbuf } | 't' { next_s "\t" (Stack.pop next_rule) lexbuf } | 'x' _ _ { @@ -724,6 +728,7 @@ and string_escape = parse next_s s (Stack.pop next_rule) lexbuf with Failure("int_of_string") -> die_in_string lexbuf ("Bad_hex_in_string \"" ^ lexeme lexbuf ^ "\"") } +| '\n' { die lexbuf "do not use \"\\\" before end-of-line, it's useless and generally bad" } | _ { next_s ("\\" ^ lexeme lexbuf) (Stack.pop next_rule) lexbuf } @@ -738,7 +743,8 @@ and string_interpolate_scalar = parse | "{" | ident "->"? '{' -| eof { next_s "$" (Stack.pop next_rule) lexbuf } +| '"' { putback lexbuf 1; next_s "$" (Stack.pop next_rule) lexbuf } +| eof { next_s "$" (Stack.pop next_rule) lexbuf } | _ { warn lexbuf (Printf.sprintf "weird \"%s\" in string" (lexeme lexbuf)); next_s ("$" ^ lexeme lexbuf) (Stack.pop next_rule) lexbuf } and delimited_string_interpolate_scalar = parse (* needed for delimited string like m!foo$! where $! should not be taken as is... *) @@ -772,8 +778,9 @@ and string_interpolate_array = parse | (ident | (ident? ("::" ident)+)) { string_interpolate token "@" lexbuf } | [ '@' '*' '<' '>' ']' '.' '('] { next_s ("@" ^ lexeme lexbuf) (Stack.pop next_rule) lexbuf } -| eof { next_s "$" (Stack.pop next_rule) lexbuf } -| _ { warn lexbuf (Printf.sprintf "weird \"%s\" in string" (lexeme lexbuf)); next_s ("$" ^ lexeme lexbuf) (Stack.pop next_rule) lexbuf } +| '"' { putback lexbuf 1; next_s "@" (Stack.pop next_rule) lexbuf } +| eof { next_s "@" (Stack.pop next_rule) lexbuf } +| _ { warn lexbuf (Printf.sprintf "weird \"%s\" in string" (lexeme lexbuf)); next_s ("@" ^ lexeme lexbuf) (Stack.pop next_rule) lexbuf } and delimited_string_interpolate_array = parse | '$' ident @@ -781,12 +788,12 @@ and delimited_string_interpolate_array = parse | (ident | (ident? ("::" ident)+)) { string_interpolate token "@" lexbuf } | [ '@' '*' '<' '>' ']' '.' '('] { next_s ("@" ^ lexeme lexbuf) (Stack.pop next_rule) lexbuf } -| eof { next_s "$" (Stack.pop next_rule) lexbuf } +| eof { next_s "@" (Stack.pop next_rule) lexbuf } | _ { let c = lexeme_char lexbuf 0 in if c <> !delimit_char then warn lexbuf (Printf.sprintf "weird \"%s\" in string" (lexeme lexbuf)); putback lexbuf 1; - next_s "$" (Stack.pop next_rule) lexbuf + next_s "@" (Stack.pop next_rule) lexbuf } and pattern_options = parse diff --git a/perl_checker.src/parser.mly b/perl_checker.src/parser.mly index a2e61dc..84655eb 100644 --- a/perl_checker.src/parser.mly +++ b/perl_checker.src/parser.mly @@ -12,7 +12,7 @@ %token <unit * (Types.spaces * Types.raw_pos)> EOF -%token <string * (Types.spaces * Types.raw_pos)> NUM RAW_STRING BAREWORD BAREWORD_PAREN REVISION COMMENT POD LABEL PERL_CHECKER_COMMENT ONE_SCALAR_PARA +%token <string * (Types.spaces * Types.raw_pos)> NUM RAW_STRING BAREWORD BAREWORD_PAREN REVISION COMMENT POD LABEL PO_COMMENT PERL_CHECKER_COMMENT ONE_SCALAR_PARA %token <(string * string) * (Types.spaces * Types.raw_pos)> PRINT_TO_STAR PRINT_TO_SCALAR %token <string * (Types.spaces * Types.raw_pos)> QUOTEWORDS COMPACT_HASH_SUBSCRIPT %token <(string * Types.raw_pos) * (Types.spaces * Types.raw_pos)> RAW_HERE_DOC @@ -425,6 +425,8 @@ bareword: word_paren: | BAREWORD_PAREN { Ident(None, fst $1, get_pos $1), snd $1} | RAW_IDENT_PAREN { to_Ident $1, snd $1} +| PO_COMMENT word_paren { po_comment($1); fst $2, sp_pos_range $1 $2 } + arraylen: ARRAYLEN_IDENT {deref_arraylen (to_Ident $1), snd $1} | ARRAYLEN scalar {sp_0($2); deref_arraylen (fst $2), snd $1} | ARRAYLEN bracket_subscript {deref_arraylen (fst $2), sp_pos_range $1 $2} scalar: SCALAR_IDENT {Deref(I_scalar, to_Ident $1), snd $1} | DOLLAR scalar {sp_0($2); Deref(I_scalar, fst $2), snd $1} | DOLLAR bracket_subscript {Deref(I_scalar, fst $2), sp_pos_range $1 $2} | DOLLAR BRACKET BRACKET expr BRACKET_END BRACKET_END {sp_0($2); sp_0($3); sp_p($5); sp_0($6); Deref(I_scalar, Ref(I_hash, sndfst $4)), sp_pos_range $1 $6} diff --git a/perl_checker.src/parser_helper.ml b/perl_checker.src/parser_helper.ml index 7f723a6..e562d15 100644 --- a/perl_checker.src/parser_helper.ml +++ b/perl_checker.src/parser_helper.ml @@ -3,6 +3,9 @@ open Common open Printf let bpos = -1, -1 +let pot_strings = ref [] +let pot_strings_and_file = Hashtbl.create 16 +let po_comments = ref [] let raw_pos2pos(a, b) = !Info.current_file, a, b let pos_range (_, (_, (a1, b1))) (_, (_, (a2, b2))) = raw_pos2pos((if a1 = -1 then a2 else a1), (if b2 = -1 then b1 else b2)) @@ -25,6 +28,7 @@ let is_parenthesized = function let un_parenthesize = function | List[List[e]] -> e + | List[e] -> e | _ -> internal_error "un_parenthesize" let rec un_parenthesize_full = function @@ -484,7 +488,15 @@ let call_func is_a_func (e, para) = | "N" | "N_" -> (match para with - | [ List(String([ _s, List [] ], _) :: _) ] -> None + | [ List(String([ s, List [] ], (file, _, _)) :: _) ] -> + if !Flags.generate_pot then ( + lpush pot_strings (s, !po_comments) ; + po_comments := [] ; + Hashtbl.add pot_strings_and_file s file ; + ) ; + (*if String.contains s '\t' then warn_rule "tabulation in translated string must be written \\\\t";*) + (*if count_matching_char s '\n' > 10 then warn_rule "long string";*) + None | [ List(String _ :: _) ] -> die_rule "don't use interpolated translated string, use %s or %d instead" | _ -> die_rule (sprintf "%s() must be used with a string" f)) @@ -595,3 +607,30 @@ let from_PATTERN_SUBST parse ((s1, s2, opts), (_, pos)) = [ String(parse_interpolated parse s1, raw_pos2pos pos) ; String(parse_interpolated parse s2, raw_pos2pos pos) ; Raw_string(opts, raw_pos2pos pos) ] + +let po_comment (s, _) = lpush po_comments s + +let generate_pot file = + let fd = open_out file in + let rec print_formatted_char = function + | '"' -> output_char fd '\\'; output_char fd '"' + | '\t' -> output_char fd '\\'; output_char fd 't' + | '\\' -> output_char fd '\\'; output_char fd '\\' + | '\n' -> output_string fd "\\n\"\n\"" + | c -> output_char fd c + in + List.iter (fun (s, po_comments) -> + match Hashtbl.find_all pot_strings_and_file s with + | [] -> () + | l -> + List.iter (fun po_comment -> output_string fd ("#. " ^ po_comment ^ "\n")) po_comments; + + List.iter (fun _ -> Hashtbl.remove pot_strings_and_file s) l ; + fprintf fd "#: %s\n" (String.concat " " l) ; + + output_string fd (if String.contains s '\n' then "msgid \"\"\n\"" else "msgid \"") ; + String.iter print_formatted_char s ; + output_string fd "\"\n" ; + output_string fd "msgstr \"\"\n\n" + ) !pot_strings ; + close_out fd diff --git a/perl_checker.src/parser_helper.mli b/perl_checker.src/parser_helper.mli index d3a1028..d1aba18 100644 --- a/perl_checker.src/parser_helper.mli +++ b/perl_checker.src/parser_helper.mli @@ -1,4 +1,7 @@ val bpos : int * int +val pot_strings : (string * string list) list ref +val pot_strings_and_file : (string, string) Hashtbl.t +val po_comments : string list ref val raw_pos2pos : 'a * 'b -> string * 'a * 'b val pos_range : 'a * ('b * (int * int)) -> 'c * ('d * (int * int)) -> string * int * int @@ -162,3 +165,5 @@ val from_PATTERN_SUBST : ((string * ((int * int) * 'a) list) list * (string * ((int * int) * 'a) list) list * string) * ('b * (int * int)) -> Types.fromparser list +val po_comment : string * 'a -> unit +val generate_pot : string -> unit diff --git a/perl_checker.src/perl_checker.ml b/perl_checker.src/perl_checker.ml index 9d88c6c..eac011f 100644 --- a/perl_checker.src/perl_checker.ml +++ b/perl_checker.src/perl_checker.ml @@ -27,12 +27,12 @@ let findfile dirs f = List.find Sys.file_exists (List.map (fun dir -> dir ^ "/" let rec parse_file state file = try if !Flags.verbose then print_endline_flush ("checking " ^ file) ; - let channel = Unix.open_process_in (Printf.sprintf "expand \"%s\"" file) in + let channel = Unix.open_process_in (Printf.sprintf "%s \"%s\"" (if !Flags.expand_tabs then "expand" else "cat") 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 _ = Unix.close_process_in channel in*) let t = Parser_helper.parse_tokens Parser.prog tokens (Some lexbuf) in let packages, required_packages = get_global_info_from_package t in List.fold_left (fun (required_packages, state) package -> @@ -69,13 +69,22 @@ let rec parse_required_packages state = function 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 := false ; + pot_file := file + in let options = [ "-v", Arg.Set Flags.verbose, " be verbose" ; "-q", Arg.Set Flags.quiet, " be quiet" ; "--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; @@ -83,6 +92,8 @@ let parse_options = let files = if !args_r = [] then ["../t.pl"] else !args_r in let required_packages, state = collect_withenv parse_file default_state files 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 ; @@ -94,3 +105,4 @@ let parse_options = let l = if !restrict_to_files then List.filter (fun pkg -> List.mem pkg.file_name files) l else l in List.iter (check_tree state) l + ) |