scripts/lib/cdvmm_phone_numbers.ml

   1 (* An example of a pre-page handler and an external function.
   2  * $Id: cdvmm_phone_numbers.ml,v 1.3 2006/09/11 09:36:43 rich Exp $
   3  *)
   4
   5 open Apache
   6 open Cgi
   7
   8 open ExtString
   9
  10 open Cocanwiki_extensions
  11 open Cocanwiki_strings
  12
  13 (* Check we're running against the correct website. *)
  14 let rex =
  15   Pcre.regexp "(cdvmortgage\\.co(\\.uk|m)|chasedevere\\.team-?notepad\\.com)$"
  16 let check_website r =
  17   let hostname =
  18     try Request.hostname r
  19     with Not_found ->
  20       failwith "Cdvmm_phone_numbers: no Host header sent in request" in
  21   Pcre.pmatch ~rex (lowercase hostname)
  22
  23 (* The phone numbers. *)
  24 let numbers = [
  25   "bweb",     "0800 358 5062"; (* Bweb *)
  26   "cweb",     "0800 358 5063"; (* Cweb *)
  27   "dweb",     "0800 358 5064"; (* Dweb *)
  28   "eweb",     "0800 358 5066"; (* Eweb *)
  29   "fweb",     "0800 358 5067"; (* Fweb *)
  30   "aweb",     "0800 358 5068"; (* Aweb (not paid) *)
  31   "mse",      "0800 358 5533"; (* Moneysavingexpert *)
  32   "euro",     "0800 358 1780"; (* Euro/dollar/euribor/libor *)
  33   "mass",     "0800 358 1781"; (* Mortgage broker *)
  34   "offset",   "0800 358 1782"; (* Offset *)
  35   "hnw",      "0800 358 1783"; (* Professionals / HNW *)
  36   "btl",      "0800 358 1784"; (* Buy to let *)
  37   "sp",       "0800 358 1785"; (* Subprimes *)
  38   "selfcert", "0800 358 1786"; (* Self-cert *)
  39   "hweb",     "0800 358 1787"; (* Hweb (appears in brand adverts) *)
  40   "iweb",     "0800 358 1788"; (* Iweb Bidvertiser *)
  41 ]
  42
  43 (* Default numbers go to Fweb. *)
  44 let default_id = "fweb"
  45 let default_number = "0800 358 5067"
  46
  47 (* The name of the cookie. *)
  48 let cookie_name = "phone"
  49
  50 (* When cookies expire. *)
  51 let expires = "Wed, 18-May-2033 04:33:20 GMT"
  52
  53 (* Get the phone cookie if the browser sent one.
  54  * If no phone cookies, raises Not_found.
  55  *)
  56 let get_phone_cookie q = q#cookie cookie_name
  57
  58 let mse_re = Pcre.regexp ~flags:[`CASELESS] "moneysavingexpert"
  59
  60 let pre_page r (q : cgi) dbh hostid _ =
  61   if check_website r then (
  62     let id =
  63       try
  64         (* Get the phone cookie, if it exists. *)
  65         let phone = get_phone_cookie q in
  66         let phone = phone#value in
  67
  68         (* Is it a valid cookie?  If not this raises Not_found and we
  69          * treat it as if we hadn't seen a cookie at all.
  70          *)
  71         ignore (List.assoc phone numbers);
  72
  73         phone
  74       with
  75         Not_found -> (* No cookie or invalid cookie - send one. *)
  76           (* Which cookie should we send? *)
  77           let id =
  78             let headers = Request.headers_in r in
  79             let referer =
  80               try Table.get headers "Referer" with Not_found -> "" in
  81             if Pcre.pmatch ~rex:mse_re referer then
  82               "mse"
  83             else (
  84               let utm_source =
  85                 try q#param "utm_source" with Not_found -> "" in
  86               let utm_campaign =
  87                 try q#param "utm_campaign" with Not_found -> "" in
  88
  89               if String.starts_with utm_campaign "currency" ||
  90                 String.starts_with utm_campaign "libor" then
  91                   "euro"
  92               else if String.starts_with utm_campaign "mass" then
  93                 "mass"
  94               else if String.starts_with utm_campaign "offset" then
  95                 "offset"
  96               else if String.starts_with utm_campaign "hnw" then
  97                 "hnw"
  98               else if String.starts_with utm_campaign "buy" then
  99                 "btl"
 100               else if String.starts_with utm_campaign "sub" then
 101                 "sp"
 102               else if String.starts_with utm_campaign "self" then
 103                 "selfcert"
 104               else if String.starts_with utm_source "bidver" then
 105                 "iweb"
 106               else
 107                 default_id
 108             ) in
 109
 110           let cookie = Cookie.cookie cookie_name id ~path:"/" ~expires in
 111           Table.set (Request.headers_out r) "Set-Cookie" cookie#to_string;
 112
 113           id in
 114     (* Make a note of the id which we can use in the {{phone}}
 115      * external function (defined below).
 116      *)
 117     let notes = Request.notes r in
 118     Table.set notes cookie_name id
 119   )
 120
 121 let phone r dbh hostid _ =
 122   if check_website r then (
 123     (* Have we got a noted phone number? *)
 124     let notes = Request.notes r in
 125     let id =
 126       try
 127         Table.get notes cookie_name
 128       with
 129         Not_found ->
 130           prerr_endline "Cdvmm_phone_numbers: warning: no 'phone' note";
 131           default_id in
 132
 133     (* Is it a valid note?  Get the phone number itself. *)
 134     let number =
 135       try List.assoc id numbers
 136       with
 137         Not_found ->
 138           prerr_endline ("Cdvmm_phone_numbers: warning: bad id: " ^ id);
 139           default_number in
 140
 141     (* Return the number. *)
 142     number
 143
 144   ) else
 145     "{{phone}}" (* XXX Should be able to decline this call. *)
 146
 147 (* Register pre-page handler and external function. *)
 148 let () =
 149   pre_page_handlers := pre_page :: !pre_page_handlers;
 150   external_functions := ("phone", phone) :: !external_functions