Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling


by jdporter (Canon)
on Jul 16, 2005 at 20:18 UTC ( #475501=sourcecode: print w/replies, xml ) Need Help??
Category: Text Processing
Author/Contact Info jdporter

See embedded pod.

This module was inspired by Array - Reading frame problem, and was written with the intent of solving that problem directly.

Understanding how this works is greatly aided by understanding substr.


=head1 NAME

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


  my $s = "abcdefghijklmnop";

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


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.


use strict;

    package Tie::Scalar::Substring;
        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;

    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";



Replies are listed 'Best First'.
Re: Tie::Scalar::Substring
by chanio (Priest) on Jul 17, 2005 at 19:36 UTC
    ... tie my $x, 'Tie::Scalar::StringFrame', \$s, 1, 1; tie my $y, 'Tie::Scalar::StringFrame', \$s, 5, 1; ...
    Shouldn't it say...
    ... tie my $x, 'Tie::Scalar::Substring', \$s, 1, 1; tie my $y, 'Tie::Scalar::Substring', \$s, 5, 1; ...

    { \ ( ' v ' ) / }
    ( \ _ / ) _ _ _ _ ` ( ) ' _ _ _ _
    ( = ( ^ Y ^ ) = ( _ _ ^ ^ ^ ^
    _ _ _ _ \ _ ( m _ _ _ m ) _ _ _ _ _ _ _ _ _ ) c h i a n o , a l b e r t o
    Wherever I lay my KNOPPIX disk, a new FREE LINUX nation could be established
      Yes! Fixed; thanks. (So you discovered my original name for the module... ;-)
Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://475501]
Discipulus shall be damned all progs that do not provide different font size!
[Corion]: Yeah - that's one important thing why I like to run my presentations from my browser. Ctrl+ and Ctrl- are incredibly helpful there to make sure everybody can read stuff

How do I use this? | Other CB clients
Other Users?
Others chilling in the Monastery: (9)
As of 2017-09-26 09:26 GMT
Find Nodes?
    Voting Booth?
    During the recent solar eclipse, I:

    Results (293 votes). Check out past polls.