(* whenjobs * Copyright (C) 2012 Red Hat Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License along * with this program; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) (* For general information about camlp4, see: * http://brion.inria.fr/gallium/index.php/Camlp4 * * For information about quotations, see: * http://brion.inria.fr/gallium/index.php/Quotation *) open Printf open Camlp4.PreCast open Syntax open Ast let unique = let i = ref 0 in fun () -> incr i; !i let unique_job_name () = sprintf "job$%d" (unique ()) let rec find s sub = let len = String.length s in let sublen = String.length sub in let rec loop i = if i <= len-sublen then ( let rec loop2 j = if j < sublen then ( if s.[i+j] = sub.[j] then loop2 (j+1) else -1 ) else i (* found *) in let r = loop2 0 in if r = -1 then loop (i+1) else r ) else -1 (* not found *) in loop 0 let rec replace_str s s1 s2 = let len = String.length s in let sublen = String.length s1 in let i = find s s1 in if i = -1 then s else ( let s' = String.sub s 0 i in let s'' = String.sub s (i+sublen) (len-i-sublen) in s' ^ s2 ^ replace_str s'' s1 s2 ) (* Convert a _loc to an AST. *) let expr_of_loc _loc loc = let file_name, start_line, start_bol, start_off, stop_line, stop_bol, stop_off, ghost = Loc.to_tuple loc in <:expr< Camlp4.PreCast.Loc.of_tuple ($str:file_name$, $`int:start_line$, $`int:start_bol$, $`int:start_off$, $`int:stop_line$, $`int:stop_bol$, $`int:stop_off$, $`bool:ghost$) >> (* Convert 'expr option' to an expression that contains the option inside. *) let expr_of_option _loc = function | None -> <:expr< None >> | Some e -> <:expr< Some $e$ >> (* "Lift" an expression, turning it from an expression into an OCaml * abstract syntax tree in the output. This is pretty obscure. * http://caml.inria.fr/pub/ml-archives/caml-list/2008/09/591f7c4a8df9295d675a5adcb6802748.en.html *) module M = Ast.Meta.Make (Ast.Meta.MetaGhostLoc) let lift_expr = M.Expr.meta_expr (* Handle a top level statement. *) let rec call_stmt name pre post (_loc, stmt, sh) = let name = match name with | None -> let name = unique_job_name () in <:expr< $str:name$ >> | Some name -> name in let pre = expr_of_option _loc pre in let post = expr_of_option _loc post in match stmt with | `When e -> when_stmt _loc name pre post e sh | `Every p -> every_stmt _loc name pre post p sh (* Handle a top level "when" statement. * e -> when expression * sh -> the shell script to run * Returns a top level statement (str_item) which when executed just * adds the statement to a global list. *) and when_stmt _loc name pre post e sh = let loc = expr_of_loc _loc _loc in let e = lift_expr _loc e in <:str_item< open Camlp4.PreCast Whenfile.add_when_job $loc$ $name$ $pre$ $post$ $e$ $sh$ >> (* Handle a top level "every" statement. *) and every_stmt _loc name pre post period sh = let loc = expr_of_loc _loc _loc in <:str_item< open Camlp4.PreCast Whenfile.add_every_job $loc$ $name$ $pre$ $post$ $period$ $sh$ >> let () = (* Quotation expander for shell script. *) let sh_quotation_expander _loc _ sh = let loc = expr_of_loc _loc _loc in (* Convert ">\>" to ">>" in code. *) let sh = replace_str sh ">\\>" ">>" in <:expr< { Whenexpr.sh_loc = $loc$; sh_script = $str:sh$ } >> in Quotation.add "sh" Quotation.DynAst.expr_tag sh_quotation_expander; (* Default quotation expander (<< .. >>) should be shell script ("sh"). *) Quotation.default := "sh" (* For period expressions " (secs|mins|hours|...)" we cannot use * the ordinary camlp4 parser since it only looks ahead by 1 symbol, so * it gets "stuck" on the integer. Write a custom parser instead. * * Note the EXTEND macro implicitly reserves KEYWORDs. *) let period_parser = Gram.Entry.of_parser "period" (fun stream -> match Stream.peek stream with | Some (INT (_, i), info) -> let i = int_of_string i in let _loc = Gram.token_location info in Stream.junk stream; (match Stream.next stream with | KEYWORD ("sec"|"secs"|"second"|"seconds"), _ -> <:expr< Whenexpr.Every_seconds $`int:i$ >> | KEYWORD ("min"|"mins"|"minute"|"minutes"), _ -> let i = 60 * i in <:expr< Whenexpr.Every_seconds $`int:i$ >> | KEYWORD ("hour"|"hours"), _ -> let i = 3600 * i in <:expr< Whenexpr.Every_seconds $`int:i$ >> | KEYWORD ("day"|"days"), _ -> <:expr< Whenexpr.Every_days $`int:i$ >> | KEYWORD ("week"|"weeks"), _ -> let i = 7 * i in <:expr< Whenexpr.Every_days $`int:i$ >> | KEYWORD ("month"|"months"), _ -> <:expr< Whenexpr.Every_months $`int:i$ >> | KEYWORD ("year"|"years"), _ -> <:expr< Whenexpr.Every_years $`int:i$ >> | KEYWORD ("decade"|"decades"), _ -> let i = 10 * i in <:expr< Whenexpr.Every_years $`int:i$ >> | KEYWORD ("century"|"centuries"|"centurys"), _ -> let i = 100 * i in <:expr< Whenexpr.Every_years $`int:i$ >> | KEYWORD ("millenium"|"millenia"|"milleniums"), _ -> let i = 1000 * i in <:expr< Whenexpr.Every_years $`int:i$ >> | (KEYWORD s | LIDENT s), _ -> eprintf "period: failed to parse %d %s\n%!" i s; raise Stream.Failure | _ -> raise Stream.Failure ) | _ -> raise Stream.Failure ) ;; EXTEND Gram GLOBAL: str_item; (* A period expression (used in "every"). *) periodexpr: [ [ ["sec"|"secs"|"second"|"seconds"] -> <:expr< Whenexpr.Every_seconds 1 >> ] | [ ["min"|"mins"|"minute"|"minutes"] -> <:expr< Whenexpr.Every_seconds 60 >> ] | [ ["hour"|"hours"] -> <:expr< Whenexpr.Every_seconds 3600 >> ] | [ ["day"|"days"] -> <:expr< Whenexpr.Every_days 1 >> ] | [ ["week"|"weeks"] -> <:expr< Whenexpr.Every_days 7 >> ] | [ ["month"|"months"] -> <:expr< Whenexpr.Every_months 1 >> ] | [ ["year"|"years"] -> <:expr< Whenexpr.Every_years 1 >> ] | [ ["decade"|"decades"] -> <:expr< Whenexpr.Every_years 10 >> ] | [ ["century"|"centuries"|"centurys"] -> <:expr< Whenexpr.Every_years 100 >> ] | [ ["millenium"|"millenia"|"milleniums"] -> <:expr< Whenexpr.Every_years 1000 >> ] | [ e = period_parser -> e ] ]; (* Pre and post functions. *) pre: [[ "pre"; f = expr -> f ]]; post: [[ "post"; f = expr -> f ]]; (* Top level statements. *) statement: [ [ "when"; e = expr; ":"; sh = expr -> (_loc, `When e, sh) ] | [ "every"; p = periodexpr; ":"; sh = expr -> (_loc, `Every p, sh) ] ]; (* "str_item" is a top level statement in an OCaml program. *) str_item: LEVEL "top" [ [ s = statement -> call_stmt None None None s ] | [ "job"; name = expr; pre = OPT pre; post = OPT post; s = statement -> call_stmt (Some name) pre post s ] ]; END