+++ /dev/null
-(* $Id$
- * ----------------------------------------------------------------------
- *
- *)
-
-
-type t =
- { s_channel : in_channel;
- s_maxlength : int option;
- s_blocksize : int;
- mutable s_current_length : int;
- mutable s_at_eos : bool;
- mutable s_win_pos : int;
- mutable s_win_len : int;
- s_netbuf : Netbuffer.t;
- s_iobuf : string;
- }
-;;
-
-
-let dump s text =
- print_string ("*** NETSTREAM DUMP " ^ text ^ "\n");
- Printf.printf "current_length=%d at_eos=%b win_pos=%d win_len=%d\n"
- s.s_current_length s.s_at_eos s.s_win_pos s.s_win_len;
- Printf.printf "netbuffer_length=%d netbuffer_size=%d\n"
- (Netbuffer.length s.s_netbuf)
- (String.length(Netbuffer.unsafe_buffer s.s_netbuf));
- Printf.printf "netbuffer=\"%s\"\n"
- (String.escaped(Netbuffer.contents s.s_netbuf));
- print_string "*** ---------------\n";
- flush stdout
-;;
-
-
-let want_another_block s =
- if not s.s_at_eos then begin
- (* How much are we allowed to read? *)
- let m =
- match s.s_maxlength with
- None -> s.s_blocksize
- | Some k -> min (k - s.s_current_length) s.s_blocksize
- in
- (* Read this. *)
- let rec read_block k =
- if k < m then
- let n =
- input s.s_channel s.s_iobuf k (m - k) in
- ( if n > 0 then
- read_block (k+n)
- else (* EOF *)
- k
- )
- else
- k
- in
- let n = read_block 0 in
- (* If n < blocksize, EOS is reached. *)
- Netbuffer.add_sub_string s.s_netbuf s.s_iobuf 0 n;
- s.s_win_len <- s.s_win_len + n;
- s.s_current_length <- s.s_current_length + n;
- s.s_at_eos <- n < s.s_blocksize;
-
- (* dump s "After appending block"; *)
- end
-;;
-
-
-let want s n =
- while not s.s_at_eos && s.s_win_len < n do
- want_another_block s
- done
-;;
-
-
-let want_minimum s =
- want s (s.s_blocksize + s.s_blocksize)
-;;
-
-
-let move s n =
- Netbuffer.delete s.s_netbuf 0 n;
- s.s_win_pos <- s.s_win_pos + n;
- s.s_win_len <- s.s_win_len - n;
- want_minimum s;
- (* dump s "After move"; *)
-;;
-
-
-let create_from_channel ch maxlength blocksize =
- let s =
- { s_channel = ch;
- s_maxlength = maxlength;
- s_blocksize = blocksize;
- s_current_length = 0;
- s_at_eos = false;
- s_win_pos = 0;
- s_win_len = 0;
- s_netbuf = Netbuffer.create (2*blocksize);
- s_iobuf = String.create blocksize;
- }
- in
- want_minimum s;
- s
-;;
-
-
-let create_from_string str =
- let l = String.length str in
- { s_channel = stdin;
- s_maxlength = None;
- s_blocksize = l;
- s_current_length = l;
- s_at_eos = true;
- s_win_pos = 0;
- s_win_len = l;
- s_netbuf =
- ( let nb = Netbuffer.create l in
- Netbuffer.add_string nb str;
- nb
- );
- s_iobuf = "";
- }
-;;
-
-
-let block_size s = s.s_blocksize;;
-
-let current_length s = s.s_current_length;;
-
-let at_eos s = s.s_at_eos;;
-
-let window_position s = s.s_win_pos;;
-
-let window_length s = s.s_win_len;;
-
-let window s = s.s_netbuf;;
-
-let print_stream s =
- Format.printf
- "<NETSTREAM window:%d/%d total_length:%d eof=%b>"
- s.s_win_pos
- s.s_win_len
- s.s_current_length
- s.s_at_eos
-;;
-
-
-(* ======================================================================
- * History:
- *
- * $Log$
- * Revision 1.1 2000/11/17 09:57:27 lpadovan
- * Initial revision
- *
- * Revision 1.2 2000/06/24 20:20:33 gerd
- * Added the toploop printer.
- *
- * Revision 1.1 2000/04/15 13:07:48 gerd
- * Initial revision.
- *
- *
- *)