Yet Another Small はてダラ暫定版 - 五十の手習い日記

まだまだテスト不足な上に、ソースもあまり綺麗じゃありませんが、とりあえず暫定版を作成してみました。
仕様を考えてから(11/19)、１０日以上たったのですが、なかなか時間が取れず、この程度しかできておりません(面目ない)。

Atompub::Client
XML::Atom::Entry

の2つのモジュールが必要です。

perl -MCPAN -e shell
install Atompub::Client
install XML::Atom::Entry

してください。そして、以下のソースを、仮にyanhw.plとして保存し、以下のようなconfig.txtファイルをそのディレクトリに置き、2012-12-01.txtを作成してみてください。

perl yanhw.pl 2012-12-01.txt

すれば、登録できます(保証できませんが・汗)。

ちなみに、2012-12-01.txtの1行目はタイトル行で「*」はいりません。送信後、ファイル内を書き換えるので、エディターで開いている場合は開き直してください。

config.txt

#
# はてなのユーザID（デフォルトは空）
id:chikkun530
#
# パスワード（デフォルトは空）
password:hogehoge
#
# ディレクトリ：YYYY-MM-DD.txtのファイルを置いておく場所（デフォルトは . ）
txt_dir:~/Dropbox/blog/gijutu
#
# タッチファイル：送信時に更新されるファイル（デフォルトは touch.txt）
touch:~/Dropbox/blog/gijutu/hw.touch
#
# HTTPプロキシー（デフォルトは空）
#proxy:http://www.example.com:8080/
#
# クライアント（ローカル）側の文字コード（デフォルトは空）
#client_encoding:Shift_JIS
#
# フィルタコマンド
#filter:iconv -f euc-jp -t utf-8 %s

yanhw.pl

use strict;
my $VERSION = "0.0.1";

use File::Basename;
use Getopt::Std;
use Atompub::Client;
use XML::Atom::Entry;
use utf8;
use FileHandle;
use Data::Dumper;#for dbug
my $enable_encode = eval('use Encode; 1');

# Prototypes.
sub login();
sub update_diary_entry($$$$$);
sub delete_diary_entry($);
sub doit_and_retry($$);
sub replace_image_name($);
sub replace_image_name_string($);
sub draft_it($$$$$);
sub insert_id($$);
sub delete_it($);
sub post_it($$$$$);
sub send_image();
sub get_timestamp();
sub print_debug(@);
sub print_message(@);
sub read_title_body($);
sub find_image_file($);
sub replace_timestamp($);
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 = '';

# AtomPub client
my $client = Atompub::Client->new;


# 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 = ".";#last / is no need
my $image_dir = '.';

# target file name
my $fname = "";
# Client and server encodings.
my $client_encoding = 'UTF-8';#overriding is possible
my $server_encoding = 'UTF-8';#overriding is impossible

# Hatena URL.
my $hatena_url = 'http://d.hatena.ne.jp';
my $draft_url = '';#after login will be assigned
my $post_url = '';#after login will be assigned
my $image_url = 'http://f.hatena.ne.jp/atom/post';

my @suffixlist = ("jpg","JPG","png","PNG","gif","GIF");
my $hatena = XML::Atom::Namespace->new(hatena => 'http://www.hatena.ne.jp/info/xmlns#');

# Other variables.
my $delete_title = ":delete:";
my $delete_regex = qr/.*$delete_title$/i;
my $draft_title = "draft:";
my $draft_regex = qr/^$draft_title.+/i;

my $delete_flag = 0;
my $draft_flag = 0;
my $update_flag = 0;
my $blog_id = "";
my $image_flag = 0;
my @images = ();
my %image_ids = ();

my $rkm; # session id for posting.

# Handle command-line option.
my %cmd_opt = (
    'u' => "",  # "username" option.
    'p' => "",  # "password" option.
    'g' => "",  # "groupname" option.
    'f' => "",  # "file" option.
    'M' => 0,   # "no timestamp" flag.
    'n' => "",  # "config file" option.
);

$Getopt::Std::STANDARD_HELP_VERSION = 1;
getopts("du:p:g:f:Mn:", \%cmd_opt) or error_exit("Unknown option.");

if ($cmd_opt{d}) {
    print_debug("Debug flag on.");
    &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};
$groupname = $cmd_opt{g} if $cmd_opt{g};
$target_file = $cmd_opt{f} if $cmd_opt{f};



# 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 {
    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.
    login();
    $draft_url = "$hatena_url/$username/atom/draft";
    $post_url = "$hatena_url/$username/atom/blog";

    print_debug("draft_url:$draft_url");
    print_debug("post_url:$post_url");

    for (@files) {

        # Check file name.
        $draft_flag  = 0;
        $delete_flag = 0;
        $update_flag = 0;
        $image_flag  = 0;
        @images      = ();
        next unless (/\b(\d\d\d\d)-(\d\d)-(\d\d)\.txt$/);

        my ( $year, $month, $day ) = ( $1, $2, $3 );
        my $date  = $year . $month . $day;
        $fname = $_;

        # Check if it is a file.
        next unless ( -f $fname );

        # Login if necessary.

        # Replace "*t*" unless suppressed.
        replace_timestamp($fname) unless ( $cmd_opt{M} );

        # Read title and body.
        my ( $title, $body ) = read_title_body($fname);

        # Find image files.
        #my $imgfile = find_image_file($_);

        if ($delete_flag) {
            # Delete entry.
            print_message("Delete $year-$month-$day.");
            delete_diary_entry($date);
            print_message("Delete OK.");
            sleep(1);
            $count++;
            next;
        }

#       print_message("Post $year-$month-$day.  " . ($imgfile ? " (image: $imgfile)" : ""));
        send_image();

        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 error_exit("touch_file error, $!:$touch_file");
            print FILE get_timestamp;
            close(FILE);
        }
    }
}


# Delete.
sub delete_it($) {
    my ($date) = @_;
    print_debug("delete_it: $date");

    my $entry = XML::Atom::Entry->new;
    my $entry_uri;
    if ($draft_flag) {
        $entry_uri = $client->deleteEntry( $draft_url . "/$blog_id", $entry );
    }
    else {
        $entry_uri = $client->deleteEntry( $post_url."/$date" . "/$blog_id", $entry );
    }
    print_debug("delete_it: ");

    # (Note that delete error != post error)
    if ( !$entry_uri ) {
        print_debug("delete_it: returns 0 (ERROR).");
        return 0;
    }
    else {
        print_debug("delete_it: returns 1 (OK).");
        return 1;
    }
}

#write the blog_id in the target file
sub insert_id($$) {
    my ( $filename, $epoch ) = @_;

    # Read.
    open( FILE, $filename ) or error_exit("cannot open target file(1:insert image id), $!: $filename");
    my $contents = "";
    my $linenum  = 0;
    while ( my $line = readline FILE ) {
        $linenum++;
        if ( $linenum == 2 && !$update_flag ) {
            if ($draft_flag) {
                $contents .= "<!--epoch=$epoch-->\n";
            }
            else {
                $contents .= "<!--blog_id=$epoch-->\n";
            }
        }
        foreach my $im ( keys(%image_ids) ) {
            while ( $line =~ /$im/gi ) {
                #f:id:hatenadiary:20041007101545j:image
                $line =~ s/$im/$image_ids{$im}/gi;
                print_debug("replace_image_name: $im");
            }
        }

        $contents .= $line;
    }
    close(FILE);
    print_debug("insert_id: $filename");
    open( FILE, "> $filename" ) or error_exit("2:cannot open target file(insert image id), $!: $filename");
    print FILE $contents;
    close(FILE);
}
#replace the image filename with the image syntax in the target file
sub replace_image_name($) {
    my ($filename) = @_;

    # Read.
    open( FILE, $filename ) or error_exit("cannot open target file, $!: $filename");
    my $contents = "";
    while ( my $line = readline FILE ) {
        foreach my $im ( keys(%image_ids) ) {
            while ( $line =~ /$im/gi ) {

                #f:id:hatenadiary:20041007101545j:image
                $line =~ s/$im/$image_ids{$im}/gi;
                print_debug("replace_image_name: $im");
            }
        }
        $contents .= $line;
    }
    close(FILE);
    print_debug("replaced image name: $filename");
    open( FILE, "> $filename" ) or error_exit("cannot open target file, $!: $filename");
    print FILE $contents;
    close(FILE);
}
#send image
sub send_image(){
    if($image_flag){
        print_debug("image file sending...");
        for my $im (@images){
            local $/; # slurp mode
            my $fh = FileHandle->new("$image_dir/$im")
                or error_exit("cannnot open $im: $!");
            my $image = $fh->getline;
            my ($name,$path,$suffix) = fileparse($im, @suffixlist);
            my $entry = XML::Atom::Entry->new;
            $entry->content($image);
	    my $s = lc($suffix);
            $entry->content->type("image/$s");
            print_debug("content_type: image/$s");
            $entry->title($im);
            my $image_id = $client->createEntry($image_url, $entry) or
                error_exit("image file not send:$client->errstr");
            my $res = XML::Atom::Entry->new(Stream => \$client->{response}->content);
            $image_ids{$im} = $res->get($hatena, "syntax");
            print_debug("post image: $im : $image_id:$image_ids{$im}");
        }
    }
}

sub replace_image_name_string($) {
    my ($body) = @_;
    foreach my $im ( keys(%image_ids) ) {
        while ( $body =~ /$im/gi ) {
            #f:id:hatenadiary:20041007101545j:image
            $body =~ s/$im/$image_ids{$im}/gi;
        }
    }
    return $body;
}

#post the blog
sub post_it($$$$$) {
    my ( $year, $month, $day, $title, $body ) = @_;
    my $entry;
    print_debug("post_it: $year-$month-$day.");

    if ($image_flag) {
	$body = replace_image_name_string($body);
    }

    $entry = XML::Atom::Entry->new;
    $entry->title($title);
    $entry->content($body);

    my $entry_uri = "";
    if ( !$update_flag ) {
        $entry->updated("$year-$month-$day");
        $entry_uri = $client->createEntry( $post_url, $entry );
        $entry_uri =~ /(\d+)$/;

        warn $client->errstr || '\n';

        insert_id( $fname, $1 );
        print_debug("blog_id:$1 blog created($entry_uri)");
    }
    else {
        $entry_uri =
          $client->updateEntry( $post_url . "/$year$month$day/$blog_id",
            $entry );
        if ($image_flag) {
            replace_image_name($fname);
        }
        warn $client->errstr || '\n';
        print_debug("blog_id:$1 blog updated($entry_uri)");
    }
    print_debug("post_it");

    # Check the result. OK if the location ends with the date.
    if ($entry_uri) {
        print_debug("post_it: returns 1 (OK).");
        return 1;
    }
    else {
        print_debug("post_it: returns 0 (ERROR).");
        return 0;
    }
}

#post the draft blog
sub draft_it($$$$$) {
    my ( $year, $month, $day, $title, $body ) = @_;

    print_debug("draft_it: $year-$month-$day.");
    $title =~ s/$draft_title//;
    if ($image_flag) {
	$body = replace_image_name_string($body);
    }
    my $entry = XML::Atom::Entry->new;
    $entry->title($title);
    $entry->content($body);

    my $entry_uri = "";
    if ( !$update_flag ) {
        $entry_uri = $client->createEntry( $draft_url, $entry );
        $entry_uri =~ /(\d+)$/;
        insert_id( $fname, $1 );
        print_debug("entry_id:$1 draft created");
    }
    else {
        $entry_uri = $client->updateEntry( $draft_url . "/$blog_id", $entry );
        print_debug("entry_id:$1 draft updated");
    }
    #http://d.hatena.ne.jp/chikkun530/atom/draft/1353480488
    warn $client->errstr || '\n';
}

# read title and body, and check (draft|read) and (create|update)
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("cannot open, $!:$input");
    }
    my $title = <FILE>;    # first line.
    chomp($title);

    #タイトル行の最後に「:delete:」があったら、削除する
    if ( $title =~ /$delete_regex/ ) {
        $delete_flag = 1;
        print_debug("delete blog");
    }

    # タイトル行の最初に「draft:」があったら、それは「下書き保存」
    if ( $title =~ /$draft_regex/ ) {
        $draft_flag = 1;
        print_debug("draft blog");
    }
    my $second = <FILE>;

    # すでに登録している場合は、以下のような「<!--epoch=***-->」とか「<!--blog_id=***-->」が2行目にある。
    # TODO 登録されていないのに「ある」場合と、登録されているのに「ない」場合の仕様決め
    if (   $second =~ /<! *--epoch *= *(\d+) *-->/
        || $second =~ /<! *--blog_id *= *(\d+) *-->/ )
    {
        $update_flag = 1;
        $blog_id     = $1;
        print_debug("update blog");
    }

    my $body = "";    #join('', <FILE>); # rest of all.
    while (<FILE>) {
        while ( $_ =~ /(\w+\.(?:jpg|png|gif))/ig ) {
            if ( -e "$image_dir/$1" ) {
                push( @images, $1 );
                $image_flag = 1;
                print_debug("Image File:$1 exists in the $file");
            }
        }
        $body .= $_;
    }

    $body = $second . $body;
    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 );
}


# Login.
sub login() {
    if ($http_proxy) {
        $client->proxy($http_proxy);
        print_debug("login: proxy for http: $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> );
    }

    $client->username($username);
    $client->password($password);
    print_message("Login OK.");
}

# Update entry.
sub update_diary_entry($$$$$) {
    my ( $year, $month, $day, $title, $body ) = @_;

    if ( !$draft_flag ) {

        # Post.
        doit_and_retry( "update_diary_entry: POST.",
            sub { return post_it( $year, $month, $day, $title, $body ) } );
    }
    else {
        doit_and_retry( "draft_diary_entry: POST.",
            sub { return draft_it( $year, $month, $day, $title, $body ) } );
    }
}

# Delete entry.
sub delete_diary_entry($) {
    my ($date) = @_;

    # Delete.
    doit_and_retry( "delete_diary_entry: DELETE.",
        sub { return delete_it($date) } );
}

# Do the $funcref, and retry if fail.
sub doit_and_retry($$) {
    my ( $msg, $funcref ) = @_;
    my $retry = 0;
    my $ok    = 0;

    while ( $retry < 2 ) {
        $ok = $funcref->();
        if ( $ok or not $cmd_opt{c} ) {
            last;
        }
        print_debug("try_it: $msg");
        print_message("Something wrong! Retry login--retry $retry.");
        $retry++;
    }

    if ( not $ok ) {
        error_exit("giving up!.");
    }
}

# 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";
Yet Another Hatena Diary Writer Version $VERSION
Copyright (C) 2012 by Chiku Kazuro.
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.

# Replace "*t*" with timestamp.
sub replace_timestamp($) {
    my ($filename) = @_;

    # Read.
    open( FILE, $filename ) or error_exit("timestamp replace, $!: $filename");
    my $file = join( '', <FILE> );
    close(FILE);

    # Replace.
    my $newfile = $file;
    $newfile =~ s/^\*t\*/"*" . time() . "*"/gem;

    # Write if replaced.
    if ( $newfile ne $file ) {
        print_debug("replace_timestamp: $filename");
        open( FILE, "> $filename" ) or error_exit("timestamp replace,$!: $filename");
        print FILE $newfile;
        close(FILE);
    }
}

# 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.
    -T seconds      Timeout. Default value is 180.
    -g groupname    Groupname. Specify groupname.
    -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
# txt_dir:/usr/yourid/diary
# touch:/usr/yourid/diary/hw.touch
# proxy:http://www.example.com:8080/
# client_encoding:Shift_JIS
# 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 comment.
        }
        elsif (/^$/) {

            # skip blank line.
        }
        elsif (/^id:([^:]+)$/) {
            $username = $1;
            print_debug("load_config: id:$username");
        }
        elsif (/^g:([^:]+)$/) {
            $groupname = $1;
            print_debug("load_config: g:$groupname");
        }
        elsif (/^password:(.*)$/) {
            $password = $1;
            print_debug("load_config: password:********");
        }
        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 (/^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 command '$_' in $config_file.");
        }
    }
    close(CONF);
}
__END__