From d9c12b1d9a6f45edcca5b1eacd73378fc21d76f3 Mon Sep 17 00:00:00 2001 From: Swrup Date: Tue, 15 Mar 2022 00:12:36 +0100 Subject: [PATCH] add thumbnail --- src/babillard.ml | 66 +++++++++++++++++++++++++++++--- src/content/assets/css/style.css | 6 +-- src/js/js_pretty_post.ml | 17 ++++++-- src/permap.ml | 11 ++++-- src/pp_babillard.ml | 4 +- 5 files changed, 87 insertions(+), 17 deletions(-) diff --git a/src/babillard.ml b/src/babillard.ml index 6b1a746..56f83b6 100644 --- a/src/babillard.ml +++ b/src/babillard.ml @@ -40,6 +40,7 @@ type image = { name : string ; alt : string ; content : string + ; thumbnail : string } type t = @@ -97,9 +98,13 @@ module Q = struct let create_image_content_table = Caqti_request.exec Caqti_type.unit - "CREATE TABLE IF NOT EXISTS image_content (post_id TEXT,image_content \ - TEXT, FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE \ - CASCADE);" + "CREATE TABLE IF NOT EXISTS image_content (post_id TEXT, content TEXT, \ + FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE);" + + let create_image_thumbnail_table = + Caqti_request.exec Caqti_type.unit + "CREATE TABLE IF NOT EXISTS image_thumbnail (post_id TEXT, content TEXT, \ + FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE);" let create_post_tags_table = Caqti_request.exec Caqti_type.unit @@ -151,6 +156,11 @@ module Q = struct Caqti_type.(tup2 string string) "INSERT INTO image_content VALUES (?,?);" + let upload_image_thumbnail = + Caqti_request.exec + Caqti_type.(tup2 string string) + "INSERT INTO image_thumbnail VALUES (?,?);" + let upload_post_reply = Caqti_request.exec Caqti_type.(tup2 string string) @@ -181,7 +191,11 @@ module Q = struct let get_post_image_content = Caqti_request.find_opt Caqti_type.string Caqti_type.string - "SELECT image_content FROM image_content WHERE post_id=?;" + "SELECT content FROM image_content WHERE post_id=?;" + + let get_post_image_thumbnail = + Caqti_request.find_opt Caqti_type.string Caqti_type.string + "SELECT content FROM image_thumbnail WHERE post_id=?;" let get_post_image_info = Caqti_request.find_opt Caqti_type.string @@ -249,6 +263,7 @@ let () = ; Q.create_post_comment_table ; Q.create_image_info_table ; Q.create_image_content_table + ; Q.create_image_thumbnail_table ; Q.create_post_tags_table ; Q.create_report_table |] @@ -271,6 +286,41 @@ let clean_image image = else if String.length alt > 1000 then Error "Image description too long" else Ok (name, alt, content) +let make_thumbnail content = + try + let filename = + Filename.concat "/tmp" (Uuidm.to_string (Uuidm.v4_gen random_state ())) + in + let thumb_filename = filename ^ "_small" in + let oc = open_out filename in + let fmt = Format.formatter_of_out_channel oc in + Format.fprintf fmt "%s" content; + close_out oc; + let command = + Format.sprintf + "convert -define jpeg:size=700x700 %s -auto-orient -thumbnail \ + '300x300>' -unsharp 0x.5 -format jpg %s" + filename thumb_filename + in + let resize_exit_code = Sys.command command in + if resize_exit_code <> 0 then + Error + (Format.sprintf "thumbnail: resize command failed with exit code: %d" + resize_exit_code ) + else + let ic = open_in thumb_filename in + let thumbnail = really_input_string ic (in_channel_length ic) in + close_in ic; + + let delete = Format.sprintf "rm %s; rm %s" filename thumb_filename in + let delete_exit_code = Sys.command delete in + if delete_exit_code <> 0 then + Error + (Format.sprintf "thumbnail: delete command failed with exit code: %d" + delete_exit_code ) + else Ok thumbnail + with Sys_error e -> Error e + (*TODO switch to markdown !*) (* insert html into the comment, and keep tracks of citations : -wraps lines starting with ">" with a @@ -346,6 +396,7 @@ let upload_post ~image post = assert (Option.is_some image_info); let^ () = Db.exec Q.upload_image_info (id, image.name, image.alt) in let^ () = Db.exec Q.upload_image_content (id, image.content) in + let^ () = Db.exec Q.upload_image_thumbnail (id, image.thumbnail) in Ok () in let^ _unit_list = @@ -417,7 +468,8 @@ let build_op ~comment ~image_info ~tag_list ~categories ~subject ~lat ~lng let build_image image_input = let* name, alt, content = clean_image image_input in - let image = { name; alt; content } in + let* thumbnail = make_thumbnail content in + let image = { name; alt; content; thumbnail } in Ok image let make_post ~comment ?image_input ~tags ~op_or_reply_data user_id = @@ -449,6 +501,10 @@ let get_post_image_content id = let^? content = Db.find_opt Q.get_post_image_content id in Ok content +let get_post_image_thumbnail id = + let^? content = Db.find_opt Q.get_post_image_thumbnail id in + Ok content + let thread_exist id = Result.is_ok (Db.find Q.get_is_thread id) (* true if post is an op too *) diff --git a/src/content/assets/css/style.css b/src/content/assets/css/style.css index 51b8e9f..6a7e440 100644 --- a/src/content/assets/css/style.css +++ b/src/content/assets/css/style.css @@ -56,12 +56,12 @@ blockquote.blockquote { } .post-image { - max-width: 250px; - height: auto; + max-width: 300px; + max-height: 300px; } .post-image-big { - max-width: 750px; + max-width: 1200px; height: auto; } diff --git a/src/js/js_pretty_post.ml b/src/js/js_pretty_post.ml index 0539255..6fbb116 100644 --- a/src/js/js_pretty_post.ml +++ b/src/js/js_pretty_post.ml @@ -21,13 +21,24 @@ let image_click post_image event = in let new_class = match of_string current_class with - | Some image_size -> - to_string (match image_size with Big -> Small | Small -> Big) + | Some image_size -> ( match image_size with Big -> Small | Small -> Big ) | None -> failwith "invalid image class name" in ignore @@ Jv.call post_image "setAttribute" - [| Jv.of_string "class"; Jv.of_string new_class |]; + [| Jv.of_string "class"; Jv.of_string (to_string new_class) |]; + let id = + Jv.to_string + @@ Jv.call post_image "getAttribute" [| Jv.of_string "data-id" |] + in + let src = + match new_class with + | Small -> Format.sprintf "/img/s/%s" id + | Big -> Format.sprintf "/img/%s" id + in + ignore + @@ Jv.call post_image "setAttribute" + [| Jv.of_string "src"; Jv.of_string src |]; (*prevent redirect to /img/:img*) ignore @@ Jv.call event "preventDefault" [||]; ignore @@ Jv.call event "stopPropagation" [||] diff --git a/src/permap.ml b/src/permap.ml index 517ce8d..237e48b 100644 --- a/src/permap.ml +++ b/src/permap.ml @@ -328,10 +328,13 @@ let avatar_image request = | Some avatar -> Dream.respond ~headers:[ ("Content-Type", "image") ] avatar ) ) -let post_image request = +let get_post_image ~thumbnail request = let post_id = Dream.param request "post_id" in if Babillard.post_exist post_id then - let image = Babillard.get_post_image_content post_id in + let image = + if thumbnail then Babillard.get_post_image_thumbnail post_id + else Babillard.get_post_image_content post_id + in match image with | Ok image -> Dream.respond ~headers:[ ("Content-Type", "image") ] image | Error _ -> Dream.empty `Not_Found @@ -481,12 +484,12 @@ let routes = ; get_ "/catalog" catalog ; get_ "/delete/:post_id" delete_get ; post "/delete/:post_id" delete_post - ; get_ "/img/:post_id" post_image + ; get_ "/img/:post_id" (get_post_image ~thumbnail:false) + ; get_ "/img/s/:post_id" (get_post_image ~thumbnail:true) ; get_ "/login" login_get ; post "/login" login_post ; get_ "/logout" logout ; get_ "/markers" markers - ; get_ "/post_pic/:post_id" post_image ; get_ "/profile" profile_get ; post "/profile" profile_post ; get_ "/report/:post_id" report_get diff --git a/src/pp_babillard.ml b/src/pp_babillard.ml index 1ba15a5..eddc3cb 100644 --- a/src/pp_babillard.ml +++ b/src/pp_babillard.ml @@ -29,11 +29,11 @@ let pp_post fmt t = {|
- %s + %s
|} - id id image_alt image_alt + id id image_alt image_alt id | None -> Format.fprintf fmt "" in