Quiz を普通の再帰で解く

Perl

辛いものを食べたあとで，あまりにお腹が痛いので，解いてみた．

お題を再掲

#XXX を埋めよ(できれば1行)
use strict;
use Data::Dumper;

sub foo {
    my ( $a_ref, $key, $value ) = @_;
    #XXX
    return $a_ref;
}

my $ref = {
    foo => {
        bar => {
            baz  => 1,
        },
    },
};

$ref = foo( $ref, 'foo.bar.baz', 100 );
warn Dumper $ref;

# 結果
# $VAR1 = {
#     'foo' => {
#         'bar' => {
#             'baz' => 100,
#         },
#     },
# };

回答

(@_=split/\./,$key)>1?foo($a_ref->{shift()}//={},join('.',@_),$value):($a_ref->{$key}=$value);

展開版

if ((@_ = split(/\./, $key)) > 1) {
    my $head = shift(@_);
    unless (exists($a_ref->{$head})) {
        $a_ref->{$head} = {};
    }
    foo($a_ref->{$head}, join('.', @_), $value);
} else {
    $a_ref->{$key} = $value;
}

ちょっとツマった場所

  • $hash_ref->{shift} だと，shift が文字列になっちゃう
    • 括弧を付けてみた
  • cnd() ? foo() : $value とか書くと "Can't modify non-lvalue subroutine call"
  • split の@_ への暗黙的な代入はdeprecated だった
    • warn で出力しているところがミソで，どうやって警告を消すかみたいな話も含まれてる？
      • と思ったら，warnings 自分で入れて単にハードルを上げていただけだった(爆
  • return $a_ref; が問題文に無かったら，関数リテラルを使ったかも．

いいところ

  • //= が書ける！*1
  • 実引数の中で，色々やってるけど，引数は順序通りに解決されると思った

おまけ

($_ = sub {
    @_ > 2
        ? $_->(shift->{shift()} //= {},@_)
            : do {
                shift->{shift()} = $value;
                $a_ref;
            }
        })->($a_ref, split(/\./,$key));

おまけ2

{no warnings; sub Dumper {"\$VAR1 = {\n    'foo' => {\n        'bar' => {\n            'baz' => 100,\n        },\n    },\n};\n"}}

warn/Dump を変えたりしないとあのフォーマットにはならないので，それ系で．
warn を STDOUT にしなければならないかというと，結果としか書いてないので，それはそれ？

参考

他の回答とか

*1:||= でもいいような．．．