Add imgur support
This commit is contained in:
parent
fcf9fa63b2
commit
ad9f0d13b2
|
@ -8,3 +8,6 @@ irc:
|
|||
|
||||
check:
|
||||
ocamlbuild -use-ocamlfind test.byte --
|
||||
|
||||
clean:
|
||||
rm -rf _build *.native *.byte
|
||||
|
|
|
@ -1,3 +1,4 @@
|
|||
open String
|
||||
open Str
|
||||
|
||||
|
||||
|
@ -5,6 +6,24 @@ let is_url url =
|
|||
let regexp = regexp "\\(https?\\://\\)?\\(www\\.\\)?.+\\..+" in
|
||||
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 regexp = regexp "\\(https?\\://\\)?\\(www\\.\\)?\\(youtube\\.com\\)\\|\\(youtu\\.be\\)/.+" in
|
||||
|
@ -18,16 +37,30 @@ let remove_spaces str =
|
|||
Some (global_replace spaces "" s)
|
||||
| None -> None
|
||||
|
||||
let format_title str =
|
||||
"[ " ^ str ^ " ]"
|
||||
|
||||
|
||||
(* Maybe have a list of functions and
|
||||
* iter on all the items in the list *)
|
||||
let evaluate str =
|
||||
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 ->
|
||||
(let title = SimpleHttp.get_http_title (SimpleHttp.get_body str) |> remove_spaces in
|
||||
match title with
|
||||
| Some t -> Some ("[ " ^ t ^ " ]")
|
||||
| Some t -> Some (format_title t)
|
||||
| None -> None)
|
||||
| "o/" -> Some "o/"
|
||||
| _ -> None
|
||||
|
|
|
@ -52,6 +52,27 @@ let test_is_url test_ctx =
|
|||
let check (url, b) = assert_equal (Evaluate.is_url url) b in
|
||||
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 *)
|
||||
let suite =
|
||||
|
@ -60,7 +81,10 @@ let suite =
|
|||
"test get_title">:: test_get_title;
|
||||
"test remove_spaces">:: test_remove_spaces;
|
||||
"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 () =
|
||||
|
|
Loading…
Reference in a new issue