Add imgur support
This commit is contained in:
parent
fcf9fa63b2
commit
ad9f0d13b2
|
@ -8,3 +8,6 @@ irc:
|
||||||
|
|
||||||
check:
|
check:
|
||||||
ocamlbuild -use-ocamlfind test.byte --
|
ocamlbuild -use-ocamlfind test.byte --
|
||||||
|
|
||||||
|
clean:
|
||||||
|
rm -rf _build *.native *.byte
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 () =
|
||||||
|
|
Loading…
Reference in a new issue