--- /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.
+ *
+ *
+ *)