unknownplace.org

やっぱりワードリストは qw// だよな。

左右対称とかDASEEEE

おもろそうだなぁ、いいなぁ。

D-5 出張版 - DBIx::Classページングのドツボ

おーそうだったんだ。あぶねー。

同じような使い方してたけど、たまたまページ指定は最後にしていた。

今日からワードリストを qw() でかく。いままでは qw// 。

なんとなく。

を書いた。会社のrepos内にアップしてしまったのでここに貼り付けちゃう。

#!/usr/bin/env perl

use strict;
use warnings;

use File::Spec;
use File::Find::Rule;
use FindBin;
use Getopt::Long;
use Pod::Usage;

use HTTP::Proxy;
use YAML;

# load config
my $config = do {
    my $config_file = File::Spec->catfile( $FindBin::Bin, 'config.yml' );
    my $port        = 0;
    my $host        = '';
    my $help        = 0;

    GetOptions(
        'port|p=s'   => \$port,
        'host|h=s'   => \$host,
        'config|c=s' => \$config_file,
        'help|?'     => \$help,
    );
    pod2usage(1) if $help;

    my $config = YAML::LoadFile($config_file);
    $config->{global} ||= {};
    $config->{global}{port} = $port if $port;
    $config->{global}{host} = $host if $host;

    $config;
};

my $proxy = HTTP::Proxy->new;
$proxy->port( $config->{global}{port} || 3000 );
$proxy->host( $config->{global}{host} || '' );

# find plugins
my %plugins;
for my $plugin_dir ( @{ $config->{global}{plugins_dir} } ) {
    my @files = File::Find::Rule->file->name('*.pm')->in($plugin_dir);
    for my $file (@files) {
        ( my $module = $file ) =~ s!(^$plugin_dir/?|\.pm$)!!g;
        $module =~ s!/!::!g;
        $plugins{"HTTP::Proxy::Plugin::$module"} = $file;
    }
}

# load and initialize plugins
for my $plugin ( @{ $config->{plugins} } ) {
    my $class = "HTTP::Proxy::Plugin::$plugin->{module}";
    my $file = $plugins{$class} || $class;

    eval { require "$file"; };
    die $@ if $@;

    my $module = $class->new( $plugin->{config} || {} );
    $module->register($proxy);
}

# set log levels
my $log_mask = 0;
for my $log_level (@{ $config->{global}{log}{mask} || [] }) {
    no strict 'refs';
    $log_mask |= &{"HTTP::Proxy::$log_level"};
}
$proxy->logmask($log_mask);

# start daemon
$proxy->start;

HTTP::Proxy自体がすばらしくて、perlユーザーであればこんなことものを使わなくても、自分でさくさくフィルタがかけるのであまり必要はなかったりする。

ただ再利用性とかperl知らない人用に考えると結構いい感じかもしれない。

プラグインの例:

package HTTP::Proxy::Plugin::Rewrite::Host;
use strict;
use warnings;
use base qw(HTTP::Proxy::HeaderFilter);

use List::Util qw(first);

sub new {
    my ( $class, $config ) = @_;
    my $self = bless { rewrites => $config }, $class;
}

sub register {
    my ( $self, $context ) = @_;
    $context->push_filter( request => $self );
}

sub filter {
    my ( $self, $content, $req ) = @_;

    my $host = first { $req->uri->host eq $_ } keys %{ $self->{rewrites} }
        or return;

    $host = $self->{rewrites}->{$host};

    if ($host and ref $host eq 'ARRAY') {
        my $path = $req->uri->path || '/';

        my $target = first { $path =~ /^$_->{path}/ } @$host
            or return;

        if ($target->{host}) {
            $path =~ s/^$target->{path}//;
            $req->uri->path( $path );
            $req->uri->host( $target->{host} );
        }
    }
    elsif ($host) {
        $req->uri->host($host);
    }
};

1;

特定のホストへのリクエストを別ホストへ転送するプラグイン

これを使う設定yamlはこんな感じ

global:
  host: ''
  port: 3000
  plugins_dir:
    - /home/typester/workdir/httpproxy/plugins
  log:
    mask:
      - ALL

plugins:
  - module: Rewrite::Host
    config:
      www.example.com: localhost:3001
      www2.example.com: localhost:3002
      www3.example.com:
        - path: /subbdir
          host: localhost:3003
        - path: /
          host: localhost:3004

これで

• www.example.com へのリクエストは localhost:3001 へのリクエストに
• www2.example.com へのリクエストは localhost:3002 へのリクエストに
• www3.example.com へのリクエストで、パスが /subdir* にマッチするものは localhost:3003 へ、それ以外は localhost:3004 へのリクエストに

なります。

パスみて変えるところはプラグインわけたほうがヨサゲではある。

追記@2006-09-15T14:43:21+09:00: plugin例が間違ってたので修正した。

入れようとしたらテストこけた。

use strict のクラス名がsysPreProcではなくsysStatementになってるのがだめぽいが、これはText::VimColorの問題？vim自体？

[MSG] [Thu Sep 14 21:48:15 2006] Writing Makefile for Text::Hatena

[MSG] [Thu Sep 14 21:48:16 2006] make: Warning: File `Makefile' has modification time 0.31 s in the future
Manifying blib/man3/Text::Hatena::AutoLink.3pm
Manifying blib/man3/Text::Hatena.3pm
make: warning:  Clock skew detected.  Your build may be incomplete.

[ERROR] [Thu Sep 14 21:48:25 2006] MAKE TEST failed: Bad file descriptor PERL_DL_NONLAZY=1 /usr/bin/perl "-MExtUtils::Command::MM" "-e" "test_harness(0, 'blib/lib', 'blib/arch')" t/*.t
t/00_text_hatena................Use of uninitialized value in string eq at /home/typester/.cpanplus/5.8.8/build/Text-Hatena-0.15/blib/lib/Text/Hatena/HTMLFilter.pm line 52, <DATA> line 855.

#   Failed test in t/00_text_hatena.t at line 292.
#          got: '<div class="section">
#   <pre class="hatena-super-pre">
# <span class="synPreProc">#!/usr/bin/perl -w</span>
# <span class="synPreProc">use strict</span>;
# 
# <span class="synStatement">my</span> <span class="synIdentifier">$s</span> = <span class="synConstant">&quot;Hello, World!&quot;</span>;
# <span class="synStatement">print</span> <span class="synIdentifier">$s</span>; <span class="synComment"># prints Hello, World!</span>
# </pre>
# </div>'
#     expected: '<div class="section">
#   <pre class="hatena-super-pre">
# <span class="synPreProc">#!/usr/bin/perl -w</span>
# <span class="synStatement">use strict</span>;
# 
# <span class="synStatement">my</span> <span class="synIdentifier">$s</span> = <span class="synConstant">&quot;Hello, World!&quot;</span>;
# <span class="synStatement">print</span> <span class="synIdentifier">$s</span>; <span class="synComment"># prints Hello, World!</span>
# </pre>
# </div>'

#   Failed test in t/00_text_hatena.t at line 307.
#          got: '<div class="section">
#   <pre class="hatena-super-pre">
# <span class="synPreProc">#!/usr/bin/perl -w</span>
# <span class="synPreProc">use strict</span>;
# 
# <span class="synStatement">my</span> <span class="synIdentifier">$s</span> = <span class="synConstant">&quot;Hello, World!&quot;</span>;
# <span class="synStatement">print</span> <span class="synIdentifier">$s</span>; <span class="synComment"># prints Hello, World!</span>
# </pre>
# </div>'
#     expected: '<div class="section">
#   <pre class="hatena-super-pre">
# <span class="synPreProc">#!/usr/bin/perl -w</span>
# <span class="synStatement">use strict</span>;
# 
# <span class="synStatement">my</span> <span class="synIdentifier">$s</span> = <span class="synConstant">&quot;Hello, World!&quot;</span>;
# <span class="synStatement">print</span> <span class="synIdentifier">$s</span>; <span class="synComment"># prints Hello, World!</span>
# </pre>
# </div>'
# Looks like you failed 2 tests of 20.
dubious
    Test returned status 2 (wstat 512, 0x200)
DIED. FAILED tests 15-16
    Failed 2/20 tests, 90.00% okay
t/01_autolink_compile...........ok
t/02_autolink_text..............ok
t/03_autolink_http..............Parsing of undecoded UTF-8 will give garbage when decoding entities at /usr/local/share/perl/5.8.8/LWP/Protocol.pm line 114.
Parsing of undecoded UTF-8 will give garbage when decoding entities at /usr/local/share/perl/5.8.8/LWP/Protocol.pm line 114.
ok
t/04_autolink_ftp...............ok
t/05_autolink_mailto............ok
t/06_autolink_hatenafotolife....ok
t/07_autolink_hatenagroup.......ok
t/08_autolink_asin..............ok
t/09_autolink_hatenadiary.......ok
t/10_autolink_hatenaid..........ok
t/11_autolink_tex...............ok
t/12_autolink_unbracket.........ok
t/13_autolink_hatenaantenna.....ok
t/14_autolink_hatenabookmark....ok
t/15_autolink_hatenarss.........ok
t/16_autolink_hatenaidea........ok
t/17_autolink_hatenaquestion....ok
t/18_autolink_ean...............ok
t/19_autolink_hatenagraph.......ok
t/20_autolink_hatenamap.........ok
t/21_autolink_google............ok
t/22_autolink_hatenasearch......ok
t/23_autolink_amazon............ok
t/24_autolink_rakuten...........ok
t/99_autolink...................Parsing of undecoded UTF-8 will give garbage when decoding entities at /usr/local/share/perl/5.8.8/LWP/Protocol.pm line 114, <DATA> line 855.
Parsing of undecoded UTF-8 will give garbage when decoding entities at /usr/local/share/perl/5.8.8/LWP/Protocol.pm line 114, <DATA> line 855.
ok
Failed Test        Stat Wstat Total Fail  List of Failed
-------------------------------------------------------------------------------
t/00_text_hatena.t    2   512    20    2  15-16
Failed 1/26 test scripts. 2/129 subtests failed.
Files=26, Tests=129,  9 wallclock secs ( 3.82 cusr +  1.99 csys =  5.81 CPU)
Use of uninitialized value in pattern match (m//) at /home/typester/.cpanplus/5.8.8/build/Text-Hatena-0.15/blib/lib/Text/Hatena/AutoLink/HTTP.pm line 135, <DATA> line 855.
Failed 1/26 test programs. 2/129 subtests failed.
make: *** [test_dynamic] Error 255

[ERROR] [Thu Sep 14 21:48:25 2006] Unable to create a new distribution object for 'Text::Hatena' -- cannot continue

個人的にかなり気に入ってるので、ドキュメントがんばって書いて(死にそう＞＜)CPANにうぷろう。

use base qw/Cache::FastMmap/;

sub get {
    my ( $self, $key ) = @_;
    ${ $self->SUPER::get($key) || return };
}

sub set {
    my ( $self, $key, $value ) = @_;
    $self->SUPER::set( $key => \$value );
}

カッコイイわぁ。

テラオソス

うーむ。

思いついてActivePerlをいれた。

案の定CPANモジュールいれるのがめんどくさい。テスト失敗したのRT見たり、ソース見たり。

問題なさげなのはforce installした。

それでおもったけどCPANのforce installってテストもはしっちゃうからうぜーのね。いつもCPANPLUS使ってたから忘れてたわぁ。

CPANPLUSだと--skiptestと--forceの両方ある。

前者はテストしないでインストール。後者は強制的にインストール(同じバージョン入れなおしたりする場合に使う)。