From 863ab575e377e3650e8415ea97ba0a6f347e9be7 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Fri, 14 Oct 2011 19:14:59 -0700
Subject: [PATCH] io.ports: stream-seekable? and stream-length
io.files.windows, io.backend.unix: platform-specific backends for those
methods
---
basis/io/backend/unix/unix.factor | 11 +++++++++--
basis/io/files/windows/windows.factor | 6 ++++++
basis/io/ports/ports.factor | 23 ++++++++++++++++++-----
3 files changed, 33 insertions(+), 7 deletions(-)
diff --git a/basis/io/backend/unix/unix.factor b/basis/io/backend/unix/unix.factor
index 502b135872..481edbce20 100755
--- a/basis/io/backend/unix/unix.factor
+++ b/basis/io/backend/unix/unix.factor
@@ -2,11 +2,12 @@
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.data alien.syntax generic
assocs kernel kernel.private math io.ports sequences strings
-sbufs threads unix unix.ffi vectors io.buffers io.backend
+sbufs threads unix unix.ffi unix.stat vectors io.buffers io.backend
io.encodings math.parser continuations system libc namespaces
make io.timeouts io.encodings.utf8 destructors
destructors.private accessors summary combinators locals
-unix.time unix.types fry io.backend.unix.multiplexers ;
+unix.time unix.types fry io.backend.unix.multiplexers
+classes.struct ;
QUALIFIED: io
IN: io.backend.unix
@@ -57,6 +58,12 @@ M: unix seek-handle ( n seek-type handle -- )
} case
[ fd>> swap ] dip [ lseek ] unix-system-call drop ;
+M: unix can-seek-handle? ( handle -- ? )
+ fd>> SEEK_CUR 0 lseek -1 = not ;
+M: unix handle-length ( handle -- n/f )
+ fd>> \ stat <struct> [ fstat -1 = not ] keep
+ swap [ st_size>> ] [ drop f ] if ;
+
SYMBOL: +retry+ ! just try the operation again without blocking
SYMBOL: +input+
SYMBOL: +output+
diff --git a/basis/io/files/windows/windows.factor b/basis/io/files/windows/windows.factor
index bd924989a9..d278ad06e6 100755
--- a/basis/io/files/windows/windows.factor
+++ b/basis/io/files/windows/windows.factor
@@ -151,6 +151,12 @@ M: windows seek-handle ( n seek-type handle -- )
[ bad-seek-type ]
} case ;
+M: windows can-seek-handle? ( handle -- ? )
+ handle>file-size zero? not ;
+
+M: windows handle-length ( handle -- n/f )
+ handle>file-size [ f ] when-zero ;
+
: file-error? ( n -- eof? )
zero? [
GetLastError {
diff --git a/basis/io/ports/ports.factor b/basis/io/ports/ports.factor
index 8f5ef977b9..68bc84cbfa 100644
--- a/basis/io/ports/ports.factor
+++ b/basis/io/ports/ports.factor
@@ -143,18 +143,21 @@ HOOK: (wait-to-write) io-backend ( port -- )
dup buffer>> buffer-empty?
[ drop ] [ dup (wait-to-write) port-flush ] if ;
-M: output-port stream-flush ( port -- )
+M: output-port stream-flush
[ check-disposed ] [ port-flush ] bi ;
HOOK: tell-handle os ( handle -- n )
HOOK: seek-handle os ( n seek-type handle -- )
-M: input-port stream-tell ( stream -- n )
+HOOK: can-seek-handle? os ( handle -- ? )
+HOOK: handle-length os ( handle -- n/f )
+
+M: input-port stream-tell
[ check-disposed ]
[ [ handle>> tell-handle ] [ buffer>> buffer-length ] bi - ] bi ;
-M: output-port stream-tell ( stream -- n )
+M: output-port stream-tell
[ check-disposed ]
[ [ handle>> tell-handle ] [ buffer>> buffer-length ] bi + ] bi ;
@@ -165,18 +168,28 @@ M: output-port stream-tell ( stream -- n )
[ n stream stream-tell + seek-absolute ] [ n seek-type ] if
stream ;
-M: input-port stream-seek ( n seek-type stream -- )
+M: input-port stream-seek
do-seek-relative
[ check-disposed ]
[ buffer>> 0 swap buffer-reset ]
[ handle>> seek-handle ] tri ;
-M: output-port stream-seek ( n seek-type stream -- )
+M: output-port stream-seek
do-seek-relative
[ check-disposed ]
[ stream-flush ]
[ handle>> seek-handle ] tri ;
+M: input-port stream-seekable?
+ handle>> can-seek-handle? ;
+M: output-port stream-seekable?
+ handle>> can-seek-handle? ;
+
+M: input-port stream-length
+ handle>> handle-length ;
+M: output-port stream-length
+ handle>> handle-length ;
+
GENERIC: shutdown ( handle -- )
M: object shutdown drop ;