(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: page.ml,v 1.41 2005/11/23 11:05:54 rich Exp $
+ * $Id: page.ml,v 1.43 2006/03/27 18:09:46 rich Exp $
*
* 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
let xhtml_re = Pcre.regexp "<.*?>|[^<>]+"
-let run r (q : cgi) (dbh : Dbi.connection) hostid
+let run r (q : cgi) dbh hostid
({ edit_anon = edit_anon; view_anon = view_anon } as host)
user =
let page = q#param "page" in
feedback_email is not null,
mailing_list, navigation
from hosts where id = ?" in
- sth#execute [`Int hostid];
+ sth#execute [Some hostid];
let has_host_css, has_feedback_email, mailing_list, navigation =
match sth#fetch1 () with
| [ `Bool has_host_css; `Bool has_feedback_email; `Bool mailing_list;
where ? ~ url_regexp
order by ordering
limit 1" in
- sth#execute [`String url];
+ sth#execute [Some url];
try
let name = sth#fetch1string () in
| Some pageid ->
t#conditional "is_old_version" true;
th#conditional "is_old_version" true;
- t#set "old_version" (string_of_int pageid);
- th#set "old_version" (string_of_int pageid));
+ t#set "old_version" (Int32.to_string pageid);
+ th#set "old_version" (Int32.to_string pageid));
(* At this point, we can print out the header and flush it back to
* the user, allowing the browser to start fetching stylesheets
let sth = dbh#prepare_cached
"select ordering, sectionname, content, divname
from contents where pageid = ? order by ordering" in
- sth#execute [`Int pageid];
+ sth#execute [Some pageid];
sth#map
- (function [`Int ordering;
- (`Null | `String _) as sectionname;
- `String content;
- (`Null | `String _) as divname] ->
+ (function [Some ordering;
+ (None | Some _) as sectionname;
+ Some content;
+ (None | Some _) as divname] ->
let divname, has_divname =
match divname with
- `Null -> "", false
- | `String divname -> divname, true in
+ None -> "", false
+ | Some divname -> divname, true in
let sectionname, has_sectionname =
match sectionname with
- `Null -> "", false
- | `String sectionname -> sectionname, true in
+ None -> "", false
+ | Some sectionname -> sectionname, true in
let linkname = linkname_of_sectionname sectionname in
- [ "ordering", Template.VarString (string_of_int ordering);
+ [ "ordering", Template.VarString (Int32.to_string ordering);
"has_sectionname",
Template.VarConditional has_sectionname;
"sectionname", Template.VarString sectionname;
let sth = dbh#prepare_cached "delete from recently_visited
where hostid = ? and userid = ?
and url = ?" in
- sth#execute [`Int hostid; `Int userid; `String page'];
+ sth#execute [Some hostid; Some userid; Some page'];
let sth = dbh#prepare_cached
"insert into recently_visited (hostid, userid, url)
values (?, ?, ?)" in
- sth#execute [`Int hostid; `Int userid; `String page'];
- dbh#commit ()
+ sth#execute [Some hostid; Some userid; Some page'];
+ PGOCaml.commit dbh
| _ -> ()
);
and rv.hostid = p.hostid and rv.url = p.url
order by 3 desc
limit ?") in
- let args = List.map (fun s -> `String s) not_urls in
+ let args = List.map (fun s -> Some s) not_urls in
sth#execute
- ([`Int hostid; `Int userid] @ args @ [`Int limit]);
+ ([Some hostid; Some userid] @ args @ [Some limit]);
sth#map
- (function [`String url; `String title; _] ->
+ (function [Some url; Some title; _] ->
url, title
| _ -> assert false)
| _ -> [] in
"select url, redirect, id, title, description,
last_modified_date, css is not null
from pages where hostid = ? and lower (url) = lower (?)" in
- sth#execute [`Int hostid; `String page];
+ sth#execute [Some hostid; Some page];
(try
(match sth#fetch1 () with
- | `String page' :: _ when page <> page' -> (* different case *)
+ | Some page' :: _ when page <> page' -> (* different case *)
FPExternalRedirect page'
- | [ _; `Null; `Int id; `String title; `String description;
+ | [ _; None; Some id; Some title; Some description;
`Timestamp last_modified_date; `Bool has_page_css ] ->
FPOK (id, title, description, last_modified_date,
has_page_css)
- | _ :: `String redirect :: _ ->
+ | _ :: Some redirect :: _ ->
FPInternalRedirect redirect
| xs -> failwith (Dbi.sdebug xs))
with
"select id, title, description, last_modified_date,
css is not null
from pages where hostid = ? and url = ?" in
- sth#execute [`Int hostid; `String page];
+ sth#execute [Some hostid; Some page];
(try
(match sth#fetch1 () with
- | [ `Int id; `String title; `String description;
+ | [ Some id; Some title; Some description;
`Timestamp last_modified_date; `Bool has_page_css ] ->
FPOK (id, title, description, last_modified_date,
has_page_css)
from pages
where hostid = ? and id = ? and
(url = ? or url_deleted = ?)" in
- sth#execute [`Int hostid; `Int version;
- `String page; `String page];
+ sth#execute [Some hostid; Some version;
+ Some page; Some page];
(try
(match sth#fetch1 () with
- | [ `Int id; `String title; `String description;
+ | [ Some id; Some title; Some description;
`Timestamp last_modified_date; `Bool has_page_css ] ->
FPOK (id, title, description, last_modified_date,
has_page_css)
let allow_redirect, version =
if can_edit then (
not (q#param_true "no_redirect"),
- try Some (int_of_string (q#param "version")) with Not_found -> None
+ try Some (Int32.of_string (q#param "version")) with Not_found -> None
) else
(true, None) in
let rec loop page' i =
if i > max_redirect then (
error ~title:"Too many redirections" ~back_button:true
- q ("Too many redirects between pages. This may happen because " ^
- "of a cycle of redirections.");
+ dbh hostid q
+ ("Too many redirects between pages. This may happen because " ^
+ "of a cycle of redirections.");
return ()
) else
match fetch_page page' version allow_redirect with
git.annexia.org / cocanwiki.git / blobdiff