~ubuntu-transition-trackers/ubuntu-transition-tracker/ben

« back to all changes in this revision

Viewing changes to lib/query.ml

  • Committer: Stephane Glondu
  • Date: 2009-07-28 15:00:25 UTC
  • Revision ID: git-v1:798d1465aec923703fdc8dfb656099cb57d2de15
Stm_monitor: add configuration file facilities

Show diffs side-by-side

added added

removed removed

Lines of Context:
18
18
(**************************************************************************)
19
19
 
20
20
open Printf
 
21
open Stml_error
21
22
open Stml_types
22
23
open Stml_base
23
24
 
24
25
type t = Stml_types.expr
25
26
 
 
27
let of_expr x = x
 
28
 
26
29
let of_string s =
27
30
  let lexbuf = Lexing.from_string s in
28
31
  Stml_parser.full_expr Stml_lexer.token lexbuf
29
32
 
30
33
let rec to_string = function
31
 
  | Match (f, r) ->
 
34
  | EMatch (f, r) ->
32
35
      sprintf "?%s ~ %s" f (string_of_regexp r)
33
 
  | Not e ->
 
36
  | ENot e ->
34
37
      sprintf "!%s" (to_string e)
35
 
  | And (e1, e2) ->
 
38
  | EAnd (e1, e2) ->
36
39
      sprintf "(%s & %s)" (to_string e1) (to_string e2)
37
 
  | Or (e1, e2) ->
 
40
  | EOr (e1, e2) ->
38
41
      sprintf "(%s | %s)" (to_string e1) (to_string e2)
39
 
  | Source -> "source"
 
42
  | EList xs ->
 
43
      sprintf "[%s]" (String.concat "; " (List.map to_string xs))
 
44
  | ESource -> "source"
 
45
  | EString x -> string_of_string x
40
46
 
41
47
let rec eval kind pkg = function
42
 
  | Match (field, (r, rex)) ->
 
48
  | EMatch (field, (r, rex)) ->
43
49
      begin try
44
50
        let value = Package.get field pkg in
45
51
        ignore (Pcre.exec ~rex value);
47
53
      with Not_found ->
48
54
        false
49
55
      end
50
 
  | Source ->
 
56
  | ESource ->
51
57
      kind = `source
52
 
  | Or (e1, e2) ->
 
58
  | EOr (e1, e2) ->
53
59
      eval kind pkg e1 || eval kind pkg e2
54
 
  | And (e1, e2) ->
 
60
  | EAnd (e1, e2) ->
55
61
      eval kind pkg e1 && eval kind pkg e2
56
 
  | Not e ->
 
62
  | ENot e ->
57
63
      not (eval kind pkg e)
 
64
  | (EString _ | EList _) as x ->
 
65
      raise (Unexpected_expression (to_string x))
58
66
 
59
67
let eval_source x = eval `source x
60
68
let eval_binary x = eval `binary x
61
69
 
62
70
let rec fields accu = function
63
 
  | Match (f, _) ->
 
71
  | EMatch (f, _) ->
64
72
      Fields.add f accu
65
 
  | Not e ->
 
73
  | ENot e ->
66
74
      fields accu e
67
 
  | And (e1, e2) | Or (e1, e2) ->
 
75
  | EAnd (e1, e2) | EOr (e1, e2) ->
68
76
      fields (fields accu e1) e2
69
 
  | Source ->
 
77
  | EList xs ->
 
78
      List.fold_left fields accu xs
 
79
  | ESource | EString _ ->
70
80
      accu