package StreamString;
use strict;
use warnings;

=pod

	use StreamString;
	
	$str = new StreamString('foo bar baz');
	
	$word = $str->unpack('A4');	
	
	print "First word is: $word\n";	# First word is: foo
	
	$word = $str->unpack('A4');
	
	print "Second word is: $word\n"; # Second word is: bar
	
	# Skip forward a byte.
	$str++;	# also $str->seek(1, StreamString::SEEK_CUR)
	
	$word = $str->unpack('A4');
	
	print "Third word is: $word\n";	# Third word is: az
	
	$str -= 3;
	
	$word = $str->unpack('A4');
	print "No, wait, it was $word\n"; # No, wait it was 

	$strpos = 0+$str;		# god bless overload()
	$strpos = $str->tell;	# if you don't like the previous syntax
	
	$bar = $str->unpack_at(4, 'A4');	# seek to 4 before unpacking
	$bar2 = $str->unpack('@4 A4');		# this works too

=cut

# not gonna pull in all of Fcntl for three constants
use constant { SEEK_SET => 0, SEEK_CUR => 1, SEEK_END => 2 };

use overload fallback => 1, 
				'0+' => 'tell',	# calls 'tell' method
				'+'	 => sub { $_[0]->tell() + $_[1] },
				'='	 => 'copy', #sub{$_[0]->new($_[0], pos(${$_[0]}))},
				'+=' => sub { $_[0]->seek($_[1], SEEK_CUR); $_[0] }, 	# += and -= are just relative seeks
				'-=' => sub { $_[0]->seek(-$_[1], SEEK_CUR); $_[0] }, 	# += and -= are just relative seeks
				'""' => sub { ${+shift} },		# stringify
				'bool' => sub { ! $_[0]->eof } ,	# false == end-of-string; truth == not
				;
				
use Carp qw(croak);

sub copy : method {
#	print "copy constructor called\n";
	my $this = shift;
	$this->new($$this, pos($$this));
}

sub new : method {  
	my $class = shift;
	$class = ref($class) if ref($class);
	my $text = shift || '';
	pos($text) = shift || 0;
	bless \$text, $class;
}

sub eof : method { my $this = shift; pos($$this) >= length($this) } 
sub tell : method { pos(${+shift}) }
sub seek : method {
	croak "Not enough arguments to StreamString::seek()" unless @_ >= 3;
	my ($this, $where, $how) = @_;
	my $newpos = 
				$how == SEEK_SET ? $where 
				: $how == SEEK_CUR ? $where + pos($$this)
				: $how == SEEK_END ? length($$this) - $where
				: croak("Invalid WHENCE specified for StreamString::Seek ($how)!");

	return pos($$this) = $newpos if $newpos>=0 && $newpos < length($$this);	# range check
	return pos($$this);
}

sub unpack : method {
	my ($this, $str) = @_;
	my $p = pos($$this);
	
	# this is grossly inefficient.  It requires making a (potentially very large)
	# copy of the not-yet-unpacked version of the string.  If anyone can tell me
	# how to make unpack return the number of bytes it's run through, OR how to
	# work the internal APIs behind unpack (unpack_str/unpackstring) to make them
	# do it, please tell me!
	my @list = CORE::unpack("\@$p $str a*", $$this);
	
	# it's very simple.  The last thing I return is (a*), which sucks up the
	# whole remainder of the string.  I figure out how long that is, and from
	# there I can find out where unpack() stopped reading the data we actually
	# wanted.

	my $remainder = pop @list;
	pos($$this) = length($$this) - length $remainder;
	
	return wantarray ? @list : $list[0];
}

sub unpack_at : method {
	my ($this, $start, $str) = @_;
	$this->seek($start, SEEK_SET);
	return $this->unpack($str);
}

sub main::StreamStringTest {
	my ($str, $word, $strpos, $bar, $bar2);
	$str = new StreamString('foo bar baz');
	
	$word = $str->unpack('A4');	
	
	print "First word is: '$word'\n";	# First word is: foo
	
	$word = $str->unpack('A4');
	
	print "Second word is: '$word'\n"; # Second word is: bar
	
	# Skip forward a byte.
	$str++;
	
	$word = $str->unpack('A4');
	
	print "Third word is: '$word'\n";	# Third word is: az
	
	$str -= 3;
	
	$word = $str->unpack('A4');
	print "No, wait, it was '$word'\n"; # No, wait it was baz

	$strpos = 0+$str;		# god bless overload()
	print "strpos is $strpos\n";
	$strpos = $str->tell;	# if you don't like the previous syntax
	print "strpos is $strpos [2]\n";
	
	$bar = $str->unpack_at(4, 'A4');	# seek to 4 before unpacking
	print "bar is '$bar'\n";
	$bar2 = $str->unpack('@4 A4');		# this works too
	print "bar2 is '$bar2'\n";

}

1;

##</code><code>##

$"=$,,$_=q>|\p4<6 8p<M/_|<('=>
.q>.<4-KI<l|2$<6%s!<qn#F<>;$,
.=pack'N*',"@{[unpack'C*',$_]
}"for split/</;$_=$,,y[A-Z a-z]
         {}cd;print lc