Add imgur support

This commit is contained in:
Fabien Freling 2015-09-06 22:16:57 +02:00
parent fcf9fa63b2
commit ad9f0d13b2
3 changed files with 62 additions and 2 deletions

View file

@ -8,3 +8,6 @@ irc:
check: check:
ocamlbuild -use-ocamlfind test.byte -- ocamlbuild -use-ocamlfind test.byte --
clean:
rm -rf _build *.native *.byte

View file

@ -1,3 +1,4 @@
open String
open Str open Str
@ -5,6 +6,24 @@ let is_url url =
let regexp = regexp "\\(https?\\://\\)?\\(www\\.\\)?.+\\..+" in let regexp = regexp "\\(https?\\://\\)?\\(www\\.\\)?.+\\..+" in
string_match regexp url 0 string_match regexp url 0
let is_imgur_url url =
let regexp = regexp "\\(https?\\://\\)?i\\.imgur\\.com/.+\\..+" in
string_match regexp url 0
let get_imgur_gallery_url url =
if not (is_imgur_url url) then
None
else begin
(* Remove i. from the beginning *)
let prefix = regexp "i\\.imgur\\.com" in
let s = replace_first prefix "imgur.com" url in
(* Remove image extension *)
let len = length s in
let ext = regexp "\\.[^\\.]+$" in
let ext_pos = search_backward ext s (len - 1) in
Some (string_before s ext_pos)
end
let is_youtube_url url = let is_youtube_url url =
let regexp = regexp "\\(https?\\://\\)?\\(www\\.\\)?\\(youtube\\.com\\)\\|\\(youtu\\.be\\)/.+" in let regexp = regexp "\\(https?\\://\\)?\\(www\\.\\)?\\(youtube\\.com\\)\\|\\(youtu\\.be\\)/.+" in
@ -18,16 +37,30 @@ let remove_spaces str =
Some (global_replace spaces "" s) Some (global_replace spaces "" s)
| None -> None | None -> None
let format_title str =
"[ " ^ str ^ " ]"
(* Maybe have a list of functions and (* Maybe have a list of functions and
* iter on all the items in the list *) * iter on all the items in the list *)
let evaluate str = let evaluate str =
match str with match str with
| str when is_imgur_url str ->
begin
match get_imgur_gallery_url str with
| None -> None
| Some url ->
begin
let title = SimpleHttp.get_http_title (SimpleHttp.get_body url) |> remove_spaces in
match title with
| Some t -> Some (format_title t)
| None -> None
end
end
| str when is_url str -> | str when is_url str ->
(let title = SimpleHttp.get_http_title (SimpleHttp.get_body str) |> remove_spaces in (let title = SimpleHttp.get_http_title (SimpleHttp.get_body str) |> remove_spaces in
match title with match title with
| Some t -> Some ("[ " ^ t ^ " ]") | Some t -> Some (format_title t)
| None -> None) | None -> None)
| "o/" -> Some "o/" | "o/" -> Some "o/"
| _ -> None | _ -> None

View file

@ -52,6 +52,27 @@ let test_is_url test_ctx =
let check (url, b) = assert_equal (Evaluate.is_url url) b in let check (url, b) = assert_equal (Evaluate.is_url url) b in
List.iter check urls List.iter check urls
let test_is_imgur test_ctx =
let urls = [
("http://imgur.com", false);
("https://foo.bar", false);
("http://i.imgur.com/", false);
("http://i.imgur.com/foobar.png", true)
] in
let check (url, b) = assert_equal (Evaluate.is_imgur_url url) b in
List.iter check urls
let test_imgur_gallery test_ctx =
let urls = [
("http://imgur.com", None);
("https://foo.bar", None);
("http://i.imgur.com/", None);
("http://i.imgur.com/foobar.png", Some "http://imgur.com/foobar");
("https://i.imgur.com/foobar.png", Some "https://imgur.com/foobar")
] in
let check (url, r) = assert_equal (Evaluate.get_imgur_gallery_url url) r in
List.iter check urls
(* Name the test cases and group them together *) (* Name the test cases and group them together *)
let suite = let suite =
@ -60,7 +81,10 @@ let suite =
"test get_title">:: test_get_title; "test get_title">:: test_get_title;
"test remove_spaces">:: test_remove_spaces; "test remove_spaces">:: test_remove_spaces;
"test HTML character escaping">:: test_escape_characters; "test HTML character escaping">:: test_escape_characters;
"test HTTPS">:: test_https "test HTTPS">:: test_https;
"test urls">:: test_is_url;
"test is_imgur">:: test_is_imgur;
"test imgur gallery">:: test_imgur_gallery
] ]
let () = let () =