neale
/
irc-bot
mirror of https://github.com/nealey/irc-bot
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Change out implementation of ocs ports

This commit is contained in:
Neale Pickett 2009-03-03 17:40:03 -06:00
parent 18491d1314
commit e3eae3bb19
2 changed files with 86 additions and 192 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

270
ocs-1.0.3/src/ocs_port.ml
View File

@ -2,222 +2,124 @@
open Ocs_error open Ocs_error
(* Ports can either be file descriptors or string buffers. File type port_impl =
descriptors may be valid for both input and output, but when | Input_channel of in_channel
switching between the two modes, the file offset may not work | Output_channel of out_channel
as expected. | Input_string of string * int ref
| Output_string of Buffer.t
For unbuffered or asynchronous I/O, from Scheme or otherwise,
the port can simply be used as a reference to the file
descriptor. *)
type port = { type port = {
mutable p_buf : string; ungot : char option ref;
mutable p_pos : int; impl : port_impl;
mutable p_wend : int;
mutable p_rend : int;
mutable p_ugc : char option;
mutable p_fd : Unix.file_descr option;
mutable p_input : bool;
mutable p_output : bool;
p_close : bool
} }
type port_flag =
Pf_input
| Pf_output
| Pf_close
let mkbuf () =
String.create 1024
;;
let mkport buf fd inf outf cl =
{ p_buf = buf;
p_pos = 0;
p_wend = 0;
p_rend = 0;
p_ugc = None;
p_fd = fd;
p_input = inf;
p_output = outf;
p_close = cl }
;;
let is_input p = let is_input p =
p.p_input match p.impl with
;; | Input_string _
| Input_channel _ -> true
| _ -> false
let is_output p = let is_output p =
p.p_output match p.impl with
;; | Output_string _
| Output_channel _ -> true
let wrflush p = | _ -> false
if not p.p_output then
raise (Error "not a valid output port");
match p.p_fd with
Some fd ->
if p.p_wend > 0 && p.p_pos > 0 then
begin
try
let n = Unix.write fd p.p_buf 0 p.p_pos in
if n <> p.p_pos then
raise (Error "write error: incomplete write")
with
Unix.Unix_error (e, _, _) ->
raise (Error ("write error: " ^ Unix.error_message e))
end;
p.p_pos <- 0;
p.p_wend <- String.length p.p_buf
| None ->
if p.p_pos = p.p_wend then
let n = String.length p.p_buf in
let nbuf = String.create (n * 2) in
String.blit p.p_buf 0 nbuf 0 n;
p.p_buf <- nbuf;
p.p_wend <- String.length p.p_buf
;;
let rdfill p =
if not p.p_input then
raise (Error "not a valid input port");
if p.p_wend > 0 then
wrflush p;
p.p_pos <- 0;
p.p_rend <- 0;
p.p_wend <- 0;
match p.p_fd with
Some fd ->
begin
try
p.p_rend <- Unix.read fd p.p_buf 0 (String.length p.p_buf)
with
Unix.Unix_error (e, _, _) ->
raise (Error ("read error: " ^ Unix.error_message e))
end
| None -> ()
;;
let getc p = let getc p =
match p.p_ugc with match (!(p.ungot), p.impl) with
Some _ as c -> p.p_ugc <- None; c | (Some c, _) ->
| None -> p.ungot := None;
if p.p_rend = 0 || p.p_pos >= p.p_rend then rdfill p; Some c
if p.p_rend = 0 then None | (None, Input_string (str, pos)) ->
else if !pos >= (String.length str) then
begin None
assert (p.p_pos < p.p_rend); else
let c = p.p_buf.[p.p_pos] in let c = str.[!pos] in
p.p_pos <- p.p_pos + 1; pos := !pos + 1;
Some c Some c
end | (None, Input_channel chan) ->
;; begin
try
let get_fd p = Some (input_char chan)
p.p_fd with End_of_file ->
;; None
end
| _ ->
None
let flush p = let flush p =
if p.p_wend > 0 then match p.impl with
wrflush p | Output_channel chan ->
;; Pervasives.flush chan
| _ ->
()
let close p = let close p =
if p.p_input || p.p_output then p.ungot := None;
begin match p.impl with
flush p; | Input_channel chan ->
p.p_input <- false; close_in chan
p.p_output <- false; | Output_channel chan ->
match p.p_fd with close_out chan
Some fd -> | _ ->
if p.p_close then Unix.close fd; ()
p.p_fd <- None
| None -> ()
end
;;
let ungetc p c = let ungetc p c =
p.p_ugc <- Some c p.ungot := Some c
;;
let char_ready p = let char_ready p =
if p.p_ugc <> None || p.p_pos < p.p_rend then true match (!(p.ungot), p.impl) with
else if not p.p_input then false | (Some _, Input_string _)
else | (Some _, Input_channel _) ->
match p.p_fd with true
Some fd -> | (None, Input_string (str, pos)) ->
let (r, _, _) = Unix.select [ fd ] [] [] 0.0 in !pos < (String.length str)
List.length r > 0 | (None, Input_channel chan) ->
| None -> false let fd = Unix.descr_of_in_channel chan in
;; let (r, _, _) = Unix.select [fd] [] [] 0.0 in
List.length r > 0
| _ ->
false
let putc p c = let putc p c =
if p.p_wend = 0 || p.p_pos >= p.p_wend then match p.impl with
wrflush p; | Output_string buf ->
assert (p.p_pos < p.p_wend); Buffer.add_char buf c
p.p_buf.[p.p_pos] <- c; | Output_channel chan ->
p.p_pos <- p.p_pos + 1 output_char chan c
;; | _ ->
()
let puts p s = let puts p s =
let n = String.length s in match p.impl with
if n > 0 && p.p_rend - p.p_pos >= n then | Output_string buf ->
begin Buffer.add_string buf s
String.blit s 0 p.p_buf p.p_pos n; | Output_channel chan ->
p.p_pos <- p.p_pos + n output_string chan s
end | _ ->
else ()
String.iter (fun c -> putc p c) s
;;
let fd_port fd flags =
let inf = ref false
and outf = ref false
and clf = ref false in
List.iter (function
Pf_input -> inf := true
| Pf_output -> outf := true
| Pf_close -> clf := true) flags;
let p = mkport (mkbuf ()) (Some fd) !inf !outf !clf in
if !clf then Gc.finalise close p;
p
;;
let input_port ch = let input_port ch =
fd_port (Unix.descr_of_in_channel ch) [ Pf_input ] { ungot = ref None; impl = Input_channel ch }
;;
let output_port ch = let output_port ch =
fd_port (Unix.descr_of_out_channel ch) [ Pf_output ] { ungot = ref None; impl = Output_channel ch }
;;
let open_input_port name = let open_input_port name =
try try
let fd = Unix.openfile name [ Unix.O_RDONLY ] 0 in input_port (open_in_bin name)
fd_port fd [ Pf_input; Pf_close ] with Sys_error err ->
with raise (Error ("unable to open '" ^ name ^ "' for input: " ^ err))
Unix.Unix_error (e, _, _) ->
let err = Unix.error_message e in
raise (Error ("unable to open '" ^ name ^ "' for input: " ^ err))
;;
let open_output_port name = let open_output_port name =
try try
let fd = Unix.openfile name [ Unix.O_WRONLY; Unix.O_APPEND; output_port (open_out_bin name)
Unix.O_CREAT; Unix.O_TRUNC ] 0o666 in with Sys_error err ->
fd_port fd [ Pf_output; Pf_close ] raise (Error ("unable to open '" ^ name ^ "' for output: " ^ err))
with
Unix.Unix_error (e, _, _) ->
let err = Unix.error_message e in
raise (Error ("unable to open '" ^ name ^ "' for output: " ^ err))
;;
let string_input_port s = let string_input_port s =
let p = mkport s None true false false in { ungot = ref None; impl = Input_string (s, ref 0) }
p.p_rend <- String.length s;
p
;;
let string_output_port () = let string_output_port () =
mkport (mkbuf ()) None false true false { ungot = ref None; impl = Output_string (Buffer.create 256) }
;;

8
ocs-1.0.3/src/ocs_port.mli
View File

@ -2,12 +2,6 @@
type port type port
type port_flag =
Pf_input
| Pf_output
| Pf_close
val fd_port : Unix.file_descr -> port_flag list -> port
val input_port : in_channel -> port val input_port : in_channel -> port
val output_port : out_channel -> port val output_port : out_channel -> port
val open_input_port : string -> port val open_input_port : string -> port
@ -25,8 +19,6 @@ val char_ready : port -> bool
val putc : port -> char -> unit val putc : port -> char -> unit
val puts : port -> string -> unit val puts : port -> string -> unit
val get_fd : port -> Unix.file_descr option
val flush : port -> unit val flush : port -> unit
val close : port -> unit val close : port -> unit