Perlの最近の記事

2008年5月22日

コンソール画面へ実行のパーセンテージとプログレスバーを表示する

実行時の画面とスクリプト

080522progress.png こんな感じで同じ行でコンソール画面の表示が変わっていくばい。たのしいばい。
#!/usr/local/bin/perl --
use strict;
use warnings;

### $maxCntには処理の最大数を、$nowCntには現在の処理数を設定する
my $maxCnt = 100;

for my $nowCnt (1 .. $maxCnt) {
select(undef, undef, undef, 0.1); #0.1秒停止する

my $progress = $nowCnt * 100 / $maxCnt;
local $| = 1;
print sprintf(" %3.0f", $progress) . "% ";
print "=" x ($progress / 10 * 2);
print "\r";
local $| = 0;

}

print "\n";

__END__

覚えたこと

■出力をバッファリングするかどうかの設定
 ### バッファリングする場合は$|に0以外を設定する。
  $| = 1;

 ### バッファリングしない場合(デフォルト)は0を設定する。
$| = 0;

■printで同じ出力を連続して行う


### print "="を5回行う
print "=" x 5;

■1秒未満の停止を行う


 ### sleepが許されるのは1秒までだよね
sleep 1;

 ### 0.1秒の停止
select(undef, undef, undef, 0.1);

参考にさせていただいたサイト

「自前でプログレスバーを表示する」 :: Perl Tech http://perl.g.hatena.ne.jp/bosh/20080107/p1

「select」 :: Perl講座 -Smart
http://www.rfs.jp/sb/perl/05/select.html

2008年5月 3日

ActivePerlでCpanを使う

  • ActivePerlのダウンロード
    • ActivePerl本家からダウンロードできます。
    • 途中で求められる名前等の記載は未記入で進めてもダウンロードできます。
    • 今回は「5.10.0.XXXX for Windows (x86)」をダウンロードして使いました。
    • MSIを利用すると環境変数を自動で設定してくれるのでMSI版がおすすめ。
  • Visual Studio 2008 Express Editionsのダウンロード
    • Microsoftの本家からダウンロードできます。
    • Visual C++ のWebインストールを選択します。
    • インストール時にVisual C++以外の選択は必要ありません。
    • インストール先のパスは半角スペース・全角を含まないのがBetter(含むと動作しない場合があるので)
  • Windowsの環境変数のPathにnmake.exeのパス設定
    • Visual C++ をインストールしたフォルダから「nmake.exe」を検索してパスを確認します。私の場合は「\VC\bin\」でした。
    • Windowsの環境変数のPATHに上記のパスを設定します。
  • ActivePerlのCpanの設定
    • ActivePerlインストール先\lib\CPAN\Config.pmのmakeの設定に、VC++フリー版のnmake.exeの場所を設定します。
    • ex) 「'make' => 'C:\vs2008\VC\bin\nmake.exe',」
    • ActivePerl5.10.0だと上記以外は未設定でもCpanを使用できました。
  • Cpanを利用したモジュールのインストール
    • コマンドプロンプトから「cpan モジュール名」と入力するとインストールが開始されます。
    • Image::Sizeをインストールしたければ、「cpan Image::Size」と入力します。
  • インストール後のモジュールの確認
    • Cpanのログを見ればインストールされたかどうかはわかるのですが、私は最初わからなかったので念のため
    • コマンドプロンプトから「perl -Mモジュール名 -e "print $モジュール名::VERSION"」と入力します。
    • Image::Sizeを確認したければ、「perl -MImage::Size -e "print $Image::Size::VERSION"」と入力します。
  • ちいさくガッツポーズする

2007年9月 1日

Perlクイズ

#!/usr/local/bin/perl --

use strict;

&main(1);

sub main {
my($val) = @_;
my $magic = "?";
if ($val eq "1") {
my $magic = "hello!!";
}

print "$magic\n";
}

"hello!!" と出力したいのに、 "?" と出力されます。
なぜでしょうか?

今日、上のような不具合ではまりました。
実際は複雑な処理を行っていて、処理の不具合かと思って調査したのだけど、
当然まったく解決しなくて、30分後にこんな初歩的な間違いに気づきました。

念のため答えも書いておきます。

続きを読む: Perlクイズ

2007年8月23日

ハッシュへ配列を追加・参照・削除する方法

  #追加
  push(@{$dataHash{$key}},"$value1,$value2,");  # %dataHashの$keyの配列の最後尾へ追加

#参照
$dataHash{$key}[0]; # %dataHashの$keyの配列の1つ目
$dataHash{$key}[1]; # %dataHashの$keyの配列の2つ目

#削除(shiftやpopを使ってもいいけど)
splice(@{$dataHash{$key}},0,1); # %dataHashの$keyの配列の1つ目
splice(@{$dataHash{$key}},1,1); # %dataHashの$keyの配列の2つ目

ハッシュへ配列を入れる方法はいままであまり使わなかったのだけど、
同じキーのデータが2つ以上ある場合のデータ加工に使うと便利ですね。

C言語のメモリリーク解析用に作成したPerlプログラムで、配列だけで
ごにょごにょしていたところにハッシュへ配列をセットする方法で
修正したら処理に5分かかっていたのが3秒になりました。

2007年7月 3日

Debian+Catalyst+Lighttpd+fastcgiのlighttpd.conf設定

Catalystで作成したアプリがmyapp_server.plでは動作するのに、
Lighttpd + fastcgiを利用した本環境で実行すると動作しない
件ではまりました。

どうもリクエストの内容に関わらずPATH_INFOが全て空になって
SCRIPT_NAMEで処理されていたのが原因ぽい?
環境はDebian。

http://lists.scsys.co.uk/pipermail/catalyst/2006-January/004579.html
を参考にさせていただき、以下の設定で動作するようになりました。

lighttpd.conf


server.modules = (
"mod_access",
"mod_alias",
"mod_accesslog",
"mod_rewrite",
"mod_setenv",
)

$HTTP["host"] == "myapp.example.com" {
    server.document-root = "/path/to/MyApp"

$HTTP["url"] =~ "^/" {
setenv.add-environment = ( "SCRIPT_NAME" => "/" )
}

url.rewrite-once = (
"^/((?:js/|css/|image/|static/).*)" => "/root/$1",
"^/(?!js/|css/|image/|static/)(.*)" => "/script/myapp_fastcgi.pl/$1"
)

fastcgi.server = (
"/script/myapp_fastcgi.pl" => (
"myapp" => (
"socket" => "/tmp/myapp.socket",
"bin-path" => "/path/to/MyApp/script/myapp_fastcgi.pl",
"min-procs" => 1,
"max-procs" => 1,
"idle-timeout" => 20,
)
)
)
}


2007年1月30日

ISBN-13・ASINのどちらのIDからでもAmazon Web Servicesからデータ取得を行う

<参考>
結城浩のはてな日記:Amazon Web Servicesを使ってISBN-13からASINを取得するPerlプログラム
http://d.hatena.ne.jp/hyuki/20070123#isbn

わくわくする情報をいつも提供してくださって感謝です。
会社の資産管理システムの書籍ISBNが13桁だったり10桁だったりしたので、
ISBN-13・ASINのどちらのIDからでもAmazonから情報を取得できるように少し変更してみました。

システムにAmazonからのデータ取得の機能を組み込んで、実行後にAmazonから
取得した書名・価格が更新されているのを確認して幸福感いっぱいです。
(書名がわりと不正確で価格も0円で登録されているデータが多かったので)

#!/usr/local/bin/perl

use strict;
use warnings;

use Encode;
use LWP::Simple;
use XML::Simple;
use URI;

my $aws_access_key_id = 'あなたのAWS Access Key Id';

# Set up ISBN.
my $itemId = '9784798111117'; # ISBN
# my $itemId = '4798111112'; #ASIN

$itemId =~ s/-//g;
#13桁未満はASINタイプ、13桁以上はISBNタイプとしてデータ取得
my $idType = '';
my $searchIndex = '';
if (length($itemId) < 13){
$idType = 'ASIN';
}
else{
$idType = 'ISBN';
$searchIndex = 'Books'
}

# Set up URL.
my $uri = URI->new('http://webservices.amazon.co.jp/onca/xml');
$uri->query_form(
Service => "AWSECommerceService",
AWSAccessKeyId => $aws_access_key_id,
Operation => "ItemLookup",
IdType => $idType,
ItemId => $itemId,
SearchIndex => $searchIndex,
ContentType => 'text/xml',
ResponseGroup => "Request,Medium",
Version => "2007-01-15",
);

# Retrieve result.
my $response_string = get($uri);
my $response_hashref = XMLin($response_string);

# Compose output string.
my $output = <<"EOD";
INPUT : $itemId
ASIN : $response_hashref->{Items}->{Item}->{ASIN}
Title : $response_hashref->{Items}->{Item}->{ItemAttributes}->{Title}
Author : $response_hashref->{Items}->{Item}->{ItemAttributes}->{Author}
Price : $response_hashref->{Items}->{Item}->{ItemAttributes}->{ListPrice}->{Amount}
EOD

# Print as string.
Encode::_utf8_off($output);
Encode::from_to($output, "utf8", "utf8");
print $output;

2007年1月16日

コリスOSの暖かい思い出

いままでWebアプリは、Windows環境でActivePerl+Apatch(AnHTTPd)で開発してきたのだけど、
使いたいPerlモジュールがインストールできなかったりで、環境作成に試行錯誤するのが大変に
なってきたので、coLinuxを使って、Windows上で動作するLinux環境での開発に移行中です。
LinuxのディストリビューションはDebianを選択しました。

仕事でも遊びでもOSはWindowsを使うのがほとんどだったのが、だんだんLinux系を使うことが
多くなってきて、覚える必要を感じていたのもあり、毎日が発見でよい感じです。


エディタはEmacsを使いつつ、今のところ使い慣れた秀丸で作業するほうが10倍ほど効率が
いいので、Sambaで共有をかけてWindows上から秀丸で編集して、Emacsは本を見ながら
ちょっとづつコマンドを覚えて、秀丸との作業効率の差を埋めていっているような感じ。


あとMVCの設計が独学の為、PerlフレームワークのCatalystで実際にWebアプリを作成してみて、
どういった設計でMVCを実現しているのかを勉強しています。
私の設計だとどうもMとCがあまり別れないXD
フレームワークは最初に掛かる学習コストに躊躇するけれど、慣れると効率良いですね。
その為にフレームワークはあるのだけど。


ちなみにcoLinux(コリナックス)の響きは、大好きなゲームのRoomania#203で主人公が
使っていたパソコンで動作していた架空上のOSの「コリスOS」を思い出して大変ほんわかします。

リスのマークがパッケージに描いてあって大変可愛いのです。
あとパソコンがらみのシナリオがこれまた泣けるのです。
コリスOSの壁紙をダウンロードして使っていたのだけど、PC切り替えの時に紛失してしまいました。

2006年12月20日

不必要なメモリ使用時の速度への影響

csvファイルからデータ検索するロジックで、
以下の2つのロジックにどれくらいの速度差がでるか試してみました。

・ロジック1(funcBigRead)
 csvの1行から全項目を取り出して検索キーとキー項目がヒットしたら出力
・ロジック2(funcSmallRead)
 csvの1行からキー項目だけ取り出して検索キーとキー項目がヒットしたら全項目を取り出して出力

・csvデータは日本郵政公社から全国一括郵便番号csv(121,684件)を拝借
・出力する検索キーは最終行の"9071801"

実行結果


s/iter funcBigRead funcSmallRead
funcBigRead 2.40 -- -53%
funcSmallRead 1.13 113% --

とうぜんロジック2の方がメモリ使用量も少なく速いだろうと予想していましたが、
ロジック2の方がロジック1に比べて2倍速い結果がでました。

データが多く、且つ最終行がヒットするという極端なシチュエーションとはいえ、
普段からロジック2を当然のように使えるようにしたいなぁ。
そしてお約束のように普段書いていたスクリプトはロジック1。

実行スクリプト


use strict;
use warnings;
use Benchmark qw(timethese cmpthese);

my $result = timethese(5,{
'funcBigRead' => 'funcBigRead',
'funcSmallRead' => 'funcSmallRead',
});
cmpthese($result);

sub funcBigRead{
my $keyZipCode = '"9071801"';
open(FILE,"< ./KEN_ALL.CSV") || die 'file open error.';
while (){
my ($id,$oldZipCode,$newZipCode,$prefectureNameKana,$townNameKana,$subNameKana,
$prefectureName,$townName,$subName) = split(/,/);
if ($keyZipCode eq $newZipCode) {
print "$prefectureName$townName\n";
last;
}
}
close(FILE);
}

sub funcSmallRead{
my $keyZipCode = '"9071801"';
open(FILE,"< ./KEN_ALL.CSV") || die 'file open error.';
while (){
my (undef,undef,$newZipCode) = split(/,/);
if ($keyZipCode eq $newZipCode) {
my ($id,$oldZipCode,$newZipCode,$prefectureNameKana,$townNameKana,$subNameKana,
$prefectureName,$townName,$subName) = split(/,/);
print "$prefectureName$townName\n";
last;
}
}
close(FILE);
}

#
#実行結果
#
#Benchmark: timing 5 iterations of funcBigRead, funcSmallRead...
#"沖縄県""八重山郡与那国町"
#"沖縄県""八重山郡与那国町"
#"沖縄県""八重山郡与那国町"
#"沖縄県""八重山郡与那国町"
#"沖縄県""八重山郡与那国町"
#funcBigRead: 12 wallclock secs (11.87 usr + 0.13 sys = 12.00 CPU) @ 0.42/s (n=5)
#"沖縄県""八重山郡与那国町"
#"沖縄県""八重山郡与那国町"
#"沖縄県""八重山郡与那国町"
#"沖縄県""八重山郡与那国町"
#"沖縄県""八重山郡与那国町"
#funcSmallRead: 6 wallclock secs ( 5.49 usr + 0.15 sys = 5.64 CPU) @ 0.89/s (n=5)
# s/iter funcBigRead funcSmallRead
#funcBigRead 2.40 -- -53%
#funcSmallRead 1.13 113% --
#

2006年12月19日

配列から取り出した変数に値をセットした時は、配列の値も変わる

配列から取り出した変数は出力する用途で使用することが多いので、
独学で動くスクリプトだけを書いている人は知らない人が多いと思われます。
私のことです。

曜日出力


use strict;
use warnings;

my @week = qw(Sun Mon Tue Wed Thu Fri Sat);
for my $outPutLine (@week){
print "$outPutLine\n";
}

#結果
#
#Sun
#Mon
#Tue
#Wed
#Thu
#Fri
#Sat
#

毎日が土曜日


use strict;
use warnings;

my @week = qw(Sun Mon Tue Wed Thu Fri Sat);
for my $line (@week){
$line = 'Sat'
}

for my $outPutLine (@week){
print "$outPutLine\n";
}

#結果
#
#Sat
#Sat
#Sat
#Sat
#Sat
#Sat
#Sat
#

これは


for my $outPutLine (@week){
print "$outPutLine\n";
}

こう書いたほうがよさそう?

print join "\n" , @week

2006年12月18日

変数はみんなのモノ。ただし汚れている可能性があります。

myを使用しない場合の不具合ではないけどよくない組み方


#use strict;
#use warnings;

&main;
sub main{
$testStr = 'Hello!!';
print "main:$testStr\n";
&func();
}

sub func{
print "func:$testStr\n";
}

$testStrがグローバル変数の扱いになってしまっています。
use strict;
を記述していれば、エラーがでます。
記述していない場合は、エラーがでずに実行できてしまいます。

言語を覚え始めた時からは
use strict;
use warnings;
を常につけるようにしていかないと、mod_perlとかで動作させた時に
変数が初期化されていなくて、とんでもない動きになるスクリプトや、
普段からメモリを余分に使ってしまうスクリプトを量産してしまう
ことになります。

人事のように書きつつ私のことです。

2006年12月17日

myは私だけのモノ

いままでPerlではとりあえず動くプログラムしか作成していなかったので
自習をはじめました。その時のメモを記載していきます。
自分理解で記述していて間違い・勘違いはあると思いますので、
気づかれたら指摘していただけると嬉しいです。

・出力したい内容
 main:Hello!!
 func:Hello!!
・$testStrの変数に文字列を代入して出力を行う。

良い使い方(と思われる組み方)


use strict;
use warnings;

&main;
sub main{
my $testStr = 'Hello!!';
print "$testStr\n";
&func($testStr);
}

sub func{
print "$_[0]\n";
}

悪い使い方(どちらかというと変数ではなく定数のような使い方)


use strict;
use warnings;

my $testStr = 'Hello!!';
&main;
sub main{
print "main:$testStr\n";
&func();
}

sub func{
print "func:$testStr\n";
}

不具合な使い方


use strict;
use warnings;

&main;
sub main{
my $testStr = 'Hello!!';
print "main:$testStr\n";
&func();
}

sub func{
no strict; #strictが効いていると以下はエラーになる為、意図的に無効
no warnings; #warningsが効いていると以下はエラーになる為、意図的に無効
print "func:$testStr\n";
}

#結果がこんな感じに
#
#main:Hello!!
#func:
#