ただダラ 0.1.0
あ〜あ、作っちゃったよ…。
tDiary Writer、略して「ただダラ」を作りました。はてダラからの派生です。
画像関係は恐らくやらないんじゃないかと…本文との依存性が高いですし。
tDiaryの場合、更新用CGIのURLが完全にカスタマイズ可能になっていて、スクリプト中に収めるのだと都合が悪そうなので設定ファイルで指定できるようにしてみました。
#!/usr/bin/perl
#
# hw.pl - tDiary Writer.
#
# Copyright (C) 2004 by Hahahaha.
# <rin_ne@big.or.jp>
# http://www20.big.or.jp/~rin_ne/
#
# Original:
#------------------------------------------------------------------
# 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.1.0";
use LWP::UserAgent;
use HTTP::Request::Common;
use File::Basename;
use Getopt::Std;
my $enable_encode = eval('use Encode; 1');
# Prototypes.
sub create_agent();
sub update_diary_entry($$$$$);
sub delete_diary_entry($);
sub create_it($$$);
sub post_it($$$$$);
sub get_timestamp();
sub print_debug(@);
sub print_message(@);
sub read_title_body($);
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 = '';
# Default file names.
my $touch_file = 'touch.txt';
my $config_file = 'config.txt';
my $target_file = '';
# 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 $http_proxy = '';
# Directory for "YYYY-MM-DD.txt".
my $txt_dir = ".";
# Client and server encodings.
my $client_encoding = '';
my $server_encoding = '';
# Your tDiary update CGI URL.
my $cgi_url = 'http://www.example.com/update.rb';
# Option for LWP::UserAgent.
my %ua_option = (
agent => "tDiaryWriter/$VERSION", # "Mozilla/5.0",
timeout => 180,
);
# Other variables.
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.
'f' => "", # "file" option.
'n' => "", # "config file" option.
);
$Getopt::Std::STANDARD_HELP_VERSION = 1;
getopts("du:p:a:T:f:n:", \%cmd_opt);
if ($cmd_opt{d}) {
print_debug("Debug flag on.");
print_debug("Cookie flag on.") if $cmd_opt{c};
print_debug("Trivial flag on.") if $cmd_opt{t};
&VERSION_MESSAGE();
}
# Override config file name (before load_config).
$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};
$ua_option{agent} = $cmd_opt{a} if $cmd_opt{a};
$ua_option{timeout} = $cmd_opt{T} if $cmd_opt{T};
$target_file = $cmd_opt{f} if $cmd_opt{f};
# Start.
&main;
# no-error exit.
exit(0);
# Main sequence.
sub main {
my $count = 0;
my @files;
# Setup file list.
if ($cmd_opt{f}) {
# Do not check timestamp.
push(@files, $cmd_opt{f});
print_debug("main: files: option -f: @files");
} else {
while (glob("$txt_dir/*.txt")) {
# Check timestamp.
next if (-e($touch_file) and (-M($_) > -M($touch_file)));
push(@files, $_);
}
print_debug("main: files: current dir ($txt_dir): @files");
}
# Process it.
for (@files) {
# Check file name.
next unless (/\b(\d\d\d\d)-(\d\d)-(\d\d)\.txt$/);
my ($year, $month, $day) = ($1, $2, $3);
my $date = $year . $month . $day;
# Check if it is a file.
next unless (-f $_);
# Read title and body.
my ($title, $body) = read_title_body($_);
# Update entry.
create_agent;
print_message("Post $year-$month-$day");
update_diary_entry($year, $month, $day, $title, $body);
print_message("Post OK.");
sleep(1);
$count++;
}
if ($count == 0) {
print_message("No files are posted.");
} else {
unless ($cmd_opt{f}) {
# Touch file.
open(FILE, "> $touch_file") or die "$!:$touch_file\n";
print FILE get_timestamp;
close(FILE);
}
}
}
# Login.
sub create_agent() {
$user_agent = LWP::UserAgent->new(%ua_option);
$user_agent->env_proxy;
if ($http_proxy) {
$user_agent->proxy('http', $http_proxy);
print_debug("login: proxy: $http_proxy");
}
# Ask username if not set.
unless ($username) {
print "Username: ";
chomp($username = <STDIN>);
}
# Ask password if not set.
unless ($password) {
print "Password: ";
chomp($password = <STDIN>);
}
}
# Update entry.
sub update_diary_entry($$$$$) {
my ($year, $month, $day, $title, $body) = @_;
my $post_retry = 0;
my $ok = 0;
POST_RETRY:
while ($post_retry < 2) {
# Post.
$ok = post_it($year, $month, $day, $title, $body);
last if ($ok);
print_debug("update_diary_entry: POST_RETRY.");
print_message("Retry.");
$post_retry++;
}
if (not $ok) {
error_exit("update_diary_entry: post: Check username/password.");
}
}
sub post_it($$$$$) {
my ($year, $month, $day, $title, $body) = @_;
print_debug("post_it: $year-$month-$day.");
my $req =
HTTP::Request::Common::POST("$cgi_url",
Content => [
replace => "replace",
old => $year . $month . $day,
year => scalar($year),
month => sprintf("%d", $month),
day => sprintf("%d", $day),
title => $title,
# Important:
# This entry must already exist.
body => $body
]
);
$req->authorization_basic($username, $password);
my $r = $user_agent->simple_request($req);
print_debug("post_it: " . $r->status_line);
# print_debug("RESP: ". $r->as_string);
# Check the result.
if ($r->is_success) {
print_debug("post_it: returns 1 (OK).");
return 1;
} else {
print_debug("post_it: returns 0 (ERROR).");
return 0;
}
}
# Get "YYYYMMDDhhmmss" for now.
sub get_timestamp() {
my (@week) = qw(Sun Mon Tue Wed Thu Fri Sat);
my ($sec, $min, $hour, $day, $mon, $year, $weekday) = localtime(time);
$year += 1900;
$mon++;
$mon = "0$mon" if $mon < 10;
$day = "0$day" if $day < 10;
$hour = "0$hour" if $hour < 10;
$min = "0$min" if $min < 10;
$sec = "0$sec" if $sec < 10;
$weekday = $week[$weekday];
return "$year$mon$day$hour$min$sec";
}
# Show version message. This is called by getopts.
sub VERSION_MESSAGE {
print <<"EOD";
tDiary Writer Version $VERSION
Copyright (C) 2004 by Hahahaha.
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";
exit(1);
}
# Read title and body.
sub read_title_body($) {
my ($file) = @_;
# Execute filter command, if any.
my $input = $file;
if ($filter_command) {
$input = sprintf("$filter_command |", $file);
}
print_debug("read_title_body: input: $input");
if (not open(FILE, $input)) {
error_exit("$!:$input");
}
my $title = <FILE>; # first line.
chomp($title);
my $body = join('', <FILE>); # rest of all.
close(FILE);
# Convert encodings.
if ($enable_encode and ($client_encoding ne $server_encoding)) {
print_debug("Convert from $client_encoding to $server_encoding.");
Encode::from_to($title, $client_encoding, $server_encoding);
Encode::from_to($body, $client_encoding, $server_encoding);
}
return($title, $body);
}
# 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.
-f filename File. Send only this file without checking timestamp.
-M Do NOT replace *t* with current time.
-n config_file Config file. Default value is $config_file.
Config file example:
#
# $config_file
#
id:yourid
password:yourpassword
cgi_url:http://example.com/tdiary/update.rb
# txt_dir:/usr/yourid/diary
# touch:/usr/yourid/diary/hw.touch
# proxy:http://www.example.com:8080/
# g:yourgroup
# client_encoding:Shift_JIS
# server_encoding:UTF-8
## for Unix, if Encode module is not available.
# 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 (/^password:(.*)$/) {
$password = $1;
print_debug("load_config: password:********");
} elsif (/^cgi_url:(.*)$/) {
$cgi_url = $1;
print_debug("load_config: cgi_url:$cgi_url");
} elsif (/^proxy:(.*)$/) {
$http_proxy = $1;
print_debug("load_config: proxy:$http_proxy");
} elsif (/^client_encoding:(.*)$/) {
$client_encoding = $1;
print_debug("load_config: client_encoding:$client_encoding");
} elsif (/^server_encoding:(.*)$/) {
$server_encoding = $1;
print_debug("load_config: server_encoding:$server_encoding");
} elsif (/^filter:(.*)$/) {
$filter_command = $1;
print_debug("load_config: filter:$filter_command");
} elsif (/^txt_dir:(.*)$/) {
$txt_dir = glob($1);
print_debug("load_config: txt_dir:$txt_dir");
} elsif (/^touch:(.*)$/) {
$touch_file = glob($1);
print_debug("load_config: touch:$touch_file");
} else {
error_exit("Unknown option '$_' in $config_file.");
}
}
close(CONF);
}設定ファイルはこんな感じ。
id:hoge password:fuga cgi_url:http://example.com/tdiary/update.rb txt_dir:/usr/yourid/diary touch:/usr/yourid/diary/tw.touch proxy:http://www.example.com:8080/ client_encoding:Shift_JIS server_encoding:EUC-JP ## for Unix, if Encode module is not available. # filter:iconv -f euc-jp -t utf-8 %s
ただダラはあとで自分の日記の方へも持っていきます。
