=pod

=head1 NAME

Tie::Scalar::Substring - Tie strings to subranges of another string.

=head1 SYNOPSIS

  my $s = "abcdefghijklmnop";

  tie my $x, 'Tie::Scalar::Substring', \$s, 1, 5;
  tie my $y, 'Tie::Scalar::Substring', \$s, 2;

=head1 DESCRIPTION

If you need to define one or more strings in terms of being
substrings of some other "fundamental" string, this module
gives you exactly that.

Strings so tied can be assigned; the effect is the same as
assigning to lvalue C<substr>. 

Note that you can define a sub-string to have a certain
specified length, or you can leave that parameter undefined,
in which case the substring is "everything up to the end
of the string", just as with C<substr>.

=head1 CAVEATS

The caveats are all the same as when assigning to lvalue C<substr>.

You generally won't get useful results if a sub-string is
defined as starting past the end of the underlying string.

Assigning to one sub-string will (in general) affect the value
of all other sub-strings, "magically".

You may be surprised by the effect of assigning a value whose
length is different from the defined length of the target string.

For example:

  my $s = "abcdefghijklmnop";

  tie my $x, 'Tie::Scalar::Substring', \$s, 1, 1;
  tie my $y, 'Tie::Scalar::Substring', \$s, 5, 1;

  print "before: '$x' '$y'\n";

  $x = 'qu';

  print "after:  '$x' '$y'\n";

produces the following output:

  before: 'b' 'f'

  after:  'q' 'e'

=head1 HISTORY

2005-07-16 jdporter Initial version.

=cut

use strict;

{
    package Tie::Scalar::Substring;
    
    sub TIESCALAR
    {
        my( $pkg, $fund_str_sr, $ofs, $len ) = @_;
        # did you know that you can bless a reference
        # of type substr?
        defined $len
          ? ( bless \substr( $$fund_str_sr, $ofs, $len ), $pkg )
          : ( bless \substr( $$fund_str_sr, $ofs ), $pkg )
    }

    sub FETCH
    {
        my $self = shift;
        $$self
    }

    sub STORE
    {
        my $self = shift;
        $$self = shift;
    }

    sub LENGTH
    {
        my $self = shift;
        length( $$self )
    }
}

# this block will be executed if you call this file as a script,
# but not when it's require'd.  It's essentially a unit test.
unless ( caller(0) )
{

my $s = "abcdefghijklmnop";

my $x;
my $y;

tie $x, 'Tie::Scalar::Substring', \$s, 5; #, 5;
tie $y, 'Tie::Scalar::Substring', \$s, 7; #, 5;

print "before:\n";
print "s=$s\n";
print "x=$x\n";
print "y=$y\n";
print "len(x)=", length($x), "\n";

$x = "quvwxyz";

print "\nafter:\n";
print "s=$s\n";
print "x=$x\n";
print "y=$y\n";
print "len(x)=", length($x), "\n";


}

1;