perlの最近のブログ記事

よーは、適当にインストールしてしまった、MT＆MySQLだったので、

latin1のままだったのですが、他のアプリから、デフォルトUTF-8で

接続したかったため、変更しましたよーってこと

まずは、MySQLの状態確認

# mysql -uroot -p
Enter password:
Welcome to the MySQL monitor.  Commands end with ; or \g.
Your MySQL connection id is 1
Server version: 5.0.51a-log Source distribution

Type 'help;' or '\h' for help. Type '\c' to clear the buffer.

mysql> STATUS;
--------------
mysql  Ver 14.12 Distrib 5.0.51a, for redhat-linux-gnu (i686) using  EditLine wrapper

Connection id:          1
Current database:
Current user:           root@localhost
SSL:                    Not in use
Current pager:          stdout
Using outfile:          ''
Using delimiter:        ;
Server version:         5.0.51a-log Source distribution
Protocol version:       10
Connection:             Localhost via UNIX socket
Server characterset:    latin1
Db     characterset:    latin1
Client characterset:    latin1
Conn.  characterset:    latin1
UNIX socket:            /tmp/mysql.sock
Uptime:                 4 sec

Threads: 1  Questions: 4  Slow queries: 0  Opens: 12  Flush tables: 1  Open tables: 6  Queries per second avg: 1.000
--------------

latin1のことを確認したら、バックアップを取りましょー

# mysqldump -uroot -p modperl --default-character-set=latin1 > modperl.latin1.db

んで、もってUTF-8にテーブルを変える

# sed -s 's/DEFAULT CHARSET=latin1/DEFAULT CHARSET=utf8/' modperl.latin1.db > modperl.utf8.db

んで、入れる

mysql -uroot -p modperl < modperl.utf8.db

んで、MySQLのmy.cnfに以下を追加してrestart

/etc/my.cnf
 [client]
 default-character-set = utf8
 [mysqld]
 default-character-set = utf8
 [mysql]
 default-character-set = utf8

ほいで、状態を確認する

# mysql -uroot -p
Enter password:
Welcome to the MySQL monitor.  Commands end with ; or \g.
Your MySQL connection id is 2
Server version: 5.0.51a-log Source distribution

Type 'help;' or '\h' for help. Type '\c' to clear the buffer.

mysql> STATUS;
--------------
mysql  Ver 14.12 Distrib 5.0.51a, for redhat-linux-gnu (i686) using  EditLine wrapper

Connection id:          2
Current database:
Current user:           root@localhost
SSL:                    Not in use
Current pager:          stdout
Using outfile:          ''
Using delimiter:        ;
Server version:         5.0.51a-log Source distribution
Protocol version:       10
Connection:             Localhost via UNIX socket
Server characterset:    utf8
Db     characterset:    utf8
Client characterset:    utf8
Conn.  characterset:    utf8
UNIX socket:            /tmp/mysql.sock
Uptime:                 25 sec

Threads: 1  Questions: 91  Slow queries: 0  Opens: 24  Flush tables: 1  Open tables: 18  Queries per second avg: 3.640
--------------

パチパチ、めでたしめでたしって、思って

MTの管理画面をリロードしたら、文字化けしやがってる！！

なんで？？

マシンは、CentOS release 5.2 (Final)　で、標準でインストールされていたPerl

# rpm -qa | grep -i perl
perl-IO-Zlib-1.04-4.2.1
perl-DBI-1.52-1.fc6
perl-HTML-Parser-3.55-1.fc6
perl-NKF-2.07-1.1.fc6
mod_perl-2.0.2-6.3.el5
ImageMagick-perl-6.2.8.0-4.el5_1.1
perl-Compress-Zlib-1.42-1.fc6
perl-Digest-SHA1-2.11-1.2.1
perl-Digest-HMAC-1.01-15
perl-Archive-Tar-1.30-1.fc6
perl-BSD-Resource-1.28-1.fc6.1
perl-Net-IP-1.25-2.fc6
perl-HTML-Tagset-3.10-2.1.1
perl-libwww-perl-5.805-1.1.1
perl-IO-Socket-INET6-2.51-2.fc6
perl-IO-Socket-SSL-1.01-1.fc6
perl-URI-1.35-3
perl-String-CRC32-1.4-2.fc6
perl-Net-DNS-0.59-3.el5
perl-Socket6-0.19-3.fc6
newt-perl-1.08-9.2.2
perl-Net-SSLeay-1.30-4.fc6
perl-5.8.8-15.el5_2.1

こんな感じ

で、Mooseをインストールしたくて、

# perl -MCPAN -e shell

cpan shell -- CPAN exploration and modules installation (v1.7602)
ReadLine support enabled

cpan> install Moose

したら

    ERROR:

    A CPAN module critically requires a function
    (Scalar::Util::weaken) that should exist in your
    Scalar::Util module but doesn't.

    This probably happened because you are using a Perl
    provided by a binary package from a vendor, and this
    vendor has packaged Perl incorrectly.

    I have checked for a couple of potential workarounds
    but none of them appear to be usable in your
    situation.

    I will try a last-ditch option anyway, but the most
    likely result is a number of noisily failing tests

    If this happens, you will need to contact technical
    support for your vendor and report the broken Perl,
    so that they can repair it.

    Please refer them to the documentation for the
    'Task::Weaken' CPAN module, which explains the problem
    and how they can fix it.

    I'm going to wait for about a minute now so you have time
    to read this message

が、出てきた

ということで、IE7でしか確認してないんですけど・・・www

Shift_JIS、EUC-JPなどでのページでは、Perlで言うと・・・

print
    $q->header(-type => 'application/x-javascript; charset=UTF-8'),
    $q->param('callback'), '(', JSON::Syck::Dump($data), ');', "\n";
exit;

は、完全OUTです！！

さらに文字によっては、}がありません

とか寝ぼけたこといい出します

※JSONデータにマルチバイトがないっていう状態では、もちろん起こりませんけどｗ

解決方法は・・・って、別にたいしたことじゃないけど

Shift_JISは、ヘッダをShift_JISへ、且つJSONデータもShift_JISへ変換

EUC-JPは、って言ってもShift_JISと同じで、文字コードを合わせるだけですw

ちなみに、このヘッダの文字コード変えるとかは、IE以外？は通用しないので

IEを判別する（UA？）とかで分岐してくださいね

MyBenchっていーのは、MySQLのベンチマークをとるものです

サイトは、こちら

http://jeremy.zawodny.com/mysql/mybench/

作者は、下↓の著者でもありますね

ともかく、実際に起動してみましょー

ダウンロードしたターボールを、tar zxvfして、展開

perl Maikfile.PL と make でインストール完了！！

bench_exampleってのをちょこっとだけ変更するだけですな

質問は、こんな感じ

perlでPHPみたいにrtrimをしたいです。
文字列の一番最後に全角スペースや半角スペースがあれば
削除するみたいな感じにしたいです。
全角が２つあってもそれも削除します。

どうすれば可能でしょうか？

#2を回答した方が、#1の方を惜しいと言ってるんだけれども、

#2の方も惜しいｗｗ

正規表現で、

$str =~ s/[\s　]+$//g;

すると、半角スペース、または、UTF-8の全角スペース「E38080」が分解され、

「\xE3」または、「\x80」または、「\x80」を消すってなっちゃいます

正解は、こんな感じ

作ったのは、チョー簡単なcgiで、やってることはパラメータで受けたURLを

perlにてリクエストし、JSON形式で返すだけ

#!/usr/bin/perl

use strict;
use warnings;
use CGI;
use HTTP::Lite;
use JSON::Syck;
use Jcode;

my($data, %qq);
my $q    = CGI->new();
my $http = HTTP::Lite->new();
my $req  = $http->request($q->param('src')) or goto RET;
my $body = $http->body();

if ($q->param('headless')) {
    $body =~ s!^.*<body[^>]*>(.*)</body>.*$!$1!i;
}
my $char = getcode($body);
if ($char && $char !~ /utf\-?8/i) {
    $body = jcode($body, $char)->utf8;
}
for ($q->param()) {
    $qq{$_} = $q->param($_);
}
$data = {%qq, content => $body};
RET:

print
    $q->header(-type => 'application/x-javascript; charset=UTF-8'),
    $q->param('callback'), '(', JSON::Syck::Dump($data), ');', "\n";
exit;

まー、いたって簡単ですな

これを使って、右サイドバーのamazon広告をonloadで変えてみます

たとえば、こんな感じのcgiを計測しようと思った時に

#!/usr/bin/perl

use strict;
use warnings;
use Time::HiRes qw(usleep ualarm gettimeofday tv_interval);

my $a = 'あいうえお';
my $t = [gettimeofday];

if (!$a) {
    use Jcode;
}

jcode($a, 'utf8')->sjis;
print "Content-type:text/html\n\n";
print tv_interval($t);
print "\n";
exit;

と、

#!/usr/bin/perl

use strict;
use warnings;
use Time::HiRes qw(usleep ualarm gettimeofday tv_interval);

my $a = 'あいうえお';
my $t = [gettimeofday];

my $jcode;
# if (!$a) {
if ($a) {
    require "/usr/lib/perl5/site_perl/5.8.8/Jcode.pm";
    $jcode = Jcode->new();
}

$jcode->set($a, 'utf8')->sjis;
print "Content-type:text/html\n\n";
print tv_interval($t);
print "\n";
exit;

は、全く結果が違っちゃいます

まー、そのまんまですけど

#!/usr/bin/perl

use strict;
use warnings;

my %a = (a => 100, b => 200);
delete $a{a};

print join(',', keys %a). "\n\n";

と

#!/usr/bin/perl

use strict;
use warnings;

my %a = (a => 100, b => 200);
undef $a{a};

print join(',', keys %a). "\n\n";

では、キーの出力が違いますね

自分メモ

File::Copy::Recursive　を使って、コピーする作業してたら、エラーが・・・

やってることは単純で、こんな感じね

open(IN,"./list");
for (<in>) {
    fcopy($_, $dest) or die $!;
}

そです、chompが抜けていたのでしたｗｗ

ちゃんと、英語は読みましょうーーってことですね

ちょっとしたことで調べたので、こちらもメモがてらｗｗ

perlで、FHを食いつぶしてみますｗ

#!/usr/bin/perl

use strict;
use warnings;

my @fhs;
for (1..2048) {
    open(my $fh, ">./tmp/$$.$_") or die "$_ => $!";
    push(@fhs, $fh);
}
exit;

これを実行すると、

1022 => Too many open files at file.pl line 8.

と、怒られます

$ ulimit -a

core file size          (blocks, -c) 0
data seg size           (kbytes, -d) unlimited
max nice                        (-e) 0
file size               (blocks, -f) unlimited
pending signals                 (-i) 16359
max locked memory       (kbytes, -l) 32
max memory size         (kbytes, -m) unlimited
open files                      (-n) 1024
pipe size            (512 bytes, -p) 8
POSIX message queues     (bytes, -q) 819200
max rt priority                 (-r) 0
stack size              (kbytes, -s) 10240
cpu time               (seconds, -t) unlimited
max user processes              (-u) 16359
virtual memory          (kbytes, -v) unlimited
file locks                      (-x) unlimited

「open files」が1024かぁー、

これはコケるねｗｗ