Permalink
Browse files

Fix payload MC, refactor exampels Makefile a bit

  • Loading branch information...
1 parent 498cfb2 commit 132e050b830ddd6b50bdaf90a97f8e881aca7e58 orbitz committed Mar 16, 2013
Showing with 91 additions and 8 deletions.
  1. +13 −7 examples/Makefile
  2. +77 −0 examples/put.ml
  3. +1 −1 lib/riakc/response.ml
View
@@ -4,7 +4,9 @@ CAMLP4=
OCAMLC_OPTS=-package riakc
OCAMLOPT_OPTS=$(OCAMLC_OPTS)
-cources=ping.ml client_id.ml server_info.ml list_buckets.ml list_keys.ml bucket_props.ml get.ml
+cources=ping.ml client_id.ml server_info.ml \
+ list_buckets.ml list_keys.ml bucket_props.ml \
+ get.ml put.ml
sources=$(cources)
@@ -16,15 +18,17 @@ byte_cmo=$(sources:%.ml=%.cmo)
native_cmi=$(sources_mli:%.mli=%.cmi)
+native_bin=$(cources:%.ml=%.native)
+
+byte_bin=$(cources:%.ml=%.byte)
+
.PHONY: all native byte native-code byte-code test clean
all: native byte
native-code: native
-native: ping.native client_id.native server_info.native \
- list_buckets.native list_keys.native bucket_props.native \
- get.native
+native: $(native_bin)
ping.native: ping.cmx
@@ -40,11 +44,11 @@ bucket_props.native: bucket_props.cmx
get.native: get.cmx
+put.native: put.cmx
+
byte-code: byte
-byte: ping.byte client_id.byte server_info.byte \
- list_buckets.byte list_keys.byte bucket_props.byte \
- get.byte
+byte: $(byte_bin)
ping.byte: ping.cmo
@@ -60,6 +64,8 @@ bucket_props.byte: bucket_props.cmo
get.byte: get.cmo
+put.byte: put.cmo
+
test:
clean:
View
@@ -0,0 +1,77 @@
+open Core.Std
+open Async.Std
+
+let option_to_string =
+ Option.value ~default:"<none>"
+
+let hex_of_string =
+ String.concat_map ~f:(fun c -> sprintf "%X" (Char.to_int c))
+
+let print_usermeta content =
+ let module P = Riakc.Robj.Pair in
+ List.iter
+ ~f:(fun p ->
+ printf "USERMETA: %s = %s\n" (P.key p) (option_to_string (P.value p)))
+ (Riakc.Robj.Content.usermeta content)
+
+let print_value content =
+ let value = Riakc.Robj.Content.value content in
+ List.iter
+ ~f:(printf "CONTENT: %s\n")
+ (String.split ~on:'\n' value)
+
+let print_contents =
+ List.iter
+ ~f:(fun content ->
+ let module C = Riakc.Robj.Content in
+ printf "CONTENT_TYPE: %s\n" (option_to_string (C.content_type content));
+ printf "CHARSET: %s\n" (option_to_string (C.charset content));
+ printf "CONTENT_ENCODING: %s\n" (option_to_string (C.content_encoding content));
+ print_usermeta content;
+ print_value content)
+
+let fail s =
+ printf "%s\n" s;
+ shutdown 1
+
+let exec () =
+ let host = Sys.argv.(1) in
+ let port = Int.of_string Sys.argv.(2) in
+ let b = Sys.argv.(3) in
+ let k = Sys.argv.(4) in
+ let v = Sys.argv.(5) in
+ Riakc.Conn.with_conn
+ ~host
+ ~port
+ (fun c ->
+ let module R = Riakc.Robj in
+ let robj = R.set_content (R.Content.create v) (R.create []) in
+ Riakc.Conn.put c ~b ~k robj)
+
+let eval () =
+ exec () >>| function
+ | Ok (robj, _) -> begin
+ let module R = Riakc.Robj in
+ let vclock =
+ match R.vclock robj with
+ | Some v ->
+ hex_of_string v
+ | None ->
+ "<none>"
+ in
+ printf "VCLOCK: %s\n" vclock;
+ print_contents (R.contents robj);
+ shutdown 0
+ end
+ | Error `Bad_conn -> fail "Bad_conn"
+ | Error `Bad_payload -> fail "Bad_payload"
+ | Error `Incomplete_payload -> fail "Incomplete_payload"
+ | Error `Notfound -> fail "Notfound"
+ | Error `Incomplete -> fail "Incomplete"
+ | Error `Overflow -> fail "Overflow"
+ | Error `Unknown_type -> fail "Unknown_type"
+ | Error `Wrong_type -> fail "Wrong_type"
+
+let () =
+ ignore (eval ());
+ never_returns (Scheduler.go ())
@@ -93,7 +93,7 @@ let get payload =
let put payload =
let open Result.Monad_infix in
- run '\x0B' payload Pb_response.put >>= fun (c, vclock, key) ->
+ run '\x0C' payload Pb_response.put >>= fun (c, vclock, key) ->
Ok (Done (Robj.of_pb c vclock None, key))
let parse_length s =

0 comments on commit 132e050

Please sign in to comment.