r4229 - in /packages/libio-string-perl: ./ branches/
branches/upstream/
branches/upstream/current/ branches/upstream/current/t/ tags/
eloy at users.alioth.debian.org
eloy at users.alioth.debian.org
Fri Nov 17 15:12:15 CET 2006
Author: eloy
Date: Fri Nov 17 15:12:15 2006
New Revision: 4229
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=4229
Log:
[svn-inject] Installing original source of libio-string-perl
Added:
packages/libio-string-perl/
packages/libio-string-perl/branches/
packages/libio-string-perl/branches/upstream/
packages/libio-string-perl/branches/upstream/current/
packages/libio-string-perl/branches/upstream/current/Changes
packages/libio-string-perl/branches/upstream/current/MANIFEST
packages/libio-string-perl/branches/upstream/current/META.yml
packages/libio-string-perl/branches/upstream/current/Makefile.PL
packages/libio-string-perl/branches/upstream/current/README
packages/libio-string-perl/branches/upstream/current/String.pm
packages/libio-string-perl/branches/upstream/current/t/
packages/libio-string-perl/branches/upstream/current/t/close.t
packages/libio-string-perl/branches/upstream/current/t/para.t
packages/libio-string-perl/branches/upstream/current/t/read.t
packages/libio-string-perl/branches/upstream/current/t/seek.t
packages/libio-string-perl/branches/upstream/current/t/truncate.t
packages/libio-string-perl/branches/upstream/current/t/write.t
packages/libio-string-perl/tags/
Added: packages/libio-string-perl/branches/upstream/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libio-string-perl/branches/upstream/current/Changes?rev=4229&op=file
==============================================================================
--- packages/libio-string-perl/branches/upstream/current/Changes (added)
+++ packages/libio-string-perl/branches/upstream/current/Changes Fri Nov 17 15:12:15 2006
@@ -1,0 +1,121 @@
+2005-12-05 Gisle Aas <gisle at ActiveState.com>
+
+ Release 1.08
+
+ The untie code in close() just seemed wrong, so just
+ remove it. The object still seems to get cleaned up
+ on various versions perl.
+
+
+
+2005-10-24 Gisle Aas <gisle at ActiveState.com>
+
+ Release 1.07
+
+ Make sure read() will not return negative values.
+ <https://rt.cpan.org/Ticket/Display.html?id=13841>
+
+
+
+2004-11-05 Gisle Aas <gisle at ActiveState.com>
+
+ Release 1.06
+
+ Make seek() return TRUE when it succeed. It used to
+ return the new position, but we want to be compatible with
+ the builtin seek().
+ Patch contributed by Kurt M. Brown <kurtb149 at yahoo.com>
+
+ Make print() and printf() return TRUE even when printing
+ the empty string. The used to return the lenght of the string
+ printed, but now they always return 1 to be compatible with
+ the builtins.
+
+ Make binmode() return TRUE unless layers are provided.
+
+
+
+2004-04-01 Gisle Aas <gisle at ActiveState.com>
+
+ Release 1.05
+
+ Fix handling of paragraph mode.
+ <https://rt.cpan.org/Ticket/Display.html?id=5425>
+
+
+
+2004-01-08 Gisle Aas <gisle at ActiveState.com>
+
+ Release 1.04
+
+ Documentation fixes by Paul Croome <Paul.Croome at softwareag.com>.
+
+
+
+2003-10-06 Gisle Aas <gisle at ActiveState.com>
+
+ Release 1.03
+
+ Seek will not reset the input_line_number (aka $.) for the IO::String
+ object any more.
+
+ Workaround for core dump in close() in perl-5.6.x.
+
+
+
+2002-12-27 Gisle Aas <gisle at ActiveState.com>
+
+ Release 1.02
+
+ Complemented the tiehandle interface with SEEK/TELL/EOF/BINMODE.
+
+ Make close($io) untie the object. This make it possible
+ to avoid memory leaks in perl-5.8 which seems to have problems
+ with self-ties. Based on patch by Eric Kolve <ekolve at attbi.com>.
+
+
+
+2000-01-28 Gisle Aas <gisle at aas.no>
+
+ Release 1.01
+
+ The eof() method had opposite logic. Bug spotted by
+ Daniel Gruhl <dgruhl at almaden.ibm.com>
+
+
+
+1999-04-12 Gisle Aas <gisle at aas.no>
+
+ Release 1.00
+
+ Perl version 5.005_03 or better is now needed, because that
+ perl has Chip's no-memory-leak-on-self-tie-patch.
+
+ Documentation update
+
+
+
+1998-10-14 Gisle Aas <aas at sn.no>
+
+ Release 0.03
+
+ Loading of the SEEK_xxx constants from the IO::Handle module
+ is now optional. The previous way did not work with IO-1.20.
+
+
+
+1998-10-12 Gisle Aas <aas at sn.no>
+
+ Release 0.02
+
+ Added some documentation.
+
+ Fixed $io->stat
+
+ Fixed $io->pad to return the default if it is set to ""
+
+
+
+1998-10-07 Gisle Aas <aas at sn.no>
+
+ Release 0.01
Added: packages/libio-string-perl/branches/upstream/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libio-string-perl/branches/upstream/current/MANIFEST?rev=4229&op=file
==============================================================================
--- packages/libio-string-perl/branches/upstream/current/MANIFEST (added)
+++ packages/libio-string-perl/branches/upstream/current/MANIFEST Fri Nov 17 15:12:15 2006
@@ -1,0 +1,12 @@
+Changes
+MANIFEST
+Makefile.PL
+README
+String.pm
+t/close.t
+t/para.t
+t/read.t
+t/seek.t
+t/truncate.t
+t/write.t
+META.yml Module meta-data (added by MakeMaker)
Added: packages/libio-string-perl/branches/upstream/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libio-string-perl/branches/upstream/current/META.yml?rev=4229&op=file
==============================================================================
--- packages/libio-string-perl/branches/upstream/current/META.yml (added)
+++ packages/libio-string-perl/branches/upstream/current/META.yml Fri Nov 17 15:12:15 2006
@@ -1,0 +1,10 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: IO-String
+version: 1.08
+version_from: String.pm
+installdirs: site
+requires:
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.17
Added: packages/libio-string-perl/branches/upstream/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libio-string-perl/branches/upstream/current/Makefile.PL?rev=4229&op=file
==============================================================================
--- packages/libio-string-perl/branches/upstream/current/Makefile.PL (added)
+++ packages/libio-string-perl/branches/upstream/current/Makefile.PL Fri Nov 17 15:12:15 2006
@@ -1,0 +1,9 @@
+require 5.005_03; # need self-tie patch
+
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ NAME => 'IO::String',
+ VERSION_FROM => 'String.pm',
+ dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
+);
Added: packages/libio-string-perl/branches/upstream/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libio-string-perl/branches/upstream/current/README?rev=4229&op=file
==============================================================================
--- packages/libio-string-perl/branches/upstream/current/README (added)
+++ packages/libio-string-perl/branches/upstream/current/README Fri Nov 17 15:12:15 2006
@@ -1,0 +1,19 @@
+IO::String is an IO::File (and IO::Handle) compatible class that read
+or write data from in-core strings. It is really just a
+simplification of what I needed from Eryq's IO-stringy modules. As
+such IO::String is a replacement for IO::Scalar.
+
+Installation as usual:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+Documentation is embedded in the module.
+
+
+Copyright 1998-2005 Gisle Aas. <gisle at aas.no>
+
+This library is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
Added: packages/libio-string-perl/branches/upstream/current/String.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libio-string-perl/branches/upstream/current/String.pm?rev=4229&op=file
==============================================================================
--- packages/libio-string-perl/branches/upstream/current/String.pm (added)
+++ packages/libio-string-perl/branches/upstream/current/String.pm Fri Nov 17 15:12:15 2006
@@ -1,0 +1,551 @@
+package IO::String;
+
+# Copyright 1998-2005 Gisle Aas.
+#
+# This library is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+require 5.005_03;
+use strict;
+use vars qw($VERSION $DEBUG $IO_CONSTANTS);
+$VERSION = "1.08"; # $Date: 2005/12/05 12:00:47 $
+
+use Symbol ();
+
+sub new
+{
+ my $class = shift;
+ my $self = bless Symbol::gensym(), ref($class) || $class;
+ tie *$self, $self;
+ $self->open(@_);
+ return $self;
+}
+
+sub open
+{
+ my $self = shift;
+ return $self->new(@_) unless ref($self);
+
+ if (@_) {
+ my $bufref = ref($_[0]) ? $_[0] : \$_[0];
+ $$bufref = "" unless defined $$bufref;
+ *$self->{buf} = $bufref;
+ }
+ else {
+ my $buf = "";
+ *$self->{buf} = \$buf;
+ }
+ *$self->{pos} = 0;
+ *$self->{lno} = 0;
+ return $self;
+}
+
+sub pad
+{
+ my $self = shift;
+ my $old = *$self->{pad};
+ *$self->{pad} = substr($_[0], 0, 1) if @_;
+ return "\0" unless defined($old) && length($old);
+ return $old;
+}
+
+sub dump
+{
+ require Data::Dumper;
+ my $self = shift;
+ print Data::Dumper->Dump([$self], ['*self']);
+ print Data::Dumper->Dump([*$self{HASH}], ['$self{HASH}']);
+ return;
+}
+
+sub TIEHANDLE
+{
+ print "TIEHANDLE @_\n" if $DEBUG;
+ return $_[0] if ref($_[0]);
+ my $class = shift;
+ my $self = bless Symbol::gensym(), $class;
+ $self->open(@_);
+ return $self;
+}
+
+sub DESTROY
+{
+ print "DESTROY @_\n" if $DEBUG;
+}
+
+sub close
+{
+ my $self = shift;
+ delete *$self->{buf};
+ delete *$self->{pos};
+ delete *$self->{lno};
+ undef *$self if $] eq "5.008"; # workaround for some bug
+ return 1;
+}
+
+sub opened
+{
+ my $self = shift;
+ return defined *$self->{buf};
+}
+
+sub binmode
+{
+ my $self = shift;
+ return 1 unless @_;
+ # XXX don't know much about layers yet :-(
+ return 0;
+}
+
+sub getc
+{
+ my $self = shift;
+ my $buf;
+ return $buf if $self->read($buf, 1);
+ return undef;
+}
+
+sub ungetc
+{
+ my $self = shift;
+ $self->setpos($self->getpos() - 1);
+ return 1;
+}
+
+sub eof
+{
+ my $self = shift;
+ return length(${*$self->{buf}}) <= *$self->{pos};
+}
+
+sub print
+{
+ my $self = shift;
+ if (defined $\) {
+ if (defined $,) {
+ $self->write(join($,, @_).$\);
+ }
+ else {
+ $self->write(join("", at _).$\);
+ }
+ }
+ else {
+ if (defined $,) {
+ $self->write(join($,, @_));
+ }
+ else {
+ $self->write(join("", at _));
+ }
+ }
+ return 1;
+}
+*printflush = \*print;
+
+sub printf
+{
+ my $self = shift;
+ print "PRINTF(@_)\n" if $DEBUG;
+ my $fmt = shift;
+ $self->write(sprintf($fmt, @_));
+ return 1;
+}
+
+
+my($SEEK_SET, $SEEK_CUR, $SEEK_END);
+
+sub _init_seek_constants
+{
+ if ($IO_CONSTANTS) {
+ require IO::Handle;
+ $SEEK_SET = &IO::Handle::SEEK_SET;
+ $SEEK_CUR = &IO::Handle::SEEK_CUR;
+ $SEEK_END = &IO::Handle::SEEK_END;
+ }
+ else {
+ $SEEK_SET = 0;
+ $SEEK_CUR = 1;
+ $SEEK_END = 2;
+ }
+}
+
+
+sub seek
+{
+ my($self,$off,$whence) = @_;
+ my $buf = *$self->{buf} || return 0;
+ my $len = length($$buf);
+ my $pos = *$self->{pos};
+
+ _init_seek_constants() unless defined $SEEK_SET;
+
+ if ($whence == $SEEK_SET) { $pos = $off }
+ elsif ($whence == $SEEK_CUR) { $pos += $off }
+ elsif ($whence == $SEEK_END) { $pos = $len + $off }
+ else { die "Bad whence ($whence)" }
+ print "SEEK(POS=$pos,OFF=$off,LEN=$len)\n" if $DEBUG;
+
+ $pos = 0 if $pos < 0;
+ $self->truncate($pos) if $pos > $len; # extend file
+ *$self->{pos} = $pos;
+ return 1;
+}
+
+sub pos
+{
+ my $self = shift;
+ my $old = *$self->{pos};
+ if (@_) {
+ my $pos = shift || 0;
+ my $buf = *$self->{buf};
+ my $len = $buf ? length($$buf) : 0;
+ $pos = $len if $pos > $len;
+ *$self->{pos} = $pos;
+ }
+ return $old;
+}
+
+sub getpos { shift->pos; }
+
+*sysseek = \&seek;
+*setpos = \&pos;
+*tell = \&getpos;
+
+
+
+sub getline
+{
+ my $self = shift;
+ my $buf = *$self->{buf} || return;
+ my $len = length($$buf);
+ my $pos = *$self->{pos};
+ return if $pos >= $len;
+
+ unless (defined $/) { # slurp
+ *$self->{pos} = $len;
+ return substr($$buf, $pos);
+ }
+
+ unless (length $/) { # paragraph mode
+ # XXX slow&lazy implementation using getc()
+ my $para = "";
+ my $eol = 0;
+ my $c;
+ while (defined($c = $self->getc)) {
+ if ($c eq "\n") {
+ $eol++;
+ next if $eol > 2;
+ }
+ elsif ($eol > 1) {
+ $self->ungetc($c);
+ last;
+ }
+ else {
+ $eol = 0;
+ }
+ $para .= $c;
+ }
+ return $para; # XXX wantarray
+ }
+
+ my $idx = index($$buf,$/,$pos);
+ if ($idx < 0) {
+ # return rest of it
+ *$self->{pos} = $len;
+ $. = ++ *$self->{lno};
+ return substr($$buf, $pos);
+ }
+ $len = $idx - $pos + length($/);
+ *$self->{pos} += $len;
+ $. = ++ *$self->{lno};
+ return substr($$buf, $pos, $len);
+}
+
+sub getlines
+{
+ die "getlines() called in scalar context\n" unless wantarray;
+ my $self = shift;
+ my($line, @lines);
+ push(@lines, $line) while defined($line = $self->getline);
+ return @lines;
+}
+
+sub READLINE
+{
+ goto &getlines if wantarray;
+ goto &getline;
+}
+
+sub input_line_number
+{
+ my $self = shift;
+ my $old = *$self->{lno};
+ *$self->{lno} = shift if @_;
+ return $old;
+}
+
+sub truncate
+{
+ my $self = shift;
+ my $len = shift || 0;
+ my $buf = *$self->{buf};
+ if (length($$buf) >= $len) {
+ substr($$buf, $len) = '';
+ *$self->{pos} = $len if $len < *$self->{pos};
+ }
+ else {
+ $$buf .= ($self->pad x ($len - length($$buf)));
+ }
+ return 1;
+}
+
+sub read
+{
+ my $self = shift;
+ my $buf = *$self->{buf};
+ return undef unless $buf;
+
+ my $pos = *$self->{pos};
+ my $rem = length($$buf) - $pos;
+ my $len = $_[1];
+ $len = $rem if $len > $rem;
+ return undef if $len < 0;
+ if (@_ > 2) { # read offset
+ substr($_[0],$_[2]) = substr($$buf, $pos, $len);
+ }
+ else {
+ $_[0] = substr($$buf, $pos, $len);
+ }
+ *$self->{pos} += $len;
+ return $len;
+}
+
+sub write
+{
+ my $self = shift;
+ my $buf = *$self->{buf};
+ return unless $buf;
+
+ my $pos = *$self->{pos};
+ my $slen = length($_[0]);
+ my $len = $slen;
+ my $off = 0;
+ if (@_ > 1) {
+ $len = $_[1] if $_[1] < $len;
+ if (@_ > 2) {
+ $off = $_[2] || 0;
+ die "Offset outside string" if $off > $slen;
+ if ($off < 0) {
+ $off += $slen;
+ die "Offset outside string" if $off < 0;
+ }
+ my $rem = $slen - $off;
+ $len = $rem if $rem < $len;
+ }
+ }
+ substr($$buf, $pos, $len) = substr($_[0], $off, $len);
+ *$self->{pos} += $len;
+ return $len;
+}
+
+*sysread = \&read;
+*syswrite = \&write;
+
+sub stat
+{
+ my $self = shift;
+ return unless $self->opened;
+ return 1 unless wantarray;
+ my $len = length ${*$self->{buf}};
+
+ return (
+ undef, undef, # dev, ino
+ 0666, # filemode
+ 1, # links
+ $>, # user id
+ $), # group id
+ undef, # device id
+ $len, # size
+ undef, # atime
+ undef, # mtime
+ undef, # ctime
+ 512, # blksize
+ int(($len+511)/512) # blocks
+ );
+}
+
+sub FILENO {
+ return undef; # XXX perlfunc says this means the file is closed
+}
+
+sub blocking {
+ my $self = shift;
+ my $old = *$self->{blocking} || 0;
+ *$self->{blocking} = shift if @_;
+ return $old;
+}
+
+my $notmuch = sub { return };
+
+*fileno = $notmuch;
+*error = $notmuch;
+*clearerr = $notmuch;
+*sync = $notmuch;
+*flush = $notmuch;
+*setbuf = $notmuch;
+*setvbuf = $notmuch;
+
+*untaint = $notmuch;
+*autoflush = $notmuch;
+*fcntl = $notmuch;
+*ioctl = $notmuch;
+
+*GETC = \&getc;
+*PRINT = \&print;
+*PRINTF = \&printf;
+*READ = \&read;
+*WRITE = \&write;
+*SEEK = \&seek;
+*TELL = \&getpos;
+*EOF = \&eof;
+*CLOSE = \&close;
+*BINMODE = \&binmode;
+
+
+sub string_ref
+{
+ my $self = shift;
+ return *$self->{buf};
+}
+*sref = \&string_ref;
+
+1;
+
+__END__
+
+=head1 NAME
+
+IO::String - Emulate file interface for in-core strings
+
+=head1 SYNOPSIS
+
+ use IO::String;
+ $io = IO::String->new;
+ $io = IO::String->new($var);
+ tie *IO, 'IO::String';
+
+ # read data
+ <$io>;
+ $io->getline;
+ read($io, $buf, 100);
+
+ # write data
+ print $io "string\n";
+ $io->print(@data);
+ syswrite($io, $buf, 100);
+
+ select $io;
+ printf "Some text %s\n", $str;
+
+ # seek
+ $pos = $io->getpos;
+ $io->setpos(0); # rewind
+ $io->seek(-30, -1);
+ seek($io, 0, 0);
+
+=head1 DESCRIPTION
+
+The C<IO::String> module provides the C<IO::File> interface for in-core
+strings. An C<IO::String> object can be attached to a string, and
+makes it possible to use the normal file operations for reading or
+writing data, as well as for seeking to various locations of the string.
+This is useful when you want to use a library module that only
+provides an interface to file handles on data that you have in a string
+variable.
+
+Note that perl-5.8 and better has built-in support for "in memory"
+files, which are set up by passing a reference instead of a filename
+to the open() call. The reason for using this module is that it
+makes the code backwards compatible with older versions of Perl.
+
+The C<IO::String> module provides an interface compatible with
+C<IO::File> as distributed with F<IO-1.20>, but the following methods
+are not available: new_from_fd, fdopen, format_write,
+format_page_number, format_lines_per_page, format_lines_left,
+format_name, format_top_name.
+
+The following methods are specific to the C<IO::String> class:
+
+=over 4
+
+=item $io = IO::String->new
+
+=item $io = IO::String->new( $string )
+
+The constructor returns a newly-created C<IO::String> object. It
+takes an optional argument, which is the string to read from or write
+into. If no $string argument is given, then an internal buffer
+(initially empty) is allocated.
+
+The C<IO::String> object returned is tied to itself. This means
+that you can use most Perl I/O built-ins on it too: readline, <>, getc,
+print, printf, syswrite, sysread, close.
+
+=item $io->open
+
+=item $io->open( $string )
+
+Attaches an existing IO::String object to some other $string, or
+allocates a new internal buffer (if no argument is given). The
+position is reset to 0.
+
+=item $io->string_ref
+
+Returns a reference to the string that is attached to
+the C<IO::String> object. Most useful when you let the C<IO::String>
+create an internal buffer to write into.
+
+=item $io->pad
+
+=item $io->pad( $char )
+
+Specifies the padding to use if
+the string is extended by either the seek() or truncate() methods. It
+is a single character and defaults to "\0".
+
+=item $io->pos
+
+=item $io->pos( $newpos )
+
+Yet another interface for reading and setting the current read/write
+position within the string (the normal getpos/setpos/tell/seek
+methods are also available). The pos() method always returns the
+old position, and if you pass it an argument it sets the new
+position.
+
+There is (deliberately) a difference between the setpos() and seek()
+methods in that seek() extends the string (with the specified
+padding) if you go to a location past the end, whereas setpos()
+just snaps back to the end. If truncate() is used to extend the string,
+then it works as seek().
+
+=back
+
+=head1 BUGS
+
+In Perl versions < 5.6, the TIEHANDLE interface was incomplete.
+If you use such a Perl, then seek(), tell(), eof(), fileno(), binmode() will
+not do anything on an C<IO::String> handle. See L<perltie> for
+details.
+
+=head1 SEE ALSO
+
+L<IO::File>, L<IO::Stringy>, L<perlfunc/open>
+
+=head1 COPYRIGHT
+
+Copyright 1998-2005 Gisle Aas.
+
+This library is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=cut
Added: packages/libio-string-perl/branches/upstream/current/t/close.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libio-string-perl/branches/upstream/current/t/close.t?rev=4229&op=file
==============================================================================
--- packages/libio-string-perl/branches/upstream/current/t/close.t (added)
+++ packages/libio-string-perl/branches/upstream/current/t/close.t Fri Nov 17 15:12:15 2006
@@ -1,0 +1,36 @@
+#!perl -w
+
+print "1..1\n";
+
+use strict;
+use IO::String;
+
+my $str = "abcd";
+
+my $destroyed = 0;
+
+{
+ package MyStr;
+ @MyStr::ISA = qw(IO::String);
+
+ sub DESTROY {
+ $destroyed++;
+ print "DESTROY @_\n";
+ }
+}
+
+
+my $rounds = 5;
+
+for (1..$rounds) {
+ my $io = MyStr->new($str);
+ die unless $io->getline eq "abcd";
+ $io->close;
+ undef($io);
+ print "-\n";
+}
+
+print "XXX $destroyed\n";
+
+print "not " unless $destroyed == $rounds;
+print "ok 1\n";
Added: packages/libio-string-perl/branches/upstream/current/t/para.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libio-string-perl/branches/upstream/current/t/para.t?rev=4229&op=file
==============================================================================
--- packages/libio-string-perl/branches/upstream/current/t/para.t (added)
+++ packages/libio-string-perl/branches/upstream/current/t/para.t Fri Nov 17 15:12:15 2006
@@ -1,0 +1,49 @@
+#!perl -w
+
+use strict;
+use Test qw(plan ok);
+
+plan tests => 8;
+
+use IO::String;
+
+my $fh = IO::String->new(<<EOT);
+a
+
+a
+b
+
+a
+b
+c
+
+
+
+a
+b
+c
+d
+EOT
+
+$/ = "";
+
+ok(<$fh>, "a\n\n");
+ok(<$fh>, "a\nb\n\n");
+ok(<$fh>, "a\nb\nc\n\n");
+ok(<$fh>, "a\nb\nc\nd\n");
+ok(<$fh>, undef);
+
+$fh = IO::String->new(<<EOT);
+a
+b
+
+
+
+
+
+
+EOT
+
+ok(<$fh>, "a\nb\n\n");
+ok(<$fh>, undef);
+ok(<$fh>, undef);
Added: packages/libio-string-perl/branches/upstream/current/t/read.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libio-string-perl/branches/upstream/current/t/read.t?rev=4229&op=file
==============================================================================
--- packages/libio-string-perl/branches/upstream/current/t/read.t (added)
+++ packages/libio-string-perl/branches/upstream/current/t/read.t Fri Nov 17 15:12:15 2006
@@ -1,0 +1,109 @@
+print "1..17\n";
+
+$str = <<EOT;
+This is an example
+of a paragraph
+
+and a single line.
+
+EOT
+
+use IO::String 0.01;
+$io = IO::String->new($str);
+
+ at lines = <$io>;
+print "not " unless @lines == 5 && $lines[1] eq "of a paragraph\n" && $. == 5;
+print "ok 1\n";
+
+use vars qw(@tmp);
+
+print "not " if defined($io->getline) ||
+ (@tmp = $io->getlines) ||
+ defined(<$io>) ||
+ defined($io->getc) ||
+ read($io, $buf, 100) != 0 ||
+ $io->getpos != length($str);
+print "ok 2\n";
+
+
+{
+ local $/; # slurp mode
+ $io->setpos(0);
+ @lines = $io->getlines;
+ print "not " unless @lines == 1 && $lines[0] eq $str;
+ print "ok 3\n";
+
+ $io->setpos(index($str, "and"));
+ $line = <$io>;
+ print "not " unless $line eq "and a single line.\n\n";
+ print "ok 4\n";
+}
+
+{
+ local $/ = ""; # paragraph mode
+ $io->setpos(0);
+ @lines = <$io>;
+ print "not " unless @lines == 2 && $lines[1] eq "and a single line.\n\n";
+ print "ok 5\n";
+}
+
+{
+ local $/ = "is";
+ $io->setpos(0);
+ @lines = ();
+ my $no = $io->input_line_number;
+ my $err;
+ while (<$io>) {
+ push(@lines, $_);
+ $err++ if $. != ++$no;
+ }
+
+ print "not " if $err;
+ print "ok 6\n";
+
+ print "not " unless @lines == 3 && join("-", @lines) eq
+ "This- is- an example\n" .
+ "of a paragraph\n\n" .
+ "and a single line.\n\n";
+ print "ok 7\n";
+}
+
+
+# Test read
+
+$io->setpos(0);
+
+print "not " unless read($io, $buf, 3) == 3 && $buf eq "Thi";
+print "ok 8\n";
+
+print "not " unless sysread($io, $buf, 3, 2) == 3 && $buf eq "Ths i";
+print "ok 9\n";
+
+$io->seek(-4, 2);
+
+print "not " if $io->eof;
+print "ok 10\n";
+
+print "not " unless read($io, $buf, 20) == 4 && $buf eq "e.\n\n";
+print "ok 11\n";
+
+print "not " unless read($io, $buf, 20) == 0 && $buf eq "";
+print "ok 12\n";
+
+print "not " unless $io->eof;
+print "ok 13\n";
+
+
+$io->setpos(0);
+print "not " if defined(read($io, $buf, -1));
+print "ok 14\n";
+
+print "not " unless read($io, $buf, 0) == 0;
+print "ok 15\n";
+
+print "not " unless read($io, $buf, 4) == 4 && $buf eq "This";
+print "ok 16\n";
+
+$str = "";
+print "not " if defined(read($io, $buf, 4));
+print "ok 17\n";
Added: packages/libio-string-perl/branches/upstream/current/t/seek.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libio-string-perl/branches/upstream/current/t/seek.t?rev=4229&op=file
==============================================================================
--- packages/libio-string-perl/branches/upstream/current/t/seek.t (added)
+++ packages/libio-string-perl/branches/upstream/current/t/seek.t Fri Nov 17 15:12:15 2006
@@ -1,0 +1,63 @@
+print "1..10\n";
+
+$str = "abcd";
+
+#$IO::String::DEBUG++;
+
+use IO::String;
+$io = IO::String->new($str);
+
+sub all_pos
+{
+ my($io, $expect) = @_;
+ $io->getpos == $expect &&
+ $io->pos == $expect &&
+ $io->tell == $expect &&
+ $io->seek(0, 1) == $expect &&
+ $io->sysseek(0, 1) == $expect &&
+ $] >= 5.006 ? ( tell($io) == $expect &&
+ seek($io, 0, 1) == $expect &&
+ sysseek($io, 0, 1) == $expect
+ )
+ : 1;
+}
+
+print "not " unless all_pos($io, 0);
+print "ok 1\n";
+
+$io->setpos(2);
+print "not " unless all_pos($io, 2);
+print "ok 2\n";
+
+$io->setpos(10); # XXX should it be defined in terms of seek??
+print "not " unless all_pos($io, 4);
+print "ok 3\n";
+
+$io->seek(10, 0);
+print "not " unless all_pos($io, 10);
+print "ok 4\n";
+
+$io->print("æøå");
+print "not " unless all_pos($io, 13);
+print "ok 5\n";
+
+$io->seek(-4, 2);
+print "not " unless all_pos($io, 9);
+print "ok 6\n";
+
+print "not " unless $io->read($buf, 20) == 4 && $buf eq "\0æøå";
+print "ok 7\n";
+
+print "not " unless $io->seek(-10,1) && all_pos($io, 3);
+print "ok 8\n";
+
+$io->seek(0,0);
+print "not " unless all_pos($io, 0);
+print "ok 9\n";
+
+if ($] >= 5.006) {
+ seek($io, 1, 0);
+ print "not " unless all_pos($io, 1);
+}
+print "ok 10\n";
+
Added: packages/libio-string-perl/branches/upstream/current/t/truncate.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libio-string-perl/branches/upstream/current/t/truncate.t?rev=4229&op=file
==============================================================================
--- packages/libio-string-perl/branches/upstream/current/t/truncate.t (added)
+++ packages/libio-string-perl/branches/upstream/current/t/truncate.t Fri Nov 17 15:12:15 2006
@@ -1,0 +1,38 @@
+print "1..6\n";
+
+use IO::String;
+
+$io = IO::String->new($str);
+
+$io->truncate(10);
+print "not " unless length($str) == 10;
+print "ok 1\n";
+
+print "not " unless $io->getpos == 0;
+print "ok 2\n";
+
+$io->setpos(8);
+$io->truncate(2);
+print "not " unless length($str) == 2 && $io->getpos == 2;
+print "ok 3\n";
+
+undef($io);
+$str = "";
+
+$io = IO::String->new($str);
+$io->pad("+");
+
+$io->truncate(5);
+
+$n = read($io, $buf, 20);
+print "not " unless $n == 5 && $buf eq "+++++" && $buf eq $str;
+print "ok 4\n";
+
+print "not " unless read($io, $buf, 20) == 0;
+print "ok 5\n";
+
+$io->truncate(0);
+print "not " unless $str eq "";
+print "ok 6\n";
+
+
Added: packages/libio-string-perl/branches/upstream/current/t/write.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libio-string-perl/branches/upstream/current/t/write.t?rev=4229&op=file
==============================================================================
--- packages/libio-string-perl/branches/upstream/current/t/write.t (added)
+++ packages/libio-string-perl/branches/upstream/current/t/write.t Fri Nov 17 15:12:15 2006
@@ -1,0 +1,46 @@
+print "1..1\n";
+
+#$IO::String::DEBUG++;
+
+use IO::String;
+$io = IO::String->new;
+
+print $io "Heisan\n";
+$io->print("a", "b", "c");
+
+{
+ local($\) = "\n";
+ print $io "d", "e";
+ local($,) = ",";
+ print $io "f", "g", "h";
+}
+
+$foo = "1234567890";
+
+syswrite($io, $foo, length($foo));
+$io->syswrite($foo);
+$io->syswrite($foo, length($foo));
+$io->write($foo, length($foo), 5);
+$io->write("xxx\n", 100, -1);
+
+for (1..3) {
+ printf $io "i(%d)", $_;
+ $io->printf("[%d]\n", $_);
+}
+select $io;
+print "\n";
+
+$io->setpos(0);
+print "h";
+
+
+local *str = $io->string_ref;
+
+select STDOUT;
+print $str;
+
+print "not " unless $str eq "heisan\nabcde\nf,g,h\n" .
+ ("1234567890" x 3) . "67890\n" .
+ "i(1)[1]\ni(2)[2]\ni(3)[3]\n\n";
+print "ok 1\n";
+
More information about the Pkg-perl-cvs-commits
mailing list