Perl を勉強したりしたメモを残しておきました。

文字列を扱う

string.pl として保存して、macOS であれば Terminal から perl string.pl で実行できます。

use strict;
use warnings;
 
# 結合
my $join1 = 'aaa'.'bbb';
print "$join1\n";
 
# 結合(別の方法)
my $join2 = join(',', 'aaa', 'bbb', 'ccc');
print "$join2\n";
 
# 分割(,で分割)
my @record = split(/,/, 'aaa,bbb,ccc');
print "@record\n";
 
# 文字列の長さ
my $length = length('abcdef');
print "$length\n";
 
# 切り出し
my $substr = substr('abcd', 0, 2);
print "$substr\n";
 
# 検索(値が存在する位置番号を取得。見つからなかった場合は -1)
my $result = index('abcd', 'cd');
print "$result\n";

% perl string.pl 
aaabbb
aaa,bbb,ccc
aaa bbb ccc
6
ab
2

モジュール化(クラス化)してオブジェクト指向プログラミング

クラス（モジュール）を作成し、サブクラスをさらに作成するサンプルです。モジュールの拡張子は .pm です。

Point.pm

package Point;
 
use strict;
use warnings;
 
# コンストラクタは便宜的に new という名前
# my $point = Point->new(x=>2, y=>3);
sub new {
    my $class = shift();
    my $self = {
        x => 0,
        y => 0,
        @_
    };
    return bless($self, $class);
}
 
# $point->x とすれば x の値が取れる
# $point->x(0) とすれば x の値を 0 にできる
sub x {
    my $self = shift();
    if (@_) {
        $self->{x} = $_[0];
    } else {
        return $self->{x};
    }
}
 
# $point->y とすれば y の値が取れる
# $point->y(0) とすれば y の値を 0 にできる
sub y {
    my $self = shift();
    if (@_) {
        $self->{y} = $_[0];
    } else {
        return $self->{y};
    }
}
 
# 値をクリアして 0 にする
# $point->clear();
sub clear {
    my $self = shift();
    $self->x(0);
    $self->y(0);
}
 
# モジュールは最後にこれを付ける
1;

Point3D.pm

package Point3D;
 
# 継承
use base "Point";
 
# コンストラクタは便宜的に new という名前
# my $point3 = Point3D->new(x=>2, y=>3, z=>4);
sub new {
    my $self = shift()->SUPER::new(@_);
    $self->z = 0 unless exists $self->{z};
    return $self;
}
 
# $point3->z とすれば z の値が取れる
# $point3->z(0) とすれば z の値を 0 にできる
sub z {
    my $self = shift();
    if (@_) {
        $self->{z} = $_[0];
    } else {
        return $self->{z};
    }
}
 
# 値をクリアして 0 にする
# $point3->clear();
sub clear {
    my $self = shift();
    $self->SUPER::clear;
    $self->z(0);
}
 
# モジュールは最後にこれを付ける
1;

point.pl

use strict;
use warnings;
 
use Point;
use Point3D;
 
# Point
my $point = Point->new(x=>2, y=>3);
print("[".$point->x.",".$point->y."]\n");
$point->clear();
print("[".$point->x.",".$point->y."]\n");
$point->y(4);
print("[".$point->x.",".$point->y."]\n");
 
# Point3D
my $point3 = Point3D->new(x=>2, y=>3, z=> 4);
print("[".$point3->x.",".$point3->y.",".$point3->z."]\n");
$point3->clear();
print("[".$point3->x.",".$point3->y.",".$point3->z."]\n");

出力

% perl point.pl 
[2,3]
[0,0]
[0,4]
[2,3,4]
[0,0,0]

Amon2 で DB を利用したウェブアプリを作る

セットアップ

とりあえず Large フレーバーで作ってみます。

$ amon2-setup.pl HelloWorld --flavor Large
$ cd HelloWorld
$ carton install
$ sqlite3 db/development.db < sql/sqlite.sql

デフォルトで sql/sqlite.sql と lib/HelloWorld/DB/Schema.pm で member テーブル (id, name) を持つ DB と O/R マッパーができるので、これにデータを足していくアプリにしてみる。

Perl: lib/HelloWorld/Web/C/Root.pm

package HelloWorld::Web::C::Root;
use strict;
use warnings;
use utf8;
 
sub index {
    my ($class, $c) = @_;
    
    my $counter = $c->session->get('counter') || 0;
    $counter++;
    $c->session->set('counter' => $counter);
    my @members = $c->db->search_by_sql(q{
        SELECT * FROM member ORDER BY id DESC LIMIT 10
    });
    return $c->render('index.tx', {
        counter => $counter,
        members => \@members,
    });
}
 
sub post {
    my ($class, $c) = @_;
    
    if ( my $body = $c->req->param('body') ) {
        $c->db->insert(
            'member',
            +{
                name => $body,
            }
        );
    }
    return $c->redirect('/');
}
 
sub reset_counter {
    my ($class, $c) = @_;
 
    $c->session->remove('counter');
    return $c->redirect('/');
}
 
1;

Perl: lib/HelloWorld/Web/Dispatcher.pm

post '/post' => 'Root#post';

一行追加

Kolon: tmpl/web/index.tx

上の方に追加 Amon2 のテンプレートデフォルト文法いつの間にか TTerse から Kolon になってたので Kolon で記述

<form method="post" action="<: uri_for('/post') :>">
  <input type="text" name="body" />
  <input type="submit" value="Send" />
</form>
 
<table>
: for $members -> $member {
  <tr>
    <td><: $member.id :></td>
    <td><: $member.name :></td>
  </tr>
: }
</table>

起動

$ carton exec perl -Ilib script/helloworld-web-server

http://127.0.0.1:5000 をブラウザで開くとフォームが出来ていて、Send したらデータが追加されていけば完成。