Hatena::ブログ(Diary)

基本は根性ナシな日記 このページをアンテナに追加 RSSフィード

2004-08-25

こちらに書いてみる

はてなダイアリーをちゃんと使ったことがなかったので、これを機に書いてみる。

自分とこもはよWikiスタイルで書くように整備せな。今のままだといろいろとめんどい…。

はてなダイアリーライター 0.5.0 のパッチ

id:hyuki:20040825にて、はてダラのバージョンアップ報告があったので、昨日自サイトの日記にアップしたパッチを再度適用。あとエントリのロード機能ではtouch.txtを更新しないように修正。パッチは以下に貼り付けときます。

--- hw050.pl	Wed Aug 25 12:07:56 2004
+++ hw050p1.pl	Wed Aug 25 18:58:10 2004
@@ -15,7 +15,7 @@
 # modify it under the same terms as Perl itself.
 #
 use strict;
-my $VERSION = "0.5.0";
+my $VERSION = "0.5.0-patch1";
 
 use LWP::UserAgent;
 use HTTP::Request::Common;
@@ -23,11 +23,17 @@
 use File::Basename;
 use Getopt::Std;
 
+my $enable_encode = eval('use Encode; 1');
+
 # Prototypes.
 sub login();
 sub logout();
+sub update_mode();
+sub load_mode();
+sub load_diary_entry($$$);
 sub update_diary_entry($$$$$$);
 sub delete_diary_entry($);
+sub load_it($$$);
 sub create_it($$$);
 sub delete_it($);
 sub post_it($$$$$$);
@@ -58,6 +64,13 @@
 # where %s is filename, output is stdout.
 my $filter_command = '';
 
+# Proxy setting.
+my $httpproxy = '';
+
+# Encoding.
+my $c_code = 'euc-jp';
+my $s_code = 'euc-jp';
+
 my $hatena_url = 'http://d.hatena.ne.jp';
 
 my %ua_option = (
@@ -81,10 +94,12 @@
     'g' => "",  # "groupname" option.
     'f' => "",  # "file" option.
     'M' => 0,   # "no timestamp" flag.
+    'l' => "",  # "load" option.
+    'n' => "",  # "coNfig file" option.
 );
 
 $Getopt::Std::STANDARD_HELP_VERSION = 1;
-getopts("tdu:p:a:T:cg:f:M", \%cmd_opt);
+getopts("tdu:p:a:T:cg:f:Ml:n:", \%cmd_opt);
 
 if ($cmd_opt{d}) {
     print_debug("Debug flag on.");
@@ -93,6 +108,8 @@
     &VERSION_MESSAGE();
 }
 
+$config_file = $cmd_opt{n} if $cmd_opt{n};
+
 # Override global vars with config file.
 load_config() if -e($config_file);
 
@@ -117,6 +134,16 @@
 
 # Main sequence.
 sub main {
+    if($cmd_opt{l}) {
+        load_mode();
+    }
+    else {
+        update_mode();
+    }
+}
+
+# Update mode.
+sub update_mode() {
     my $count = 0;
     my @files;
 
@@ -189,10 +216,30 @@
     }
 }
 
+# Load mode
+sub load_mode() {
+
+    # Check -s option format.
+    error_exit("Illegal -l option format.") if $cmd_opt{l} !~ /(\d\d\d\d)-(\d\d)-(\d\d)/;
+    my ($year, $month, $day) = ($1, $2, $3);
+    
+    # Login if necessary.
+    login unless ($user_agent);
+
+    # Load
+    print_message("Load $year-$month-$day.");
+    load_diary_entry($year,$month,$day);
+    print_message("Load OK.");
+
+    # Logout if necessary.
+    logout if ($user_agent);
+}
+
 # Login.
 sub login() {
     $user_agent = LWP::UserAgent->new(%ua_option);
     $user_agent->env_proxy;
+    $user_agent->proxy( 'http', $httpproxy ) if $httpproxy;
 
     # Ask username if not set.
     unless ($username) {
@@ -276,6 +323,31 @@
     print_message("Logout OK.");
 }
 
+# Load entry.
+sub load_diary_entry($$$) {
+    my ($year, $month, $day) = @_;
+    my $load_retry = 0;
+    my $ok = 0;
+
+LOAD_RETRY:
+    while ($load_retry < 2) {
+        # Load.
+        $ok = load_it($year, $month, $day);
+        if ($ok or not $cmd_opt{c}) {
+            last;
+        }
+        print_debug("load_diary_entry: LOAD_RETRY.");
+        unlink($cookie_file);
+        print_message("Old cookie. Retry login.");
+        login();
+        $load_retry++;
+    }
+
+    if (not $ok) {
+        error_exit("load_diary_entry: get: Check username/password.");
+    }
+}
+
 # Update entry.
 sub update_diary_entry($$$$$$) {
     my ($year, $month, $day, $title, $body, $imgfile) = @_;
@@ -381,6 +453,70 @@
     }
 }
 
+# Load.
+sub load_it($$$) {
+    my ($year, $month, $day) = @_;
+
+    print_debug("load_it: $year-$month-$day.");
+
+    $user_agent->cookie_jar($cookie_jar);
+
+    my $r = $user_agent->simple_request(
+        HTTP::Request::Common::GET("$hatena_url/$username/edit?date=$year$month$day"));
+
+    print_debug("load_it: " . $r->status_line);
+
+    if (not $r->is_success()) {
+        error_exit("Load: Unexpected response: ", $r->status_line);
+    }
+
+    # Check entry exist.
+    $r->content =~ /<form method="post" action="\.\/edit" .*?>(.*<\/textarea>)/s;
+    my $form_data = $1;
+
+    $form_data =~ /<input type="hidden" name="date" value="(\d\d\d\d\d\d\d\d)">/;
+    my $resp_date = $1;
+
+    if($resp_date ne "$year$month$day") {
+        error_exit("Load: Not exist entry.");
+    }
+    
+    $form_data =~ /<input class="field" name="title" .*?value="(.*?)">/;
+    my $title = $1 . "\n";
+    $form_data =~ /<textarea .*?>(.*)<\/textarea>/s;
+    my $body = $1;
+    
+    if ($enable_encode and ($c_code ne $s_code)) {
+        Encode::from_to($title,$s_code,$c_code);
+        Encode::from_to($body,$s_code,$c_code);
+    }
+    # Save entry to file.
+    my $datename = "$year-$month-$day";
+    
+    # Check if file is exist.
+    if(-f "$datename.txt") {
+        my $bakext = 0;
+        while(-f "$datename.$bakext") {
+            $bakext++;
+        }
+        if (not rename("$datename.txt", "$datename.$bakext")) {
+            error_exit("$!:$datename.txt");
+        }
+    }
+    
+    if (not open(OUT, ">$datename.txt")) {
+        error_exit("$!:$datename.txt");
+    }
+    
+    print OUT $title;
+    print OUT $body;
+    close(OUT);
+    
+    print_debug("load_it: returns 1 (OK).");
+    return 1;
+}
+
+
 sub create_it($$$) {
     my ($year, $month, $day) = @_;
 
@@ -521,10 +657,12 @@
 # Read title and body.
 sub read_title_body($) {
     my ($file) = @_;
+    my $title;
+    my $body;
 
     # Execute filter command, if any.
     my $input = $file;
-    if ($filter_command) {
+    if ( (!$enable_encode) and $filter_command) {
         $input = sprintf("$filter_command |", $file);
     }
     print_debug("read_title_body: input: $input");
@@ -535,6 +673,11 @@
     chomp($title);
     my $body = join('', <FILE>); # rest of all.
     close(FILE);
+    
+    if($enable_encode and ($c_code ne $s_code)) {
+        Encode::from_to($title,$c_code,$s_code);
+        Encode::from_to($body,$c_code,$s_code);
+    }
     return($title, $body);
 }
 
@@ -601,6 +744,8 @@
     -g groupname    Groupname. Specify groupname.
     -f filename     File. Send only this file without checking timestamp.
     -M              Do NOT replace *t* with current time.
+    -l date         Load entry. Specify date.
+    -n conffile     Config file. Specify conffile.
 
 Config file example:
 #
@@ -610,6 +755,9 @@
 password:yourpassword
 cookie:cookie.txt
 # g:yourgroup
+# httpproxy:proxy
+# c_code:client_encoding
+# s_code:server_encoding
 ## for Unix.
 # filter:iconv -f euc-jp -t utf-8 %s
 EOD
@@ -640,6 +788,15 @@
         } elsif (/^filter:(.*)$/) {
             $filter_command = $1;
             print_debug("load_config: filter:$filter_command");
+        } elsif (/^proxy:(.*)$/) {
+            $httpproxy = $1;
+            print_debug("load_config: proxy:$httpproxy");
+        } elsif (/^c_code:(.*)$/) {
+            $c_code = $1;
+            print_debug("load_config: c_code:$c_code");
+        } elsif (/^s_code:(.*)$/) {
+            $s_code = $1;
+            print_debug("load_config: s_code:$s_code");
         } else {
             error_exit("Unknown option '$_' in $config_file.");
         }

あ〜っ、ほんとにperlは組むの楽だ…。本気でhatena-diary-modeのエンジンとして使っちゃおうかと考えてしまう。form-data形式のPOSTデータを構築するライブラリ作っててキレそうなんだもの…。

だれかAPEL/FLIM/SEMIをxyzzyに移植してやろうという猛者はいないものか…。

APEL/FLIM/SEMI

キーワードになってないのね…ちょっと意外。

はてダラに一部採用

id:hyuki:20040825にて、設定ファイルオプションが取り込まれることに。う〜んそっちよりもプロクシ設定のほうを取り込んでほしかったかな。今の環境がまさにそうなので(イントラネット内で、環境変数のユーザ設定が禁止されている)

エントリのロード機能は別プログラムに分離します。あとちょっとで完成。その名も「はてなダイアリーローダー」。はてダラのコードをかなりパクってます(って元々統合していたし、しょうがないよね)

ぐわっバグだっ

取り込まれるってことで今一度パッチ部分を確認してたら、バグ発見。よりにもよって取り込まれる機能のとこで…。

$config_file = $cmd_opt{n} if $cmd_opt{n};

は、load_config() を呼ぶ前においておかないといけないんでした。前回のパッチ作成の時にマージミスしていたようです。申し訳ないです…。

いじってて思った

このスクリプト、tDiaryでも使えそうだよなぁ…。画像のところはちょっと考えないといけないけど、基本的なところはそのままいけそう。…作るか?

なんてことはあとから考えたことで、一番初めに思いついたのは名前だった。

tDiary Writer、名づけて「ただダラ」(ひ〜たださんごめんなさ〜い)

はてなダイアリーローダー

てなわけで、出来ました。通称はやっぱり「はてダロ?」?(キザっぽいな)

はてダラのパッチでは実体参照のサニタイズをしていませんでした(バグですバグ)がこれはちゃんとやってます。

#!/usr/bin/perl
#
# hl.pl - Hatena Diary Loader.
#
# Copyright (C) 2004 by Hahahaha.
# <rin_ne@big.or.jp>
# http://www20.big.or.jp/~rin_ne/
#
#--------------
# Original: hw.pl - Hatena Diary Writer.
#
# Copyright (C) 2004 by Hiroshi Yuki.
# <hyuki@hyuki.com>
# http://www.hyuki.com/techinfo/hatena_diary_writer.html
#--------------
#
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

use strict;
my $VERSION = "0.3.0";

use LWP::UserAgent;
use HTTP::Request::Common;
use HTTP::Cookies;
use File::Basename;
use Getopt::Std;

my $enable_encode = eval('use Encode; 1');

# Prototypes.
sub login();
sub logout();
sub load_diary_entry($$$);
sub load_it($$$);
sub sanitize($);
sub print_debug(@);
sub print_message(@);
sub error_exit(@);
sub load_config();

# Hatena user id (if empty, I will ask you later).
my $username = '';
# Hatena password (if empty, I will ask you later).
my $password = '';
# Hatena group name (for hatena group user only).
my $groupname = '';

# Default file names.
my $cookie_file = 'cookie.txt';
my $config_file = 'config.txt';

# Filter command.
# e.g. 'iconv -f euc-jp -t utf-8 %s'
# where %s is filename, output is stdout.
my $filter_command = '';

# Proxy setting.
my $httpproxy = '';

# Encoding.
my $c_code = 'euc-jp';
my $s_code = 'euc-jp';

my $hatena_url = 'http://d.hatena.ne.jp';

my %ua_option = (
    agent => "HatenaDiaryLoader/$VERSION", # "Mozilla/5.0",
    timeout => 180,
);

my $cookie_jar;
my $user_agent;

# Handle command-line option.
my %cmd_opt = (
    'd' => 0,   # "debug" flag.
    'u' => "",  # "username" option.
    'p' => "",  # "password" option.
    'a' => "",  # "agent" option.
    'T' => "",  # "timeout" option.
    'c' => 0,   # "cookie" flag.
    'g' => "",  # "groupname" option.
    'n' => "",  # "coNfig file" option.
);

$Getopt::Std::STANDARD_HELP_VERSION = 1;
getopts("du:p:a:T:cg:n:", \%cmd_opt);

if ($cmd_opt{d}) {
    print_debug("Debug flag on.");
    print_debug("Cookie flag on.") if $cmd_opt{c};
    &VERSION_MESSAGE();
}

$config_file = $cmd_opt{n} if $cmd_opt{n};

# Override global vars with config file.
load_config() if -e($config_file);

# Override global vars with command-line options.
$username = $cmd_opt{u} if $cmd_opt{u};
$password = $cmd_opt{p} if $cmd_opt{p};
$groupname = $cmd_opt{g} if $cmd_opt{g};
$ua_option{agent} = $cmd_opt{a} if $cmd_opt{a};
$ua_option{timeout} = $cmd_opt{T} if $cmd_opt{T};

# Change $hatena_url to Hatena group URL if ($groupname is defined).
if ($groupname) {
    $hatena_url = "http://$groupname.g.hatena.ne.jp";
}

# Start.
&main;

# no-error exit.
exit(0);

# Main sequence.
sub main {

    # Check -s option format.
    error_exit("Illegal argument.") if $ARGV[0] !~ /(\d\d\d\d)-(\d\d)-(\d\d)/;
    my ($year, $month, $day) = ($1, $2, $3);

    # Login if necessary.
    login unless ($user_agent);

    # Load
    print_message("Load $year-$month-$day.");
    load_diary_entry($year,$month,$day);
    print_message("Load OK.");

    # Logout if necessary.
    logout if ($user_agent);
}

# Login.
sub login() {
    $user_agent = LWP::UserAgent->new(%ua_option);
    $user_agent->env_proxy;
    $user_agent->proxy( 'http', $httpproxy ) if $httpproxy;

    # Ask username if not set.
    unless ($username) {
        print "Username: ";
        chomp($username = <STDIN>);
    }

    # If "cookie" flag is on, and cookie file exists, do not login.
    if ($cmd_opt{c} and -e($cookie_file)) {
        print_debug("login: Loading cookie jar.");

        $cookie_jar = HTTP::Cookies->new;
        $cookie_jar->load($cookie_file);

        print_debug("login: \$cookie_jar = " . $cookie_jar->as_string);

        print_message("Skip login.");

        return;
    }

    # Ask password if not set.
    unless ($password) {
        print "Password: ";
        chomp($password = <STDIN>);
    }

    my %form;
    $form{key} = $username;
    $form{password} = $password;

    print_message("Login to Hatena as $form{key}.");

    my $r = $user_agent->simple_request(
        HTTP::Request::Common::POST("$hatena_url/login", \%form)
    );

    print_debug("login: " . $r->status_line);

    if (not $r->is_redirect) {
        error_exit("Login: Unexpected response: ", $r->status_line);
    }

    print_message("Login OK.");

    print_debug("login: Making cookie jar.");

    $cookie_jar = HTTP::Cookies->new;
    $cookie_jar->extract_cookies($r);
    $cookie_jar->save($cookie_file);

    print_debug("login: \$cookie_jar = " . $cookie_jar->as_string);
}

# Logout.
sub logout() {
    return unless $user_agent;

    # If "cookie" flag is on, and cookie file exists, do not logout.
    if ($cmd_opt{c} and -e($cookie_file)) {
        print_message("Skip logout.");
        return;
    }

    my %form;
    $form{key} = $username;
    $form{password} = $password;

    print_message("Logout from Hatena as $form{key}.");

    $user_agent->cookie_jar($cookie_jar);
    my $r = $user_agent->get("$hatena_url/logout");
    print_debug("logout: " . $r->status_line);

    if (not $r->is_redirect and not $r->is_success) {
        error_exit("Logout: Unexpected response: ", $r->status_line);
    }

    unlink($cookie_file);

    print_message("Logout OK.");
}

# Load entry.
sub load_diary_entry($$$) {
    my ($year, $month, $day) = @_;
    my $load_retry = 0;
    my $ok = 0;

LOAD_RETRY:
    while ($load_retry < 2) {
        # Load.
        $ok = load_it($year, $month, $day);
        if ($ok or not $cmd_opt{c}) {
            last;
        }
        print_debug("load_diary_entry: LOAD_RETRY.");
        unlink($cookie_file);
        print_message("Old cookie. Retry login.");
        login();
        $load_retry++;
    }

    if (not $ok) {
        error_exit("load_diary_entry: get: Check username/password.");
    }
}

# Load.
sub load_it($$$) {
    my ($year, $month, $day) = @_;

    print_debug("load_it: $year-$month-$day.");

    $user_agent->cookie_jar($cookie_jar);

    my $r = $user_agent->simple_request(
        HTTP::Request::Common::GET("$hatena_url/$username/edit?date=$year$month$day"));

    print_debug("load_it: " . $r->status_line);

    if (not $r->is_success()) {
        error_exit("Load: Unexpected response: ", $r->status_line);
    }

    # Check entry exist.
    $r->content =~ /<form .*?action="\.\/edit" .*?>(.*<\/textarea>)/s;
    my $form_data = $1;

    $form_data =~ /<input type="hidden" name="date" value="(\d\d\d\d\d\d\d\d)">/;
    my $resp_date = $1;

    if($resp_date ne "$year$month$day") {
        error_exit("Load: Not exist entry.");
    }
    
    # Get title and body.
    $form_data =~ /<input class="field" name="title" .*?value="(.*?)">/;
    my $title = $1 . "\n";
    $form_data =~ /<textarea .*?>(.*)<\/textarea>/s;
    my $body = $1;
    
    # Escape string.
    $title = sanitize($title);
    $body = sanitize($body);
    
    if ($enable_encode and ($c_code ne $s_code)) {
        Encode::from_to($title,$s_code,$c_code);
        Encode::from_to($body,$s_code,$c_code);
    }
    # Save entry to file.
    my $datename = "$year-$month-$day";
    
    # Check if file is exist.
    if(-f "$datename.txt") {
        my $bakext = 0;
        while(-f "$datename.$bakext") {
            $bakext++;
        }
        if (not rename("$datename.txt", "$datename.$bakext")) {
            error_exit("$!:$datename.txt");
        }
    }
    
    if (not open(OUT, ">$datename.txt")) {
        error_exit("$!:$datename.txt");
    }
    
    print OUT $title;
    print OUT $body;
    close(OUT);
    
    print_debug("load_it: returns 1 (OK).");
    return 1;
}

# Sanitize.
sub sanitize($) {
    my $str = $_[0];

    my @escape_string = (
        "&lt;<",
        "&gt;>",
        "&quot;\"",
        "&nbsp; ",
    );
    
    for(@escape_string) {
        my ($from, $to) = split(/;/);
        $str =~ s/$from;/$to/sg;
    }
    
    $str =~ s/&#(\d+);/chr($1)/seg;
    $str =~ s/&amp;/&/sg;
    
    return $str;
}

# Show version message. This is called by getopts.
sub VERSION_MESSAGE {
    print <<"EOD";
Hatena Diary Writer Version $VERSION
Copyright (C) 2004 by Hiroshi Yuki.
EOD
}

# Debug print.
sub print_debug(@) {
    if ($cmd_opt{d}) {
        print "DEBUG: ", @_, "\n";
    }
}

# Print message.
sub print_message(@) {
    print @_, "\n";
}

# Error exit.
sub error_exit(@) {
    print "ERROR: ", @_, "\n";
    unlink($cookie_file);
    exit(1);
}

# Show help message. This is called by getopts.
sub HELP_MESSAGE {
    print <<"EOD";

Usage: perl $0 [Options]

Options:
    --version       Show version.
    --help          Show this message.
    -d              Debug. Use this switch for verbose log.
    -u username     Username. Specify username.
    -p password     Password. Specify password.
    -a agent        User agent. Default value is HatenaDiaryWriter/$VERSION.
    -T seconds      Timeout. Default value is 180.
    -c              Cookie. Skip login/logout if $cookie_file exists.
    -g groupname    Groupname. Specify groupname.
    -n conffile     Config file. Specify conffile.

Config file example:
#
# File $config_file in current directory is used to configure hw.pl.
#
id:yourid
password:yourpassword
cookie:cookie.txt
# g:yourgroup
# httpproxy:proxy
# c_code:client_encoding
# s_code:server_encoding
## for Unix.
# filter:iconv -f euc-jp -t utf-8 %s
EOD
}

# Load config file.
sub load_config() {
    print_debug("Loading config file ($config_file).");
    if (not open(CONF, $config_file)) {
        error_exit("Can't open $config_file.");
    }
    while (<CONF>) {
        chomp;
        if (/^\#/) {
            # skip comments
        } elsif (/^id:([^:]+)$/) {
            $username = $1;
            print_debug("load_config: id:$username");
        } elsif (/^g:([^:]+)$/) {
            $groupname = $1;
            print_debug("load_config: g:$groupname");
        } elsif (/^password:(.*)$/) {
            $password = $1;
        } elsif (/^cookie:(.*)$/) {
            $cookie_file = glob($1);
            $cmd_opt{c} = 1; # If cookie file is specified, Assume '-c' is given.
            print_debug("load_config: cookie:$cookie_file");
        } elsif (/^filter:(.*)$/) {
            $filter_command = $1;
            print_debug("load_config: filter:$filter_command");
        } elsif (/^proxy:(.*)$/) {
            $httpproxy = $1;
            print_debug("load_config: proxy:$httpproxy");
        } elsif (/^client_encoding:(.*)$/) {
            $c_code = $1;
            print_debug("load_config: client_encoding:$c_code");
        } elsif (/^server_encoding:(.*)$/) {
            $s_code = $1;
            print_debug("load_config: server_encoding:$s_code");
        } else {
            error_exit("Unknown option '$_' in $config_file.");
        }
    }
    close(CONF);
}

さて、そろそろLispの世界に戻るか。

パッチ修正

バグがあったと書いたけど、だったら修正したパッチを出しなおせばいいじゃん…と先ほど気づくバカ。

というわけで、上のパッチは修正済みです。

はてダラバージョンアップ

id:hyuki:20040825にて、0.9.0が出ました。結城さんお疲れ様です。結局ほとんど取り込まれたみたいで…。

プロクシの動作試験ですが、ちょっとやってみます。

  • 環境
    • WindowsXP Professional
    • ActivePerl 5.8.4
    • proxy経由アクセス
  • 作業手順
    1. 拙作「はてダロ?」でこの日記をロード
    2. 取得した「2004-08-25.txt」に新規エントリ(今書いているこれ)を追加
    3. はてダラ」最新版で更新

この「はてダラバージョンアップ」のエントリが無事追加されれば、proxyの動作実験は成功です。

はてダロ?をちょこっと変更

あ、はてダラの設定ファイルオプションの名前が、パッチのと変わってる。これじゃconfig.txtを共用できないな。

ということで、上の「はてダロ?」をちょこっと修正して、0.2.0にしました。

メモリリーク?

今日は仕事が暇だったのでずっとはてダラをいじっていました(苦笑)

で、帰ろうとPCを落とそうとしたら…あれ?なんだかシャットダウンにえらく時間がかかるぞ。今日はヘンなソフト動かしてないし、ウイルスアラートもないんだけど…。

Windowsがこういう動作をする時に多いのが、起動中に動作させていたソフトが起こす大量のメモリリークなんですが、もしかするとActivePerlがその原因なのかも。あまり大事なマシンではてダラを使わない方がいいかもしれないです。

hyukihyuki 2004/08/25 20:23 ハハハハさん、いつもありがとうございます。はてダラバージョンアップしました(0.9.0)。結局ローダ以外は取り込みました…。proxyのテストをしていただけるとありがたいです。

Connection: close