Acme-Throw

 view release on metacpan or  search on metacpan

t/lib/IO/String.pm  view on Meta::CPAN

	*$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("",@_).$\);
	}
    }
    else {
	if (defined $,) {
	    $self->write(join($,, @_));
	}
	else {
	    $self->write(join("",@_));
	}
    }
    return 1;
}
*printflush = \*print;

sub printf
{
    my $self = shift;
    print "PRINTF(@_)\n" if $DEBUG;
    my $fmt = shift;
    $self->write(sprintf($fmt, @_));
    return 1;
}

t/lib/IO/String.pm  view on Meta::CPAN

*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

t/lib/IO/String.pm  view on Meta::CPAN

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