mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-06 11:15:31 -05:00
83 lines
2.8 KiB
OCaml
83 lines
2.8 KiB
OCaml
|
|
(** Crawl the web to find shortest path between two urls *)
|
|
|
|
open Batteries
|
|
|
|
let pool = Future.Pool.create ~timeout:15. ~size:50
|
|
|
|
let split_lines s = String.nsplit s ~by:"\n"
|
|
|
|
let get_and_parse url =
|
|
let cmd = Format.sprintf "wget -q '%s' -O - | grep -o 'http\\(s\\)\\?://[^ \"]\\+'" url in
|
|
let content = Future.spawn_process ?stdin:None ~pool ~cmd in
|
|
content
|
|
|> Future.map (fun (_, stdout, _) -> stdout)
|
|
|> Future.map split_lines
|
|
|> Batteries.tap (fun lines ->
|
|
Future.on_success lines (fun lines -> Format.printf "downloaded %s (%d urls)@." url (List.length lines)))
|
|
|
|
type page = string * (string list Future.t)
|
|
|
|
(** The web graph; its vertices are annotated by futures of the content *)
|
|
let g : (page, string, unit) LazyGraph.t =
|
|
let force (url, future) =
|
|
Format.printf "force %s@." url;
|
|
let urls =
|
|
try Future.get future |> List.map (fun url -> (), (url, get_and_parse url))
|
|
with e -> [] in
|
|
let edges = Gen.of_list urls in
|
|
(* need to parse the page to get the urls *)
|
|
LazyGraph.Node ((url, future), url, edges)
|
|
in LazyGraph.make
|
|
~eq:(fun (url1,_) (url2,_) -> url1 = url2)
|
|
~hash:(fun (url,_) -> Hashtbl.hash url)
|
|
force
|
|
|
|
let pp_path fmt path =
|
|
List.print ~sep:"\n"
|
|
(fun fmt ((u1,_), (), (u2,_)) ->
|
|
String.print fmt u1; String.print fmt " -> "; String.print fmt u2)
|
|
fmt path
|
|
|
|
(* seek a path from the first url to the second *)
|
|
let path_between from into =
|
|
Format.printf "seek path from %s to %s@." from into;
|
|
let on_explore (url,_) = Format.printf " explore %s...@." url in
|
|
try
|
|
let cost, path = LazyGraph.dijkstra ~on_explore g
|
|
(from, get_and_parse from) (into, get_and_parse into) in
|
|
Printf.printf "found path (cost %f):\n%a\n" cost pp_path path
|
|
with Not_found ->
|
|
Format.printf "no path could be found@."
|
|
|
|
let print_limit file start depth =
|
|
Format.printf "print into %s webgraph starting from %s, up to depth %d@."
|
|
file start depth;
|
|
let start = start, get_and_parse start in
|
|
let g' = LazyGraph.limit_depth g depth (Gen.singleton start) in
|
|
let g'' = LazyGraph.map ~vertices:(fun v -> [`Label v]) ~edges:(fun _ -> []) g' in
|
|
let out = Format.formatter_of_out_channel (open_out file) in
|
|
LazyGraph.Dot.pp ~name:"web" g'' out (Gen.singleton start);
|
|
Format.pp_print_flush out ();
|
|
()
|
|
|
|
let _ =
|
|
let timer = Future.Timer.create () in
|
|
let rec ping () =
|
|
Format.printf "*** ping! (size of pool: %d)@." (Future.Pool.size pool);
|
|
Future.Timer.schedule_in timer 10. ping
|
|
in ping ()
|
|
|
|
let print_usage () =
|
|
Format.printf "usage: crawl path url1 url2@.";
|
|
Format.printf "usage: crawl print file url depth@.";
|
|
()
|
|
|
|
let _ =
|
|
match Sys.argv with
|
|
| [|_; "print"; file; url; depth|] ->
|
|
print_limit file url (int_of_string depth)
|
|
| [|_; "path"; from; into|] ->
|
|
path_between from into
|
|
| _ ->
|
|
print_usage ()
|