static ssize_t write_flush(struct cbdata *cbd) {
ssize_t result;
- result = call_writer(cbd, cbd->buffer, cbd->used);
- cbd->used = 0;
- return result;
+ if (cbd->used) {
+ result = call_writer(cbd, cbd->buffer, cbd->used);
+ cbd->used = 0;
+ return result;
+ }
+ else {
+ return 1; /* success of some sort */
+ }
}
static off_t io_seeker(void *p, off_t offset, int whence) {
}
cbd->writing = 1;
if (cbd->used && cbd->used + size > cbd->maxlength) {
- if (write_flush(cbd) <= 0) {
- return 0;
+ int write_res = write_flush(cbd);
+ if (write_res <= 0) {
+ return write_res;
}
cbd->used = 0;
}
return call_writer(cbd, data, size);
}
-static ssize_t io_reader(void *p, void *data, size_t size) {
+static ssize_t
+io_reader(void *p, void *data, size_t size) {
struct cbdata *cbd = p;
ssize_t total;
char *out = data; /* so we can do pointer arithmetic */
+ /* printf("io_reader(%p, %p, %d)\n", p, data, size); */
if (cbd->writing) {
if (write_flush(cbd) <= 0)
return 0;
total += copy_size;
size -= copy_size;
}
+ if (did_read < 0)
+ return -1;
}
else {
/* just read the rest - too big for our buffer*/
total += did_read;
out += did_read;
}
+ if (did_read < 0)
+ return -1;
}
return total;
#ifdef SvUTF8
if (SvUTF8(data_sv)) {
data_sv = sv_2mortal(newSVsv(data_sv));
+ /* yes, we want this to croak() if the SV can't be downgraded */
sv_utf8_downgrade(data_sv, FALSE);
}
#endif
OUTPUT:
RETVAL
-SV *
+void
i_io_read(ig, buffer_sv, size)
Imager::IO ig
SV *buffer_sv
PREINIT:
void *buffer;
int result;
- CODE:
- if (size < 0)
+ PPCODE:
+ if (size <= 0)
croak("size negative in call to i_io_read()");
/* prevent an undefined value warning if they supplied an
undef buffer.
#endif
buffer = SvGROW(buffer_sv, size+1);
result = i_io_read(ig, buffer, size);
- if (result < 0) {
- RETVAL = &PL_sv_undef;
+ if (result >= 0) {
+ SvCUR_set(buffer_sv, result);
+ *SvEND(buffer_sv) = '\0';
+ SvPOK_only(buffer_sv);
+ EXTEND(SP, 1);
+ PUSHs(sv_2mortal(newSViv(result)));
}
- else {
+ ST(1) = buffer_sv;
+ SvSETMAGIC(ST(1));
+
+void
+i_io_read2(ig, size)
+ Imager::IO ig
+ int size
+ PREINIT:
+ SV *buffer_sv;
+ void *buffer;
+ int result;
+ PPCODE:
+ if (size <= 0)
+ croak("size negative in call to i_io_read2()");
+ buffer_sv = newSV(size);
+ buffer = SvGROW(buffer_sv, size+1);
+ result = i_io_read(ig, buffer, size);
+ if (result >= 0) {
SvCUR_set(buffer_sv, result);
*SvEND(buffer_sv) = '\0';
SvPOK_only(buffer_sv);
- RETVAL = newSViv(result); /* XS will mortal this */
+ EXTEND(SP, 1);
+ PUSHs(sv_2mortal(buffer_sv));
}
- OUTPUT:
- RETVAL
- buffer_sv
+ else {
+ /* discard it */
+ SvREFCNT_dec(buffer_sv);
+ }
int
i_io_seek(ig, position, whence)
long position
int whence
-void
+int
i_io_close(ig)
Imager::IO ig
ier->cpos += bc;
IOL_DEB( printf("realseek_read: rc = %d, bc = %d\n", rc, bc) );
- return bc;
+ return rc < 0 ? rc : bc;
}
ier->cpos += bc;
IOL_DEB( printf("realseek_write: rc = %d, bc = %d\n", rc, bc) );
- return bc;
+ return rc < 0 ? rc : bc;
}
--- /dev/null
+=head1 NAME
+
+Imager::IO - Imager's io_layer object.
+
+=head1 SYNOPSIS
+
+ # Imager supplies Imager::IO objects to various callbacks
+ my $IO = ...;
+
+ my $count = $IO->write($data);
+ my $count = $IO->read($buffer, $max_count);
+ my $position = $IO->seek($offset, $whence);
+ my $status = $IO->close;
+
+=head1 DESCRIPTION
+
+Imager uses an abstraction when dealing with image files to allow the
+same code to work with disk files, in memory data and callbacks.
+
+If you're writing an Imager file handler your code will be passed an
+Imager::IO object to write to or read from.
+
+=head1 METHODS
+
+=over
+
+=item write
+
+Call to write to the file. Returns the number of bytes written. The
+data provided may contain only characters \x00 to \xFF - characters
+outside this range will cause this method to croak().
+
+If you supply a UTF-8 flagged string it will be converted to a byte
+string, which may have a performance impact.
+
+Returns -1 on error, though in most cases if the result of the write
+isn't the number of bytes supplied you'll want to treat it as an error
+anyway.
+
+=item read
+
+ my $buffer;
+ my $count = $io->read($buffer, $max_bytes);
+
+Reads up to I<$max_bytes> bytes from the current position in the file
+and stores them in I<$buffer>. Returns the number of bytes read on
+success or an empty list on failure. Note that a read of zero bytes
+is B<not> a failure, this indicates end of file.
+
+=item read2
+
+ my $buffer = $io->read2($max_bytes);
+
+An alternative interface to read, that might be simpler to use in some
+cases.
+
+Returns the data read or an empty list.
+
+=item seek
+
+ my $new_position = $io->seek($offset, $whence);
+
+Seek to a new position in the file. Possible values for I<$whence> are:
+
+=over
+
+=item *
+
+C<SEEK_SET> - I<$offset> is the new position in the file.
+
+=item *
+
+C<SEEK_CUR> - I<$offset> is the offset from the current position in
+the file.
+
+=item *
+
+C<SEEK_END> - I<$offset> is the offset relative to the end of the
+file.
+
+=back
+
+Note that seeking past the end of the file may or may not result in an
+error.
+
+Returns the new position in the file, or -1 on error.
+
+=item close
+
+ my $result = $io->close;
+
+Call when you're with the file. If the IO object is connected to a
+file this won't close the file handle, but buffers may be flushed (if
+any).
+
+Returns 0 on success, -1 on failure.
+
+=back
+
+=head1 AUTHOR
+
+Tony Cook <tony@imager.perl.org>
+
+=head1 SEE ALSO
+
+Imager, Imager::Files
+
+=cut
+
#!perl -w
use strict;
-use Test::More tests => 43;
+use Test::More tests => 64;
use Fcntl ':seek';
BEGIN { use_ok(Imager => ':all') };
my $data = Imager::io_slurp($io);
is($data, "testtestdata", "check we have the right data");
}
+
+{ # callback failure checks
+ my $fail_io = Imager::io_new_cb(\&fail_write, \&fail_read, \&fail_seek, undef, 1);
+ # scalar context
+ my $buffer;
+ my $read_result = $fail_io->read($buffer, 10);
+ is($read_result, undef, "read failure undef in scalar context");
+ my @read_result = $fail_io->read($buffer, 10);
+ is(@read_result, 0, "empty list in list context");
+ $read_result = $fail_io->read2(10);
+ is($read_result, undef, "read2 failure (scalar)");
+ @read_result = $fail_io->read2(10);
+ is(@read_result, 0, "read2 failure (list)");
+
+ my $write_result = $fail_io->write("test");
+ is($write_result, -1, "failed write");
+
+ my $seek_result = $fail_io->seek(-1, SEEK_SET);
+ is($seek_result, -1, "failed seek");
+}
+
+{ # callback success checks
+ my $good_io = Imager::io_new_cb(\&good_write, \&good_read, \&good_seek, undef, 1);
+ # scalar context
+ my $buffer;
+ my $read_result = $good_io->read($buffer, 10);
+ is($read_result, 10, "read success (scalar)");
+ is($buffer, "testdatate", "check data");
+ my @read_result = $good_io->read($buffer, 10);
+ is_deeply(\@read_result, [ 10 ], "read success (list)");
+ is($buffer, "testdatate", "check data");
+ $read_result = $good_io->read2(10);
+ is($read_result, "testdatate", "read2 success (scalar)");
+ @read_result = $good_io->read2(10);
+ is_deeply(\@read_result, [ "testdatate" ], "read2 success (list)");
+}
+
+{ # end of file
+ my $eof_io = Imager::io_new_cb(undef, \&eof_read, undef, undef, 1);
+ my $buffer;
+ my $read_result = $eof_io->read($buffer, 10);
+ is($read_result, 0, "read eof (scalar)");
+ is($buffer, '', "check data");
+ my @read_result = $eof_io->read($buffer, 10);
+ is_deeply(\@read_result, [ 0 ], "read eof (list)");
+ is($buffer, '', "check data");
+}
+
+{ # no callbacks
+ my $none_io = Imager::io_new_cb(undef, undef, undef, undef, 0);
+ is($none_io->write("test"), -1, "write with no writecb should fail");
+ my $buffer;
+ is($none_io->read($buffer, 10), undef, "read with no readcb should fail");
+ is($none_io->seek(0, SEEK_SET), -1, "seek with no seekcb should fail");
+}
+
+SKIP:
+{ # make sure we croak when trying to write a string with characters over 0xff
+ # the write callback shouldn't get called
+ skip("no native UTF8 support in this version of perl", 2)
+ unless $] >= 5.006;
+ my $io = Imager::io_new_cb(\&good_write, undef, undef, 1);
+ my $data = chr(0x100);
+ is(ord $data, 0x100, "make sure we got what we expected");
+ my $result =
+ eval {
+ $io->write($data);
+ };
+ ok($@, "should have croaked")
+ and print "# $@\n";
+}
+
+sub eof_read {
+ my ($max_len) = @_;
+
+ return '';
+}
+
+sub good_read {
+ my ($max_len) = @_;
+
+ my $data = "testdata";
+ length $data <= $max_len or substr($data, $max_len) = '';
+
+ print "# good_read ($max_len) => $data\n";
+
+ return $data;
+}
+
+sub fail_write {
+ return;
+}
+
+sub fail_read {
+ return;
+}
+
+sub fail_seek {
+ return -1;
+}