はてなへの書き込み

d:id:tamura70:20091123:hatena で紹介したはてなへの書き込み用Perlスクリプト h-assemble.pl を少し改良し，再帰的なincludeにも対応するようにした．

リンク

• はてダラ
• http://d.hatena.ne.jp/tamura70/20091123/hatena
• http://d.hatena.ne.jp/tamura70/20091227/fotolife

使い方

• xxx-20YY-MM-DD.txt 等のファイルをまとめて，20YY-MM-DD.txt が作成される．
  • 20YY-MM-DD.txt のタイムスタンプがxxx-20YY-MM-DD.txt 等および includeされるファイルよりも新しければ作成しない．
• <include "ファイル名"> と記述すれば，ファイルを挿入できる．
• 先頭に空白文字がある行は，空白を取り除いて前の行に連結される．
  • ただし空白文字の直後が英数字の場合は，空白を残す．
• 「>##」のみの行があれば，行連結しないモードになる．「##<」のみの行があれば，行連結するモードに戻る．
  • 入れ子になっていても大丈夫なはず．
• d:id:tamura70:20091227:fotolife のスクリプトによる画像アップロードにも対応．

20YY-MM-DD.txt が作成されたら，「はてダラ」を使ってアップロードすれば良い．

h-assemble.pl

#!/usr/bin/perl
use strict;
use Getopt::Std;
use Jcode;
use IO::File;

use vars qw($opt_s $opt_o $opt_c $opt_p $opt_q);
&getopts("s:o:c:p:q:");

my $source = $opt_s || "txt";
my $output = $opt_o || "output";
my $encode = $opt_c || "euc";
my $pretag0 = $opt_p || ">##";
my $pretag1 = $opt_q || "##<";

my $line = "";
my $pre = 0;
&assemble_diaries();
exit 0;

sub assemble_diaries {
    my %diaries = ();
    foreach my $file (<$source/*.txt>) {
	if ($file !~ /\b((\d\d\d\d)-(\d\d)-(\d\d)).*?\.txt$/) {
	    next;
	}
	my ($date, $y, $m, $d) = ($1, $2, $3, $4);
	@_ = localtime();
	if (&compare_date($y, $m, $d, $_[5]+1900, $_[4]+1, $_[3]) > 0) {
	    print "$file skipped\n";
	    next;
	}
	my @d = ();
	if ($diaries{$date}) {
	    @d = @{$diaries{$date}};
	}
	push(@d, $file);
	$diaries{$date} = \@d;
    }
    foreach my $date (sort keys %diaries) {
	my $out = "$output/$date.txt";
	&assemble_diary($date, $out, @{$diaries{$date}});
    }
}

sub assemble_diary {
    my ($date, $out, @files) = @_;
    my $mtime_out = &mtime($out);
    my $modified = 0;
    foreach my $file (@files) {
	if (&newer_in($file, $mtime_out)) {
	    $modified = 1;
	    last;
	}
    }
    if ($modified) {
	print "$out <-- ", join(" ", @files), "\n";
	open(OUT, ">", $out) || die "$0: $out $!";
	foreach my $file (@files) {
	    my $in = new IO::File;
	    open($in, "<", $file) || die "$0: $file $!";
	    $line = "";
	    $pre = 0;
	    while (<$in>) {
		chomp;
		&assemble_line($_);
	    }
	    &assemble_line("");
	    close($in);
	}
	close(OUT);
    }
}

sub assemble_line {
    my ($str) = @_;
    if ($str =~ /^\s*<(include|source)\s+(src=)?["']?(.*?)["']?>\s*$/) {
	my $incfile = $3;
	my $in = new IO::File;
	open($in, "<", $incfile) || die "$0: $incfile $!";
	while (<$in>) {
	    chomp;
	    &assemble_line($_);
	}
	close($in);
    } elsif ($str =~ /^\s*<(image)\s+(src=)?["']?(.*?)["']?(\s+size=["']?(.*?)["']?)?>\s*$/) {
	my $fotofile = $3;
	my $size = $5;
	my $infofile = $fotofile;
	$infofile =~ s/\.\w+$/.txt/;
	my %info = &load_info($infofile);
	$_ = $info{"hatena"};
	if (! $_) {
	    die "$0: not uploaded $fotofile";
	}
	if ($size) {
	    $_ = "$_:$size";
	}
	&process_line("[$_]");
    } else {
	if ($str =~ /\[[^\]]+\]\*/) {
	    $str =~ s/\[([^\]]+?)(:title=[^\]]+)\]\*/\[\1\2\] \[\1:bookmark\]/g;
	    $str =~ s/\[([^\]]+?)\]\*/\[\1] \[\1:bookmark\]/g;
	}
	&process_line($str);
    }
}

sub process_line {
    my ($str) = @_;
    &Jcode::convert(\$str, $encode, undef);
    if ($str eq $pretag0) {
	print OUT $line;
	if ($pre > 0) {
	    print OUT "$str\n";
	}
	$line = "";
	$pre++;
    } elsif ($str eq $pretag1) {
	$pre--;
	if ($pre > 0) {
	    print OUT "$str\n";
	}
    } elsif ($pre) {
	print OUT "$str\n";
    } else {
	if ($str =~ /^\s+/) {
	    if ($str !~ /^\s+\w/) {
		$str =~ s/^\s+//;
	    }
	    if ($line) {
		chomp($line);
	    }
	    $line .= "$str\n";
	} else {
	    print OUT $line;
	    $line = "$str\n";
	}
    }
}

sub newer_in {
    my ($file, $mtime0) = @_;
    if (&mtime($file) > $mtime0) {
	return 1;
    }
    my $in = new IO::File;
    open($in, "<", $file) || die "$0: $file $!";
    while (<$in>) {
	chomp;
	if (/^\s*<(include|source)\s+(src=)?["']?(.*?)["']?>\s*$/) {
	    my $include = $3;
	    if (&newer_in($include, $mtime0)) {
		close($in);
		return 1;
	    }
	}
    }
    close($in);
    return 0;
}

sub compare_date {
    my ($y1, $m1, $d1, $y2, $m2, $d2) = @_;
    if ($y1 != $y2) {
	return $y1 <=> $y2;
    }
    if ($m1 != $m2) {
	return $m1 <=> $m2;
    }
    return $d1 <=> $d2;
}

sub mtime {
    my ($file) = @_;
    my @stat = stat($file);
    my $mtime = $stat[9];
    return $mtime;
}

sub load_info {
    my ($infofile) = @_;
    my %info = ();
    if (-e $infofile) {
	my $in = new IO::File;
	open($in, "<", $infofile) || die "$0: $infofile $!";
	while (<$in>) {
	    chomp;
	    my ($tag, $value) = split(/\t/);
	    $info{$tag} = $value;
	}
	close($in);
    }
    return %info;
}