2009-02-06

Perl5.8.9でYAML::XSの挙動が変わった気がする

Perl5.8.8まではutf8フラグを付けていなくてもutf8の文字列をDumpできていた筈が、
どうもPerl5.8.9ではutf8フラグを付けないと文字化けを起こすようになっている様に思える。
原因がPerlのバージョンにあるのかどうかは定かではない、
私の使用しているPerl5.8.8はCentOS5.2のパッケージ付属のものだが、
Perl5.8.9は同じ環境に別途ソースからコンパイルして入れたものだ、
Perlのコンパイルオプションがおかしいのだろうか？

詳しく調べる必要がある。

2008-03-26

PerlでLDAP検索、しかも全検索

普通にNet::LDAPで bind すると非常に重い、しかも
20万件以上エントリーのあるLDAPを引いてみたところ、Out Of Memory!! が出力されてしまった。
そこでldapsearchをパイプでParseする事に、これで断然高速化が図れかつメモリ使用量も肥大化せずに済む筈だ。

ldapsearchをパイプでPerlに渡す

./ldap_parse.sh

#!/bin/sh

ldapsearch -x -LLL -h xxx.xxx.xxx.xxx -D "cn=admin,o=enecom,c=com" -w password -b c=com '(cn=*)' | ./ldap_parse.pl

exit 0

./ldap_parse.pl

#!/usr/bin/perl

use strict;
use Net::LDAP::LDIF;

my $ldif = Net::LDAP::LDIF->new();
while( not $ldif->eof() ) {
my $entry = $ldif->read_entry();
if ( $ldif->error() ) {
print "Error msg: ", $ldif->error(), "\n";
print "Error lines:\n", $ldif->error_lines(), "\n";
} else {
# some code
}
}
$ldif->done();

exit(0);

LDAP接続の段階からPerlで行う

./ldap_get.pl

#!/usr/bin/perl

use strict;
use Net::LDAP;

my $ldap_host = 'xxx.xxx.xxx.xxx';
my $bind_dn   = 'cn=admin,o=example,c=com';
my $bind_pw   = 'password';
my $base      = 'c=com';
my $filter    = '(cn=*)';

my $ldap = Net::LDAP->new( $ldap_host ) or die "$@ $!";

$ldap->bind( $bind_dn, password => $bind_pw ) or die "$@ $!";

my $mesg = $ldap->search( base => $base, filter => $filter );

$mesg->code and die $mesg->error;

for my $entry ( $mesg->all_entries ) {
# some code
}

$ldap->unbind;

exit(0);

2007-07-10

運用サーバーと開発サーバーを分けて開発する

運用サーバーと開発サーバーを個別に構築し、開発サーバーでテストを行う場合、
大抵hostsファイルや社内DNSで一時的にIPを開発サーバーに向けていましたが、
www.example.com ... xxx.xxx.xxx.xxx (運用時)
www.example.com ... yyy.yyy.yyy.yyy (開発時)
しかしこれではどっちのサーバーを見ているのか解りづらい為、
www.example.com ... xxx.xxx.xxx.xxx (運用時)
dev.example.com ... yyy.yyy.yyy.yyy (開発時)
という用にドメインを分けることにしました。

しかし、httpのページからhttpsのページへ遷移する際等、
https://www.example.com/foo.htmlというリンクを張る為、
不意に開発サーバーから運用サーバーに切り替わってしまい事があります。

www.example.com を dev.example.com に置換して出力すれば良い訳ですが、
今回はその方法にApacheのPerlOutputFilterHandlerを使うことにしました。

Apache::SimpleReplaceという要求に近いモジュールはありますが、
これはPerlHandlerに設定して、自分でファイルを開いて置換して
出力する為PHPやCGIの処理後に置換処理を挟むことが出来ないようです。
http://search.cpan.org/~geoff/Apache-SimpleReplace/

自作したモジュールは以下です。

Apache/StrReplace.pm

package Apache::StrReplace;

BEGIN {

  if ( $ENV{'MOD_PERL_API_VERSION'} == 2 ) {
    require Apache2::Filter;
    push @ISA, 'Apache2::Filter';
    require Apache2::Response;
    require Apache2::Const;
    require Apache2::RequestRec;
    require Apache2::RequestUtil;
    Apache2::Const->import(qw(OK DECLINED));
  } else {
    require Apache::Filter;
    push @ISA, 'Apache::Filter';
    require Apache::Response;
    require Apache::Const;
    require Apache::RequestRec;
    require Apache::RequestUtil;
    Apache::Const->import(qw(OK DECLINED));
  }
}

use strict;
use warnings;

use constant BUFF_LEN => 1024;

sub handler {
  my $f = shift;

  unless ($f->r->content_type =~/text\/html/) {
    return DECLINED(); 
  }

  unless ( $f->ctx ) {
    $f->ctx( { body => '' } );
  }

  while ($f->read(my $buffer, BUFF_LEN)) {
    $f->ctx->{'body'}.= $buffer;
  }

  unless ($f->seen_eos) {
    return OK();
  }

  my $search = $f->r->dir_config('StrReplaceSearch');
  my $replace = $f->r->dir_config('StrReplaceReplace');

  $f->ctx->{'body'}=~s/$search/$replace/ig;

  $f->r->set_content_length( length( $f->ctx->{'body'} ) );

  $f->print( $f->ctx->{'body'} );

  OK();
}

1;

StrReplaceSearch を StrReplaceReplace に置換します。

httpd.conf

PerlModule Apache::StrReplace
PerlSetVar StrReplaceSearch www.example.com
PerlSetVar StrReplaceReplace dev.example.com
PerlOutputFilterHandler Apache::StrReplace

2007-02-06

NTT西日本Bフレッツ

私は今６階に住んでいる、５階までBフレッツが来ているにもかかわらず、なんと６階には引けないと言われた（NTTの下請け）
どうにかできないか現在粘って交渉中だがこれは計算外だった。

2006-07-06

IEでmod_rewrite経由の画像がbmp形式で保存されてしまう問題への対応

# IEでmod_rewrite経由の画像がbmp形式で保存されてしまう問題への対応
BrowserMatch "MSIE" force-no-vary

2006-02-04

bind_columns用クエスチョンマークの生成

Perl

繰り返し演算子はスカラー値の繰り返し生成の他リストの生成もできる。
今日知った、恥ずかしい。
何に利用できるか考えてみたが、とりあえずDBI.pmのprpare時に指定する
SQLの?マークの生成に利用できないかと思った。

# ベタなコード

my $num = 10;
my $question = ('?, ' x ($num - 1)) . '?';

# Template::Simple v3から見つけたコードを利用

my $num = 10;
my $question = join(', ', (('?') x $num));
my $sql = "INSERT INTO tbl(columns) VALUES ($question)";

正直どっちでもいいか・・・。
ではfetchrow_arrayrefで使ってみてはどうだろうか。
bind_columns + fetchrow_arrayrefを常用するなら便利かもしれない。
最近はダレて数十件のレコード取得ならfetchrow_hashrefを使ってしまう。

my @array = ("") x 3;
my @arrayrefs = \( @array );
my $sth $dbh->prepare( "SELECT * FROM tbl" );
$sth->execute;
$sth->bind_columns( @arrayrefs );
while ( $sth->fetchrow_arrayref ) {
  print @arrayrefs;
}

格納カラムが決まっているならこう書いてます。

my $obj = {
  hoge => "",
  foo => "",
  bar => ""
};
my @arrayrefs = \( values %{ $obj } );

2006-01-05

ハッシュリファレンスのオーバーライト

ここにハッシュリファレンス$selfと$paramsがあり、
$paramsの値を$selfに上書きしたいとします。

# ベタなコード

foreach my $key ( keys %$params ) {
　$self->{$key} = $params->{$key};
}

# Class::DBIから発見したコード(変数名は異なります)

my @keys = keys %$params;
@{$self}{@keys} = @{$params}{@keys};

# Template::Stashから発見したコード(変数名は異なります)

@$self{ keys %$params } = values %$params;

一時的に局所的なリスト変数空間に対するkeysの代入を行わずに、
直接ハッシュリファレンスに流し込める点が有効化と思われます。
見栄えも美しいです。