bbz

perl

_
previous | next | edit
1: 09/11/03(Tue) 03:46
perlは素晴らしい。もはやひとつのプログラミング言語であるのを超えて、フレームワークとなっている。
いろんな言語やフレームワークに触れてきたが、これほど便利で使いやすく応用範囲もひろいものは例がない。もっと早く知っておきたかった。
実際に知ったのはもうかなり前で、インターネットというものにつなぎはじめて、「ホームページ」をつくり、そこにCGIを設置する、というときに、よくわからないままperlのソースを写していて、クォーテーションがシングルだったりバックだったりダブルだったりするのがなぜかもわからず、わかろうともせずにいた。
2: 09/11/03(Tue) 03:51
perl以外で感動したものは、delphi, dbMAGIC, secondlife, C#くらいだろうか。
でも、便利さと書きやすさ、読みやすさはperlが群を抜いている。

その理由は、書かなくてもよいデフォルト値の存在と、書式が柔軟というか厳密でないというところ。

たとえばファイルを読むときにレコードが格納される変数$_とか、
foreachとか、chompとか。

「perlのソースは読みにくい」というのを何度か聞いたことがあるし、自分でもそう思っていたが、その理由のほとんどは正規表現である。
正規表現は、簡潔で有用にしようとするとわけがわからなくなる。
しかし、正規表現も柔軟で、厳密さを問わなければかなりわかりやすく書くことができる。
3: 09/11/03(Tue) 03:53
モジュールも豊富であり、そのインストールもコマンド一発で可能であり、
linuxでもwindowsでもほとんど同じように使用できる。

いままでC言語でポインタがどうの文字列の抽出や検索がどうの、ということは、
perlと正規表現を知った今となっては一体なんだったのかと思う。
4: 09/11/03(Tue) 03:58
私が後進にすすめるとしたら、とにかく必須のものとしてc。公私にわたるツールとしてperl。私的なwindows限定ツールとしてdelphi。

cとperlは必須である。

あとは、vbscript、MSofficeのVBA(マクロ)、かな。

delphiは開発ツールの理想の姿として、知っておくべきだと思う。
これは言語とライブラリとIDEを含めたもの、フレームワークとして。
5: 09/11/03(Tue) 04:00
あとphpもかな。
phpはちょっとかじったけど、perlを知ってしまうと、もういいかな、という感じ。

ただphpは後発で、perlにはない良さがなんかあるんだろうな。
動きが軽いとかかな?
6: 09/11/03(Tue) 04:17
最近自分がレンタルしているサーバのアクセスログの、検索語をデコードするスクリプトを書いた。ごく簡単なものであり、そもそもサポートページでwebalizerを使って表示できる機能がある。

だが、それを自分で書いてみたかった。
その書き方もいろいろあった。logをパースするモジュールもいろいろあるが、
それを使わないこともできる。使うのがいいのだろうが、使わなくても簡単にできることがわかった。
モジュールを使わなければできないこともあれば、めんどくさいのでモジュールを使うこともあるし、誰かに教わったやり方がモジュールを使う方法だったから使っているだけだったり、ちょっと考えたらできたから自分で書いたり、エラーしょりとか実行速度とかはあまり重要でないからとりあえずできるものでいいからという場合もある。

そして、perlはそのすべてが許される。それは質問掲示板とかブログとかMLとかにも見られる。「こういう風にやれ、こうするのが通」みたいな思想があまりない。

まして、「こうしないとできない」ということはほとんどない。
「え!?これでできちゃうの?」と驚くことの連続である。
7: 09/11/03(Tue) 04:26
なかにはperlの書き方について標準的なものを推奨している人がいたりした。
たとえば$_は使うなとか。きっと、スクリプトをブツとして納品し、メンテしていくような場合にはそういうものが必要なのだろう。

これはperl以外でも、そしてソースやスクリプトに限らず、試験手順書でも項目でもマニュアルでもなんでも、「標準化」「品質管理」の名の下におこなわれる縛りはほとんど百害あって一利なしである。

「プログラミングにはバグがつきものだから管理を厳密にする」
これはもう、私には全く受け入れられない。

「ミスのないように気をつける」「チェックをする」「よく確認する」

こんなことは、しなくてよい。してはいけない。
気をつけなくても、チェックしなくても、確認しなくても、できるようにすること。

気をつけて注意して何度もチェックして作ったものは、きっとトランプの塔のように崩れやすく近寄りがたいものになっているだろう。

8: 09/11/03(Tue) 04:32
私がperlで何か書く場合、use strictも使わない。
programming perlでは使うことが推奨されていたし、次のバージョン(6?)ではデフォルトで有効になるらしい。

だがいちいちmy $nantokaと定義するのはメンド臭い。

windowsでactive perlを使うときは最初の行の #!/usr/bin/perlとかも書かない。

書き忘れたけど動いたのでそれ以来必要なときしか書かない。

ファイルの入力やforeachなどでもなるべく変数を使わないようにしている。
インデックスも原則禁止している。

そしてそういう「怠惰」さが、結果をよくするのである。

そしてその怠惰さは本当は怠惰ではないのである。

わたしはこの業界で感じていた不満と一見いい加減でテキトーに見える自分の仕事のやり方が間違っていなかったことを、perlと出会って確信した。
9: 09/11/03(Tue) 04:36
cでwindowsプログラミングしていたときは、ライブラリがないと何もできなかった。
そのくせそのライブラリは自分で苦労して探してもってこないといけない。

ほんとうに不親切というかいやがらせのような開発環境だった。

入門書の類は死ぬほどあるしわたしも何冊も買ったがほとんどモノにならない。

perlに関してはcよりは少ないと思う。

しかも、定番と呼ばれるものがほぼ決まっている。

そしてその定番を読んでしばらくすれば、この言語はとても柔軟で人間の考え方にうまく適合することがわかり、何かをするにはどうする、といったハウツー的な情報を探す必要が少ないことがわかる。
10: 09/11/03(Tue) 05:42
#! /usr/bin/perl

use Regexp::Log::Common;
use IO::File;


my $foo = Regexp::Log::Common->new(
format => ':extended',
capture => [qw(host rfc authuser date request status bytes referer useragent)],
);
my $re = $foo->regexp;
my @fields = $foo->capture;

$logfile = $ARGV[0];

open (LOG, $logfile) or die "$!";

while () {
my %data;
@data{@fields} = /$re/;

print 'host: '.@data{'host'}."\n";
print 'UA: '.@data{'useragent'}."\n";
print 'request: '.@data{'request'}."\n";

}

close LOG;
11: 09/11/03(Tue) 05:46
ppm install Rexexp::Log::Common

を実行。
黙って数十秒待つ。

上記のソースを書く。

use IO::File;
が必須。

@data{@fields} = /$re/;

という行の意味がよくわからないが、
@data{@fields} はリファレンスというやつかな、と、

{}の中にフィールド名を入れてみたら表示された。

なるほど。

しかし、問題はrequestの中の分割なんだよな。
12: 09/11/03(Tue) 05:52
useragentが長い。
自分のUAを表示させると150文字くらいある。
13: 09/11/03(Tue) 06:06
日本語にすると、

googlebotかbaiduspiderなら飛ばす。(検索後にこのキーワードが入っていたらそれも飛ばしてしまうがそれはオーライ)

カッコにかこまれた文字列をUseragentとして保存。

グーグルからの検索だったら、検索後を探してデコードする。
まずスペースで区切る。
区切ったものをさらに "?"で区切る。

区切ったものから "q="を含むものを探す。
それをさらに"&"で区切る。

区切ったもののなかで、先頭が"q="であるものを探す。

"q="を消したものを、デコードする。

デコード結果から AND検索の場合に付く"+"を消す。

結果をprintする。

一番最初にスペースで区切ったフィールドのうち、
2個目: 日付
3個目: ホスト
さっき保存したUseragentをプリントする。
14: 09/11/03(Tue) 06:09
google以外にも、yahooとbaiduについて同様にして区切り文字のみを変更して対応。
それ以外のサーチエンジンから来たものはログをそのまま表示する。

もし新しいエンジンのものが見つかったら追加していく。
しばらく前はgoogleオンリーだったが、yahooも一日に1,2個くらい混じるようになった。

ログ総数は100もいかない零細サイトなので、日々ログを眺めつつ、改善していく。
15: 09/11/03(Tue) 06:58
ちなみにここで読んでいるログはあるphpスクリプトが吐いたログで、
apacheのログではなかった。
ただし、検索ワードのパースだけはできていた。
いい加減主義が結果オーライとなった。
16: 09/12/26(Sat) 17:52
デコードで失敗する場合がある。
まず、goo.ne.jpの検索文字列はeuc-jpでエンコードされている。
今までは全部utf-8としてデコードしていたが、gooだけはeuc-jpを指定した。

今までもたびたび失敗する場合があったので調べてみると、googleの検索でもshiftjisになる場合があるようだ。
そして、Encodeモジュールにはguessという、文字コード判別機能がある。

なんだ、最初からこれを使えばよかった、と、shift-jisとutf-8を判別できるようになった、と思ったら、
今度は判別に失敗して死んでしまう場合がある。

そこで、guessはgoogleだけに使い、guessに失敗したら今までどおりutf-8固定にして、
成功したらもう一度guess指定でデコードした。

成功したときに2回デコードするのがアレだが、とりあえず動くので、後で直す。
17: 09/12/26(Sat) 17:53
というわけで、いつの間にか、6種類ものサーチエンジンに対応していた。

google
yahoo
baidu
bing
biglobe
goo
18: 09/12/27(Sun) 03:56
guessに失敗したときにutf-8にしてもダメな場合がある。
euc-jpの場合もあるようだ。

結局、3種類全部試す必要があるのか・・・
decodeに失敗すると?がならぶ。
いくつ並ぶかはわからないが、とりあえず二つ並んだら失敗とみなせるかな・・・

検索すると「失敗することがある」という情報がたくさん見つかるけどさ、
これ、単にEncodeのバグじゃないの?
19: 10/01/24(Sun) 11:38
今perlでrssフィードを配信するスクリプトを書いている。
といってもWEBでさがしたサンプルをそのまま使っているだけだが。
それが、うまく動かない。
スクリプト内に日本語を書くと実行できなくなる。
文字化けするのではなく、実行ができないのだ。
20: 10/01/24(Sun) 11:45
多分文字コードの問題だと思う。
ただのhtmlなら、そのまま直接日本語を書けば表示されるが、rssフィードはxmlであり、
このとき日本語はutf-8でないとダメなようなのである。
・・・・・・・・
と、ここまで書いて、わかった。
スクリプトはeuc-jpで保存する。
21: 10/01/24(Sun) 12:14
さて、それでとりあえずリテラル文字列なら日本語が書けたのだが、
ファイルを読み込んでその中の日本語を出力できない。
Jcodeで変換させるだけでエラーになる。
文字コードの指定が間違っているのか。
sjis -> utf-8 だと思うのだが。
念のために
euc-jp -> utf-8
なども試してみたがダメだ。
22: 10/01/24(Sun) 15:00

#!/usr/bin/perl -w

use strict;
use CGI::Carp qw(fatalsToBrowser);
use XML::RSS;


my $rss = new XML::RSS (version => '1.0');
$rss->channel(
title => "clebriz.net",
link => 'http://clebriz.net',
language => 'ja',
description => "abc",
);


open SUBBACK, "<./subback.txt" or die;

while (){
if(/(\d*),(.*),(\d*)/){
$rss->add_item(
title => "$1",
link => "http://clebriz.net/cgi-bin/main.cgi",
description => "$3",
);
}
}

close SUBBACK;

print "Content-type: application/xml\n\n";
print $rss->as_string;
23: 10/02/12(Fri) 07:05
1. perl(cgi)スクリプトの文字コード
2. use encodingの文字コード

が一致していないときに、リテラルで日本語を書くとエラーになる。
24: 10/02/12(Fri) 07:16
とりあえずエラーは出なくなった。
化けてはいるが。


#!/usr/bin/perl -w

use strict;
use XML::RSS;
use encoding 'utf8';
use Jcode;


my $rss = new XML::RSS (version => '1.0');
$rss->channel(
title => "clebriz.net",
link => 'http://clebriz.net',
language => 'ja',
description => "abc",
);


open SUBBACK, "<./subback.txt" or die;

while (){
if(/(\d*),(.*),(\d*)/){

my $jp = $2;

Jcode::convert( \$jp , 'utf8', 'sjis');

$rss->add_item(
title => "$jp",
link => "http://clebriz.net/cgi-bin/bbz/main.cgi",
# description => "南無阿弥陀仏",
description => "test",
);
}
}

close SUBBACK;

print "Content-type: application/xml\n\n";
print Jcode->new($rss->as_string)->utf8;





ファイルを保存するときの文字コードと、use encodingが一致しないとエラーになる。
ただしそれは日本語リテラルを書いた場合。
(ファイルから読んだ場合も同じか?)

読み込んでいるタイトル一覧ファイルのエンコードはsjisなのは間違いない。
だからそれをutf8に変換しているのだが・・・化ける・・・。
コードの指定をあれこれ変えたりしてもダメ・・・。

そんなことをしていると、
ときどきcgiが返ってこなくなる。
バグってるときもしょっちゅうあるが、ちゃんと書いていても返らないことがときどきある。

とりあえずこのソースで一度は動いた。
もう気が狂いそうなので今日はここまで。
朝飯にする。
25: 10/02/12(Fri) 09:06

#!/usr/bin/perl -w

use strict;
use XML::RSS;
use encoding 'utf8';

use Jcode;


my $rss = new XML::RSS (version => '1.0', encode_output => 0);
$rss->channel(
title => "clebriz.net",
link => 'http://clebriz.net',
language => 'ja',
description => "description",
);


open SUBBACK, "<./subback.txt" or die;

while (){
if(/(\d*),(.*),(\d*)/){

my $jp = $2;

Jcode::convert( \$jp , 'utf8', 'sjis');

$rss->add_item(
title => "$jp",
link => "http://clebriz.net/cgi-bin/bbz/main.cgi",
description => "$3",
);
}
}

close SUBBACK;

print "Content-type: application/xml\n\n";

print $rss->as_string;



やっと書けた・・・。
utf8フラグだのなんだのと悩んだが、
encode_output => 0
がポイントだったようだ。

ある方のソースを参考にさせてもらったのだが、
そのままではうまくいかず、
---
use utf8;
binmode STDIN, ":utf8";
binmode STDOUT, ":utf8";
---
を、以下のようにした。
---
use encoding 'utf8';
---

めんどくさいねえ・・・。
この辺も、仕様じゃなくてバグが潜んでるんじゃないかと思えてならない・・・。
26: 10/02/12(Fri) 09:08
あと、cgiはいきなりサーバーにあげず、とりあえずwinで動かしてエラーがないことくらいは確認するようにした。

さくらと同じ環境をローカルに作れば一番いいんだよな・・・
virtual pcでできるかな?
27: Sat Mar 20 05:51:40 2010
while(<>){
@tmp = split;
push @LoL, [ @tmp ];
}

for $array_ref ( @LoL ) {
print "\t [ @$array_ref ], \n";
}
28: Sat Mar 20 05:55:17 2010
perlのソースを載せたらなんかおかしくなる・・・。
それは直すとして・・・

>>27 は、リファレンスによる多次元配列の作り方と表示の仕方である。
たったこれだけである。
いろいろ情報をさがしたが、この7行に尽きる。プログラミングperlの4章にある。
29: Thu Mar 25 05:09:22 2010
hashの例。


$members;

while (<>){
chomp;
@inputs = split / /;
$members{$inputs[0]} = $inputs[1];
}

while (<>){
chomp;
print $members{$_}."\n";
}
30: Thu Mar 25 05:11:14 2010
まず、フルネームを入力する。first nameとlast nameの間はスペースをいれる。
Bob Dylan
John Lennon
すると、それぞれのfirst nameをキーとして、family nameをハッシュとして登録する。

いったんCtrl+Zを押す。

今度は、first nameのみを入力する。
すると、それに対応するfamily nameが表示される。

31: Sat Oct 23 05:05:20 2010
MeCabというものを知った。あの、食べる「めかぶ」だ。日本語の形態素解析をするソフトである。
yahooのapiとか、「ちゃせん」とかいろいろあるようだが、これが新しくて速いようだ。

形態素解析という言葉は、何度か耳にしている。初めて聞いたのは、コールセンターなどに寄せられた問い合わせないようを分析するソフトの説明を聞いたときだ。
その後、いわゆる「人口無能」というもの、「意味不明だがなんとなく文章として成立している」というものを作るのに使われているということだった。
32: Sat Oct 23 05:13:21 2010
「言葉をコンピュータで解析する」とか、自動翻訳とかいうものについては、私はとても否定的に考えている。
つまり、「そんなのはムリだ」という考えである。
実際、形態素解析を使って一番おもしろいのは「無能」であり、自動翻訳はせいぜい、その文章に含まれる単語を辞書で引いて並べるくらいのことしかできていない。

私は語学は好きだが、外国語を読むというのはつまり辞書を引くことである。そして、辞書を引くというのはある単語をリストのなかから探すことでは、ない。それだけなら、コンピューターでできるだろう。

しかし、まったく未知の文章を辞書をひいて理解しようとした人にはわかるだろうが、辞書があっても引けないことがある。
まずは動詞の活用。辞書に載っている動詞は原型だけである。そして動詞の活用の仕方は多様で、単純に規則化することもできない。それから同音意義語や、特別な言い回し、とにかく例外だらけなのである。

文法という、なまじ法則化されたようなものがあるから、人は言葉を科学的に扱おうとするが、結局言葉は科学の対象にはならない。極端なことを言うと、言葉というのは科学を拒否するものである。
33: Sat Oct 23 05:14:39 2010
自動翻訳の精度もずいぶん向上したようだが、聞いた話ではとにかく大量の例文を持つそうである。そしてその中から同じ表現をさがしてくる、という方法がとられているようだ。

34: Sat Oct 23 05:17:40 2010
話がそれたが、perlでmecabを使ってみた。職場のWindows XPで、active perlで使ってみた。
おもしろそうなので続きは家で、と思ったら、xpで使えたモジュールがvistaでインストールできなかった。

vistaはよく俺を困らせる。しかし、私はvistaを使うことをやめない。
もうvistaもリリースされてずいぶんたつ。これだけたってvistaに移植されていないのには、理由があるのだ。

35: Sat Oct 23 05:19:42 2010
だが、わたしにはさくらインターネットのレンタルサーバがある。
さくらに最近mecabがインストールされたという情報を見て、sshで入って使えることを確認している。
cygwinも、virtual pcもいらない。私はすでにfreebsd(だっけ)が動くサーバを持っているのだ。
36: Sat Oct 23 06:11:30 2010
さて、ではさくらでめかぶを。

と、その前にcgiを動かすだけでひと騒動。

まず、cgiを動かすディレクトリは決めてある。そしてパスワードを設定してある。パスワードが何か忘れている。
なんとか思い出す。

mecabを呼ぶperlが動くことをsshで確認する。
しかしcgiにするとinternal server errorになる。
いろいろ悩んだ末、permissionが777だと動かないことがわかる。755にしたら、動く。
37: Sat Oct 23 06:11:51 2010

#!/usr/bin/perl -w

use strict;
use Encode;
use MeCab 0.97;

open IN,"
print "Content-type: text/html\n";
print "\n";
print "

mecab test

\n";

while(){
my $str = $_;

my $t = new MeCab::Tagger("-Owakati");

Encode::from_to($str, "Shift_JIS", "EUC-JP");
$str = $t->parse($str);

Encode::from_to($str, "EUC-JP", "Shift_JIS");
print "

$str

\n";
}
close IN;
38: Sat Oct 23 06:14:33 2010
このソースは、shift_jisで保存してあり、読み込むファイル jpsjisもshift_jisである。
そのため、エンコード処理が入っている。

わたしのcgiは全部UTF8にしており、これもUTF8にしてエンコードなどしたくなかったのだが、
utf8だとどうしてもうまくいかない。

mecabがeuc-jpなのだろうか?

cgiをやるときはいつも日本語の文字コードで悩む。
日本人のハンデである。
39: Sat Oct 23 06:23:12 2010
このスクリプトは日本語でかかれた文章を形態素で「分かち書き」するだけのものである。
とりあえずmecabをcgiで動かすテスト用スクリプトである。

本当にやりたいことのひとつが、アクセスログの検索後から名詞を抜き出すことだ。
webalizerの検索語一覧は、複数の検索文字列をそのまま表示するので、同じ名詞が含まれていても別の検索語としてカウントされる。

"delphi  ics ftp"
"delphi コンポーネント テキスト ルビ"
"delphi ハードコピー bitblt"

というようになる。この場合、"delphi"というキーワードを数えたいのである。
私のサイトだと、"delphi", "tokai", "トーカイ", "whea-logger" などがこれで数えられて上位にランクされるはずだ。


40: Sat Oct 23 06:26:06 2010
次にやりたいのが、人口無能、あるいはbot、のようなもの。
すでにtwitterにたくさんあるbotである。
これらは形態素解析するだけでなく、それを再構成する必要がある。
このときに使われるのが「マルコフ連鎖」とかいうリクツである。
マルコフなんたらがどういうことなのかはなんとなくわかるのだが、はっきりとはわからない。
だが、少なくとも形態素で分解できてその品詞まで判定してもらえば、あとはなんとかなりそうだ。
41: Sat Oct 23 07:29:09 2010

#!/usr/bin/perl -w

use strict;
use Encode;
use MeCab 0.97;

open IN,"
print "Content-type: text/html\n";
print "\n";
print "

mecab test

\n";


while(){
my $m = new MeCab::Tagger ("");
my $str2 = $_;

Encode::from_to($str2, "Shift_JIS", "EUC-JP");

for (my $n = $m->parseToNode ($str2); $n ; $n = $n->{next}) {
if($n->{posid}==38){
my $surf=$n->{surface};
Encode::from_to($surf, "EUC-JP", "Shift_JIS");
print $surf."
";
}
}
}

close IN;
42: Sat Oct 23 07:32:25 2010
これで名詞だけを抜き出せる。
$n->{posid} というのが品詞IDで、これは自由に設定できるようだが、さくらでは38になっていた。
区別さえできればよいので、そのまま、「38だったらと」いう条件で$n-{surface}を表示した。

そして文章のなかで名詞の出現回数をかぞえるには、名詞を保存していき、すでにあるかを検索して、
なかったら追加する、ということをすればよい。
私がやろうとしている規模であればたいしたことはないが、大量に処理するならDBが必要かな。
43: Sat Oct 23 07:37:43 2010
今、「英単語はどうなるのかな」と思ってアクセスログを読ませてみたら、逆に英単語しか表示されない。
そう、日本語はエンコードされているからデコードしないといけないのだ。メンドクサイ・・・。
44: Sat Oct 23 07:38:35 2010
ログから検索文字列を抜き出し、それをデコードする処理が必要だ。
これは以前作ってある。
45: Sat Oct 23 07:41:38 2010
さっきeuc_jpでデコードするのがどうこう、と言っていた件は、めかぶの辞書がeuc_jpだからだそうだ。
そして辞書をUTF8に変更できるようだ。
あとでやろう。
46: Sat Oct 23 08:14:06 2010
さくらのログを表示させようとして、残っているのが前日の日付であることに気づいた。
1日引けば・・・と思ったところで月初だったら、年初だったら・・・とそう単純ではないことに気づいたが、
調べると簡単にできた。

my $yesterday = DateTime->now->subtract( days => 1 );
47: Sat Oct 23 11:09:02 2010
とりあえずmecabがどんなものか試すスクリプト。
htmlからpostしたテキストを形態素に分割して品詞等を表示する。

#!/usr/bin/perl -w

use strict;
use CGI;
use utf8;
use Encode;
use MeCab 0.97;


my $q= CGI->new;

my $value=$q->param('text');

print $q->header(-charset=>'utf-8'),
$q->start_html(-title=>'mecab'),
$q->p($value),
$q->br;


print "\n";
print "
\n";

my $m = new MeCab::Tagger ("");
my $str2 = $value;

Encode::from_to($str2, "UTF8", "EUC-JP");

for (my $n = $m->parseToNode ($str2); $n ; $n = $n->{next}) {

my $surf=$n->{surface};
Encode::from_to($surf, "EUC-JP", "UTF8");
print ''.$surf.' ';

my $feature=$n->{feature};
Encode::from_to($feature, "EUC-JP", "UTF8");

print ''.$feature.' ';

print ''.$n->{posid}.' ';

if($n->{posid}==4){
print "

";
}
if($n->{posid}==9){
print "
";
}

}

print $q->end_html;

exit;

48: Sat Oct 23 11:12:36 2010
cgiを呼び出すhtml。cgiもこのhtmlファイルも、文字コードはutf-8で保存する。
(エイチティティピーはこのページでNGワードなため、hxtpに置き換えてある)






just post









49: Sun Oct 24 18:23:52 2010
とりあえず名詞の抽出をする。頻出単語を数えるなどをしてみるが、一般名詞と固有名詞の区別も簡単ではない。
たとえば
「中国国家発展改革委員会」という言葉は

中国[47]国家[38]発展[36]改革[36]委員[38]会[51]

という風に分離される。カッコ内の数字は品詞の種類を表す数値である。

こういうものはくっつけたいが、なんでもくっつけるわけにもいかない。

とりあえず、いろんな文章を形態素分離させてみて、どういうパターンがあるかを見て、
38->36はくっつける、などとひとつひとつ決めていくしかないか。
50: Sun Oct 24 18:25:57 2010
「人口無能」であれば、その辺はテキトーにやって、頻度や乱数をつかって文章を切り貼りしていけばいい。
だが、まったくの「無能」ではやっぱり面白くない。

「圧縮新聞」はそれを新聞でやることによって、ある程度のもっともらしさを保っている。
ツイッターのツイートやブログなどでは、文体が多様すぎて混沌としすぎる。
51: Sat Oct 30 11:11:44 2010
aaa
52: Sun Oct 31 13:56:40 2010

$ref_array1 = [apple, banana, cherry, donkey];
$ref_array2 = [monkey, dog, cat, fish, horse, sheep];

push(@a,$ref_array);
push(@a,$ref_array2);


このようにして、配列のリファレンスを変数に格納し、それを配列にpushしていくことはできる。

しかし、STDINとか、ファイルを読むとかして作る配列を、同じようにpushできない。
53: Sun Oct 31 14:08:43 2010

while(){
chomp;
@b=split / /, $_;
push (@a,@b);
}


こういう風にすると、単に配列を追加するだけになる。
そうではなくて、2次元配列にしたい。
dog cat horse
orange banana apple

と入力したら、
@a=([dog cat horse],[orange banana apple]);
という配列にしたいのである。
54: Sun Oct 31 14:09:16 2010
dog cat horse

orange banana apple

ね。
55: Sun Oct 31 14:14:23 2010

while(){
chomp;
@b=split / /, $_;
$ref=\@b;
push (@a,$ref);
}

for $i (0 .. $#a) {
for $j (0 .. $#{$a[$i]}) {
print '$a[' . $i . '][' . $j . ']=' . $a[$i][$j] . ' ';
}
print "\n";
}


固定文字列のときは、スカラー変数に[]で囲った配列を代入し、そのスカラー変数を配列にpushしたから、

$ref=\@b

として、それを同じように配列にpushしたらできるのかと思ったら、


a b c
d e f
^Z

$a[0][0]=d $a[0][1]=e $a[0][2]=f
$a[1][0]=d $a[1][1]=e $a[1][2]=f


という風になってしまう。
2行目は望みどおりの結果なのだが、1行目も2行目と同じになってしまっている。

56: Sun Oct 31 14:21:51 2010
「スカラー変数」「配列」「リファレンス」「[]で囲って,で区切ったた複数の文字列」「()で囲って,で区切った複数の文字列」

配列に\をつけたもの \@array

スカラー変数に\をつけたもの \$var

これらの意味がよくわからず混同している。

[]で囲った文字列を「無名配列」と呼び、


$ref = ["apple", "orange", "banana"];


のようにした時、$ref に代入されるのは「無名配列へのリファレンス」だそうだ。

つまり、$ref には配列そのものの値が入っているのではなく、配列へのポインタが入っている。
だから、さっきのスクリプトでSTDINが2行入力されたときに、
1行目のポインタの内容が2行目で上書きされ、
@aに入っているポインタが指す内容が同じになる、というわけか。



57: Sun Oct 31 14:25:30 2010
じゃあどうすればいいのか・・・。

リファレンスについては、「続・はじめてのPerl」に書いてあるそうだ。
買わなきゃだめか・・・。
58: Sun Oct 31 16:31:08 2010

while () {
chomp();
push(@a, [ split(" ") ]);
}

for $i (0 .. $#a) {
for $j (0 .. $#{$a[$i]}) {
print '$a[' . $i . '][' . $j . ']=' . $a[$i][$j] . ' ';
}
print "\n";
}


とりあえずこれで、やりたいことはできた。
某所からの丸パクリであるが。
59: Fri Nov 5 04:02:31 2010
クラスの使い方。
これもほぼ丸パクリである。
元は車だったのだが、人間に変えた。


package Man;

sub new{

my $this = shift;
my ( $name, $gender ) = @_ ;

print "$nameさんが誕生しました。\n" ;

my $man = {"Name" => $name,
"Gender" => $gender,
"Age" => 0,
"Money" => 0 } ;

bless $man, $this;
return $man ;

}

# デストラクタ
sub DESTROY{

my $this = shift;
print "$this->{Name}($this->{Age})さんが死にました。\n";

}

sub tosi{
$this = shift ;
$this->{Age}++;
print "$this->{Name}さんが$this->{Age}才になりました。\n\n" ;
}

sub tellage{
my $this = shift;
print "わたしは$this->{Name}、$this->{Age}才です。\n";
}

package main;

my $taro = new Man "太郎", "Male";

my $hanako = new Man "花子", "Female";

$taro->tosi;

print"\n";

$taro->tosi;

$hanako->tellage;
$hanako->tosi;
$hanako->tosi;
$hanako->tosi;
$hanako->tosi;
$hanako->tellage;

print"\n";
60: Fri Nov 5 04:04:02 2010
実行した結果。


C:\>perl man.pl
太郎さんが誕生しました。
花子さんが誕生しました。
太郎さんが1才になりました。


太郎さんが2才になりました。

わたしは花子、0才です。
花子さんが1才になりました。

花子さんが2才になりました。

花子さんが3才になりました。

花子さんが4才になりました。

わたしは花子、4才です。

太郎(2)さんが死にました。
花子(4)さんが死にました。

C:\>


最後の「死にました」は、何もしていないのに表示される。
終了するときに自動的にデストラクタが動いているようだ。
61: Fri Nov 5 04:05:44 2010
こういうものは、「C++入門」とかを読んで何度かやってみたことがあるが、いつもサンプルを写して、一部を今回のように変えて、「フーン・・・」で終わっている。おもしろそうだな、とは思うのだが・・・。
62: Fri Nov 5 15:50:11 2010
引数に指定したファイルの内容をすべて表示するperlスクリプトを書け、
と言われたら、私なら以下のように書く。



open IN,"<".$ARGV[0];

while(){
print;
}


そしてperlって簡単だなァ・・・とニタニタする。

しかし、実は以下のように書けばいいのである。


while(<>){
print;
}



そしてもっと恐ろしいことには、


print <>;


でよい。

そして、このときの引数は複数あってもよい。
指定されただけのファイルについて、内容を表示する。


そして、以下のようにすると、ファイル内容を逆順に、つまり最後の行から順に先頭の行まで表示する・・・


print reverse<>;


・・・・・。

これは、実は一番最後のスクリプトを見たのである。
そして、これでこうならもしかして、と、今書いたのと逆にさかのぼっていったのである。

63: Sat Nov 6 02:59:29 2010
>>73
は、「初めてのPerl」からのネタです。
「初P」では「ダイヤモンド演算子」ということでその使い方が説明してあるのでそれを読んでいればわかることですが、私はここを飛ばしていたのです。

そして5章のハッシュのところを読み、最後の問題の答えを見ていたら、6章の答えである print reverse<>;
が目に入ったわけです。

今日は仕事がちょっとヒマだったので「初P」を読んでいたのですが、何度か吹き出しました。
こういう冗談って、なかなか書けないですよね。

絵文字も、(笑)ともかかずに、マジメな顔してあきらかに冗談であることがわかる文章を書くのって、難しいものです。
64: Fri Nov 26 13:42:37 2010

@fruits=qw(apple banana orange strawberry peach);

@animals=qw(elephant tiger lion cat dog);

@flowers=qw(daisy lily violet tulip);


@creatures=(
\@fruits,
\@animals,
\@flowers
);


foreach(@creatures){
foreach (@{$_}){
print;
print "\n";
}
print "\n";
}
65: Fri Nov 26 13:43:32 2010
実行結果

C:\>perl hai.pl
apple
banana
orange
strawberry
peach

elephant
tiger
lion
cat
dog

daisy
lily
violet
tulip
66: Fri Nov 26 14:47:53 2010
This is what I wanted to do.


my @table;

my @line;

while(<>){
chomp;
@line = split (/ /,$_);
push(@table, [@line]);
}


foreach(@table){
foreach (@{$_}){
print;
print " ";
}
print "\n";
}
67: Fri Nov 26 14:52:54 2010
このとき使う [ ] は「無名配列コンストラクタ」であり、
[@line]は 無名配列なのである。
68: Tue Nov 30 10:00:48 2010
要素数が決まっているなら、これでよい。


for $x (1..10){
for $y (1..10){
$LoL[$x][$y] = ($x * $y);
}
}

for $x (1..10){
for $y (1..10){
print $LoL[$x][$y]."\n";
}
}
69: Tue Nov 30 10:01:19 2010
もしくは end of row や end of column が判定できるなら。
70: Tue Nov 30 10:09:06 2010

@array = qw /apple banana orange/;

print @array."\n";
print "@array\n";


これを実行すると、以下のようになる。


C:\>perl hai3.pl
3
apple banana orange


つまり、配列はそのままprintすると要素数を返し、
引用符で囲むと中身を展開して表示する。

知らなかった。

配列の中身を表示するときはいつも foreachを使っていた。

まあ、配列の中身をベタっとそのまま全部表示することはあまりないけどね。

71: Tue Nov 30 16:05:31 2010

@array =qw/apple banana orange/;

print @array;

print "\n";

print @array."\n";

print "@array\n";


こうすると、


applebananaorange
3
apple banana orange


こうなる。
リストをそのまま print に渡すと配列の中身を表示する。
"\n"をくっつけると要素数、つまりスカラーコンテキストになる。
だがリスト自体も引用符でくくるとやっぱりリストになる。



72: Tue Dec 21 17:55:58 2010
vmstat をcsvに

print "r,b,swpd,free,buff,cache,si,so,bi,bo,in,cs,us,sy,id,wa,st,\n";

while(<>){
if(/\d/){
chomp;
$_ =~ s/\t//;
@array = split / /, $_;
foreach(@array){
if($_ =~ /.+/){
print;
print",";
}
}
print "\n";
}
}
73: Tue Dec 21 17:56:12 2010

print "r,b,swpd,free,buff,cache,si,so,bi,bo,in,cs,us,sy,id,wa,st,\n";

while(<>){
if(/\d/){
chomp;
$_ =~ s/\t//;
@array = split / /, $_;
foreach(@array){
if($_ =~ /.+/){
print;
print",";
}
}
print "\n";
}
}
74: Mon Jan 3 13:32:20 2011

use LWP::Simple;

$filename=1;

while(<>){
chomp;
$url=$_;
$file = $filename.'.jpg';
getstore($url,$file);
$filename++;
}

amebloから移行したブログの画像を取得する。
画像のurlはファイルに書いてあり、それを引数とする。
本当はそのurl一覧も取得したかったのだがなぜかできないので、
そこはしかたなく手でコピペした。
75: Sun Apr 10 15:21:48 2011
さくらインターネットのレンタルサーバではwebalizerが使えるのだが、このログは午前0時に前日のログを作成するようになっている。「現在のログ」が見たくてさがしたのだがなかった。
おそらく共用サーバなのでひとつにまとまっているのを分割しているのだと思う。

そこでcgiでログをとることにした。
環境変数をファイルにはくだけでよいので簡単である。
flockという関数を、よくわからないが使ってみた。

パースは厳密にやろうとすると大変なので、とりあえずそのまま書いて、
検索後だけをデコードするようにした。
76: Sat Apr 30 11:46:13 2011
サブルーチンで一つの引数を取得するとき


sub my_subroutine{
my $val1 = @_;
...
}


とやってしまい、$val1が "1" となってしまった。



sub my_subroutine{
my ($val1) = @_;
...
}


このようにしなければならない。
@_ は、配列だからである。
配列を、カッコで括った複数の変数に代入すると、その変数の数だけの配列がコピーされる。
上記の例は、配列の最初の要素を、$val1にコピーしているのである。

基本的なことだけど。
最初の $val1 = @_ とやると、配列 @_ の要素数が入るのかな。だから1になった。
77: Wed May 11 10:57:11 2011

browse_directory("c:\\mydoc\\");

sub browse_directory{
local($dir)=@_;
local(*DIR,$file);

if(!opendir(DIR, $dir)){
return;
}

while ($file = readdir(DIR)) {
if(($file eq ".") || ($file eq "..")){
next;
}
if (-d "$dir\\$file") {
browse_directory("$dir\\$file");
}else{
$file_size = -s "$dir\\$file";
$file_size{"$dir\\$file"} = $file_size;
$file_name{"$dir\\$file"} = $file;
}
}
closedir(DIR);
}

foreach $fullpath (sort {$file_size{$b} <=> $file_size{$a}} keys %file_size) {
print "$fullpath,$file_size{$fullpath},$file_name{$fullpath}\n";
}

78: Wed May 11 11:02:06 2011
指定したディレクトリ配下のファイルについて、フルパス、サイズ、ファイル名を取得してサイズの降順に並べる。

しかしこれには不具合がある。
たまたま、フォルダ名が「○○表」というフォルダがあった。
これがフォルダとしてではなく、ファイルとして認識されてしまったのだ。

回避方法はあるようだがメンドクサイし意味がわからない。

79: Wed May 11 11:17:26 2011
shift-jisはダメだな。

「ヤカン」が「ポット」とマッチするという冗談みたいなことが起きる。


while(<>){
if(/ポット/){
print;
print " matched\n";
}else{
print;
print " unmatched\n"
}
}


このスクリプトに「ヤカン」という文字列を含むファイルを読ませると、マッチする。
80: Mon May 23 18:37:30 2011
その日の前の週と翌週を含めた3週間を表示する。

@weekday = qw /Sun Mon Tue Wed Thu Fri Sat/;

print "";

foreach(@weekday){
print "";
}

( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst )
= localtime ( time );

$last = ($wday + 7) * -1;


$d=$last;
for($j=0;$j<21;$j++){
( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst )
= localtime ( time + $d * 24 * 3600);
if($wday==0){
print "";
}
print "";
}
$d++;
}

print "
$_
";
printf("%2d/%2d ",$mon+1,$mday);
print "";

if($wday==6){
print "
";

81: Tue May 24 11:56:11 2011
print (1+2)+3;

を実行すると、3 と表示される。
最初はどうしてかわからなかったが、
以下のようにしてみるとわかる。


print (1+2);
print "\n";

print (1+2)+3;
print "\n";

$a=print(1+2);
print "\n";

$a=print(1+2);
print "\n";

print $a;
print "\n";

print (1+2)+3;
print "\n";

上記の出力結果は以下のようになる。


3
3
3
3
1
3

printという関数は引数を表示して結果を返す。

perl -e "print print \"hello\""
上記を実行すると
hello1
と表示される。

helloの後ろにくっついている1は、print "hello" の実行結果である。


print (1+2)+3

これは、「(1+2)の結果をprintし、その実行結果の値に3を足す」という意味になる。
成功したらTRUE(1)なので1+3=4となるが、その値はprintされないので、
print(1+2) の結果の 3 のみが表示される。

もし (1+2)+3 という式の結果をprintしたいのであれば、
print ((1+2)+3)
とする必要がある。

82: Mon Jun 20 11:46:20 2011


package Fruit;

# コンストラクタ
sub new{

my $this = shift;
my ( $name, $value, $quantity ) = @_ ;

print "There are some $name"."s.\n\n" ;

my $fruit = {"Name" => $name,
"Value" => $value,
"Quantity" => $quantity } ;

bless $fruit, $this;
return $fruit ;

}

# デストラクタ
sub DESTROY{

my $this = shift;
print "$this->{Quantity} $this->{Name}s are disposed.\n";

}

# メソッドの定義
sub eaten{
$this = shift ;
my ($nums) = @_;
if($this->{Quantity}<$nums){
print "You demand $nums $this->{Name}"."s,
but there are only $this->{Quantity} $this->{Name}s. \n\n";
}else{
$this->{Quantity}-=$nums;
my $costs = $nums * $this->{Value};
print "You've got $nums $this->{Name}s. They cost $costs.\n\n" ;
}
}

# アクセスメソッドの定義
sub howmany{
my $this = shift;
print "There are $this->{Quantity} $this->{Name}"."s.\n\n";
}

# main のパッケージ名を設定
package main;

my $apple = new Fruit "Apple", 100, 30;
$apple->eaten(3);
$apple->howmany;
$apple->eaten(10);


my $banana = new Fruit "Banana", 80, 20;
$banana->eaten(10);
$banana->howmany;
$banana->eaten(20);




83: Wed Jun 22 14:05:25 2011
perlじゃないけど


#!/bin/sh
echo $#

if [ -e $1 ]; then
echo \"$1\" exists.
if [ -f $1 ]; then
echo \"$1\" is a file.
else
echo \"$1\" is not a file.
fi
else
echo \"$1\" does not exist.
fi

84: Tue Jul 5 09:54:38 2011
日報をメールで出すのだがタイトルは辞書登録して日付だけ書き換えていたのを日付取得してクリップボードにコピーするようにした。


use Win32::Clipboard;
my $clip = Win32::Clipboard();
($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime();
$m = $mon+1;
$text = sprintf ("日報\(2011/%02d/%02d\)",$m,$mday);
$clip->Set($text);

85: Tue Jul 5 09:56:01 2011
.plはテキストエディタに関連付けているので、バッチファイルを作ってクイック起動にショートカットをおく。これでワンクリックでタイトルが生成され、貼り付ければよい。
86: Tue Jul 5 09:56:36 2011
年が固定になってる・・・ここはアレしてね
87: Sat Jul 16 10:07:02 2011
さくらのVPSを借りた。
何がしたかったって、Net::Twitterをいれたかった。このためだけに借りたといっても過言ではない。
だが、多少の困難があった。インストールがすっといかなかった。

perl -MCPAN -e shell
とやると cpanのプロンプトになるので、
install Net::Twitter
とやればいいのだが、やたら長い上に最後にエラーになる。

ダラダラと出ているログは読んでられないのでまずサーチする。
失敗している人が散見され、いろいろ回避策が公開されていたがどれを試してもダメ。

結局、ログを見て、can't locate といわれているmoduleを片っ端から入れていった。
Math::Round とか。

あと、opensslのライブラリ(?)がないみたいなことを言われるので
yum install -y openssl-devel
をやった。

cpanのモジュールは依存関係にあるものを勝手にいれるんじゃなかったっけ?
そんな親切なのはppm installだけなのか?

88: Sun Jul 17 09:32:50 2011
bot

use strict;
use warnings;
use utf8;
use Encode;
use Net::Twitter;

binmode STDOUT, ':utf8';


my $twit = Net::Twitter->new(
traits => [qw/API::REST OAuth WrapError/],
consumer_key => 'yourconsumerkey',
consumer_secret => 'yourconsumersecret',
ssl => 1,
);
$twit->access_token ('youraccesstoken');
$twit->access_token_secret('youraccesstokensecret');

while (1){
my $line;
open(my $file, " rand($.)<1 and $line = $_ while <$file>;
close $file;
my $decoded = Encode::decode('utf8', $line);
$twit->update($decoded);

sleep 3600;
}

exit;

89: Sun Jul 17 09:35:29 2011
テキストファイルからランダムに1行ずつ選んでツイートする、簡単なボット。
ちょっと手間取ったのは日本語の扱い。
tweets.txt は utf8で保存してあるのだが、なぜかそのまま Net::Twitterに渡すと文字化けする。
リテラルは化けない。

いろいろ調べて、utf8をいったんデコードして渡すという、ちょっと釈然としないやり方で解決。
90: Wed Jul 27 17:19:13 2011

sub logmsg{ print "$0 $$: @_ at ", scalar localtime, "\n" }

プログラミングPerlのSocketのサンプルにあった一行。
なんのおまじないか?と思った。
$0 はプログラム名、
$$ はプロセス番号(Windowsにもある)
@_ は引数(これは知ってた)

scalar localtime で時刻が人間に読める形式で表示できる。


91: Thu Jul 28 10:01:49 2011

use 5.010;
say "hello";


sayという関数がversion5.10から追加されているそうだ。
vesionを確認すると5.14なので使ってみたらエラーになったので調べると、
use 5.010;
が必要とのことであった。

sayは\nをつけなくても改行してくれる。
92: Thu Oct 6 15:24:27 2011
splitの区切り文字は、複数の文字からなる単語でもよい。

@array = split /http/,$string;

こうすれば "http"の前後で文字列を分割できる。
何に使うかというとアクセスログの検索文字列の抽出である。

今は、まず ?で区切って、格納した配列を見て、また区切って、などとやっているのだが、
見逃しや余計な物がくっついてエンコードに失敗したりしている。

区切り文字は1文字でないとダメだと思い込んでいたのだ。

93: Sat Oct 8 04:45:18 2011
アクセスログ解析スクリプト、改善した。

#! /usr/bin/perl

use strict;
use URI::Escape;
use Encode;
use DateTime;
use utf8;

my @line;
my @line2;
my @line3;
my $useragent;
my $unescaped;
my $print_level = 2;



sub print_selected{
my ($date, $time, $host, $addr, $search_engine,
$search_string,$useragent,$browser,$misc)=@_;

print '
';
print ''.$search_string.'
';
print '';

if($search_engine=~ /Google/){
print ' '.$search_engine.'';
}elsif($search_engine=~ /Yahoo/){
print ' '.$search_engine.'';
}elsif($search_engine=~ /Baidu/){
print ' '.$search_engine.'';
}else{
print ' '.$search_engine.'';
}

$time =~ s/\[//g;

print '

'."\n";

}




my $date = DateTime->now( time_zone => 'Asia/Tokyo' )->subtract(days=>1);

my $logfilename;

if($#ARGV >=0){
my $test='cp ../../log/access_log_'.$ARGV[0].'.gz ../../log/tmp';
system($test);

$test='gunzip -f ../../log/tmp/*.gz';
system($test);

$test='mv ../../log/tmp/access_log_'.$ARGV[0].' ../../log/tmp/log.txt';
system($test);

$logfilename='../../log/tmp/log.txt';
}else{
$logfilename='log.txt';
}


print "Content-type: text/html\n\n";
print "\n";
print '';
print "Searched Strings\n";
print '


'."\n";
print "\n";

print "\n";
#print "$logfilename<\/a> ";
#print "
print level:".$print_level."
";

print "
\n";

open LOG,"<$logfilename" or die;


while(){

if(/googlebot\.com|Baiduspider/){
if ($print_level > 1) {
next;
}
}else{
print "
";
}

print '';
print;
print '
';

@line=split;

if(/.+(\(.+\))/){
$useragent=$1;
}

if(/google/){
@line2 = split /&q=|\?q=/, $_;
@line3 = split /&/, $line2[1];

$unescaped = uri_unescape($line3[0]);

if($_ =~ /ie=SJIS/){
$unescaped = Encode::decode('shiftjis',$unescaped);
}

$unescaped =~ s/\+/ /g;
&print_selected(@line[0],@line[1],@line[2],@line[3],
"Google",$unescaped,$useragent);

}elsif(/yahoo.+search\?/){
@line2 = split /p=/, $_;
@line3 = split /&/, $line2[1];
$unescaped = uri_unescape($line3[0]);
$unescaped =~ s/\+/ /g;
&print_selected(@line[0],@line[1],@line[2],@line[3],
"Yahoo",$unescaped,$useragent);

}elsif(/yahoofs.+search/){
@line2 = split /p=/, $_;
@line3 = split /&/, $line2[1];
$unescaped = uri_unescape($line3[0]);
$unescaped =~ s/\+/ /g;
&print_selected(@line[0],@line[1],@line[2],@line[3],
"Yahoofs",$unescaped,$useragent);

}elsif(/baidu.jp\/s\?/){
@line2 = split /wd=/, $_;
@line3 = split /&/, $line2[1];
$unescaped = uri_unescape($line3[0]);
$unescaped =~ s/\+/ /g;
&print_selected(@line[0],@line[1],@line[2],@line[3],
"Baidu",$unescaped,$useragent);

}elsif(/bing.+search/){
@line2 = split /q=/, $_;
@line3 = split /&/, $line2[1];
$unescaped = uri_unescape($line3[0]);
$unescaped =~ s/\+/ /g;
&print_selected(@line[0],@line[1],@line[2],@line[3],
"bing",$unescaped,$useragent);

}elsif(/biglobe.+search/){
@line2 = split /q=/, $_;
@line3 = split /&/, $line2[1];
$unescaped = uri_unescape($line3[0]);
$unescaped =~ s/\+/ /g;
&print_selected(@line[0],@line[1],@line[2],@line[3],
"biglobe",$unescaped,$useragent);

}elsif(/search\.goo\.ne\.jp/){
@line2 = split /MT=/, $_;
@line3 = split /&/, $line2[1];
$unescaped = uri_unescape($line3[0]);
Encode::from_to($unescaped, 'euc-jp','utf8');
$unescaped =~ s/\+/ /g;
&print_selected(@line[0],@line[1],@line[2],@line[3],
"goo",$unescaped,$useragent);

}else{
print "
\n";
}
}

close(LOG);

print "
\n";
94: Sat Oct 8 04:54:57 2011
検索エンジンごとに個別にやっているところは、本当はまとめてしまいたいところなのだが、とりあえずはこれで。
これでもずいぶんすっきりした。

googleで、url(uri?)デコードしたした後に文字バケしたことがあった。

URLデコードのできるページで同じ文字列をデコードするとちゃんと表示される。shift-jisとかutf-8とかを判定してどのコードでも表示できるようにしているのだろう。どうやっているのかはわからない。

ログをよく見ると、&ie=SJIS&oe=SJIS というパラメータがついている。どういう場合にこうなるのかわからないが、あまりないので、この文字列があったら shift-jisをデコードするようにした。

最初は from_to で shiftjis から utf8 に変換したのだがなぜかうまくいかないので decode を使った。
Encodeの動作がイマイチよくわからない・・・
95: Sat Oct 8 07:20:17 2011
log解析スクリプトは、最新を上に表示したいので、print reverseを使ってログをひっくり返してから読むようにした。

そのときちょっとはまったのは、最初に

open FILE,">filename.txt";

とやって書き出すのはできるんだけど、その後にもういちどそこに書き込めないこと。
ファイルが開けない。
属性を書き換えていけたんだけど。
どうして一発目はかけるのに、その後はダメなんだろう?
96: Sat Oct 8 07:27:46 2011
perlのハナシじゃないんだけど、iPhoneでこのページを見ると字が小さすぎてしまう。

useragentを見てページを作り分けるなんてことは面倒だしもっと簡単な方法があるだろうと調べた。

以下のようにする。


print '';
print '';
print '';


最初の行は、今まで書いてあった cssファイルを指定していたもの。
その後の2行を足す。そして bbziphone.css に、iPhone用のスタイルを書く。

とりあえずこれでできたけど、普通のと、iPhone用とほとんど同じで一部だけ違うっていうのが、
ちょっとイヤだな。cssファイル内部でなんとかできないものかな?
97: Wed Oct 26 00:09:23 2011
yahoo, google, twitter, amazon, 今はどこのサイトもログインしてそのユーザ専用ページが表示されるようになっている。

前からこの仕組みをやってみたいと思っていた。

idとパスワードを入力させて、それをデータベースで参照して正しければ認証する。

実際は暗号化したり、SQLとかを使っているのだろうが、
原理だけを確認するなら、その辺は平分でテキストファイルでもできる。


98: Wed Oct 26 00:09:35 2011
平文ね
99: Wed Oct 26 00:21:52 2011
テキストボックス2つとボタンを作って、postさせれば認証機能は実現できる。

しかし問題はその先である。

単純に考えるなら、

1.OKなら ok.htmlを表示し、NGなら ng.htmlを表示する。
2.OKなら"ok"を、NGなら"ng"を引数としてauth.cgiを呼び、引数に応じて「ようこそ」「認証できません」などと表示する。

しかし問題なのは、認証の可否をどこかに維持しておかなければならないということだ。

それを「セッション管理」といって、perlにも CGI:Session というモジュールがある。
それを使えばいいのだろうが、複雑で、mySQLなどもからんでいてメンドクサイ。

もっと単純にできないだろうか?

100: Wed Oct 26 00:27:34 2011
IPアドレスで管理するのはどうだろうか?

いったんIDとパスワードを認証したら、そのときのuserのIPアドレスと、認証がOKであることを、ファイルに記録しておく。

サイトでは常にそのファイルを参照するようにして、認証されているかどうかに応じてページの表示を変える。

多分、「セッション管理」とか言うのも、同じようなことをしているはずだ。あとはポート番号を見たり、認証した時間を記録しておいて一定時間がたったらタイムアウトさせるとか・・・
101: Wed Oct 26 00:47:05 2011
でもあれか、natしてたりしたらIPアドレスで管理したら全部同じになっちゃうな。

セッションIDというのはHTTPプロトコルの仕組みで、それをサーバとクライアント(ブラウザ)で保持するようだ。

だが、キャプチャしても"session id"みたいなフィールドが見つからない。
102: Wed Oct 26 02:02:20 2011
セッション管理というのは、ステートレスであるHTTPプロトコルで状態管理をさせるための苦肉の策のようだ。
セッションIDを生成して、それをクッキーを使ってクライアントに渡す。
103: Wed Oct 26 02:07:44 2011

#!/usr/bin/perl

use CGI;
use CGI::Session;

my $cgi = CGI->new;
my $session = CGI::Session->new(undef, $cgi, {Directory=>'./tmp'});
session->param('name','mysession');

print $session->header(-charset=>'UTF-8');

print $cgi->start_html(-lang=>'ja', -encoding=>'UTF-8', -title=>'http session test'),
$cgi->p('session id: '.$session->id.'
',
'name: '.$session->param('name').'
'),
$cgi->end_html;



とりあえずこのようなcgiを作って実行すると、session idが表示される。
F5を押すたびにidは変わる。

キャプチャしてみると


Set-Cookie: CGISESSID=5d6b6c1c3248aa9b399060dcef4c4e58; path=/

のように、セッションIDがサーバからクライアントに返す HTTP OKのパケットの中に入っているのがわかる。


・・・・・・で?
104: Wed Oct 26 03:07:40 2011
まずはcookieからだな。

cookieというのは、サーバ側から送信するもので、ユーザが閲覧するとユーザがcookieを無効にしていない限り勝手に保存される。

cookieには名前、値、ドメイン名、パスなどが設定できる。

ユーザが保存しているcookieは、環境変数
$ENV{'HTTP_COOKIE'}
で取得できる。

たとえば名前=アクセス日時というcookieを送信しておけば、次のアクセス時に「前回のアクセスはxxでした」などと表示できる。



105: Wed Oct 26 03:13:43 2011
amazon.co.jpにアクセスしたら、6個のcookieが保存された。

at-acbjp
session-id
session-id-time
session-token
ubid-acbjp
x-acbjp

値を見てもなんのことやらさっぱりわからないが、
サインインしたときにアカウントと関連付けて保存しておけば、どのアカウントかわかる。

どのサイトでも「ログインしたままにする」などのチェックボックスがついているが、
それをチェックしたときはcookieを見てアカウントの認証プロセスを飛ばすのだろう。
106: Wed Oct 26 03:15:24 2011
と、こう見てくるとperlの CGI::Session モジュールがやってることはたいしたことがないように思えてきた。
ただidを発行してcookieにセットしてるだけじゃないのか?

107: Fri Oct 28 01:46:57 2011
画像アップローダーを作ろう。

そういうサイトはたくさんあるけど、なかなか私の使いたいものがない。

以前使っていたサイトがあって、それがとてもよかった。

まず、画像はすべてサムネイルが表示される。

サムネイルといっても、結構大きめで、それで十分楽しめるくらいの大きさである。
PCの1画面で、3、4列くらいかな。

背景は黒。各画像の下には短いコメントが表示される。
多くの場合は何もないか、ごく短い。
投稿者だけでなく閲覧者もコメントをつけられるが、そのコメントはサムネイル表示時には表示されない。

108: Fri Oct 28 01:48:48 2011
画像の表示はglobでいいかな。
まずglobで画像を表示させてみると、大きさがまちまちになる。
これをプレビュー画面では同じ大きさに統一したい。

Windowsのexplorerとかpicasaとかのように。

さて、どうやるか。
ちょっと調べるといろいろ出てくる。

いつもはとりあえずなんでもいいから動くものに食いついてきたけど、
今回はどんな方法があるのかを調べて吟味してから使おう。
109: Fri Oct 28 04:56:36 2011
Image::Magick
GD
ImgResize


110: Fri Oct 28 18:33:38 2011
画像のサムネイルを作成する。


#!/usr/bin/perl
use strict;
use Image::Magick;

print "Content-type: text/html\n";
print "\n";

my @files = glob "./images/*.png ./images/*.jpg";

foreach (@files){
&MakeThumbnails($_);
}

print '';

my @files = glob "./thumbnails/*.png ./thumbnails/*.jpg";

my $count =0;

foreach (@files){
if($count % 5 <1){
print "";
}

$count++;
}

print '
';

sub MakeThumbnails{
my ($name) = @_;
my $dir = './thumbnails';
(my $newname = $name) =~ s/\/images/\/thumbnails/;

my $img = Image::Magick->new;
my $x;
$x = $img->Read($name);
$x = $img->Resize(geometry=>"200x150");
$x = $img->Write($newname);
}

111: Fri Oct 28 18:35:46 2011
サムネイルの作成と表示を同時に実施している。
表示(リロード)するたびにサムネイルを上書きするのはムダかもしれない。
枚数が増えてくると重くなるから、ページを分けたりする必要もあるだろう。
サムネイルをクリックしたら元画像を表示するとか、コメントをつけたり削除したりできれば、
表示部分はOK。

あとは、アップロード部分か。
112: Thu Nov 3 20:17:22 2011
google検索文字列のエンコードが、下記のように%のあとが4桁になっている場合がある。
これをそのままデコードすると、25だけが取れる。
読めるようにするにはこれをもう一度でコードしなければならない。

%25E5%25A4%25A7%25E6%25B1%259F%25E6%2588%25B8%25E7%25B7...

検索すると、%25がついている場合は25を消す、という人がいたので私もマネした。


$string =~ s/%25([a-fA-F0-9][a-fA-F0-9])/%$1/g;


[]を2回繰り返す時の書き方がわからないので続けて書いた。
113: Wed Nov 9 03:16:52 2011
またスタイルの話であるが、このスレのようにpreを使っていると、iphoneで表示が崩れる。
preにはソースを書くので1行の文字数がどうしても長くなる。
するとなぜかほかの部分の文字が大きくなってしまう。
preの幅にあわせて小さくなるならわかるのだが・・・
どうしよう・・・
114: Sun Nov 13 04:33:04 2011
javascriptがアツい。
javascriptのコンパクトな画像ビューアがあったので、
cgiの中に入れることにした。
ヒアドキュメントを使ったら、文字化けしている。

それは、変数展開によるものであった。

print <<"END_OF_TXT";

apple
banana
$test

END_OF_TXT

とやると、$testが変数展開されてしまう。

それをさせないようにするには、

print <<'END_OF_TXT';

とすればよい。
115: Sun Nov 13 04:33:34 2011
ちなみにそのjavascriptによるビューアは動きが重かったので不採用。
116: Sun Nov 13 06:47:59 2011
ファイルの拡張子を取り出そうと調べたら、以下のようなソースがあった。

$name = "aaa.jpg";

if( index($name, '.', 0) != -1){
$suffix = (split(/\./, $name))[-1];
}

print $suffix."\n";


なるほどね、ピリオドで区切ってsplitすればいいのか・・・
と思ったがsplitしたものの取り出し方がちょっと変わっている。
私だったら、

@tmp = split /\./, $name;
$suffix = pop(@tmp);

とやるところだ。
おそらくそれを一発でできるのだろうが、どういうことなのかよくわからない。
[-1]で配列の最後を意味するのかな?
117: Tue Nov 15 03:58:08 2011
アクセスログにデコードされていない文字列が。UAを見ると、ezschとあった。
解析スクリプトの検索エンジンごとの処理にezschを追加する。
が、デコード結果が化ける。文字コードが違うのだろう・・・。
なんの文字コードなのかが判断できないので検索するとshift-jisらしい。
uri_unescapeの前にshiftjisでdecodeする。まだダメだ。
後か。
uri_unescapeした文字列をもう一回shiftjisでデコード。
できた。
118: Tue Nov 15 04:22:54 2011
しかし、やっていることはほとんど同じで、サーチエンジンによる違いというのは
・UAに含まれる検索エンジン名
・検索文字列の前につく文字列(p= とか、 q= とか)
・uri_unescapeの後にさらにデコードが必要な場合それをやる

なので、本当はこれらを引数にしてサブルーチン化すればよいのである。
119: Thu Dec 1 05:05:29 2011
検索エンジン経由で来たアクセスについては、検索後を即時ツイートするようにしているのだが、EZから来たものだけツイートされない。
それは、ツイートするまえにしていた以下の処理が原因だった。

$unescaped = Encode::decode('utf8', $unescaped);

無条件にutf8でデコードしていたのだがEZはshiftjisを使っている。
というわけでEZのときだけshiftjisでデコードし、それ以外はutf8でデコードするようにした。
120: Thu Dec 1 05:13:28 2011
ちなみにUAによる動作を確認するには以下のようなスクリプトを使う。

use LWP::UserAgent;
use strict;
use warnings;

my $url = "http://clebriz.net/cgi-bin/test.cgi";
my $ua = LWP::UserAgent->new;
my $req = HTTP::Request->new(GET => "$url");
$req->referer("http://ezsch.ezweb.ne.jp/search/?sr=0101&query=aiueo%20%95a%93I");
my $res = $ua->request($req);
if($res->is_success){
print $res->content;
}else{
print $res->status_line;
}

bing, yahoo, googleはブラウザから検索すればいいのだがauの携帯がないのでEZの場合はこれを使った。

そこで気付いたのだがezschのquery文字列は短い。これがshiftjisのメリットか。
121: Thu Dec 1 05:15:04 2011
$req->referer に設定しているのは、実際にアクセスがあったログのHTTP_REFERERである。
122: Sat Dec 3 06:56:50 2011
perlを使ってルータの設定をするのはよくやっていたが、全部telnetで、シリアルポートを使ったことがないのに気付いた。

Win32::SerialPort

を使う。

ppm install Win32::SerialPort

をやって、

以下、サンプル。


use strict;
use Win32::SerialPort;

my $ob = new Win32::SerialPort('COM1') || die;

$ob->user_msg(1);
$ob->error_msg(1);

$ob->baudrate(9600);
$ob->parity("none");
$ob->parity_enable(1);
$ob->databits(8);
$ob->stopbits(1);
$ob->handshake('rts');

$ob->write_settings;

$ob->write("\n");
sleep 1;
my $result = $ob->input;
print $result;


$ob->write("en\n");
sleep 1;
my $result = $ob->input;
print $result;

$ob->write("enable\n");
sleep 1;
my $result = $ob->input;
print $result;


$ob->write("conf t\n");
sleep 1;
my $result = $ob->input;

print $result;

$ob->write("hostname donguri\n");
sleep 1;
$result = $ob->input;
print $result;

$ob->write("end\n");
sleep 1;
$result = $ob->input;
print $result;

$ob->write("reset\n");
sleep 1;
$result = $ob->input;
print $result;

$ob->write("y\n");

undef $ob;

123: Sat Dec 3 06:58:14 2011
sleepして結果を表示しているところはダサいですね。
ここはteratermの waitのようにしたいところですが、そのやり方は後で調べる。
とりあえずserialポートで入出力ができるというサンプルです。
124: Sat Dec 3 07:55:30 2011
プロンプト待ちバージョン。


use strict;
use Win32::SerialPort;
use Time::HiRes;

my $ob = new Win32::SerialPort('COM1') || die;

$ob->user_msg(1);
$ob->error_msg(1);

$ob->baudrate(9600);
$ob->parity("none");
$ob->parity_enable(1);
$ob->databits(8);
$ob->stopbits(1);
$ob->handshake('rts');

$ob->write_settings;

$ob->are_match('>','#','word:');
$ob->lookclear;

&waitfor("\n",">");

&waitfor("en\n","word:");

&waitfor("enable\n","#");

&waitfor("conf t\n","#");

&waitfor("hostname otanko\n","#");

&waitfor("end\n","#");

&waitfor("reset\n",'(y/n)');

$ob->write("y\n");

undef $ob;

sub waitfor{
my($output_string,$prompt_to_wait)=@_;
my $gotit = "";

$ob->are_match($prompt_to_wait);
$ob->write($output_string);

until ("" ne $gotit) {
$gotit = $ob->lookfor;
die "aborted\n" unless (defined $gotit);
sleep 0.1;
}

my ($match, $after) = $ob->lastlook;
printf "%s%s",$gotit,$match;

}
125: Sat Dec 3 08:00:36 2011
$ob->are_match("hoge1", "hoge2", ...)

という風にして、特定の文字列を待つことができる。複数指定できる。

waitfor というサブルーチンを作って、入力するコマンドと、期待するプロンプトを指定して実行する。

$ob->lookfor で、are_matchで指定した文字列が来るのを待つ。

sleepは1秒未満で待ちたいので Time::HiRes を使う。

$ob->lastlook で、マッチした文字列を取得できる。
この例では are_matchを1個しかしていないので確認する必要はないが、
複数していした場合はどの文字列にマッチしたのかを知ることができる。

これでだいぶ使えるでしょう。

あとは、期待したプロンプトが帰ってこなかったときにタイムアウトするようにすれば完璧。
126: Fri Feb 3 20:17:15 2012
portfastを設定したポートにスイッチをつないでループが発生する状況を作ろうと思ったが、どうしてもできない。
ループが発生するのは2つのスイッチで両方spanning treeを無効にした場合だけである。
2つのスイッチのvlan 10に所属する二つのポートをそれぞれportfastに設定して2本のケーブルでつないだら、
全部FWDになってループが発生すると思ったのだが、ちゃんと一個がBLKになる。どうしてだろう・・・?
127: Thu Jan 31 09:07:04 2013
最近はどんなサイトもユーザーIDとパスワードを登録させて各ユーザごとにカスタマイズしたサイトを利用できるようにしている。私もそれをやってみたいとは思っているのだが、この仕組み時代には以前から不満を持っている。それは、自分のID/パスワードがどんどん増えてしまうことである。また、自分のIDとパスワードを決めることがメンドクサくて、忘れてしまう。
128: Tue Oct 28 05:15:38 2014
test
129: Tue Oct 28 06:10:36 2014
このスレッドではPREタグを有効にしている。

有効にしているといっても、PREタグがあったらそれ用の処置をしているわけだが、

それがうまくいってない。

なんか、img srcタグが悪さをして、apacheにerror_logを書いている。

とりあえずその部分は消した。


自分で書いたものだが、なんだかわけがわからない。

130: Tue Oct 28 06:14:05 2014
test

あれ

声が

遅れて

聞こえるよ
^
previous | next | edit