1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19

# Composite（ツリーノード）
package AST::Node {
    use Moo;
    has 'children' => (is => 'rw', default => sub { [] });
    
    sub accept ($self, $visitor) {
        $visitor->visit($self);
        $_->accept($visitor) for $self->children->@*;
    }
}

# Visitor（操作注入）
package Visitor::Optimizer {
    use Moo;
    
    sub visit ($self, $node) {
        # ノードごとに最適化処理
    }
}

1
2
3
4
5
6
7

Slack
  ↓（webhook）
Mediator（指令ルーター）
  ↓
Command（実行可能な命令オブジェクト）
  ↓
Observer（結果通知・ログ記録）

1
2
3
4
5
6
7
8
9

# Multiton（型ごとシングルトン）
package DriverRegistry {
    use Moo;
    my %instances;
    
    sub get_driver ($class, $type) {
        $instances{$type} //= $class->_factory($type);
    }
}

1
2
3
4
5
6
7
8

1. PPI（Perl Parser）でソース解析
2. Composite構造のAST構築
3. Visitorで最適化パス
   - 未使用変数削除
   - 定数畳み込み
   - ループ最適化
4. Iteratorで全ノード走査
5. 最適化コードを出力

1
2
3
4

/deploy production        → デプロイコマンド発火
/db-backup staging        → DBバックアップ
/server-status web-01     → サーバーヘルスチェック
/rollback production      → ロールバック（Undo）

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14

# Abstract Factoryでサンドボックス種別選択
my $factory = SandboxFactory->create('linux_isolated');

# Builderで段階的構築
my $lab = LabBuilder->new
    ->set_os('ubuntu22.04')
    ->set_network('isolated')
    ->add_tool('wireshark')
    ->add_tool('tcpdump')
    ->place_sample('suspicious.bin')
    ->build;

# Prototypeで設定複製
my $lab2 = $lab->clone->modify(os => 'windows10');

1
2
3
4
5
6
7
8
9

┌──────────────────────────────────────┐
│ UNIFIED CONTROL PANEL v2.0           │
├──────────────────────────────────────┤
│ [GitHub] 3 open PRs | 12 issues      │
│ [Jira]   Sprint: 65% complete        │
│ [Slack]  5 unread channels           │
│ [AWS]    EC2: 8 running, $45.2/day   │
└──────────────────────────────────────┘
> _

 1
 2
 3
 4
 5
 6
 7
 8
 9
10

1. 「Perlコードを解析したい」という動機
2. PPI（Perl Parser Interface）でAST取得
3. Composite パターンでツリー構造表現
4. Iterator パターンで全ノード走査
5. Visitor パターンで最適化操作注入
   - Pass1: 未使用変数削除
   - Pass2: 定数畳み込み
   - Pass3: ループ最適化
6. 最適化済みコード出力
7. 拡張：新しい最適化パスの追加方法

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51

#!/usr/bin/env perl
use v5.36;
use Moo;

# Composite: AST Node
package AST::Node {
    use Moo;
    has 'type'     => (is => 'ro', required => 1);
    has 'value'    => (is => 'rw');
    has 'children' => (is => 'rw', default => sub { [] });
    
    sub accept ($self, $visitor) {
        $visitor->visit($self);
        $_->accept($visitor) for $self->children->@*;
    }
}

# Visitor: 最適化パス
package Visitor::ConstantFolding {
    use Moo;
    
    sub visit ($self, $node) {
        return unless $node->type eq 'BinaryOp';
        
        my ($left, $right) = $node->children->@*;
        if ($left->type eq 'Literal' && $right->type eq 'Literal') {
            # 定数畳み込み: 2 + 3 → 5
            my $result = eval "$left->{value} $node->{value} $right->{value}";
            $node->type('Literal');
            $node->value($result);
            $node->children([]);
        }
    }
}

# Iterator（暗黙的にaccept内で実装）
# Facadeとして全体を統合
package Optimizer {
    use Moo;
    
    sub optimize ($self, $source_code) {
        my $ast = $self->parse($source_code);
        
        # 最適化パス実行
        $ast->accept(Visitor::ConstantFolding->new);
        $ast->accept(Visitor::DeadCodeElimination->new);
        $ast->accept(Visitor::LoopOptimization->new);
        
        return $self->generate_code($ast);
    }
}

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13

1. 「SlackからCLIツールを実行したい」という動機
2. Mojoliciousでwebhook受信
3. Mediator パターンでコマンドルーティング
4. Command パターンで実行可能命令化
   - DeployCommand
   - BackupCommand
   - ServerStatusCommand
5. Observer パターンで実行結果通知
   - Slack通知
   - ログ記録
   - メトリクス送信
6. Undo/Redo機能実装
7. 拡張：新コマンド追加のプラグイン化

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83

#!/usr/bin/env perl
use Mojolicious::Lite -signatures;

# Command基底クラス
package Command {
    use Moo;
    has 'params' => (is => 'ro', required => 1);
    
    sub execute ($self) { die "Abstract method" }
    sub undo ($self) { die "Abstract method" }
}

package DeployCommand {
    use Moo; extends 'Command';
    
    sub execute ($self) {
        my $env = $self->params->{env};
        system("git pull && ./deploy.sh $env");
        return { success => 1, message => "Deployed to $env" };
    }
    
    sub undo ($self) {
        my $env = $self->params->{env};
        system("./rollback.sh $env");
        return { success => 1, message => "Rolled back $env" };
    }
}

# Mediator: コマンドルーター
package CommandMediator {
    use Moo;
    has 'observers' => (is => 'rw', default => sub { [] });
    has 'history'   => (is => 'rw', default => sub { [] });
    
    sub route ($self, $command_name, $params) {
        my $command = $self->_create_command($command_name, $params);
        my $result = $command->execute;
        
        push $self->history->@*, $command;
        $self->_notify_observers($result);
        
        return $result;
    }
    
    sub _create_command ($self, $name, $params) {
        my %registry = (
            deploy => 'DeployCommand',
            backup => 'BackupCommand',
            status => 'ServerStatusCommand',
        );
        my $class = $registry{$name} or die "Unknown command: $name";
        return $class->new(params => $params);
    }
    
    sub _notify_observers ($self, $result) {
        $_->update($result) for $self->observers->@*;
    }
}

# Observer: 通知
package SlackNotifier {
    use Moo;
    has 'webhook_url' => (is => 'ro', required => 1);
    
    sub update ($self, $result) {
        # Slack通知
    }
}

# Webhook受信
post '/slack/command' => sub ($c) {
    my $command = $c->param('command');  # /deploy
    my $text    = $c->param('text');     # production
    
    my $mediator = CommandMediator->new(
        observers => [SlackNotifier->new(webhook_url => $ENV{SLACK_WEBHOOK})]
    );
    
    my $result = $mediator->route($command, { env => $text });
    $c->render(json => $result);
};

app->start;

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11

1. 「怪しいファイルを安全に調査したい」という動機
2. Abstract Factory で解析環境種別選択
   - LinuxSandboxFactory
   - WindowsSandboxFactory
   - NetworkSandboxFactory
3. Builder で段階的に環境構築
   - OS選択 → ネットワーク設定 → ツール導入 → 検体配置
4. Prototype で既存設定複製＋カスタマイズ
5. 実行：検体を仮想環境で起動
6. 観察：ログ・ネットワーク・プロセスを監視
7. クリーンアップ：環境自動削除

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101

#!/usr/bin/env perl
use v5.36;

# Abstract Factory
package SandboxFactory {
    use Moo;
    
    sub create ($class, $type) {
        my %factories = (
            linux   => 'LinuxSandboxFactory',
            windows => 'WindowsSandboxFactory',
            network => 'NetworkSandboxFactory',
        );
        return $factories{$type}->new;
    }
}

package LinuxSandboxFactory {
    use Moo;
    
    sub create_os ($self)      { return OS::Ubuntu->new }
    sub create_network ($self) { return Network::Isolated->new }
    sub create_tools ($self)   { return [Tool::Wireshark->new, Tool::Strace->new] }
}

# Builder
package LabBuilder {
    use Moo;
    has 'os'      => (is => 'rw');
    has 'network' => (is => 'rw');
    has 'tools'   => (is => 'rw', default => sub { [] });
    has 'sample'  => (is => 'rw');
    
    sub set_os ($self, $os) {
        $self->os($os);
        return $self;
    }
    
    sub set_network ($self, $network) {
        $self->network($network);
        return $self;
    }
    
    sub add_tool ($self, $tool) {
        push $self->tools->@*, $tool;
        return $self;
    }
    
    sub place_sample ($self, $sample) {
        $self->sample($sample);
        return $self;
    }
    
    sub build ($self) {
        return Lab->new(
            os      => $self->os,
            network => $self->network,
            tools   => $self->tools,
            sample  => $self->sample,
        );
    }
}

# Prototype
package Lab {
    use Moo;
    has 'os'      => (is => 'ro', required => 1);
    has 'network' => (is => 'ro', required => 1);
    has 'tools'   => (is => 'ro', required => 1);
    has 'sample'  => (is => 'ro', required => 1);
    
    sub clone ($self, %overrides) {
        return __PACKAGE__->new(
            os      => $overrides{os}      // $self->os,
            network => $overrides{network} // $self->network,
            tools   => $overrides{tools}   // [@{$self->tools}],
            sample  => $overrides{sample}  // $self->sample,
        );
    }
    
    sub run ($self) {
        say "Starting lab with OS: " . $self->os;
        # Docker/VM起動処理
    }
}

# 使用例
my $factory = SandboxFactory->create('linux');

my $lab = LabBuilder->new
    ->set_os($factory->create_os)
    ->set_network($factory->create_network)
    ->add_tool($_) for $factory->create_tools->@*
    ->place_sample('eicar.com')
    ->build;

$lab->run;

# 設定複製して別検体を試す
my $lab2 = $lab->clone(sample => 'another_sample.bin');
$lab2->run;

1
2
3
4
5
6

use v5.36;  # signatures, say, state などが有効化

sub method ($self, $arg) {  # signaturesでスッキリ
    state $cache = {};      # state変数
    say "Processing: $arg"; # say
}

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14

package MyClass {
    use Moo;
    use Types::Standard qw(Str Int ArrayRef);
    
    # 型制約
    has 'name' => (is => 'ro', isa => Str, required => 1);
    has 'count' => (is => 'rw', isa => Int, default => 0);
    has 'items' => (is => 'ro', isa => ArrayRef, default => sub { [] });
    
    # BUILD: コンストラクタ後処理
    sub BUILD ($self, $args) {
        $self->_initialize;
    }
}

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28

#!/usr/bin/env perl
use v5.36;
use Moo;

# パッケージをネスト定義
package Pattern::Strategy {
    use Moo::Role;
    requires 'execute';
}

package Concrete::StrategyA {
    use Moo;
    with 'Pattern::Strategy';
    
    sub execute ($self, $data) { ... }
}

package Main {
    use Moo;
    has 'strategy' => (is => 'ro', required => 1);
    
    sub run ($self) {
        $self->strategy->execute(...);
    }
}

# エントリーポイント
__PACKAGE__->new(strategy => Concrete::StrategyA->new)->run unless caller;

1
2
3
4
5
6

# CPANモジュールはコア or 有名どころのみ
use Moo;                   # オブジェクト指向
use JSON;                  # JSON処理
use LWP::UserAgent;        # HTTP通信（オプション：Mojo::UserAgent）
use DBI;                   # DB接続（必要なら）
use Test::More;            # テスト

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13

package Testing {
    use Test::More;
    
    sub run_tests {
        my $obj = MyClass->new(name => 'test');
        is $obj->name, 'test', 'Constructor works';
        
        done_testing;
    }
}

# テストモード起動
Testing->run_tests if $ENV{TEST_MODE};