(* An example of a pre-page handler and an external function.
 * $Id: cdvmm_phone_numbers.ml,v 1.3 2006/09/11 09:36:43 rich Exp $
 *)

open Apache
open Cgi

open ExtString

open Cocanwiki_extensions
open Cocanwiki_strings

(* Check we're running against the correct website. *)
let rex =
  Pcre.regexp "(cdvmortgage\\.co(\\.uk|m)|chasedevere\\.team-?notepad\\.com)$"
let check_website r =
  let hostname =
    try Request.hostname r
    with Not_found ->
      failwith "Cdvmm_phone_numbers: no Host header sent in request" in
  Pcre.pmatch ~rex (lowercase hostname)

(* The phone numbers. *)
let numbers = [
  "bweb",     "0800 358 5062"; (* Bweb *)
  "cweb",     "0800 358 5063"; (* Cweb *)
  "dweb",     "0800 358 5064"; (* Dweb *)
  "eweb",     "0800 358 5066"; (* Eweb *)
  "fweb",     "0800 358 5067"; (* Fweb *)
  "aweb",     "0800 358 5068"; (* Aweb (not paid) *)
  "mse",      "0800 358 5533"; (* Moneysavingexpert *)
  "euro",     "0800 358 1780"; (* Euro/dollar/euribor/libor *)
  "mass",     "0800 358 1781"; (* Mortgage broker *)
  "offset",   "0800 358 1782"; (* Offset *)
  "hnw",      "0800 358 1783"; (* Professionals / HNW *)
  "btl",      "0800 358 1784"; (* Buy to let *)
  "sp",       "0800 358 1785"; (* Subprimes *)
  "selfcert", "0800 358 1786"; (* Self-cert *)
  "hweb",     "0800 358 1787"; (* Hweb (appears in brand adverts) *)
  "iweb",     "0800 358 1788"; (* Iweb Bidvertiser *)
]

(* Default numbers go to Fweb. *)
let default_id = "fweb"
let default_number = "0800 358 5067"

(* The name of the cookie. *)
let cookie_name = "phone"

(* When cookies expire. *)
let expires = "Wed, 18-May-2033 04:33:20 GMT"

(* Get the phone cookie if the browser sent one.
 * If no phone cookies, raises Not_found.
 *)
let get_phone_cookie q = q#cookie cookie_name

let mse_re = Pcre.regexp ~flags:[`CASELESS] "moneysavingexpert"

let pre_page r (q : cgi) dbh hostid _ =
  if check_website r then (
    let id =
      try
	(* Get the phone cookie, if it exists. *)
	let phone = get_phone_cookie q in
	let phone = phone#value in

	(* Is it a valid cookie?  If not this raises Not_found and we
	 * treat it as if we hadn't seen a cookie at all.
	 *)
	ignore (List.assoc phone numbers);

	phone
      with
	Not_found -> (* No cookie or invalid cookie - send one. *)
	  (* Which cookie should we send? *)
	  let id =
	    let headers = Request.headers_in r in
	    let referer =
	      try Table.get headers "Referer" with Not_found -> "" in
	    if Pcre.pmatch ~rex:mse_re referer then
	      "mse"
	    else (
	      let utm_source =
		try q#param "utm_source" with Not_found -> "" in
	      let utm_campaign =
		try q#param "utm_campaign" with Not_found -> "" in

	      if String.starts_with utm_campaign "currency" ||
		String.starts_with utm_campaign "libor" then
		  "euro"
	      else if String.starts_with utm_campaign "mass" then
		"mass"
	      else if String.starts_with utm_campaign "offset" then
		"offset"
	      else if String.starts_with utm_campaign "hnw" then
		"hnw"
	      else if String.starts_with utm_campaign "buy" then
		"btl"
	      else if String.starts_with utm_campaign "sub" then
		"sp"
	      else if String.starts_with utm_campaign "self" then
		"selfcert"
	      else if String.starts_with utm_source "bidver" then
		"iweb"
	      else
		default_id
	    ) in

	  let cookie = Cookie.cookie cookie_name id ~path:"/" ~expires in
	  Table.set (Request.headers_out r) "Set-Cookie" cookie#to_string;

	  id in
    (* Make a note of the id which we can use in the {{phone}}
     * external function (defined below).
     *)
    let notes = Request.notes r in
    Table.set notes cookie_name id
  )

let phone r dbh hostid _ =
  if check_website r then (
    (* Have we got a noted phone number? *)
    let notes = Request.notes r in
    let id =
      try
	Table.get notes cookie_name
      with
	Not_found ->
	  prerr_endline "Cdvmm_phone_numbers: warning: no 'phone' note";
	  default_id in

    (* Is it a valid note?  Get the phone number itself. *)
    let number =
      try List.assoc id numbers
      with
	Not_found ->
	  prerr_endline ("Cdvmm_phone_numbers: warning: bad id: " ^ id);
	  default_number in

    (* Return the number. *)
    number

  ) else
    "{{phone}}" (* XXX Should be able to decline this call. *)

(* Register pre-page handler and external function. *)
let () =
  pre_page_handlers := pre_page :: !pre_page_handlers;
  external_functions := ("phone", phone) :: !external_functions