1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
|
(* $Id: netstream.ml,v 1.2 2000/06/24 20:20:33 gerd Exp $
* ----------------------------------------------------------------------
*
*)
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: netstream.ml,v $
* 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.
*
*
*)
|
