/pliant/language/stream/pipe.pli
 
 1  # Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx 
 2  # 
 3  # This program is free software; you can redistribute it and/or 
 4  # modify it under the terms of the GNU General Public License version 2 
 5  # as published by the Free Software Foundation. 
 6  # 
 7  # This program is distributed in the hope that it will be useful, 
 8  # but WITHOUT ANY WARRANTY; without even the implied warranty of 
 9  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the 
 10  # GNU General Public License for more details. 
 11  # 
 12  # You should have received a copy of the GNU General Public License 
 13  # version 2 along with this program; if not, write to the Free Software 
 14  # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA. 
 15   
 16  module "ring.pli" 
 17  module "/pliant/language/os/socket.pli" 
 18   
 19  type HandleDriver 
 20    field Int handle 
 21    field Float timeout 
 22    field CBool autoclose 
 23  StreamDriver maybe HandleDriver 
 24   
 25  method drv read buf mini maxi -> red 
 26    arg_rw HandleDriver drv ; arg Address buf ; arg Int mini maxi red 
 27    if drv:timeout=defined 
 28      if (os_socket_wait drv:handle in drv:timeout)=failure 
 29        return 0 
 30    if os_api="linux" or os_api="posix" 
 31      red := os_read drv:handle buf maxi 
 32    eif os_api="win32" 
 33      if not (os_ReadFile drv:handle buf maxi red null) 
 34        red := 0 
 35    eif os_api="os2" 
 36      if (os_DosRead drv:handle buf maxi red)<>0 
 37        red := 0 
 38    else 
 39      error "not implemented under "+os_api 
 40      red := 0 
 41    red := max red 0 
 42   
 43  method drv write buf mini maxi -> written 
 44    arg_rw HandleDriver drv ; arg Address buf ; arg Int mini maxi written 
 45    if drv:timeout=defined 
 46      if (os_socket_wait drv:handle out drv:timeout)=failure 
 47        return 0 
 48    if os_api="linux" or os_api="posix" 
 49      written := os_write drv:handle buf maxi 
 50    eif os_api="win32" 
 51      if not (os_WriteFile drv:handle buf maxi written null) 
 52        written := 0 
 53    eif os_api="os2" 
 54      if (os_DosWrite drv:handle buf maxi written)<>0 
 55        written := 0 
 56    else 
 57      error "not implemented under "+os_api 
 58      written := 0 
 59    written := max written 0 
 60   
 61  method drv configure command stream -> status 
 62    arg_rw HandleDriver drv ; arg Str command ; arg_rw Stream stream ; arg ExtendedStatus status 
 63    if (command parse word:"timeout" drv:timeout) 
 64      status := success 
 65    else 
 66      status := failure 
 67   
 68  method drv close -> status 
 69    arg_rw HandleDriver drv ; arg ExtendedStatus status 
 70    if drv:autoclose 
 71      status := shunt (os_close drv:handle)=0 success failure 
 72    else 
 73      status := success 
 74   
 75  type HandleFileSystem 
 76    void 
 77  FileSystem maybe HandleFileSystem 
 78   
 79  method fs open name options flags stream support -> status 
 80    arg_rw HandleFileSystem fs ; arg Str name options ; arg Int flags ; arg_rw Stream stream support ; arg ExtendedStatus status 
 81    if not (name parse (var Int handle)) 
 82      return failure 
 83    var Link:HandleDriver drv :> new HandleDriver 
 84    if os_api="win32" 
 85      if handle = 0 
 86        handle := os_GetStdHandle os_STD_INPUT_HANDLE 
 87      eif handle = 1 
 88        handle := os_GetStdHandle os_STD_OUTPUT_HANDLE 
 89      eif handle = 2 
 90        handle := os_GetStdHandle os_STD_ERROR_HANDLE 
 91    drv handle := handle 
 92    drv timeout := undefined 
 93    drv autoclose := options option "autoclose" 
 94    stream stream_driver :> drv 
 95    stream stream_handle := handle 
 96    status := success 
 97   
 98  gvar HandleFileSystem handle_file_system 
 99  pliant_multi_file_system mount "handle:" "" handle_file_system 
 100   
 101   
 102  if os_api="linux" 
 103   
 104    function stream_pipe in_name out_name -> status 
 105      arg_w Str in_name out_name ; arg Status status 
 106      stream_lock_handle 
 107      stream_lock_handle 
 108      var Int err := os_pipe (var os_pipe_handles handles) 
 109      stream_unlock_handle handles:in 
 110      stream_unlock_handle handles:out 
 111      if err<>0 
 112        return failure 
 113      status := success 
 114      in_name := (string "handle:"+(string handles:in))+" autoclose" 
 115      out_name := (string "handle:"+(string handles:out))+" autoclose" 
 116       
 117    export stream_pipe