Perl日記

日々の知ったことのメモなどです。Perlは最近やってないです。

overloadでマジックデクリメントその3

わかった。
fallback => 1 であとはよきに計らってくれるのならほんとに必要なとこだけ書けばいいんだ。
実際に文字列一文字前処理サブルーチンはプログラミングPerl Vol.1から。

MagicDecrement.pm

package MagicDecrement;
use strict;
use warnings;
use Scalar::Util qw/ looks_like_number /;
use overload
  q(--) => \&decrement,
  q("") => sub { $_[0]->{val} },
  fallback => 1,
;

sub import {
  overload::constant(
    integer => \&handler,
    q => \&handler,
  );
}
sub unimport {
  overload::remove_constant(
    integer => \&handler,
    q => \&handler,
  );
}

sub handler {
  my ($orig, $interp, $context) = @_;
  bless { val => $interp };
}

sub decrement {
  my $dec = $_[0];
  if (looks_like_number($dec->{val})) {
    $dec->{val} -= 1;
  }
  elsif ($dec->{val} =~ /[a-zA-Z]$/) {
    $dec->{val} = magic_decrement($dec->{val});
  }
  bless { val => $dec->{val} };
}

#-- from Programming Perl Vol.1
sub magic_decrement {
  my $word = shift;
  my @string = reverse split(//, $word);
  my $i;
  for ($i = 0; $i < @string; $i++) {
    last unless $string[$i] =~ /a/i;
    $string[$i] = chr(ord($string[$i]) + 25);
  }
  $string[$i] = chr(ord($string[$i]) - 1);
  my $result = join(q{}, reverse @string);
  return $result;
}

1;
__END__
#!/usr/local/bin/perl
use strict;
use warnings;
use feature qw/ say /;
use MagicDecrement;

my $n = 123;
my $w = 'AIUEO';

say "\$n is [$n]. \$w is [$w].";

$n--;
$w--;

say "\$n is [$n]. \$w is [$w].";
$n is [123]. $w is [AIUEO].
$n is [122]. $w is [AIUEN].


できた。


よしじゃあこの調子で他もちゃんと大丈夫かテストを書くぜーとやってみたらTest::More が動かなかった。

use strict;
use warnings;
use Test::More;

BEGIN { use_ok 'MagicDecrement' }

my ($n, $w);

$n = 0;
$n--;
is $n, -1;

$w = 'B';
$w--;
is $w, 'A';

done_testing();

__END__
ok 1 - use MagicDecrement;
ok 2
not ok 3
#   Failed test at 01test.t line 15.
#          got: '-1'
#     expected: 'A'
1..3
# Looks like you failed 1 test of 3.


なんだろ、Test::More って overload のテストはできないのかな。
perldoc してもoverloadのオブジェクトは文字列扱いしてくれるとしかないし。