substr のマジカルな挙動を再現したい
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
use strict; | |
use warnings; | |
use Test::More; | |
package MySubstrLeft { | |
sub TIESCALAR { | |
my ($class, $string_ref, $offset, $length) = @_; | |
my $string = $$string_ref; | |
$offset = $offset < 0 ? length($string) + $offset : $offset; | |
$length = $length > 0 ? $length + $offset - length($string): $length; | |
return bless { | |
string_ref => $string_ref, | |
offset => $offset, | |
length => $length, | |
}, $class; | |
} | |
sub FETCH { | |
my ($self) = @_; | |
my @chars = split //, $self->{string_ref}->$*; | |
my @sub_chars = splice @chars, $self->{offset}, $self->{length}; | |
return join '', @sub_chars; | |
} | |
sub STORE { | |
my ($self, $replacement) = @_; | |
my @chars = split //, $self->{string_ref}->$*; | |
my @replacement_chars = split //, $replacement; | |
splice @chars, $self->{offset}, $self->{length}, @replacement_chars; | |
$self->{string_ref}->$* = join '', @chars; | |
} | |
} | |
sub my_substr : lvalue { | |
my ($str, $offset, $length, $replacement) = @_; | |
my @chars = split //, $str; | |
if (scalar @_ == 2) { | |
my @sub_chars = splice @chars, $offset; | |
my $substr = join '', @sub_chars; | |
return $substr | |
} elsif (scalar @_ == 3) { | |
tie my $substr, 'MySubstrLeft', \$_[0], $offset, $length; | |
return $substr; | |
} else { | |
my @replacement_chars = split //, $replacement; | |
my @sub_chars = splice @chars, $offset, $length, @replacement_chars; | |
$_[0] = join '', @chars; | |
my $substr = join '', @sub_chars; | |
return $substr | |
} | |
} | |
subtest 'ステップ1. 部分文字列を取り出し' => sub { | |
my $s = 'The black cat climbed the green tree'; | |
my $color = my_substr $s, 4, 5; | |
is $color, 'black'; | |
my $middle = my_substr $s, 4, -11; | |
is $middle, 'black cat climbed the'; | |
my $end = my_substr $s, 14; | |
is $end, 'climbed the green tree'; | |
my $tail = my_substr $s, -4; | |
is $tail, 'tree'; | |
my $z = my_substr $s, -4, 2; | |
is $z, 'tr'; | |
}; | |
subtest 'ステップ2. 一部を置き換え' => sub { | |
my $s = 'The black cat climbed the green tree'; | |
my $z = my_substr $s, 14, 7, 'jumped from'; | |
is $s, 'The black cat jumped from the green tree', '元の文字列は置き換わる'; | |
is $z, 'climbed' , '置き換えられた文字列が返る'; | |
}; | |
subtest 'ステップ3. 左辺値として使う' => sub { | |
my $s = 'The black cat climbed the green tree'; | |
my_substr($s, 14, 7) = 'jumped from'; | |
is $s, 'The black cat jumped from the green tree', '元の文字列は置き換わる'; | |
}; | |
subtest 'ステップ4. 魔法の弾丸' => sub { | |
my $x = '1234'; | |
for (substr $x, 1, 2) { | |
is $_, '23'; | |
$_ = 'a'; | |
is $x, '1a4'; | |
$_ = 'xyz'; | |
is $x, '1xyz4'; | |
$x = '56789'; | |
$_ = 'pq'; | |
is $x, '5pq9'; | |
} | |
my $y = '1234'; | |
for (substr($y, -3, 2)) { | |
$_ = 'a'; | |
is $y, '1a4'; | |
$y = 'abcdefg'; | |
is $_, 'f'; | |
} | |
}; | |
done_testing; |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
use strict; | |
use warnings; | |
use Test::More; | |
sub my_substr { | |
my ( $string, $offset, $length ) = @_; | |
my @chars = split //, $string; | |
if ( scalar @_ == 2 ) { | |
my @sub_chars = splice @chars, $offset; | |
return join '', @sub_chars; | |
} | |
else { | |
my @sub_chars = splice @chars, $offset, $length; | |
return join '', @sub_chars; | |
} | |
} | |
subtest 'ステップ1. 部分文字列を取り出し' => sub { | |
my $s = 'The black cat climbed the green tree'; | |
my $color = my_substr $s, 4, 5; | |
is $color, 'black'; | |
my $middle = my_substr $s, 4, -11; | |
is $middle, 'black cat climbed the'; | |
my $end = my_substr $s, 14; | |
is $end, 'climbed the green tree'; | |
my $tail = my_substr $s, -4; | |
is $tail, 'tree'; | |
my $z = my_substr $s, -4, 2; | |
is $z, 'tr'; | |
}; | |
done_testing; |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
use strict; | |
use warnings; | |
use Test::More; | |
sub my_substr { | |
my ( $string, $offset, $length, $replacement ) = @_; | |
my @chars = split //, $string; | |
if ( scalar @_ == 2 ) { | |
my @sub_chars = splice @chars, $offset; | |
return join '', @sub_chars; | |
} | |
elsif ( scalar @_ == 3 ) { | |
my @sub_chars = splice @chars, $offset, $length; | |
return join '', @sub_chars; | |
} | |
else { | |
my @replacement_chars = split //, $replacement; | |
my @sub_chars = splice @chars, $offset, $length, @replacement_chars; | |
$_[0] = join '', @chars; | |
return join '', @sub_chars; | |
} | |
} | |
subtest 'ステップ1. 部分文字列を取り出し' => sub { | |
my $s = 'The black cat climbed the green tree'; | |
my $color = my_substr $s, 4, 5; | |
is $color, 'black'; | |
my $middle = my_substr $s, 4, -11; | |
is $middle, 'black cat climbed the'; | |
my $end = my_substr $s, 14; | |
is $end, 'climbed the green tree'; | |
my $tail = my_substr $s, -4; | |
is $tail, 'tree'; | |
my $z = my_substr $s, -4, 2; | |
is $z, 'tr'; | |
}; | |
subtest 'ステップ2. 一部を置き換え' => sub { | |
my $s = 'The black cat climbed the green tree'; | |
my $z = my_substr $s, 14, 7, 'jumped from'; | |
is $s, 'The black cat jumped from the green tree', '元の文字列は置き換わる'; | |
is $z, 'climbed', '置き換えられた文字列が返る'; | |
}; | |
done_testing; |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
use strict; | |
use warnings; | |
use Test::More; | |
package MySubstrLeft { | |
sub TIESCALAR { | |
my ($class) = @_; | |
print "TIESCALAR\n"; | |
return bless {}, $class; | |
} | |
sub FETCH { | |
my ($self) = @_; | |
print "FETCH\n"; | |
return undef; | |
} | |
sub STORE { | |
my ( $self, $val ) = @_; | |
print "STORE\n"; | |
} | |
} | |
sub my_substr : lvalue { | |
my ( $str, $offset, $length, $replacement ) = @_; | |
my @chars = split //, $str; | |
if ( scalar @_ == 2 ) { | |
my @sub_chars = splice @chars, $offset; | |
my $substr = join '', @sub_chars; | |
return $substr; | |
} | |
elsif ( scalar @_ == 3 ) { | |
my @sub_chars = splice @chars, $offset, $length; | |
my $substr = join '', @sub_chars; | |
tie my $t, 'MySubstrLeft'; | |
return $t; | |
} | |
else { | |
my @replacement_chars = split //, $replacement; | |
my @sub_chars = splice @chars, $offset, $length, @replacement_chars; | |
$_[0] = join '', @chars; | |
my $substr = join '', @sub_chars; | |
return $substr; | |
} | |
} | |
subtest 'ステップ3. 左辺値として使う' => sub { | |
my $s = 'The black cat climbed the green tree'; | |
my_substr( $s, 14, 7 ) = 'jumped from'; | |
is $s, 'The black cat jumped from the green tree', '元の文字列は置き換わる'; | |
}; | |
done_testing; |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
use strict; | |
use warnings; | |
use Test::More; | |
package MySubstrLeft { | |
sub TIESCALAR { | |
my ( $class, $string_ref, $offset, $length ) = @_; | |
my $string = $$string_ref; | |
$offset = $offset < 0 ? length($string) + $offset : $offset; | |
$length = $length > 0 ? $length + $offset - length($string) : $length; | |
return bless { | |
string_ref => $string_ref, | |
offset => $offset, | |
length => $length, | |
}, $class; | |
} | |
sub FETCH { | |
my ($self) = @_; | |
my @chars = split //, $self->{string_ref}->$*; | |
my @sub_chars = splice @chars, $self->{offset}, $self->{length}; | |
return join '', @sub_chars; | |
} | |
sub STORE { | |
my ( $self, $replacement ) = @_; | |
my @chars = split //, $self->{string_ref}->$*; | |
my @replacement_chars = split //, $replacement; | |
splice @chars, $self->{offset}, $self->{length}, @replacement_chars; | |
$self->{string_ref}->$* = join '', @chars; | |
} | |
} | |
sub my_substr : lvalue { | |
my ( $str, $offset, $length, $replacement ) = @_; | |
my @chars = split //, $str; | |
if ( scalar @_ == 2 ) { | |
my @sub_chars = splice @chars, $offset; | |
my $substr = join '', @sub_chars; | |
return $substr; | |
} | |
elsif ( scalar @_ == 3 ) { | |
tie my $substr, 'MySubstrLeft', \$_[0], $offset, $length; | |
return $substr; | |
} | |
else { | |
my @replacement_chars = split //, $replacement; | |
my @sub_chars = splice @chars, $offset, $length, @replacement_chars; | |
$_[0] = join '', @chars; | |
my $substr = join '', @sub_chars; | |
return $substr; | |
} | |
} | |
subtest 'ステップ1. 部分文字列を取り出し' => sub { | |
my $s = 'The black cat climbed the green tree'; | |
my $color = my_substr $s, 4, 5; | |
is $color, 'black'; | |
my $middle = my_substr $s, 4, -11; | |
is $middle, 'black cat climbed the'; | |
my $end = my_substr $s, 14; | |
is $end, 'climbed the green tree'; | |
my $tail = my_substr $s, -4; | |
is $tail, 'tree'; | |
my $z = my_substr $s, -4, 2; | |
is $z, 'tr'; | |
}; | |
subtest 'ステップ2. 一部を置き換え' => sub { | |
my $s = 'The black cat climbed the green tree'; | |
my $z = my_substr $s, 14, 7, 'jumped from'; | |
is $s, 'The black cat jumped from the green tree', '元の文字列は置き換わる'; | |
is $z, 'climbed', '置き換えられた文字列が返る'; | |
}; | |
subtest 'ステップ3. 左辺値として使う' => sub { | |
my $s = 'The black cat climbed the green tree'; | |
my_substr( $s, 14, 7 ) = 'jumped from'; | |
is $s, 'The black cat jumped from the green tree', '元の文字列は置き換わる'; | |
}; | |
subtest 'ステップ4. 魔法の弾丸' => sub { | |
my $x = '1234'; | |
for ( substr $x, 1, 2 ) { | |
is $_, '23'; | |
$_ = 'a'; | |
is $x, '1a4'; | |
$_ = 'xyz'; | |
is $x, '1xyz4'; | |
$x = '56789'; | |
$_ = 'pq'; | |
is $x, '5pq9'; | |
} | |
my $y = '1234'; | |
for ( substr( $y, -3, 2 ) ) { | |
$_ = 'a'; | |
is $y, '1a4'; | |
$y = 'abcdefg'; | |
is $_, 'f'; | |
} | |
}; | |
done_testing; |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
use strict; | |
use warnings; | |
use Test::More; | |
subtest 'ステップ1. 部分文字列の取り出し' => sub { | |
my $s = 'The black cat climbed the green tree'; | |
my $color = substr $s, 4, 5; | |
is $color, 'black'; | |
my $middle = substr $s, 4, -11; | |
is $middle, 'black cat climbed the'; | |
my $end = substr $s, 14; | |
is $end, 'climbed the green tree'; | |
my $tail = substr $s, -4; | |
is $tail, 'tree'; | |
my $z = substr $s, -4, 2; | |
is $z, 'tr'; | |
}; | |
subtest 'ステップ2. 一部を置き換え' => sub { | |
my $s = 'The black cat climbed the green tree'; | |
my $z = substr $s, 14, 7, 'jumped from'; | |
is $s, 'The black cat jumped from the green tree', '元の文字列は置き換わる'; | |
is $z, 'climbed' , '置き換えられた文字列が返る'; | |
}; | |
subtest 'ステップ3. 左辺値として使う' => sub { | |
my $s = 'The black cat climbed the green tree'; | |
substr($s, 14, 7) = 'jumped from'; | |
is $s, 'The black cat jumped from the green tree', '元の文字列は置き換わる'; | |
}; | |
subtest 'ステップ4. 魔法の弾丸' => sub { | |
my $x = '1234'; | |
for (substr $x, 1, 2) { | |
is $_, '23'; | |
$_ = 'a'; | |
is $x, '1a4'; | |
$_ = 'xyz'; | |
is $x, '1xyz4'; | |
$x = '56789'; | |
$_ = 'pq'; | |
is $x, '5pq9'; | |
} | |
my $y = '1234'; | |
for (substr($y, -3, 2)) { | |
$_ = 'a'; | |
is $y, '1a4'; | |
$y = 'abcdefg'; | |
is $_, 'f'; | |
} | |
}; | |
done_testing; |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment