戯術者の日記

少なくとも子プロセスの pid はわかってるはずだから、プロセスグループ ID を取得して、kill する。

$pgrp = getpgrp $chld_pid;
kill -9, $pgrp;

kill の第一引数は、送りたいシグナル番号。

かなりドンくさいけどテストコード

if ($pid[0] = fork) {
  # oya;
  local $SIG{INT} = sub {
    my $pgrp = getpgrp $pid[0];
    print "pgrp: ", $pgrp, "\n";
    print "catch ", shift, " (oya)\n";
    kill -15, $pgrp;
    exit;
  };
  &loop;
}
elsif (defined $pid[0]) {

  if ($pid[1] = fork) {
    # ko
    local $SIG{TERM} = $SIG{HUP} = sub {
      print "catch ", shift, " (ko)\n";
      exit;
    };
    &loop;
  }
  elsif (defined $pid[1]) {

    local $SIG{CHLD} = 'IGNORE';

    if ($pid[2] = fork) {
      # mago
      local $SIG{TERM} = $SIG{HUP} = sub {
        print "catch ", shift, " (mago)\n";
        exit;
      };
      &loop;
    }
    elsif (defined $pid[2]) {
      # himago
      local $SIG{TERM} = $SIG{HUP} = sub {
        print "catch ", shift, " (himago)\n";
        exit;
        };
      &loop;
    }
  }
}

sub loop {
  while (1) {
    print "sleep ";
    sleep 1;
  }
}

kill にシグナル名を与えられないのは微妙に使いにくいかな??

実行

% ./test.pl
sleep sleep sleep sleep ^Cpgrp: 7060
catch INT (oya)
catch TERM (himago)
catch TERM (mago)
catch TERM (ko)
zsh: terminated  ./test.pl

というわけで試作。Perl 5.8+ 用。shift_jis -> eucjp 固定

#!/usr/bin/perl

use Encode qw(from_to);
use File::Find;

my $basedir = shift;
-d $basedir or die "Usage $0 dir\n";

find( sub {
        my $target = $_;
        sj2e($target) if -f $target;
      },
      $basedir);

find( sub {
        my $target = $_;
        sj2e($target) if -d $target;
      },
      $basedir);

sub sj2e {
  my $from = shift;
  my $to = $from;
  from_to($to, "shiftjis", "euc-jp");
  rename($from, $to) ? print "renamed: ", $File::Find::name, "\n" :
    print "renamed failed: ", $File::Find::name, "\n";
}

なんか、ムダに長いなぁ。ってか、1パスで動作させた方がスマートかも。
ascii のみのファイル/ディレクトリの場合は、同じファイル名への rename のため失敗するが、仕様です :p

#!/usr/bin/perl

use POSIX;

my $fmt = shift;
if ($fmt =~ m#(\d{4})/(\d{2})/(\d{2})-(\d{2}):(\d{2}):(\d{2})#) {
  print strftime "%a, %d-%b-%Y %H:%M:%S\n", $6, $5, $4, $3, $2 - 1, $1 - 1900;
}
elsif (not defined $fmt) {
  print strftime "%a, %d-%b-%Y %H:%M:%S\n", localtime;
}
else {
  print "Invalid format\n";
  print "$0 YYYY/mm/dd-HH:MM:ss\n";
}

実行

$ cookiefmt 2005/08/10-16:17:11
Wed, 10-Aug-2005 16:17:11

だからナニ? って感じだけど^^;

Pkg::method($arg1, $arg2);

とすれば、sub method での $_[0] は $arg1, $_[1] は $arg2

Pkg->methoc($arg1, $arg2);

とすれば、sub method での $_[0] は "Pkg", $_[1] は $arg1, $_[2] は $arg2 になる。

OOP 形式のコードじゃない場合は、前者で実行するか EXPORT しておくのが無難

m/[ -~]/

0x20(スペース)から0x7e(チルダ)まで。
0x20未満のハードタブ(0x09)や改行(0x0A)は個別に対処せよ。
0x7F(DEL)はいらねーよな。

あぁ、grep でも使える

$ command | grep -v '[ -~]'

asciiを含まない行を出力

$ command | grep '[^ -~]'

ascii以外を含む行を出力

lv(v.4.50, v.4.51)の正規表現検索は、スペースを範囲に含めると overcrossing range と出力されて効かないので、0x21の!から指定する

/[^ !-~]

ascii以外(タブなど除く)を含む行を出力

less(351, 358)は [ -~]で大丈夫なんだけどなぁ。意外にも more も大丈夫だ。

[2005-06-14-2]でカテゴリ名を RSS フィードに表示するようにしたけど、カテゴリの数が多いと(こんな使い方余りいない??)、Firefox のライブブックマークでの非表示部分が多くなってしまう。
ので、記述しているカテゴリ名のうち、最後の1個だけを表示するように修正

前回の状態からは

--- chalow.20050706     2005-06-29 19:40:01.000000000 +0900
+++ chalow      2005-07-06 17:55:49.000000000 +0900
@@ -1102,7 +1102,7 @@

            push @items, {
                permlink => $permlink,
-               itemheader => html2xmlstr("[".join("][", @{$all_entries{$ymd}{$i}{cat}})."]".$all_entries{$ymd}{$i}{h}),
+               itemheader => html2xmlstr("[" . $all_entries{$ymd}{$i}{cat}[$#{$all_entries{$ymd}{$i}{cat}}] . "]" . $all_entries{$ymd}{$i}{h}),
                itemauthor => $all_entries{$ymd}{$i}{a},
                itemcontent => $cont,
                itemcontentencoded => $coen,

てな感じで。

スゲー見にくいけど、要は

$array[$#array]

で、配列最後の要素をとってるだけ。
先頭がよければ、0 で良い(未確認)

ま、これは簡単か

--- chalow.20050030     Fri Jun 24 23:51:11 2005
+++ chalow      Thu Jun 30 00:04:47 2005
@@ -1185,7 +1185,7 @@
     return if ($output_cat_pages == 0 and $cat_page_cgi eq "");

     my @lines = ();
-    foreach my $cat (sort keys %category_count) {
+    foreach my $cat (sort { lc $a cmp lc $b } keys %category_count) {
        my $n = $category_count{$cat};
 #    foreach my $cat (sort keys %category_item) {
 #      my $n = scalar(@{$category_item{$cat}});

久々に呪文(?)作成

my %count = ();
foreach (map {$_->[1]} sort {$a->[0] <=> $b->[0]} grep { $count{$_->[0]} > 1 } grep { ++$count{$_->[0]} } map { [$hash{$_}, $_] } keys %hash) {
  printf "%s\t%d\n", $_, $hash{$_};
}

もっと短くならないものだろうか… ^^;

メールを送るのに便利な Mail::Sender だけど、ポートの指定ができない(25/tcp固定)ので、オブジェクトの作成時にポート指定できるようにするパッチ。

--- Sender.pm.org       2005-06-27 10:43:24.000000000 +0900
+++ Sender.pm   2005-06-27 10:43:24.000000000 +0900
@@ -811,7 +811,6 @@
        delete $self->{'_buffer'};
        $self->{'debug'} = 0;
        $self->{'proto'} = (getprotobyname('tcp'))[2];
-       $self->{'port'} = getservbyname('smtp', 'tcp')||25 if not defined $self->{'port'};
 
        $self->{'boundary'} = 'Message-Boundary-by-Mail-Sender-'.time();
        $self->{'multipart'} = 'mixed'; # default is multipart/mixed
@@ -838,6 +837,8 @@
                }
        }
 
+       $self->{'port'} = getservbyname('smtp', 'tcp')||25 if not defined $self->{'port'};
+
        $self->{'fromaddr'} = $self->{'from'};
        $self->{'replyaddr'} = $self->{'reply'};

まぁ、単純に、$self->{'port'} のセット位置を変更するだけなんだけど。

@array = map { "foobar" } (1..1000);

他にいい方法ないかな…

[2005-06-13-2]の続き。
sub write_rss_file の itemheader にタイトル名を突っ込む箇所に、同じように、カテゴリ名も含ませる

--- chalow.org     2005-06-13 18:00:26.000000000 +0900
+++ chalow      2005-06-14 12:55:53.000000000 +0900
@@ -1102,7 +1102,7 @@

            push @items, {
                permlink => $permlink,
-               itemheader => html2xmlstr($all_entries{$ymd}{$i}{h}),
+               itemheader => html2xmlstr("[".join("][", @{$all_entries{$ymd}{$i}{cat}})."]".$all_entries{$ymd}{$i}{h}),
                itemauthor => $all_entries{$ymd}{$i}{a},
                itemcontent => $cont,
                itemcontentencoded => $coen,

って、まだ www.jp-z.jp のには反映してないんだけど。

sub write_latest_item_list_file の部分。
$all_entries{$ymd}{$i}{cat} に、カテゴリ文字列の入った配列のリファレンスがあるんで、これをくっつければいい。

foreach my $i (sort {$b <=> $a} keys %{$all_entries{$ymd}}) {
  next if ($i !~ /^\d/);
    my ($ym) = ($ymd =~ /^(\d{4}-\d\d)-\d\d/);
    my $c = $all_entries{$ymd}{$i}{h};
    $c =~ s/[\t\n]//g;
    $c =~ s/\s\s+/ /g;
    [...]
    $c = $c . "[" . join("][", @{$all_entries{$ymd}{$i}{cat}}) . "]";    # <= ココ

[2005-06-03-1] のやつ。
まず、CGI でファイルアップローダ(chlogup.cgi)をテキトーに作成

#!/usr/bin/perl
use CGI;
my $cgi = new CGI;
my $updata = $cgi->param('file');
my $chfile = "ChangeLog";

print $cgi->header('text/plain');

unless (open F, "> $chfile") {
  print "open error $chfile: $!\n";
  exit 1;
}
while (<$updata>) {
  print F;
}
close F;

print "exec chalow start\n";
print `/foo/bar/exec.sh 2>&1`;
print "exec chalow done\n";

で、ChangeLog をさくらへ up し、chalow を実行するシェルスクリプト(exec.sh)を作成

#!/bin/sh

/bin/cat ChangeLog | /usr/bin/ssh -i sshの鍵 username@sakura 'cat | env PERL5LIB=local/chalow/ local/chalow/chalow -c local/chalow/cl.conf -o www/changelog -'

CGI を呼ぶ HTML もテキトーに。

<html>
<body>
<form action="chlogup.cgi" method="post" enctype="multipart/form-data">
<input type="file" name="file">
<input type="submit">
</form>
</body>
</html>

さくらのサーバ上の ~/local/chalow 以下に chalow があるのが前提。

あとは、https でアクセスできるサーバにおいて、BASIC認証なりなんなりで制限すればいい(httpsなんでBASIC認証で十分でしょ)

Foo::Bar を入れたい

# apt-cache search Foo::Bar
(説明に Foo::Bar が含まれるパッケージが出力
# apt-get install libfoo-bar-perl
(インストール)

大抵は、libXXX-XXX-perl というパッケージ名になってる

[2005-04-18-1] から chalow を使い始めたけど、ジツは使っていた ChangeLog のフォーマットとあってなかった。私が書いてたフォーマット

YYYY-mm-dd  name <mailaddr>

	* category1 category2...: title1
	内容...
	
	* category1 ...: title2
	内容...

を html にしたかったけど、設定修正のみだと対応できなかった。

で、ChangeLogReader.pm を修正

--- ChangeLogReader.pm.org	2005-06-04 23:41:10.578203100 +0900
+++ ChangeLogReader.pm	2005-06-04 23:42:36.772143900 +0900
@@ -91,28 +91,24 @@
     # item header - case 2: "* AAA:\n"
     # item header - case 3: "* AAA: BBB\n"
     # item header - case 4: "* AAA\n"
-    my ($rest) = ($ih =~ s/:(\s.*)$/:/s) ? $1 : ""; # for case 1,2,3
-    $rest =~ s/^ +//;
-    my $cont = $rest.join("", @$linesp);
-    if ($ih =~ /^p:/) { # Ignoring private items
-	return;
-    } elsif ($ih =~ /^(message-top|message-bottom):/) {	# pragma items
-	$entp->{$1} = $rest.$cont;
-	return;
-    }
 
-    # item ID : Y in XXXX-XX-XX-Y
-    $entp->{curid}++;
+    my $cont = join "", @$linesp;
 
     # Processing item header
     # # If 1st line doesn't have ": ", it will become item header.
     my @cat;
-#    $ih =~ s/(:|\s+)$//g;
-    $ih =~ s/(:|\s*)$//sg;	# Triming trailing spaces and ":"
-#    print "[[[[$ih]]]\n";
-    if ($ih =~ s/\s*\[(.+)\]$//) { # category
-	@cat = split(/\s*\]\s*\[\s*/, $1);
+
+    if ($ih =~ s/^([^:]+):\s*//) { # category
+      @cat = split(/\s+/, $1);
     }
+    $ih =~ s/\x0D?\x0A?$//;
+
+    if (grep /^(p|work)$/, @cat) {
+      return;
+    }
+
+    # item ID : Y in XXXX-XX-XX-Y
+    $entp->{curid}++;
 
     # Processing item content
     $cont =~ s/^( {8}| {0,7}\t)//gsm; 

ChangeLogReader.pm と同じディレクトリで上のファイルを置いて

% patch < ChangeLogReader.pm.patch

ちなみに、個人的な事情により、p と work の2つのカテゴリを非表示にしてます。p はプライベートなメモ、work は仕事な話をメモってるんで公開できない:p

+    if (grep /^(p|work)$/, @cat) {
+      return;

この部分ね

pipe(READ, WRITE);
select((select(WRITE), $|=1)[0]);

if ($pid = fork) {
  close WRITE;
  while (<READ>) {
    print;
  }
  exit;
}
elsif (defined $pid) {
  print WRITE "foo\n";
  print WRITE "bar\n";
  print WRITE "baz\n";
  exit;
}

まぁ、単純化してこんな感じ
バッファのフラッシュはしておかないと、反応が鈍い。

…あれ? Perl はしばらく書かなかったんじゃ??＞自分

(いや、チョー基本的なことなんだろうケド)
char* の中身に % が含まれていたときに意図した動きをしない。

…あ、Perl もだ。printf なんてほとんど使わないから気づかんかった。

Pathologically Eclectic Rubbish Liste
病的折衷主義ガラクタ出力装置
という説も

$ perl -MCPAN -e shell

初回起動時は、インストールするパスやキャッシュ、各プログラムのパス(gzip, tar, make, lynx その他)、make のオプション、proxy などの設定。基本的にデフォで OK
設定は ~/.cpan 以下に保存

で

$ perl -MCPAN -e shell
cpan>

で、

cpan> install HTML::Template

とかで、サクっとインストールできる。

1をセットすると、parseデータをメモリ上に保持する。デフォルトでは解析結果
のうちbody部(本文やマルチパートの添付ファイル)は即時ディスクに書き出し。
(perldoc では、巨大ファイルが添付された場合などでちょっとriskyとさ)