|
Packit Service |
136ff3 |
package IO::String;
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
# Copyright 1998-2005 Gisle Aas.
|
|
Packit Service |
136ff3 |
#
|
|
Packit Service |
136ff3 |
# This library is free software; you can redistribute it and/or
|
|
Packit Service |
136ff3 |
# modify it under the same terms as Perl itself.
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
require 5.005_03;
|
|
Packit Service |
136ff3 |
use strict;
|
|
Packit Service |
136ff3 |
use vars qw($VERSION $DEBUG $IO_CONSTANTS);
|
|
Packit Service |
136ff3 |
$VERSION = "1.08"; # $Date: 2005/12/05 12:00:47 $
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
use Symbol ();
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
sub new
|
|
Packit Service |
136ff3 |
{
|
|
Packit Service |
136ff3 |
my $class = shift;
|
|
Packit Service |
136ff3 |
my $self = bless Symbol::gensym(), ref($class) || $class;
|
|
Packit Service |
136ff3 |
tie *$self, $self;
|
|
Packit Service |
136ff3 |
$self->open(@_);
|
|
Packit Service |
136ff3 |
return $self;
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
sub open
|
|
Packit Service |
136ff3 |
{
|
|
Packit Service |
136ff3 |
my $self = shift;
|
|
Packit Service |
136ff3 |
return $self->new(@_) unless ref($self);
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
if (@_) {
|
|
Packit Service |
136ff3 |
my $bufref = ref($_[0]) ? $_[0] : \$_[0];
|
|
Packit Service |
136ff3 |
$$bufref = "" unless defined $$bufref;
|
|
Packit Service |
136ff3 |
*$self->{buf} = $bufref;
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
else {
|
|
Packit Service |
136ff3 |
my $buf = "";
|
|
Packit Service |
136ff3 |
*$self->{buf} = \$buf;
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
*$self->{pos} = 0;
|
|
Packit Service |
136ff3 |
*$self->{lno} = 0;
|
|
Packit Service |
136ff3 |
return $self;
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
sub pad
|
|
Packit Service |
136ff3 |
{
|
|
Packit Service |
136ff3 |
my $self = shift;
|
|
Packit Service |
136ff3 |
my $old = *$self->{pad};
|
|
Packit Service |
136ff3 |
*$self->{pad} = substr($_[0], 0, 1) if @_;
|
|
Packit Service |
136ff3 |
return "\0" unless defined($old) && length($old);
|
|
Packit Service |
136ff3 |
return $old;
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
sub dump
|
|
Packit Service |
136ff3 |
{
|
|
Packit Service |
136ff3 |
require Data::Dumper;
|
|
Packit Service |
136ff3 |
my $self = shift;
|
|
Packit Service |
136ff3 |
print Data::Dumper->Dump([$self], ['*self']);
|
|
Packit Service |
136ff3 |
print Data::Dumper->Dump([*$self{HASH}], ['$self{HASH}']);
|
|
Packit Service |
136ff3 |
return;
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
sub TIEHANDLE
|
|
Packit Service |
136ff3 |
{
|
|
Packit Service |
136ff3 |
print "TIEHANDLE @_\n" if $DEBUG;
|
|
Packit Service |
136ff3 |
return $_[0] if ref($_[0]);
|
|
Packit Service |
136ff3 |
my $class = shift;
|
|
Packit Service |
136ff3 |
my $self = bless Symbol::gensym(), $class;
|
|
Packit Service |
136ff3 |
$self->open(@_);
|
|
Packit Service |
136ff3 |
return $self;
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
sub DESTROY
|
|
Packit Service |
136ff3 |
{
|
|
Packit Service |
136ff3 |
print "DESTROY @_\n" if $DEBUG;
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
sub close
|
|
Packit Service |
136ff3 |
{
|
|
Packit Service |
136ff3 |
my $self = shift;
|
|
Packit Service |
136ff3 |
delete *$self->{buf};
|
|
Packit Service |
136ff3 |
delete *$self->{pos};
|
|
Packit Service |
136ff3 |
delete *$self->{lno};
|
|
Packit Service |
136ff3 |
undef *$self if $] eq "5.008"; # workaround for some bug
|
|
Packit Service |
136ff3 |
return 1;
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
sub opened
|
|
Packit Service |
136ff3 |
{
|
|
Packit Service |
136ff3 |
my $self = shift;
|
|
Packit Service |
136ff3 |
return defined *$self->{buf};
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
sub binmode
|
|
Packit Service |
136ff3 |
{
|
|
Packit Service |
136ff3 |
my $self = shift;
|
|
Packit Service |
136ff3 |
return 1 unless @_;
|
|
Packit Service |
136ff3 |
# XXX don't know much about layers yet :-(
|
|
Packit Service |
136ff3 |
return 0;
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
sub getc
|
|
Packit Service |
136ff3 |
{
|
|
Packit Service |
136ff3 |
my $self = shift;
|
|
Packit Service |
136ff3 |
my $buf;
|
|
Packit Service |
136ff3 |
return $buf if $self->read($buf, 1);
|
|
Packit Service |
136ff3 |
return undef;
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
sub ungetc
|
|
Packit Service |
136ff3 |
{
|
|
Packit Service |
136ff3 |
my $self = shift;
|
|
Packit Service |
136ff3 |
$self->setpos($self->getpos() - 1);
|
|
Packit Service |
136ff3 |
return 1;
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
sub eof
|
|
Packit Service |
136ff3 |
{
|
|
Packit Service |
136ff3 |
my $self = shift;
|
|
Packit Service |
136ff3 |
return length(${*$self->{buf}}) <= *$self->{pos};
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
sub print
|
|
Packit Service |
136ff3 |
{
|
|
Packit Service |
136ff3 |
my $self = shift;
|
|
Packit Service |
136ff3 |
if (defined $\) {
|
|
Packit Service |
136ff3 |
if (defined $,) {
|
|
Packit Service |
136ff3 |
$self->write(join($,, @_).$\);
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
else {
|
|
Packit Service |
136ff3 |
$self->write(join("",@_).$\);
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
else {
|
|
Packit Service |
136ff3 |
if (defined $,) {
|
|
Packit Service |
136ff3 |
$self->write(join($,, @_));
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
else {
|
|
Packit Service |
136ff3 |
$self->write(join("",@_));
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
return 1;
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
*printflush = \*print;
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
sub printf
|
|
Packit Service |
136ff3 |
{
|
|
Packit Service |
136ff3 |
my $self = shift;
|
|
Packit Service |
136ff3 |
print "PRINTF(@_)\n" if $DEBUG;
|
|
Packit Service |
136ff3 |
my $fmt = shift;
|
|
Packit Service |
136ff3 |
$self->write(sprintf($fmt, @_));
|
|
Packit Service |
136ff3 |
return 1;
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
my($SEEK_SET, $SEEK_CUR, $SEEK_END);
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
sub _init_seek_constants
|
|
Packit Service |
136ff3 |
{
|
|
Packit Service |
136ff3 |
if ($IO_CONSTANTS) {
|
|
Packit Service |
136ff3 |
require IO::Handle;
|
|
Packit Service |
136ff3 |
$SEEK_SET = &IO::Handle::SEEK_SET;
|
|
Packit Service |
136ff3 |
$SEEK_CUR = &IO::Handle::SEEK_CUR;
|
|
Packit Service |
136ff3 |
$SEEK_END = &IO::Handle::SEEK_END;
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
else {
|
|
Packit Service |
136ff3 |
$SEEK_SET = 0;
|
|
Packit Service |
136ff3 |
$SEEK_CUR = 1;
|
|
Packit Service |
136ff3 |
$SEEK_END = 2;
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
sub seek
|
|
Packit Service |
136ff3 |
{
|
|
Packit Service |
136ff3 |
my($self,$off,$whence) = @_;
|
|
Packit Service |
136ff3 |
my $buf = *$self->{buf} || return 0;
|
|
Packit Service |
136ff3 |
my $len = length($$buf);
|
|
Packit Service |
136ff3 |
my $pos = *$self->{pos};
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
_init_seek_constants() unless defined $SEEK_SET;
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
if ($whence == $SEEK_SET) { $pos = $off }
|
|
Packit Service |
136ff3 |
elsif ($whence == $SEEK_CUR) { $pos += $off }
|
|
Packit Service |
136ff3 |
elsif ($whence == $SEEK_END) { $pos = $len + $off }
|
|
Packit Service |
136ff3 |
else { die "Bad whence ($whence)" }
|
|
Packit Service |
136ff3 |
print "SEEK(POS=$pos,OFF=$off,LEN=$len)\n" if $DEBUG;
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
$pos = 0 if $pos < 0;
|
|
Packit Service |
136ff3 |
$self->truncate($pos) if $pos > $len; # extend file
|
|
Packit Service |
136ff3 |
*$self->{pos} = $pos;
|
|
Packit Service |
136ff3 |
return 1;
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
sub pos
|
|
Packit Service |
136ff3 |
{
|
|
Packit Service |
136ff3 |
my $self = shift;
|
|
Packit Service |
136ff3 |
my $old = *$self->{pos};
|
|
Packit Service |
136ff3 |
if (@_) {
|
|
Packit Service |
136ff3 |
my $pos = shift || 0;
|
|
Packit Service |
136ff3 |
my $buf = *$self->{buf};
|
|
Packit Service |
136ff3 |
my $len = $buf ? length($$buf) : 0;
|
|
Packit Service |
136ff3 |
$pos = $len if $pos > $len;
|
|
Packit Service |
136ff3 |
*$self->{pos} = $pos;
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
return $old;
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
sub getpos { shift->pos; }
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
*sysseek = \&see;;
|
|
Packit Service |
136ff3 |
*setpos = \&pos;
|
|
Packit Service |
136ff3 |
*tell = \&getpos;
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
sub getline
|
|
Packit Service |
136ff3 |
{
|
|
Packit Service |
136ff3 |
my $self = shift;
|
|
Packit Service |
136ff3 |
my $buf = *$self->{buf} || return;
|
|
Packit Service |
136ff3 |
my $len = length($$buf);
|
|
Packit Service |
136ff3 |
my $pos = *$self->{pos};
|
|
Packit Service |
136ff3 |
return if $pos >= $len;
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
unless (defined $/) { # slurp
|
|
Packit Service |
136ff3 |
*$self->{pos} = $len;
|
|
Packit Service |
136ff3 |
return substr($$buf, $pos);
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
unless (length $/) { # paragraph mode
|
|
Packit Service |
136ff3 |
# XXX slow&lazy implementation using getc()
|
|
Packit Service |
136ff3 |
my $para = "";
|
|
Packit Service |
136ff3 |
my $eol = 0;
|
|
Packit Service |
136ff3 |
my $c;
|
|
Packit Service |
136ff3 |
while (defined($c = $self->getc)) {
|
|
Packit Service |
136ff3 |
if ($c eq "\n") {
|
|
Packit Service |
136ff3 |
$eol++;
|
|
Packit Service |
136ff3 |
next if $eol > 2;
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
elsif ($eol > 1) {
|
|
Packit Service |
136ff3 |
$self->ungetc($c);
|
|
Packit Service |
136ff3 |
last;
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
else {
|
|
Packit Service |
136ff3 |
$eol = 0;
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
$para .= $c;
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
return $para; # XXX wantarray
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
my $idx = index($$buf,$/,$pos);
|
|
Packit Service |
136ff3 |
if ($idx < 0) {
|
|
Packit Service |
136ff3 |
# return rest of it
|
|
Packit Service |
136ff3 |
*$self->{pos} = $len;
|
|
Packit Service |
136ff3 |
$. = ++ *$self->{lno};
|
|
Packit Service |
136ff3 |
return substr($$buf, $pos);
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
$len = $idx - $pos + length($/);
|
|
Packit Service |
136ff3 |
*$self->{pos} += $len;
|
|
Packit Service |
136ff3 |
$. = ++ *$self->{lno};
|
|
Packit Service |
136ff3 |
return substr($$buf, $pos, $len);
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
sub getlines
|
|
Packit Service |
136ff3 |
{
|
|
Packit Service |
136ff3 |
die "getlines() called in scalar context\n" unless wantarray;
|
|
Packit Service |
136ff3 |
my $self = shift;
|
|
Packit Service |
136ff3 |
my($line, @lines);
|
|
Packit Service |
136ff3 |
push(@lines, $line) while defined($line = $self->getline);
|
|
Packit Service |
136ff3 |
return @lines;
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
sub READLINE
|
|
Packit Service |
136ff3 |
{
|
|
Packit Service |
136ff3 |
goto &getlines if wantarray;
|
|
Packit Service |
136ff3 |
goto &getline;
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
sub input_line_number
|
|
Packit Service |
136ff3 |
{
|
|
Packit Service |
136ff3 |
my $self = shift;
|
|
Packit Service |
136ff3 |
my $old = *$self->{lno};
|
|
Packit Service |
136ff3 |
*$self->{lno} = shift if @_;
|
|
Packit Service |
136ff3 |
return $old;
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
sub truncate
|
|
Packit Service |
136ff3 |
{
|
|
Packit Service |
136ff3 |
my $self = shift;
|
|
Packit Service |
136ff3 |
my $len = shift || 0;
|
|
Packit Service |
136ff3 |
my $buf = *$self->{buf};
|
|
Packit Service |
136ff3 |
if (length($$buf) >= $len) {
|
|
Packit Service |
136ff3 |
substr($$buf, $len) = '';
|
|
Packit Service |
136ff3 |
*$self->{pos} = $len if $len < *$self->{pos};
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
else {
|
|
Packit Service |
136ff3 |
$$buf .= ($self->pad x ($len - length($$buf)));
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
return 1;
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
sub read
|
|
Packit Service |
136ff3 |
{
|
|
Packit Service |
136ff3 |
my $self = shift;
|
|
Packit Service |
136ff3 |
my $buf = *$self->{buf};
|
|
Packit Service |
136ff3 |
return undef unless $buf;
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
my $pos = *$self->{pos};
|
|
Packit Service |
136ff3 |
my $rem = length($$buf) - $pos;
|
|
Packit Service |
136ff3 |
my $len = $_[1];
|
|
Packit Service |
136ff3 |
$len = $rem if $len > $rem;
|
|
Packit Service |
136ff3 |
return undef if $len < 0;
|
|
Packit Service |
136ff3 |
if (@_ > 2) { # read offset
|
|
Packit Service |
136ff3 |
substr($_[0],$_[2]) = substr($$buf, $pos, $len);
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
else {
|
|
Packit Service |
136ff3 |
$_[0] = substr($$buf, $pos, $len);
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
*$self->{pos} += $len;
|
|
Packit Service |
136ff3 |
return $len;
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
sub write
|
|
Packit Service |
136ff3 |
{
|
|
Packit Service |
136ff3 |
my $self = shift;
|
|
Packit Service |
136ff3 |
my $buf = *$self->{buf};
|
|
Packit Service |
136ff3 |
return unless $buf;
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
my $pos = *$self->{pos};
|
|
Packit Service |
136ff3 |
my $slen = length($_[0]);
|
|
Packit Service |
136ff3 |
my $len = $slen;
|
|
Packit Service |
136ff3 |
my $off = 0;
|
|
Packit Service |
136ff3 |
if (@_ > 1) {
|
|
Packit Service |
136ff3 |
$len = $_[1] if $_[1] < $len;
|
|
Packit Service |
136ff3 |
if (@_ > 2) {
|
|
Packit Service |
136ff3 |
$off = $_[2] || 0;
|
|
Packit Service |
136ff3 |
die "Offset outside string" if $off > $slen;
|
|
Packit Service |
136ff3 |
if ($off < 0) {
|
|
Packit Service |
136ff3 |
$off += $slen;
|
|
Packit Service |
136ff3 |
die "Offset outside string" if $off < 0;
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
my $rem = $slen - $off;
|
|
Packit Service |
136ff3 |
$len = $rem if $rem < $len;
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
substr($$buf, $pos, $len) = substr($_[0], $off, $len);
|
|
Packit Service |
136ff3 |
*$self->{pos} += $len;
|
|
Packit Service |
136ff3 |
return $len;
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
*sysread = \&read;
|
|
Packit Service |
136ff3 |
*syswrite = \&write;
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
sub stat
|
|
Packit Service |
136ff3 |
{
|
|
Packit Service |
136ff3 |
my $self = shift;
|
|
Packit Service |
136ff3 |
return unless $self->opened;
|
|
Packit Service |
136ff3 |
return 1 unless wantarray;
|
|
Packit Service |
136ff3 |
my $len = length ${*$self->{buf}};
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
return (
|
|
Packit Service |
136ff3 |
undef, undef, # dev, ino
|
|
Packit Service |
136ff3 |
0666, # filemode
|
|
Packit Service |
136ff3 |
1, # links
|
|
Packit Service |
136ff3 |
$>, # user id
|
|
Packit Service |
136ff3 |
$), # group id
|
|
Packit Service |
136ff3 |
undef, # device id
|
|
Packit Service |
136ff3 |
$len, # size
|
|
Packit Service |
136ff3 |
undef, # atime
|
|
Packit Service |
136ff3 |
undef, # mtime
|
|
Packit Service |
136ff3 |
undef, # ctime
|
|
Packit Service |
136ff3 |
512, # blksize
|
|
Packit Service |
136ff3 |
int(($len+511)/512) # blocks
|
|
Packit Service |
136ff3 |
);
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
sub FILENO {
|
|
Packit Service |
136ff3 |
return undef; # XXX perlfunc says this means the file is closed
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
sub blocking {
|
|
Packit Service |
136ff3 |
my $self = shift;
|
|
Packit Service |
136ff3 |
my $old = *$self->{blocking} || 0;
|
|
Packit Service |
136ff3 |
*$self->{blocking} = shift if @_;
|
|
Packit Service |
136ff3 |
return $old;
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
my $notmuch = sub { return };
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
*fileno = $notmuch;
|
|
Packit Service |
136ff3 |
*error = $notmuch;
|
|
Packit Service |
136ff3 |
*clearerr = $notmuch;
|
|
Packit Service |
136ff3 |
*sync = $notmuch;
|
|
Packit Service |
136ff3 |
*flush = $notmuch;
|
|
Packit Service |
136ff3 |
*setbuf = $notmuch;
|
|
Packit Service |
136ff3 |
*setvbuf = $notmuch;
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
*untaint = $notmuch;
|
|
Packit Service |
136ff3 |
*autoflush = $notmuch;
|
|
Packit Service |
136ff3 |
*fcntl = $notmuch;
|
|
Packit Service |
136ff3 |
*ioctl = $notmuch;
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
*GETC = \&get;;
|
|
Packit Service |
136ff3 |
*PRINT = \&prin;;
|
|
Packit Service |
136ff3 |
*PRINTF = \&printf;
|
|
Packit Service |
136ff3 |
*READ = \&read;
|
|
Packit Service |
136ff3 |
*WRITE = \&write;
|
|
Packit Service |
136ff3 |
*SEEK = \&see;;
|
|
Packit Service |
136ff3 |
*TELL = \&getpos;
|
|
Packit Service |
136ff3 |
*EOF = \&eof;
|
|
Packit Service |
136ff3 |
*CLOSE = \&close;
|
|
Packit Service |
136ff3 |
*BINMODE = \&binmode;
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
sub string_ref
|
|
Packit Service |
136ff3 |
{
|
|
Packit Service |
136ff3 |
my $self = shift;
|
|
Packit Service |
136ff3 |
return *$self->{buf};
|
|
Packit Service |
136ff3 |
}
|
|
Packit Service |
136ff3 |
*sref = \&string_ref;
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
1;
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
__END__
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
=head1 NAME
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
IO::String - Emulate file interface for in-core strings
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
=head1 SYNOPSIS
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
use IO::String;
|
|
Packit Service |
136ff3 |
$io = IO::String->new;
|
|
Packit Service |
136ff3 |
$io = IO::String->new($var);
|
|
Packit Service |
136ff3 |
tie *IO, 'IO::String';
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
# read data
|
|
Packit Service |
136ff3 |
<$io>;
|
|
Packit Service |
136ff3 |
$io->getline;
|
|
Packit Service |
136ff3 |
read($io, $buf, 100);
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
# write data
|
|
Packit Service |
136ff3 |
print $io "string\n";
|
|
Packit Service |
136ff3 |
$io->print(@data);
|
|
Packit Service |
136ff3 |
syswrite($io, $buf, 100);
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
select $io;
|
|
Packit Service |
136ff3 |
printf "Some text %s\n", $str;
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
# seek
|
|
Packit Service |
136ff3 |
$pos = $io->getpos;
|
|
Packit Service |
136ff3 |
$io->setpos(0); # rewind
|
|
Packit Service |
136ff3 |
$io->seek(-30, -1);
|
|
Packit Service |
136ff3 |
seek($io, 0, 0);
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
=head1 DESCRIPTION
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
The C<IO::String> module provides the C<IO::File> interface for in-core
|
|
Packit Service |
136ff3 |
strings. An C<IO::String> object can be attached to a string, and
|
|
Packit Service |
136ff3 |
makes it possible to use the normal file operations for reading or
|
|
Packit Service |
136ff3 |
writing data, as well as for seeking to various locations of the string.
|
|
Packit Service |
136ff3 |
This is useful when you want to use a library module that only
|
|
Packit Service |
136ff3 |
provides an interface to file handles on data that you have in a string
|
|
Packit Service |
136ff3 |
variable.
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
Note that perl-5.8 and better has built-in support for "in memory"
|
|
Packit Service |
136ff3 |
files, which are set up by passing a reference instead of a filename
|
|
Packit Service |
136ff3 |
to the open() call. The reason for using this module is that it
|
|
Packit Service |
136ff3 |
makes the code backwards compatible with older versions of Perl.
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
The C<IO::String> module provides an interface compatible with
|
|
Packit Service |
136ff3 |
C<IO::File> as distributed with F<IO-1.20>, but the following methods
|
|
Packit Service |
136ff3 |
are not available: new_from_fd, fdopen, format_write,
|
|
Packit Service |
136ff3 |
format_page_number, format_lines_per_page, format_lines_left,
|
|
Packit Service |
136ff3 |
format_name, format_top_name.
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
The following methods are specific to the C<IO::String> class:
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
=over 4
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
=item $io = IO::String->new
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
=item $io = IO::String->new( $string )
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
The constructor returns a newly-created C<IO::String> object. It
|
|
Packit Service |
136ff3 |
takes an optional argument, which is the string to read from or write
|
|
Packit Service |
136ff3 |
into. If no $string argument is given, then an internal buffer
|
|
Packit Service |
136ff3 |
(initially empty) is allocated.
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
The C<IO::String> object returned is tied to itself. This means
|
|
Packit Service |
136ff3 |
that you can use most Perl I/O built-ins on it too: readline, <>, getc,
|
|
Packit Service |
136ff3 |
print, printf, syswrite, sysread, close.
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
=item $io->open
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
=item $io->open( $string )
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
Attaches an existing IO::String object to some other $string, or
|
|
Packit Service |
136ff3 |
allocates a new internal buffer (if no argument is given). The
|
|
Packit Service |
136ff3 |
position is reset to 0.
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
=item $io->string_ref
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
Returns a reference to the string that is attached to
|
|
Packit Service |
136ff3 |
the C<IO::String> object. Most useful when you let the C<IO::String>
|
|
Packit Service |
136ff3 |
create an internal buffer to write into.
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
=item $io->pad
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
=item $io->pad( $char )
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
Specifies the padding to use if
|
|
Packit Service |
136ff3 |
the string is extended by either the seek() or truncate() methods. It
|
|
Packit Service |
136ff3 |
is a single character and defaults to "\0".
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
=item $io->pos
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
=item $io->pos( $newpos )
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
Yet another interface for reading and setting the current read/write
|
|
Packit Service |
136ff3 |
position within the string (the normal getpos/setpos/tell/seek
|
|
Packit Service |
136ff3 |
methods are also available). The pos() method always returns the
|
|
Packit Service |
136ff3 |
old position, and if you pass it an argument it sets the new
|
|
Packit Service |
136ff3 |
position.
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
There is (deliberately) a difference between the setpos() and seek()
|
|
Packit Service |
136ff3 |
methods in that seek() extends the string (with the specified
|
|
Packit Service |
136ff3 |
padding) if you go to a location past the end, whereas setpos()
|
|
Packit Service |
136ff3 |
just snaps back to the end. If truncate() is used to extend the string,
|
|
Packit Service |
136ff3 |
then it works as seek().
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
=back
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
=head1 BUGS
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
In Perl versions < 5.6, the TIEHANDLE interface was incomplete.
|
|
Packit Service |
136ff3 |
If you use such a Perl, then seek(), tell(), eof(), fileno(), binmode() will
|
|
Packit Service |
136ff3 |
not do anything on an C<IO::String> handle. See L<perltie> for
|
|
Packit Service |
136ff3 |
details.
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
=head1 SEE ALSO
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
L<IO::File>, L<IO::Stringy>, L<perlfunc/open>
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
=head1 COPYRIGHT
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
Copyright 1998-2005 Gisle Aas.
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
This library is free software; you can redistribute it and/or
|
|
Packit Service |
136ff3 |
modify it under the same terms as Perl itself.
|
|
Packit Service |
136ff3 |
|
|
Packit Service |
136ff3 |
=cut
|