examples/omulti.ml

   1 (*
   2  * omulti.ml
   3  *
   4  * Copyright (c) 2009, ygrek, <ygrek@autistici.org>
   5  *)
   6
   7 module M = Curl.Multi
   8 module Ev = Libevent
   9
  10 let pr fmt = Printf.ksprintf print_endline fmt
  11
  12 let finished mt =
  13   let rec loop n =
  14   match M.remove_finished mt with
  15   | None -> (*if n > 0 then pr "Removed %u handles" n*) ()
  16   | Some _ -> loop (n+1)
  17   in loop 0
  18
  19 let loop_wait mt =
  20   pr "perform/wait";
  21   while M.perform mt > 0 do
  22     ignore (M.wait mt)
  23   done;
  24   finished mt
  25
  26 let events_base = Ev.init ()
  27
  28 let loop_async mt =
  29   pr "action/event";
  30   let events = Hashtbl.create 32 in
  31   let on_event fd flags =
  32     let event = match flags with
  33                 | Ev.READ -> M.EV_IN
  34                 | Ev.WRITE -> M.EV_OUT
  35                 | _ -> M.EV_AUTO
  36     in
  37     let _ = M.action mt fd event in
  38     finished mt
  39   in
  40   let evs = ref 0 in
  41   M.set_socket_function mt begin fun fd what ->
  42     List.iter (fun ev -> decr evs; Ev.del ev) (Hashtbl.find_all events fd); Hashtbl.remove events fd;
  43     let flags = match what with
  44           | M.POLL_REMOVE | M.POLL_NONE -> []
  45           | M.POLL_IN -> [Ev.READ]
  46           | M.POLL_OUT -> [Ev.WRITE]
  47           | M.POLL_INOUT -> [Ev.READ;Ev.WRITE]
  48     in
  49     match flags with
  50     | [] -> finished mt
  51     | flags ->
  52       let ev = Ev.create () in
  53       Ev.set events_base ev fd flags ~persist:true on_event;
  54       Ev.add ev None;
  55       incr evs;
  56       Hashtbl.add events fd ev
  57   end;
  58   let _ = M.action_all mt in
  59   Ev.dispatch events_base;
  60   assert (0 = !evs);
  61   finished mt
  62
  63 let loop_select mt =
  64   pr "action/select";
  65   let in_fd = ref [] in
  66   let out_fd = ref [] in
  67   let on_event fd event =
  68     let _ = M.action mt fd event in
  69     finished mt
  70   in
  71   M.set_socket_function mt begin fun fd what ->
  72     in_fd := List.filter ((<>) fd) !in_fd;
  73     out_fd := List.filter ((<>) fd) !out_fd;
  74     match what with
  75     | M.POLL_REMOVE | M.POLL_NONE -> finished mt
  76     | M.POLL_IN -> in_fd := fd :: !in_fd
  77     | M.POLL_OUT -> out_fd := fd :: !out_fd
  78     | M.POLL_INOUT -> in_fd := fd :: !in_fd; out_fd := fd :: !out_fd
  79   end;
  80   let _ = M.action_all mt in
  81   while !in_fd <> [] || !out_fd <> [] do
  82     let (fdi,fdo,_) = Unix.select !in_fd !out_fd [] (-1.) in
  83     List.iter (fun fd -> on_event fd M.EV_IN) fdi;
  84     List.iter (fun fd -> on_event fd M.EV_OUT) fdo;
  85   done;
  86   finished mt
  87
  88 let input_lines file =
  89   let ch = open_in file in
  90   let lines = ref [] in
  91   try while true do lines := input_line ch :: !lines done; []
  92   with End_of_file -> close_in_noerr ch; List.rev !lines
  93
  94 let () =
  95   let module A = Array in
  96   let func = ref None in
  97   let urls =
  98     let urls = ref [] in
  99     let n = ref 10 in
 100     let args = Arg.align
 101       ["-n",Arg.Set_int n,"<N> ";
 102        "-i",Arg.String (fun s -> urls := input_lines s @ !urls),"<file> read urls from file";
 103        "-l",Arg.String (fun s -> urls := s :: !urls),"<url> fetch url";
 104        "-m",Arg.String (function
 105            | "wait" -> func := Some loop_wait
 106            | "event" -> func := Some loop_async
 107            | "select" -> func := Some loop_select
 108            | s-> failwith (Printf.sprintf "unknown method : %s" s)), "<wait|event|select> loop method";
 109       ]
 110     in
 111     Arg.parse args failwith "Options :";
 112     match !urls with
 113     | [url] -> A.make !n url
 114     | l -> A.of_list l
 115   in
 116 (*   if A.length urls = 0 then failwith "Specify urls to download"; *)
 117   let init url =
 118     let h = Curl.init () in
 119     Curl.set_url h url;
 120     Curl.set_writefunction h String.length;
 121     h
 122   in
 123   let cleanup h =
 124     Printf.printf "Time: %f Size: %Lu Speed: %.2f KB/s URL: %s\n"
 125       (Curl.get_totaltime h)
 126       (Int64.of_float (Curl.get_sizedownload h))
 127       (Curl.get_speeddownload h /. 1024.)
 128       (Curl.get_effectiveurl h);
 129     Curl.cleanup h
 130   in
 131   let test loop =
 132    let hs = A.map init urls in
 133    let mt = M.create () in
 134    A.iter (M.add mt) hs;
 135    loop mt;
 136    A.iter cleanup hs;
 137    M.cleanup mt;
 138    pr "Finished";
 139   in
 140   match !func with
 141   | None -> test loop_wait; test loop_select; test loop_async
 142   | Some f -> test f
 143