unknownplace.org

plenv でつかわれる Perl をプロンプトに表示したりするのに使えるかと。検出ロジックは plenv とおなじつもり。

plenv_perl_version() {
    local dir=$PWD

    [[ -n $PLENV_VERSION ]] && { echo $PLENV_VERSION; return }

    while [[ -n $dir && $dir != "/" && $dir != "." ]]; do
        if [[ -f "$dir/.perl-version" ]]; then
            head -n 1 "$dir/.perl-version"
            return
        fi
        dir=$dir:h
    done

    local plenv_home=$PLENV_HOME
    [[ -z $PLENV_HOME && -n $HOME ]] && plenv_home="$HOME/.plenv"

    if [[ -f "$plenv_home/version" ]]; then
        head -n 1 "$plenv_home/version"
    fi
}

dir=$dir:h とかしてるので zsh でしか動かないと思う。

しかし、書くのにだいぶ時間かかった。。

デフォルトだと動かないのでなんか変なラッパーを挟むのがスタンダードな方法みたいですが、たまにしか使わないのにそんな無駄なことしたくないと、

# tmux
if [[ "$TMUX" != "" ]] then
    alias pbcopy="ssh 127.0.0.1 pbcopy"
    alias pbpaste="ssh 127.0.0.1 pbpaste"
fi

としてしのいでいる。僕の使用頻度だとこれで十分ぽい。

というようなことをつぶやいていたら、

Twitter / hchbaw: @typester 最近になって screen -Q windows とできるようになってますね。

と教えていただいた。

-Q コマンドというのは -X と同じようなものだけど、コマンド結果を screen 内のステータス領域ではなく標準出力で得ることができる。また、-X はつねに実行時にそれ自体がアクティブな screen セッションになるのに対し -Q はアクティブなセッションにクエリを投げる感じで、セッションが切り替わらない。（この辺は理解が怪しいので突っ込み歓迎）

それでそれを使うと

screen -Q windows

と実行することで :windows で echo されるのとおなじ文字列を標準出力で得ることができる。その出力をパースすれば、自分が screen の裏にいるかどうか判断することができるというわけ。

zsh でコマンド完了時（正確にはプロンプトが表示される直前）に呼ばれるフックは precmd なので以下のように定義：

function precmd() {
    $HOME/bin/precmd.pl `history -n -1 | head -1`
}

シェルスクリプトかけないので Perl に逃げています。 で、precmd.pl は以下のような感じ：

#!/usr/bin/perl

use strict;
use warnings;
use FileHandle;

my $lastcmd = join ' ', @ARGV;

my $window = $ENV{WINDOW};

my $windows = qx{ screen -Q windows } or die "Your screen doesn't support -Q";
qx{ screen -X redisplay };

my $active;
for my $win (split "\x20\x20", $windows) {
    my ($num, $flag, $title) = $win =~ /^(\d+)(.)? (.+)/;

    if ($flag and $flag eq '*') {
        $active = $num;
        last;
    }
}

if ($window != $active) {
    open my $fh, "|/usr/local/bin/growlnotify -t 'GNU screen window $window'" or die $!;
    print $fh sprintf 'command done: "%s"', $lastcmd;
    print $fh "\n";
    close $fh;
}

これで、コマンドが完了した場合にピコーンと通知が来るようになりました。

長い make や wget の時に超絶便利ですね！

書き忘れましたが、現在この機能をつかうためには開発版の screen を使用する必要があります。

レガシーなアプリをメンテするのにレガシーな Perl モジュールが必要になることがあり、そのために古いアプリ用には専用の local::lib ディレクトリを切っているわけですが、普段から日常的に local::lib を使用しているため shell が上がったタイミングではデフォルトの local::lib 環境変数がセットされていて切り替えが非常に面倒だった。

これまではそれほど頻繁に使用しなかったので放置していたのだが、ここのところ頻繁に必要になるためいい加減うざくなってきて簡単に local::lib を切り替えられるよう設定をしてみた。

zsh に次のような関数をつくり、それで local::lib を切り替えるようにする。

function locallib () {
    INSTALL_BASE=$1
    if [ -d $INSTALL_BASE ]; then
        eval $(~/bin/use-locallib $INSTALL_BASE)
    fi
}

これは

$ locallib ~/perl5

などのように INSTALL_BASE を指定して使う。指定されたパスが存在したら use-locallib というコマンドを使用して環境変数を切り替えるという内容。

この use-locallib コマンドは以下のようなソースになっていて、古い local::lib の環境変数をクリアするとともに、新しい local::lib の環境変数を print するというものになっている。

#!/usr/bin/env perl

use strict;
use warnings;
use Pod::Usage;

use Config;
use File::Spec;

my $install_base = $ARGV[0]
    or pod2usage(-1);

$install_base = File::Spec->rel2abs($install_base);

my $path     = $ENV{PATH};
my $perl5lib = $ENV{PERL5LIB};

push @INC, File::Spec->catdir($install_base, 'lib', 'perl5');

require local::lib;
my %env = local::lib->build_environment_vars_for($install_base, 1);

# remove $PERL5LIB set by old local::lib if it exists.
if (my $old_base = $ENV{PERL_MM_OPT}) {
    my %mmopt;
    for my $opt (split /:+/, $old_base) {
        my ($k, $v) = split /=/, $opt;
        $mmopt{$k} = $v;
    }

    if (my $old_installbase = $mmopt{INSTALL_BASE}) {
        if ($old_installbase eq $install_base) {
            # do nothing if install_base is equal to old one
            exit;
        }

        my @old_perl5lib = (
            File::Spec->catdir($old_installbase, 'lib', 'perl5'),
            File::Spec->catdir($old_installbase, 'lib', 'perl5', $Config{archname}),
        );

        $env{PERL5LIB} = do {
            my @env;
            ENV: for my $e (grep { $_ } split $Config{path_sep}, $env{PERL5LIB}) {
                for my $old (@old_perl5lib) {
                    next ENV if $old eq $e;
                }
                push @env, $e;
            }
            join $Config{path_sep}, @env;
        };

        my $old_path = File::Spec->catdir($old_installbase, 'bin');
        $env{PATH} = do {
            my @p;
            for my $p (grep {$_} split $Config{path_sep}, $env{PATH}) {
                next if $p eq $old_path;
                push @p, $p;
            }
            join $Config{path_sep}, @p;
        };
    }
}

while (my ($k, $v) = each %env) {
    print qq[export $k="$v"\n];
}

=head1 NAME

use-locallib - set/switch local::lib environment

=head1 SYNOPSIS

use-locallib (MODULE INSTALL BASE)

これで local::lib を簡単に切り替えられるようになるけれど、複数の local::lib 環境を同時に使用しているとどのシェルがどの local::lib を使用しているかわからなくなってしまう。

そのためシェルのプロンプトに INSTALL_BASE を表示されるようにしてしのいだ。

これは単純に以下のような PERL_MM_OPT の INSTALL_BASE をプリントするスクリプトを PROMPT 設定から読んでいるだけである。

#!/usr/bin/env perl

use strict;
use warnings;

my %mm_opt;
for my $opt (split /:+/, $ENV{PERL_MM_OPT} || '') {
    my ($k, $v) = split /=/, $opt;
    $mm_opt{$k} = $v;
}

my $install_base = $mm_opt{INSTALL_BASE};
if ($ENV{HOME}) {
    $install_base =~ s/^$ENV{HOME}/~/;
}

print $install_base || 'none';

svk でやってたものの git 版。

ref: refs/heads/ という部分を消していいのか、ほかのものが入る場合があるのかよくわからなかったので全表示している。

まぁぱっと見で git とわかるからいいかということでとりあえず。

codereposにあげてあるよ。

あぁ、なんか ref: とかすらでずに sha-1 ハッシュ値だけのときもある。もう少し調べないとだめだ。

これだけでもいいかもしんない。

.zshrc といっしょにcodereposにあげた。

http://coderepos.org/share/browser/dotfiles/zsh/typester

File::HomeDir と Path::Class を使わずに愚直にかいてみたがあまり体感変わらず、ためしに YAML を YAML::Syck にしてみたら激早くなった。

#!/usr/bin/env perl

use strict;
use warnings;

use YAML::Syck;

my $path   = $ARGV[0] or die;
my $config = YAML::Syck::LoadFile( $ENV{HOME} . '/.svk/config' );

my $hash = $config->{checkout}{hash};
my @path = split '/', $path;

my $svkinfo;
do {
    $svkinfo = $hash->{ join '/', @path }
} while !$svkinfo and pop @path;

exit unless $svkinfo;

if (my ($trunk, $branch) = $svkinfo->{depotpath} =~ m!(?:/(trunk)|/(branches/[^/]+))$!) {
    print '(' . ($trunk || $branch) . ')';
}

こんな感じ。

このくらいの体感速度なら割と普通に使えそう。

毎回svk infoしてどこにいるか確かめるのが面倒になったので、

PROMPT='%(?..exit %?)
 %{%}%~%{%} %{%}`perl /home/typester/dev/scratch/svkpath.pl $(pwd)`%{%}
%{%}%(!.#.$)%{%}%{m%} '

PROMPTをこんなにして

#!/usr/bin/env perl

use strict;
use warnings;

use YAML;
use File::HomeDir;
use Path::Class qw/file dir/;

my $path   = $ARGV[0] or die;
my $config = YAML::LoadFile( file(File::HomeDir->my_home, '.svk', 'config') );

my $hash = $config->{checkout}{hash};
$path = dir($path);

my $svkinfo;
do {
    $svkinfo = $hash->{"$path"}
} while !$svkinfo and $path ne ($path = $path->parent);

exit unless $svkinfo;

if (my ($trunk, $branch) = $svkinfo->{depotpath} =~ m!(?:/(trunk)|/(branches/[^/]+))$!) {
    print '(' . ($trunk || $branch) . ')';
}

とかしてみた。

これで

こんな感じになるわけだけども、毎回perl呼んでるので重い。

軽くできないかなー。

perlでやるなら裏でデーモン化してそこ呼ぶようにするのがいいのか。でもそこまでがんばる必要があるのかどうか。

適当なレンタルサーバー、redhat es4 でたぶんredhatデフォと思われるzshでやってもできるのを確認した。色分けはされなかった。