perl







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

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

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

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

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

「圧縮新聞」はそれを新聞でやることによって、ある程度のもっともらしさを保っている。
ツイッターのツイートやブログなどでは、文体が多様すぎて混沌としすぎる。
Sat Oct 30 11:11:44 2010
aaa
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できない。
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]);
という配列にしたいのである。
Sun Oct 31 14:09:16 2010
dog cat horse

orange banana apple

ね。
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行目と同じになってしまっている。

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

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

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

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

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


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


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

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



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

リファレンスについては、「続・はじめてのPerl」に書いてあるそうだ。
買わなきゃだめか・・・。
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";
}


とりあえずこれで、やりたいことはできた。
某所からの丸パクリであるが。
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";
Fri Nov 5 04:04:02 2010
実行した結果。


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


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

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

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

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

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

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

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

C:\>


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



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

while(){
print;
}


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

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


while(<>){
print;
}



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


print <>;


でよい。

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


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


print reverse<>;


・・・・・。

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

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

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

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

絵文字も、(笑)ともかかずに、マジメな顔してあきらかに冗談であることがわかる文章を書くのって、難しいものです。
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";
}
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
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";
}
Fri Nov 26 14:52:54 2010
このとき使う [ ] は「無名配列コンストラクタ」であり、
[@line]は 無名配列なのである。
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";
}
}
Tue Nov 30 10:01:19 2010
もしくは end of row や end of column が判定できるなら。
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を使っていた。

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

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"をくっつけると要素数、つまりスカラーコンテキストになる。
だがリスト自体も引用符でくくるとやっぱりリストになる。



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";
}
}
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";
}
}
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一覧も取得したかったのだがなぜかできないので、
そこはしかたなく手でコピペした。
Sun Apr 10 15:21:48 2011
さくらインターネットのレンタルサーバではwebalizerが使えるのだが、このログは午前0時に前日のログを作成するようになっている。「現在のログ」が見たくてさがしたのだがなかった。
おそらく共用サーバなのでひとつにまとまっているのを分割しているのだと思う。

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

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


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


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



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


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

基本的なことだけど。
最初の $val1 = @_ とやると、配列 @_ の要素数が入るのかな。だから1になった。
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";
}

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

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

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

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

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


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


このスクリプトに「ヤカン」という文字列を含むファイルを読ませると、マッチする。
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 "
";

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)
とする必要がある。

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);




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

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);

Tue Jul 5 09:56:01 2011
.plはテキストエディタに関連付けているので、バッチファイルを作ってクイック起動にショートカットをおく。これでワンクリックでタイトルが生成され、貼り付ければよい。
Tue Jul 5 09:56:36 2011
年が固定になってる・・・ここはアレしてね
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だけなのか?

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;

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

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

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

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

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


Thu Jul 28 10:01:49 2011

use 5.010;
say "hello";


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

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

@array = split /http/,$string;

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

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

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

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";
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の動作がイマイチよくわからない・・・
Sat Oct 8 07:20:17 2011
log解析スクリプトは、最新を上に表示したいので、print reverseを使ってログをひっくり返してから読むようにした。

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

open FILE,">filename.txt";

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

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

以下のようにする。


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


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

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

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

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

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


Wed Oct 26 00:09:35 2011
平文ね
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などもからんでいてメンドクサイ。

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

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

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

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

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

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

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


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

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

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

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

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



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を見てアカウントの認証プロセスを飛ばすのだろう。
Wed Oct 26 03:15:24 2011
と、こう見てくるとperlの CGI::Session モジュールがやってることはたいしたことがないように思えてきた。
ただidを発行してcookieにセットしてるだけじゃないのか?

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

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

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

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

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

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

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

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

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

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


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);
}

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

あとは、アップロード部分か。
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回繰り返す時の書き方がわからないので続けて書いた。
Wed Nov 9 03:16:52 2011
またスタイルの話であるが、このスレのようにpreを使っていると、iphoneで表示が崩れる。
preにはソースを書くので1行の文字数がどうしても長くなる。
するとなぜかほかの部分の文字が大きくなってしまう。
preの幅にあわせて小さくなるならわかるのだが・・・
どうしよう・・・
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';

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

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

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

無条件にutf8でデコードしていたのだがEZはshiftjisを使っている。
というわけでEZのときだけshiftjisでデコードし、それ以外はutf8でデコードするようにした。
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のメリットか。
Thu Dec 1 05:15:04 2011
$req->referer に設定しているのは、実際にアクセスがあったログのHTTP_REFERERである。
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;

Sat Dec 3 06:58:14 2011
sleepして結果を表示しているところはダサいですね。
ここはteratermの waitのようにしたいところですが、そのやり方は後で調べる。
とりあえずserialポートで入出力ができるというサンプルです。
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;

}
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個しかしていないので確認する必要はないが、
複数していした場合はどの文字列にマッチしたのかを知ることができる。

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

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

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

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

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

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


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

Tue Oct 28 06:14:05 2014
test

あれ

声が

遅れて

聞こえるよ