First Weblog: Perl アーカイブ

2005年10月05日

リスト値をハッシュに変換する

my ($v, %h);
foreach (@_) {
if (! $v) {$h{"$_"} = ""; $v = $_;}
else {$h{"$v"} = $_; $v = "";}
}

2004年12月29日

AUサイトで cgi-lib.pl を使う時の注意

cgi-lib.pl をつかって携帯電話AUの次世代機(WAP2.0対応)EZwebだと以下のようなエラーが出る。

----------------------------------------
cgi-lib.pl:Unknown Content-type:
application/x-www-form-urlencoded;charset=shift_jis
----------------------------------------

2005年1月現在の最新バージョン（Version 2.18）の場合 82行目で
$type eq 'application/x-www-form-urlencoded') {
となっているところを、
$type =~ m#application/x-www-form-urlencoded#) {
に変更する。

The cgi-lib.pl Home Page

投稿者 mkomu : 09:37 | コメント (0) | トラックバック

2004年12月08日

perlでEXCELファイル作成

PerlでEXCELファイルを作れるモジュールを発見しました。

"Spreadsheet-WriteExcel"

2004年12月8日現在の最新バージョン2.11ではUNICODE対応とかで日本語がうまく表示できなかったので少し前のバージョンを試してみました。
バージョン0.43（2004年4月27日）
http://search.cpan.org/~jmcnamara/Spreadsheet-WriteExcel-0.43/

このバージョンだとそのままS-JISが使えるので楽ちんです。

日本語の説明はこちらが詳しいです。
http://homepage3.nifty.com/hippo2000/perltips/Spreadsheet/WriteExcel.htm

作ったプログラムの中で SUM関数を使いたかったのですが、A1記法で設定する方法しか思いつきませんでした。
（本当は R2C4 とかいう風に設定できたら楽かなと思った）

そこで「行-列記法」から「A1記法」に変更するサブルーチンを作りました。
sub R2C { my @abc = ("A","B","C","D","E","F","G","H","I","J","K","L","M","N","O","P","Q","R","S","T","U","V","W","X","Y","Z",""); my $row = $_[0]; my $col = $_[1]; my $row_abs = ''; my $col_abs = $_[3]; if ($row) { $row++; $row_abs = $_[2]; } return $col_abs . $abc[int ($col / 26) - 1] . $abc[$col % 26] . $row_abs . $row; } 使い方 $worksheet1->write($retu, $gyou, "=SUM(" . &R2C(2,$gyou) . ":" . &R2C($retu -1,$gyou) . ")");

参考になれば。。。

投稿者 mkomu : 14:15 | コメント (0) | トラックバック

2004年09月19日

クッキーの内容のみを取得する

sub get_cookie {
my $ecookie;
my $del = '(domain|path|expires|secure)';
my @cookie = split (/; /, shift);
foreach (@cookie) {
my ($k,@v) = split /=/;
if ($k !~ m/$del/i && @v) {$ecookie .= "$_; ";}
}
return $ecookie;
}

使い方例
$COOKIE = &get_cookie($COOKIE);}

ヘッダリストの中からクッキーのみを取出し値のみを取得
while ($_ = shift @headers) {
if (m/set-cookie/i) {$COOKIE .= &get_cookie(shift @headers);}
}

投稿者 mkomu : 07:29 | コメント (0) | トラックバック

2004年09月18日

配列から余計な値を取り除く方法

（画像名が入っているファイルより gif jpg jpeg を取り除く）
@img = grep (! /\.(gif|jpg|jpeg)$/, @img);

投稿者 mkomu : 11:20 | コメント (0) | トラックバック

2004年09月11日

配列の要素数をキーにしたハッシュを作る

%data = map {$i++ => $_} @data;

（例）
----------------------------------------------
#!/usr/bin/perl

$data = "abc0,abc1,abc2,,abc4,";
%data = map {$i++ => $_} (split /,/, $data);

foreach $key (keys %data) {
print "$key => $data{$key}
\n";
}
-----------------------------------------------

（出力結果）
-----------------------------------------------
0 => abc0
1 => abc1
2 => abc2
3 =>
4 => abc4
-----------------------------------------------

問題点：値が空でもキーが出来てしまう

投稿者 mkomu : 20:12 | コメント (0) | トラックバック

2004年09月07日

cgi-lib.pl を使って改行もあるCSVファイルを受け取って表示するサンプル

大崎さんの「perlメモ」を参考にさせて頂きました。

HTMLファイル -------------------------------------------------- <table border=1><form action="csv.cgi" ENCTYPE="multipart/form-data" METHOD="POST"> <tr><td>アップするファイル</td><td><input type=file name=file size=50></td></tr> <tr><th colspan=2><input type=submit name=kind value="ファイル送信"></th></tr> </form></table><p> perlプログラム -------------------------------------------------- #!/usr/bin/perl require 'cgi-lib.pl'; &ReadParse; # 必要があればファイル名を取得 foreach (@in) { if (/(.*)filename=(.*)/i) {$fname=$2;} } $fname =~ tr/\"\x0D\x0A//d; @file = split /\n/, $in{'file'}; print "Content-type: text/html\n\n"; print "<table border>\n"; while (my $line = shift @file) { while ($line =~ tr/"// % 2) {$line .= shift @file;} $line =~ s/(?:\x0D\x0A|[\x0D\x0A])?$/,/; @values = map {/^"(.*)"$/ ? scalar($_ = $1, s/""/"/g, $_) : $_} ($line =~ /("[^"]*(?:""[^"]*)*"|[^,]*),/g); print "<tr>"; foreach (@values) { # 改行コードを削除する。 tr/\x0D\x0A//d; print "<td>$_</td>"; } print "</tr>\n"; } print "</table>\n";

【バグ】
改行コードがラインフィールド（LF)のみの時改行のみの行が途中にあるとそれ以降のデータは読み込みされない。
（それほどある事ではないのでとりあえずそのまま）

投稿者 mkomu : 07:07 | コメント (0) | トラックバック

2004年08月02日

サーバ間でミラーリングFTPをするプログラム

投稿者 mkomu : 23:19 | コメント (0) | トラックバック

日付のフォーマット

@time = localtime;

$time = sprintf ("%04d/%02d/%02d %02d:%02d:%02d",
$time[5] + 1900,$time[4] + 1,$time[3],$time[2],$time[1],$time[0]);

------------------------------------------------------------------------------
cookie での expires (GMTで出力)

（例）2時間後を指定の場合
@gmt = split (/ /, gmtime(time + 2 * 60 * 60));
$gmtime = "$gmt[0], $gmt[2]-$gmt[1]-$gmt[4] $gmt[3] GMT";

cookie のフォーマットで日にちが１桁の場合エラーになる。
以下のように変更

@gmt = split (/ +/, gmtime(time + 2 * 60 * 60));

投稿者 mkomu : 23:16 | コメント (0) | トラックバック

CSVファイルを読み込んで２次元配列に代入する。

$i = 0;
open IN, "sample.csv";
while (<IN>) {
   my @data = ();
   @data = split (/,/);
   # 二次元配列
   for (0..@data) {$jdata[$i][$_] = "$data[$_]";}
   $i++;
}
close IN;

投稿者 mkomu : 20:35 | コメント (0) | トラックバック

2004年07月20日

逆順にソート

文字列を逆順にソートする。
メールアドレスをドメインごとに振り分けるときなど便利！

#!/usr/bin/perl

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

@list = ('order@abc.com','aaa@xyz.com','info@abc.com');

foreach (sort {(reverse $a) cmp (reverse $b)} @list) {
print "$_
\n";
}

単にメールアドレスをドメインごとに集めるのならこの方が良いかも、

foreach (sort {(split /@/, $a)[1] cmp (split /@/, $b)[1]} @list) {
print "$_
\n";
}

投稿者 mkomu : 11:11 | コメント (0) | トラックバック

2004年07月15日

CSVファイルで先頭の値をキーにしてデータベースに登録する。

投稿者 mkomu : 00:00 | コメント (0) | トラックバック

標準モジュール File::Find を使ってディレクトリーのツリー表示する

投稿者 mkomu : 00:00 | コメント (0) | トラックバック

特定の文字列をその文字数分別の任意の文字に変更する

$maildata =~ s/(ID:\d+)/&ast($1)/ge;
sub ast {
for (1..(length $_[0])) {$astsuu .= "*";}
return $astsuu;
}

投稿者 mkomu : 00:00 | コメント (0) | トラックバック

特定の日付の曜日を知る

（例）2003-6-23
use Time::Local;
($yy,$mm,$dd) = split (/-/, $kigen);
$wday = (qw(日月火水木金土)) [(localtime(&timelocal(0, 0, 0, $dd, $mm - 1, $yy)))[6]];
$kigen = "$yy年$mm月$dd日（$wday）";

投稿者 mkomu : 00:00 | コメント (0) | トラックバック

ファイルのタイムスタンプを取得する。

@time = localtime(time - ((-M "$file_name") * 24 * 60 * 60));
$time = sprintf ("%04d/%02d/%02d",$time[5] + 1900,$time[4] + 1,$time[3]);

これだと日にちまでしか取れないので時分秒を取得する場合は以下のようにする。

@time = localtime((stat TEXT)[9]);
$time = sprintf ("%04d/%02d/%02d %02d:%02d:%02d",$time[5] + 1900,$time[4] + 1,$time[3],$time[2],$time[1],$time[0]) ;

投稿者 mkomu : 00:00 | コメント (0) | トラックバック

インストールされているモジュールの一覧を取得

#!/usr/bin/perl -- $INC = join (" ", @INC); @PM = `find $INC -type f -name *.pm`; print "Content-type: text/html\n\n"; print join ("<br>", @PM);

投稿者 mkomu : 00:00 | コメント (0) | トラックバック

Net-FTP を使ってファイルのみの一覧を取得して GET する

投稿者 mkomu : 00:00 | コメント (0) | トラックバック

ファイルをCGIからダウンロードする方法

print "Content-type: application/octet-stream;\n";
print "Content-Disposition: attachment; filename=\"$file_name\"\n\n";

open(LOCK,"lockfile");
flock(LOCK,2);
open TEXT, "/virtual/anonymous/$file_name";
while () {
# アスキーモードの時は改行コードを勝手に変えられてしまうので再度変更する
if ($in{'fname'} =~ /\.txt$/) {s/\n/\r\n/;}
print "$_";
}
close(TEXT);
flock(LOCK,8);
close(LOCK);

投稿者 mkomu : 00:00 | コメント (0) | トラックバック

サブルーチンでスカラーの変数を変更する

$aaa = &kaigyo($aaa);

sub kaigyo {
$_[0] =~ s/\n//g;
return $_[0];
}

投稿者 mkomu : 00:00 | コメント (0) | トラックバック

正規表現の変わりに index を使う方法

（検索エンジンなどでEUCを使わない方法）
if ($sdata[$i] && $data[$i] !~ /$sdata[$i]/) {next LOOP;}
if ($sdata[$i] && (index $data[$i], $sdata[$i]) == -1) {next LOOP;}

投稿者 mkomu : 00:00 | コメント (0) | トラックバック

メールアドレスのみを取得

sub extract_address {
my ($from) = @_;
if ($from =~ /.*<(.+)>/) {return $1;} # From: Foo Bar <foobar@com.edu>
elsif ($from =~ s/\s*$.*$//) {return $from;} # From: foobar@com.edu (Foo Bar)
else {return $from;} # From: foobar@com.edu [I hope]
}

投稿者 mkomu : 00:00 | コメント (0) | トラックバック

毎月５の付く日に何かする

if ((split //, (localtime())[3])[-1] == 5) {
# 処理 ( 5のところの数字を変えるといつでもOK)
}

投稿者 mkomu : 00:00 | コメント (0) | トラックバック

ソケットモジュールを使ってPOST送信する。

投稿者 mkomu : 00:00 | コメント (0) | トラックバック

ループ制御

LOOP: foreach $k (sort {$a <=> $b} keys (%DATA)) {
for $i (0..(@sdata - 1)) {
if ($DATA{"$k"} !~ /$sdata[$i]/) {next LOOP;}
}
# ヒットしたものだけ表示
print "$k => $DATA{$k}";
}
}

投稿者 mkomu : 00:00 | コメント (0) | トラックバック