前のエントリ/次のエントリにタイトル付加
2011-02-06-3 / カテゴリ: [perl][chalow] / [permlink]

アイテム毎ページの次へ/前へに、そのタイトルをつける。
--- chalow.20110206	2011-01-23 16:42:29.715835927 +0900
+++ chalow	2011-02-06 03:59:16.342571765 +0900
@@ -763,15 +763,21 @@
    my $ymdi_before;
    my $ymdi_after;
+	    my $before_title;
+	    my $after_title;
    if ($i > 1) {
	$ymdi_before = $ymd."-".($i-1);
+		$before_title = $ent->{$i-1}->{ho};
    } elsif ($idx < @day_list - 1) {
	my $day_b = $day_list[$idx + 1];
	$ymdi_before = $day_b."-".$cl->{all}->{$day_b}{curid};
+		$before_title = $cl->{all}->{$day_b}->{$cl->{all}->{$day_b}{curid}}->{ho};
    }
    if ($i != $ent->{curid}) {
	$ymdi_after = $ymd."-".($i+1);
+		$after_title = $ent->{$i+1}->{ho};
    } elsif ($idx > 0) {
	my $day_a = $day_list[$idx - 1];
	$ymdi_after = $day_a."-1";
+		$after_title = $cl->{all}->{$day_a}->{1}->{ho};
    }
 
@@ -794,4 +800,6 @@
    $t->param(back => $ymdi_before);
    $t->param(next => $ymdi_after);
+	    $t->param(back_title => $before_title);
+	    $t->param(next_title => $after_title);
 
    my $ccc = $item->{c}; $ccc =~ s!^<br />!!g;# ad hoc
現在の処理対象アイテムのタイトル取得は
$t->param(header_text => $item->{ho};
にあるので、特定のアイテムのタイトルは
$cl->{all}->{"YYYYmmdd"}->{x}->{ho};
で取れる。

テンプレ例
--- cl.conf.20110206	2011-01-23 16:42:37.523566691 +0900
+++ cl.conf	2011-02-06 03:58:01.367043689 +0900
@@ -362,6 +362,6 @@
 <div id="content">
 <p class="calendar"><a href="<TMPL_VAR name=ym>.html"><TMPL_VAR name=ym></a> / <a href="<TMPL_VAR name=ymd>.html"><TMPL_VAR name=ymd></a></p>
-<TMPL_IF name=back><a href="<TMPL_VAR name=back>.html">前のエントリ</a> / </TMPL_IF>
-<TMPL_IF name=next><a href="<TMPL_VAR name=next>.html">次のエントリ</a></TMPL_IF>
+<TMPL_IF name=back><a href="<TMPL_VAR name=back>.html">前のエントリ(<TMPL_VAR name=back_title>)</a> / </TMPL_IF>
+<TMPL_IF name=next><a href="<TMPL_VAR name=next>.html">次のエントリ(<TMPL_VAR name=next_title>)</a></TMPL_IF>
 <!-- start:<TMPL_VAR name=ymdi> -->
 <div class="day">

PKCS#5パディングでAES暗号化/復号
2011-01-25-1 / カテゴリ: [暗号][perl] / [permlink]

メモってたつもりが書いてなかったので今更シリーズ

続きを読む
Referrer (Inside): [2011-01-25-2]

itemページのタイトルにカテゴリ表示
2011-01-23-3 / カテゴリ: [perl][chalow] / [permlink]

今まで「エントリ」と書いてたけど、chalow的にはitemだったなう。
itemごとのページ(YYYYmmdd-x.html)のhtmlタイトルに、カテゴリを表示してみた。
--- chalow.20110123	2011-01-22 22:56:41.727087965 +0900
+++ chalow	2011-01-23 16:42:29.715835927 +0900
@@ -749,6 +749,7 @@
 
 	    ### カテゴリ
 	    my $catstr = make_cat_link_html($ent->{$i}{cat});
+	    my $dispcat = "[".join("][", @{$ent->{$i}{cat}})."]";
 
 	    ### 日付リンクによるリファラー
 	    my @inside_refs = get_inside_ref("$ymdi");
@@ -799,6 +800,7 @@
 	    #$t->param(header => $item->{h});
 	    $t->param(header => qq(<a href="@{[datestr2url($ymdi)]}">).$item->{h}."</a>");
 	    $t->param(cat => $catstr);
+	    $t->param(dispcat => $dispcat);
 	    $t->param(author => $item->{a});
 	    $t->param(referrer => join(" ", @inside_refs));
 	    $t->param(id => $item_id); # 200101011
それ用の変数を見つけられなかったのでwrite_item_page()内で、テンプレート用の $dispcat を新しく作成。
あとは、テンプレート側からdispcatを呼び出せばOK
--- cl.conf.20110123	2011-01-23 02:19:18.367193474 +0900
+++ cl.conf	2011-01-23 16:42:37.523566691 +0900
@@ -345,7 +345,7 @@
 $tmpl_starthtml
 <head>
 $tmpl_header
-<title><TMPL_VAR name=header_text> | <TMPL_VAR name=cl_name></title>
+<title><TMPL_VAR name=header_text> / <TMPL_VAR name=dispcat> | <TMPL_VAR name=cl_name></title>
 </head>
 <!-- ================== ITEM_PAGE_TEMPLATE ================= -->
 <body>

そろそろchalowもsvnに突っ込むか…

SyntaxHighlighter用に[src]の言語指定可能改造
2011-01-23-2 / カテゴリ: [perl][chalow] / [permlink]

--- chalow.20110122	2011-01-22 22:41:33.635539221 +0900
+++ chalow	2011-01-22 22:56:41.727087965 +0900
@@ -1296,6 +1296,7 @@
 my %escaped_string;
 my $num_of_escaped_src;
 my %escaped_src;
+my %escaped_src_type;
 my $num_of_escaped_plugin;
 my %escaped_plugin;
 
@@ -1315,8 +1316,9 @@
 
     ### ソースエスケープ - "&" や "<" などを置換し pre を付ける
     $num_of_escaped_src = 0;
-    $$strp =~ s!\[src\](.*?)\[/src\]!
-	$escaped_src{++$num_of_escaped_src} = $1,
+    $$strp =~ s!\[src(\s\w+)?\](.*?)\[/src\]!
+	$escaped_src{++$num_of_escaped_src} = $2,
+	$escaped_src_type{$num_of_escaped_src} = $1,
 	$escaped_src{$num_of_escaped_src} =~ s/&/&amp;/g,
 	$escaped_src{$num_of_escaped_src} =~ s/</&lt;/g,
 	$escaped_src{$num_of_escaped_src} =~ s/>/&gt;/g,
@@ -1336,7 +1338,7 @@
     $$strp =~ s|\x7\x13(\d+)\x3|eval($escaped_plugin{$1})|ge;
     ### ソースアンエスケープ - pre 追加
     # todo(SyntaxHilighter)
-    $$strp =~ s|\x6\x13(\d+)\x3|<pre class="brush:plain;">$escaped_src{$1}</pre>|g;
+    $$strp =~ s|\x6\x13(\d+)\x3|"<pre class=\"brush:".(length $escaped_src_type{$1}? $escaped_src_type{$1}: "plain").";\">$escaped_src{$1}</pre>"|eg;
     # <p>は使ってないので
     #$$strp =~ s|\x6\x13(\d+)\x3|</p><pre>$escaped_src{$1}</pre><p>|g;
     ### HTML アンエスケープ
こんな感じで。

んで、Changelogの方は
(src)
コード
(/src)
となってるのを
(src perl)
コード
(/src)
とか書けばオーケー
※ ()は実際は[]

まぁ簡単にいっちゃえば、/ foo/ があれば brush:foo、無ければ brush:plain に置換するための保持用変数とコードを追加。
というか、既存Changelogへの自動種別追記なんかできないから、全部手作業で追記したぞ(笑)

このエントリまで含めた時点での統計

全ソース指定
% grep "^.\[src" ChangeLog | wc -l
915

手作業で言語指定
% grep "^.\[src " ChangeLog | sed -e "s/[][]//g" | awk '{print $2}' |lv | wc -l
218

言語指定ランキング
% grep "^.\[src " ChangeLog | sed -e "s/[][]//g" | awk '{print $2}' |lv | sort | uniq -c | sort -r
    102 perl
     64 cpp
     19 bash
     13 xml
     12 diff
      5 js
      2 html
      1 java

やっぱperl多いな。cpp(というかC)が意外な多さだ。
というか、コマンド実行とかconfigが大半だったから、全体からすれば少ないけど。

あと、lispスタイルも欲しかったな…

というか、sed/awk/sort/uniq使ったの何年ぶりだろ。
Referrer (Inside): [2011-06-16-1]

レジストリの参照/更新
2010-02-01-1 / カテゴリ: [programming][win][perl] / [permlink]

Win32::Registryを使う
use Win32::Registry;

my $tips;
$::HKEY_CURRENT_USER->Open('Software\\zzz', $tips)
  or die "cannot open registry";

サブキーの取得
regeditで言えば、左部ツリーの'HKEY_CURRENT_USER/Software/zzz'以下のサブキーのリストが取れる
my @subkeys;
$tips->GetKeys(\@subkeys);

キーの名前・データの取得
my %vals;
$tips->GetValues(\%vals);
%vals にはarrayrefのハッシュが入る。
キーの名前 => [ キーの名前, 型, キーのデータ]

キーの更新(なければ新しく作られる)
$tips->SetValueEx(キーの名前, 0, 型, キーのデータ);

終了
$tips->Close();

型は、見た感じ
文字列1
バイナリ3
DWORD4
複数行テキスト7
みたい。

ActivePerlなら、html/lib/Win32/Registry.html あたりにドキュメントあるのでそっち参考。
ちょっと情報量少ないけど…。
よくわからなければ、Dumper で見れば問題ない :p

クリップボードのテキストをコマンドラインperlで変換
2010-01-31-1 / カテゴリ: [cygwin][perl] / [permlink]

  • /usr/bin/getclip
クリップボードの中身をstdoutへ出力する。
cygutilsパッケージに含まれる。

  • /usr/bin/putclip
stdinをクリップボードへコピーする。
cygutilsパッケージに含まれる。

これらとperl(-e によるコマンドライン実行)をパイプで組み合わせれば、「エディタの置換機能じゃちょっと困難だけど、スクリプトにするまでもない変換」なんかをサクサク実行。

例: 開いているエクセルの特定部分をコピーしたデータ(tab区切り)をpukiwikiの表形式に変換
% getclip | perl -ple 's/^|[,\r]/|/g' | putclip
入力
入力エクセル
出力
|ID|曲名|アーティスト|ファイルサイズ|再生時間|再生回数|
|4863|私の時間|初音ミク|6412945|266919|1024|
|4879|SUPER HATSUNE BEAT vol.1|初音ミク|4613135|575373|919|
|4917|SING&SMILE LONG ver.|初音ミク|1809195|223869|919|
|5081|ぴんぽんだっしゅ!|初音ミク|2188842|136097|954|
|5133|みくみくにしてあげる♪|初音ミク|1198334|99134|940|
|5149|ラジカルペイント|初音ミク|1572383|97567|984|
|5193|教えて!! 魔法のLyric|初音ミク|2070128|257619|952|
|5257|電脳スキル|初音ミク|3157470|196832|866|
|5267|魔法少女ラジカルペイント(Long Ver)|初音ミク|1838250|228649|885|
|5691|とらいあんぐる☆Girl's Heart|初音ミク|3608040|180035|1091|

例が適当すぎるだろ…

-p はこっち
スクリプトでがっつり変換するならこちら。=> [2006-03-08-3]

今更だけどFizzBuzz問題(正規表現で)
2010-01-06-1 / カテゴリ: [programming][正規表現][perl] / [permlink]

更にPerlネタ

昨日([2010-01-05-1])に引き続き他人の日記をこっそり覗き見しているとFizzBuzz問題のPerlのコードを発見
2年位前に結構盛り上がってたみたいだけど、何故かリアルタイム参戦してなかったので、ちょっとやってみた。

が、何のヒネリも入らなかった。
perl -le 'print (($_%15==0)?"FizzBuzz":($_%3==0)?"Fizz":($_%5==0)?"Buzz":$_) for (1..100)'

んで、件のエントリに
剰余を使うな

とかありました
とあったし、ワンライナーは出尽くしてるっぽいので、剰余禁止(ついでに乗除算禁止、変換テーブル禁止)で、Perl使いらしく正規表現(キャプチャ禁止)でマニアックに実装してみた。
(ググったらそのものズバリな正規表現でFizzBuzzは見つかったけど、手持ちスキルはPerl5.8止まりなのでよくわからんかったorz <- 何がPerl使いだ>自分)

#!/usr/bin/perl -l
for (1..100) {
  s/(?<=[50])$/Buzz/;
  for (($a = $_) =~ s/\D*//g; $a !~ /^.$/; $a =~ s/(\d)(\d)/$1+$2/eg){}
  s/(?=$|\D)/Fizz/ if $a =~ /[369]/;
  s/\d+(?=\D)//;
  print;
}

とりあえず解説。
処理の流れ: 5倍数時は"数字Buzz"に置換、3倍数時は"数字Fizz"に置換、最後に数字以外が付加されていれば数字を削除して出力する。先に5を処理してるのは "5か0 + (非数字があるか空)" のパターンでキャプチャ不使用で末尾にBuzzを付加するパターン置換がどうしてもできなかったからorz

  • 1行目: シェバングは -l 付き。print; 単体で手抜き出力させるため:p
  • 2-8行目: 1から100までループ
  • 3行目: 「5の倍数は1桁目が0か5」なので、末尾($)が5or0([50])の場合に、数字部分を残して((?<=))末尾のみをBuzzに置換。数字は3の倍数判定に使用するので消さない。
  • 4行目: 「3の倍数は各桁の数字の和が3で割り切れる」ので、各桁の和を求める処理を1桁になるまで繰り返して3or6or9なら3の倍数ってことで、4行目のfor()の初期処理で倍数判定処理用に一時変数に一旦コピー(これがかなり気に入らん)、ただし既に5の倍数時はBuzzが付加されているので、数字以外(\D*)はコピー後($a = $_)に消去(s///g)、継続条件式で1桁判定(length($a)!=1に置換え可)、更新式で"数数"を((\d)(\d))数+数($1+$2/e)に全部(g)置換(s///)する。
  • 5行目: 「元のループ変数($_)」を1桁になるまで求めた各桁の和($a)が3or6or9(/[369]/)だった場合のみ(if修飾子)置換。ただし5の処理で既にBuzzが付いてる場合があるので、次の文字((?=))が末尾か非数字($|\D)の位置を置換。
  • 6行目: この時点で、数字のみ or 数字+Fizz or 数字+Buzz or 数字+FizzBuzz になってるので、次の文字((?=))が非数字(\D)の数字全て(\d+)を消去(s///);
  • 7行目: 出力
てか、Perlって空処理の制御構文でもブレース省略できないのね。
Cだと
for (...);
ってできるけど。


あ、多分当時はCに毒されてPerlを忘れつつあったから、面倒がって流行に乗らなかったのかも。(2007年のprogrammingカテがCばっか…)

世界のナベアツ問題をワンライナーで
2010-01-05-1 / カテゴリ: [programming][perl] / [permlink]

ネタがないと言いつつ見つかってしまった。というか、2年ぶりくらいの戯術ネタ。

前の部署の同期がブログで「perlで世界のナベアツ問題」と題してコードを書いてたのをたまたま発見したけど、最後に、単に改行とインデントを削っただけのワンライナーを載せてるのでちょっと添削してみた

元(http://d.hatena.ne.jp/bata64/20080410/1207801849から引用)
perl -e 'foreach(1..40){if($_%8==0){print"$_ぅぅういえぇえあ\n";}elsif($_%3==0||$_=~/3/){print"$_っ!!\n";}else{print"$_\n";}}'

アレンジ後
perl -le 'print !($_%8)?"$_ぅぅういえぇえあ":(!($_%3) or /3/)?"$_っ!!":$_ for(1..40);'

一応解説
  • -lは、printなどで自動改行するためのオプションスイッチ(ぺるりめも書いてねぇ…)。
  • foreach でなく for なのは単にタイプ数の削減(Perlでは、forとforeachは同じ働きをする)、更に、ループブロックとして使用せず、文の修飾子として記述することで、ブレースを削除( expr if cond; の要領)。
  • 出力部分を print の引数に三項演算子を使用することで、1文に圧縮。
  • 剰余0の検知を比較演算子でなく、否定を使うことでなんとなくスマートに。(多分見にくくなってる)
  • 3のマッチングの $_ =~ の削除はセオリー通り
やっぱ1文で書いてこそのワンライナーだよねっ :D
ちなみに元の要件はチェックしてないのでアルゴリズム自体は知らん:p


chalowってリスト表記どうすんだっけ…


リスト対応したぜ [2011-06-13-1]
Referrer (Inside): [2010-01-06-1]

Text::Diff で差分抽出
2008-02-28-1 / カテゴリ: [programming][perl] / [permlink]

ファイル単位の比較なら/usr/bin/diffで済むけど、比較前にフィルタ通してごにょごにょした結果を比較したりして追加行・削除行・変更行を一覧にしてサクっと出したい、とか
続きを読む

Text::CHMでHTMLヘルプファイル(.chm)を展開する
2008-02-27-1 / カテゴリ: [programming][perl] / [permlink]

とあるSDKのマニュアルがchmファイルでのみ提供されていて、エディタのキーワード色変更設定用([2005-12-12-1])にAPIだけ抜き出したいとき、とか
続きを読む

ActivePerlのppmがGUIになってる
2008-02-26-1 / カテゴリ: [programming][perl] / [permlink]

ActivePerl 5.8.8の場合
ppmコマンドを使い慣れない私にはわかりやすい:)
続きを読む

Perl TK(2) プルダウンメニュー
2008-01-09-1 / カテゴリ: [programming][perl] / [permlink]

検索しても全然ないなぁと思ったら、別名の同機能(?)だった。
プルダウンメニュー(?)
my $mw = MainWindow->new;

$opt = $mw->Optionmenu(-variable=>\$val)->pack();
$opt->addOptions("item1","item2","item3");
これで、選択した項目が $val にセットされる。
リストに表示する文字列と値を別にしたい場合は
$opt = $mw->Optionmenu(-variable=>\$val,-textvariable=>\$txt)->pack();
$opt->addOptions([item1=>1],[item2=>2],[item3=>3]);
で、選択した項目名(item1,item2,item3)が $txt に、値(1,2,3)が $val にセットされる。

Perl TK
2007-12-20-1 / カテゴリ: [programming][perl] / [permlink]

VC連携用に小物をいろいろ作ったのでメモ
cygwin perl だと X が必要なので、ActivePerl の方が楽かも。5.8 で確認。標準モジュールのみでOK

ラベル・テキスト入力・ボタンを持つウィンドウの作成
PerlTk
続きを読む

postされた生データを取得する
2007-08-09-1 / カテゴリ: [CGI][perl] / [permlink]

use CGI;
my $q = new CGI;
my $buf = $q->param('POSTDATA');
でゲット。

ただし、メソッドがpostでかつ、リクエストヘッダの Content-type が application/x-www-form-urlencoded でも multipart/form-data でもないとき。
HANDLING NON-URLENCODED ARGUMENTS

加えて、Content-type リクエストヘッダがない場合も読めないっぽい。

結局、<STDIN> を読むのが手っ取り早いかな…

LWPでリクエストヘッダ付 Web アクセス(proxy込)
2007-07-26-1 / カテゴリ: [HTTP][perl] / [permlink]

use LWP::UserAgent;
use HTTP::Request;

my $ua = LWP::UserAgent->new;
my $req = HTTP::Request->new( GET => 'http://www.example.org/' );

$ua->agent("perl-wget");
$ua->proxy('http', 'http://proxy.example.org:8080');
$req->header( 'X-Header1' => 'hoge',
	      'X-Header2' => 'foobar',
	    );

my $res = $ua->request($req);

$res->as_string;         // レスポンス(ヘッダ+ボディ)は
$res->headers_as_string; // レスポンスヘッダ
$res->content;           // レスポンスボディ

GDで画像編集
2007-07-25-1 / カテゴリ: [perl] / [permlink]

BMP形式はGDで操作できないので、予めpngあたりに変換しておく。
続きを読む

cpanの接続先サーバの追加変更
2007-03-01-1 / カテゴリ: [perl] / [permlink]

Digest::HMAC_MD5 を入れようとしたら ftp.cpan.jp に繋がらない…?
というわけで設定変更

現在の設定の表示
$ perl -MCPAN -e shell

cpan> o conf urllist
    urllist
        http://ftp.cpan.jp/
Type 'o conf' to view configuration edit options
cpan>

URLの追加
cpan> o conf urllist push http://ftp.jaist.ac.jp/pub/lang/perl/CPAN/

cpan> o conf urllist
    urllist
        http://ftp.cpan.jp/
        http://ftp.jaist.ac.jp/pub/lang/perl/CPAN/
Type 'o conf' to view configuration edit options


cpan> o conf commit
commit: wrote /usr/lib/perl5/5.8/CPAN/Config.pm
削除は pop。最後に commit すること。

GD::Barcode::NW7でバーコード作成
2007-02-27-1 / カテゴリ: [perl] / [permlink]

[2006-12-12-1]の関連
GD::Barcode::QRCode を cpan でインストールしていれば一緒に入っているっぽい。
なければインストール(試してないけど多分こんな感じ)
cpan> install GD::Barcode::NW7

インタフェースは QRCode とまったく一緒。なので簡単に…(手抜き)
use GD::Barcode::NW7;

$data = '12121212';

binmode STDOUT;
print GD::Barcode::NW7->new($data)->plot->png;
出力をファイルに吐くとこんな感じ。
生成ファイル
デフォルトで下部に入力データ文字列が付加される。これを非表示にするには
print GD::Barcode::NW7->new($data)->plot(NoText=>1)->png;
高さの調節も同時にするには
print GD::Barcode::NW7->new($data)->plot(Height=>20, NoText=>1)->png;
で、ピクセル数を指定できる。
データ・スタートビット/ストップビットとして入力できる文字は、[0-9_$:/.+A-D]の20種。小文字の[a-d]は不可(newで失敗する)

Code39やらEAN8やらほかにもモジュールがあるけど、どれも同じインタフェースで使えるっぽい。

置換時に式を評価する
2007-02-09-3 / カテゴリ: [perl][正規表現] / [permlink]

/e で。割とよく使われてるはずだからサンプルだけ
C/C++ ソースの #ifdef を削る。
@define = qw/__DEBUG __WRITELOG/; # define を指定する

# $src にソースを丸ごとつっこむ

# #if-#endif
$src =~ s|^#if\s+(\w+)(.*?)^(#else(.*?))?^#endif|($1)?$2:$4|emsg;
# #ifdef-#endif
$src =~ s|^#ifdef\s+(\w+)(.*?)^(#else(.*?))?^#endif|(grep {$_ eq $1 } @define)?$2:$4|emsg;
# #ifndef-#endif
$src =~ s|^#ifndef\s+(\w+)(.*?)^(#else(.*?))?^#endif|(grep {$_ eq $1 } @define)?$4:$2|emsg;
/m で複数行マッチ、/s で . を改行にマッチさせる。
/m で複数行マッチ処理を行ってる場合、式の途中の ^ は改行直後の位置にマッチする。
else 節がない場合は $4 は空になるのでバッサリ削られる。
カテゴリ: perl / 1 2 3 4 5 次ページ

最終更新時間: 2013-05-02 16:12