Perl6 的 YAML::Dumper 模块

#!/usr/bin/env perl6
use v6;
use DBIish;
use YAML;
my $base_dir = "/etc/puppet/webui";
# 函数在 Perl6 中依然使用 sub 关键字定义，不过有个超酷的特性是 multi sub
# 脚本中没有用到，但是在 YAML::Dumper 中遍地都是，这里也提一句。
# MAIN 函数在 Perl6 里可以直接用 :$opt 命令参数起 getopt 的作用
# 不过 ENC 脚本就是直接传一个主机名，用不上这个超酷的特性
sub MAIN($node) {
# connect 方法接收参数选项是 |%opts，所以可以把哈希直接平铺写
# 这个 | 的用法一个月前在《Using Perl6》里看到过
    my $dbh = DBIish.connect( 'SQLite', database => "{$base_dir}/node_info.db" );
    my $sth = $dbh.prepare("select * from node_info where node_fqdn = ?");
    $sth.execute("$node");
    my $ret = $sth.fetchrow_hashref;
    my $res;
    if ( !$ret ) {
        $res = {
# Perl5 的 qw() 在 Perl6 里直接写成 <> 。也不用再通过 [] 来指明是引用
            classes     => <puppetd repos>,
            environment => 'testing',
        };
    }
    else {
        $res = {
            environment => $ret{'environment'},
            parameters  => { role => $ret{'role'} },
            classes     => {},
        };
# 这个 for 的用法，在 Perl5 的 Text::Xslate 模板里就用过
        for split(',', $ret{'classes'}) -> $class {
            if ( $class eq 'nginx' ) {
# 这个 <== 符号指明数据流方向，完全可以把数组倒过来，然后用 ==> 写这行
# 如果不习惯这种流向操作符的，可以用,号，反正不能跟 Perl5 那样啥都不写
# 这里比较怪的一点是我试图把这么长的一句分成多行写，包括每行后面加\，我看到 YAML 代码里就用\分行了，但是我这就会报错
# Perl6 的正则变化较大，这里 /^#/ 要写成 /^'#'/ 或者 /^\x23/
# 正则 // 前面不加 m// 不会立刻开始匹配
# 原先的 s///g 可以写作 s:g///，也可以写作对象式的 .subst(m//, '', :g)，. 前面为空就是默认的 $_
# 捕获的数据存在 @() 数组里，也可以用 $/[i] 的形式获取
# 字符串内插时，不再写作 ${*}，而是 {$*} 的形式
# 命名捕获这里没用上，写个示例：
#     $str ~~ /^(\w+?)$<laststr>=(\w ** 4)\w$/;
#     $/<laststr>.chomp.say;
# 注意里面的 \w{4} 变成了 \w ** 4
                my @needs <== map { .subst(m/^(.+)\:(\d+)$/, "{$/[0]} max_fails=30 weight={$/[1]}", :g) } <== grep { !m/^\x23/ } <== split(',', $ret{'extstr'});
                $res{'classes'}{'nginx'}{'iplist'} = @needs;
            }
            else {
# Perl5 的 undef 不再使用，可以使用 Nil 或者 Any 对象
                $res{'classes'}{$class} = Nil;
            }
        }
    };
    $dbh.disconnect();
# 这个 dump 就是 YAML 模块导出的函数
# Perl6 的模块要导出函数不再需要 Exporter 那样，直接用 our sub dump($obj) {} 就可以了
    say dump($res);
};