helm/DEVEL/pxp/netstring/netstream.ml

   1 (* $Id$
   2  * ----------------------------------------------------------------------
   3  *
   4  *)
   5
   6
   7 type t =
   8     { s_channel : in_channel;
   9       s_maxlength : int option;
  10       s_blocksize : int;
  11       mutable s_current_length : int;
  12       mutable s_at_eos : bool;
  13       mutable s_win_pos : int;
  14       mutable s_win_len : int;
  15       s_netbuf : Netbuffer.t;
  16       s_iobuf : string;
  17     }
  18 ;;
  19
  20
  21 let dump s text =
  22   print_string ("*** NETSTREAM DUMP " ^ text ^ "\n");
  23   Printf.printf "current_length=%d  at_eos=%b  win_pos=%d  win_len=%d\n"
  24                 s.s_current_length s.s_at_eos s.s_win_pos s.s_win_len;
  25   Printf.printf "netbuffer_length=%d  netbuffer_size=%d\n"
  26                 (Netbuffer.length s.s_netbuf)
  27                 (String.length(Netbuffer.unsafe_buffer s.s_netbuf));
  28   Printf.printf "netbuffer=\"%s\"\n"
  29                 (String.escaped(Netbuffer.contents s.s_netbuf));
  30   print_string "*** ---------------\n";
  31   flush stdout
  32 ;;
  33
  34
  35 let want_another_block s =
  36   if not s.s_at_eos then begin
  37     (* How much are we allowed to read? *)
  38     let m =
  39       match s.s_maxlength with
  40           None   -> s.s_blocksize
  41         | Some k -> min (k - s.s_current_length) s.s_blocksize
  42     in
  43     (* Read this. *)
  44     let rec read_block k =
  45       if k < m then
  46         let n =
  47           input s.s_channel s.s_iobuf k (m - k) in
  48         ( if n > 0 then
  49             read_block (k+n)
  50           else (* EOF *)
  51             k
  52         )
  53       else
  54         k
  55     in
  56     let n = read_block 0 in
  57     (* If n < blocksize, EOS is reached. *)
  58     Netbuffer.add_sub_string s.s_netbuf s.s_iobuf 0 n;
  59     s.s_win_len        <- s.s_win_len + n;
  60     s.s_current_length <- s.s_current_length + n;
  61     s.s_at_eos         <- n < s.s_blocksize;
  62
  63     (* dump s "After appending block"; *)
  64   end
  65 ;;
  66
  67
  68 let want s n =
  69   while not s.s_at_eos && s.s_win_len < n do
  70     want_another_block s
  71   done
  72 ;;
  73
  74
  75 let want_minimum s =
  76   want s (s.s_blocksize + s.s_blocksize)
  77 ;;
  78
  79
  80 let move s n =
  81   Netbuffer.delete s.s_netbuf 0 n;
  82   s.s_win_pos <- s.s_win_pos + n;
  83   s.s_win_len <- s.s_win_len - n;
  84   want_minimum s;
  85   (* dump s "After move"; *)
  86 ;;
  87
  88
  89 let create_from_channel ch maxlength blocksize =
  90   let s =
  91     { s_channel = ch;
  92       s_maxlength = maxlength;
  93       s_blocksize = blocksize;
  94       s_current_length = 0;
  95       s_at_eos = false;
  96       s_win_pos = 0;
  97       s_win_len = 0;
  98       s_netbuf = Netbuffer.create (2*blocksize);
  99       s_iobuf = String.create blocksize;
 100     }
 101   in
 102   want_minimum s;
 103   s
 104 ;;
 105
 106
 107 let create_from_string str =
 108   let l = String.length str in
 109   { s_channel = stdin;
 110     s_maxlength = None;
 111     s_blocksize = l;
 112     s_current_length = l;
 113     s_at_eos = true;
 114     s_win_pos = 0;
 115     s_win_len = l;
 116     s_netbuf =
 117       ( let nb = Netbuffer.create l in
 118         Netbuffer.add_string nb str;
 119         nb
 120       );
 121     s_iobuf = "";
 122   }
 123 ;;
 124
 125
 126 let block_size s = s.s_blocksize;;
 127
 128 let current_length s = s.s_current_length;;
 129
 130 let at_eos s = s.s_at_eos;;
 131
 132 let window_position s = s.s_win_pos;;
 133
 134 let window_length s = s.s_win_len;;
 135
 136 let window s = s.s_netbuf;;
 137
 138 let print_stream s =
 139   Format.printf
 140     "<NETSTREAM window:%d/%d total_length:%d eof=%b>"
 141     s.s_win_pos
 142     s.s_win_len
 143     s.s_current_length
 144     s.s_at_eos
 145 ;;
 146
 147
 148 (* ======================================================================
 149  * History:
 150  *
 151  * $Log$
 152  * Revision 1.1  2000/11/17 09:57:27  lpadovan
 153  * Initial revision
 154  *
 155  * Revision 1.2  2000/06/24 20:20:33  gerd
 156  *      Added the toploop printer.
 157  *
 158  * Revision 1.1  2000/04/15 13:07:48  gerd
 159  *      Initial revision.
 160  *
 161  *
 162  *)