Archer - ”><xmp>TokuLog 改メ tokuhirom’s blog

■Archer

まるごとPerl! Vol.1

作者: 小飼弾,宮川達彦,伊藤直也,川合孝典,水野貴明
出版社/メーカー: インプレスコミュニケーションズ
発売日: 2006/08/24
メディア: 大型本
購入: 7人クリック: 113回
この商品を含むブログ (115件) を見る

http://naoya.g.hatena.ne.jp/naoya/20060928/1159437059

弊社ではカピなんちゃらいうのは使っておらず、自社開発の Archer というツールを使っています。

先日作ってからしばらく運用しており、なかなか快適です。

まえにさらしてから、だいぶ変わったので再度さらしてみるテスト。

irc で通知
準備フェーズ
- 更新された分の svn log の表示
- svn up
- mysqldiff
[y/n] で本当に deploy するかを確認
deploy フェーズ(この部分は fork まくって並列で動作します)
- rsync
- apache stop/start
irc で通知

というフローで動きます。

サンプルの config.yaml はこんな感じ。

deploy_source: /path/to/src/

cmd:
  svnlog: "svn log -v -r`LANG=C svn info [% deploy_source %]/[% proj %]|perl -ne 'print $1+1 if /Revision: (\d+)/'`:HEAD [% deploy_source %]/[% proj %]"
  svnup: svn up [% deploy_source %]/[% proj %]

  rsync: |-
            rsync -auvz --exclude=.svn/ -e ssh --delete [% opt %] [% deploy_source %]/[% proj %]/[% l_proj %]/ [% server %]:/path/to/dest/[% l_proj %]/
            rsync -auvz --exclude=.svn/ -e ssh --delete [% opt %] [% deploy_source %]/[% proj %]/site_perl/[% proj %]/ [% server %]:/path/to/dest/site_perl/[% proj %]/

  restart: ssh [% server %] "if [ -e /etc/init.d/apache ] ; then  /etc/init.d/apache stop; sleep 6; /etc/init.d/apache start; fi"

  notice: '/usr/local/bin/ircbot-client.pl "[% msg %]"'

skiprestart:
  - 192.168.1.2

projects:
  XXX:
    - 192.168.1.15
    - 192.168.4.19

ソースコードは下記になります。

==> deploy.pl <==
#!/usr/bin/perl
use strict;
use warnings;

use Getopt::Long;
use Pod::Usage;
use FindBin ();
use Path::Class;

use lib dir($FindBin::RealBin, 'lib')->stringify;

use Archer::Script::Deploy;

my $argv_str = "@ARGV";
my $fork_num = 1;
my $config = file($FindBin::RealBin, 'config.yaml')->stringify;
Getopt::Long::GetOptions(
    '--para=i'         => \$fork_num,
    '--debug'          => \my $debug_fg,
    '--skip-svn-up'    => \my $skip_svn_up_fg,
    '--skip-mysqldiff' => \my $skip_mysqldiff,
    '--man'            => \my $man,
    '--config=s'       => \$config,
    '--skip-restart'   => \my $skip_restart,
  )
  or pod2usage(2);
Getopt::Long::Configure("bundling");    # allows -p
pod2usage(-verbose => 2) if $man;
pod2usage(2) unless @ARGV;

for my $proj (@ARGV) {
    Archer::Script::Deploy->new(
        {
            project        => $proj,
            debug          => $debug_fg,
            fork_num       => $fork_num,
            skip_svn_up_fg => $skip_svn_up_fg,
            skip_mysqldiff => $skip_mysqldiff,
            config_yaml    => $config,
            skip_restart   => $skip_restart,
            argv_str       => $argv_str,
        }
    )->run;
}

__END__

=head1 SYNOPSIS

    $ deploy.pl Caspeee
    
    Options:
        --para=5         並列rsync&再起動する数(デフォルト1)
        --debug          debug mode.
        --skip-svn-up    skip the 'svn up'
        --skip-mysqldiff mysqldiffを行いません。
        --man            show manual
        --config         config.yaml path
        --skip-restart   Apache再起動しません

=head1 DESCRIPTION

サーバへの deploy を一括でやってくれる君。

=head1 TODO

    DB に sync 先リストをいれる(ほんとに必要?)
    Apache の設定ファイルは動的に生成？
    半分ずつパラで走らせられるように
    deploy の記録をとれるように(どうやってやる？)
    --para=half が指定できるとよいかも？

=head1 TIPS

    compctl -k '(--skip-restart --skip-mysqldiff --para --skip-svn-up)' deploy.pl

.zshrc に書いておくと幸せになれます。

=head1 AUTHORS

Tokuhiro Matsuno <tokuhiro at mobilefactory.jp>.

==> lib/Archer/Script.pm <==
package Archer::Script;
use strict;
use warnings;
use base qw(Class::Accessor::Fast);

use YAML::Syck ();
use String::CamelCase ();

__PACKAGE__->mk_accessors(qw(project config));

sub new {
    my ($proto, $opt) = @_;

    $opt->{config} = YAML::Syck::LoadFile($opt->{config_yaml});
    bless {%$opt}, $proto;
}

sub servers {
    my $self = shift;

    return $self->config->{projects}->{$self->project};
}

sub is_appserver {
    my ($self, $server) = @_;

    my $skiprestart = {
        map { $_ => 1 }
        @{ $self->config->{skiprestart} }
    };

    return not $skiprestart->{$server};
}

sub validate {
    my $self = shift;

    unless ( $self->servers ) {
        die "unknown project $self->{project}";
    }
}

sub cmdline {
    my ($self, $tmpl, $opt) = @_;

    my $tt = Template->new();

    $tt->process(
        \( $self->config->{cmd}->{$tmpl} ),
        {
            deploy_source => $self->config->{deploy_source},
            proj          => $self->project,
            l_proj        => $self->l_project,
            %{ $opt or {} },
        },
        \my $out,
      )
      or die $tt->error;

    return $out;
}

sub l_project {
    my $self = shift;

    my $lc = String::CamelCase::decamelize($self->project);
    if (-e File::Spec->catfile($self->config->{deploy_source}, $self->project, $lc)) {
        return $lc;
    } else {
        return lc $self->project;
    }
}

1;

==> lib/Archer/Script/Deploy.pm <==
package Archer::Script::Deploy;
use strict;
use warnings;
use base qw(Archer::Script);

use IO::Prompt ();
use Parallel::ForkManager;
use Template;
use YAML::Syck ();
use UNIVERSAL::require;
use MySQL::Diff;

__PACKAGE__->mk_accessors(qw(project debug fork_num skip_svn_up_fg skip_mysqldiff config argv_str));

sub run {
    my $self = shift;

    $self->validate;

    $self->notice("start deploy by $ENV{USER} $self->{argv_str} $$");

    $self->prepare;

    $self->notice("please input [y/n] > $ENV{USER}");
    if ( IO::Prompt::prompt( 'do ? [y/n]', '-yn' ) ) {
        $self->deploy;

        $self->notice("end deploy by $ENV{USER} $self->{argv_str} $$");
    } else {
        $self->notice("cancel deploy by $ENV{USER} $self->{argv_str} $$");
    }
}

sub notice {
    my ($self, $msg) = @_;

    $self->exec(
        $self->cmdline(notice => {msg => $msg})
    );
}

sub prepare {
    my ( $self, @methods ) = @_;

    unless ($self->skip_svn_up_fg) {
        $self->exec( $self->cmdline('svnlog') );
        $self->exec( $self->cmdline('svnup') );
    }

    $self->exec(
        $self->cmdline(
            'rsync' => {
                server => $self->servers->[0],
                opt    => '--dry-run',
            }
        )
    );

    unless ($self->skip_mysqldiff) {
        $self->mysqldiff;
    }
}

sub deploy {
    my $self = shift;

    my $pm = Parallel::ForkManager->new( $self->fork_num );

    for my $server ( @{ $self->servers } ) {
        $pm->start and next;

        $self->_sync_and_restart($server);

        $pm->finish;
    }

    $pm->wait_all_children;
}

sub _sync_and_restart {
    my ($self, $server) = @_;

    $self->exec( $self->cmdline('rsync', {server => $server}) );

    if ($self->is_appserver($server) and not $self->{skip_restart}) {
        $self->exec( $self->cmdline('restart', {server => $server}) );
    }
}

sub exec {
    my ( $self, $cmdline ) = @_;

    print "$cmdline\n";

    unless ( $self->debug ) {
        system $cmdline;
    }
}

sub mysqldiff {
    my $self = shift;

    my $config = "$self->{project}::Config";
    $config->use or die;

    return unless $config->can('_new_instance');

    my $dev = $self->_mysql($config->_new_instance->datasource);
    local $ENV{SLEDGE_CONFIG_NAME} = '_product';
    my $product = $self->_mysql($config->_new_instance->datasource);

    print MySQL::Diff::diff_dbs({}, $product, $dev);
}

sub _mysql {
    my ($self, $drv, $user, $pass) = @_;

    my $db = ($drv =~ /^dbi:[^:]+:([^:;=]+)/) ? $1 : '';
    my $host = ($drv =~ /hostname=([a-zA-Z_0-9.]+)/) ? $1 : '';

    return MySQL::Database->new(
        auth =>
          { user => $user, password => $pass, host => $host },
        db => $db,
    );
}

1;