ChangeLogMemoにメモったブックマークをdel.icio.usに投稿

koyachi2005-12-15


普通にインターネットできる環境では はてなブックマークなりMMなりdel.icio.usなり使えるので問題にならないのですが、認証が必要なWebサービスへのアクセスが制限されている場合、ブックマークしたいページを見つけても自分のSBMに登録することが出来ません。しょうがないので普段メモに使ってるChangeLogMemoにメモっておいて自分の家からまとめて登録していたのですが、登録作業を忘れたりすると数日分まとめて登録することになります、手作業で。
DRY!
ということで登録作業を自動化してみました。ChangeLogMemoへはこんな感じでメモってます。今日のメモから当たり障りのないところを抜粋しました。

2005-12-14  T.Koyachi  <t-koyachi@hoge.co.jp>

        * memo: del.icio.us死んでる
        記念に保存しておいた。~/memo/dead_delicious.htm

        * moso: バスクリン
        デバクスクリン
        デ・バクスクリン
        バクスクリン
        バスクリン

        * clip:
        - Martin Fowler's Bliki in Japanese - ヒューメイン・インタフェース
        http://capsctrl.que.jp/kdmsnr/wiki/bliki/?HumaneInterface
        [interface programming ruby]使用者が楽するためのインターフェース。考えられるものは全て提供。被るもの(length,size)はエイリアス。今読んでる本と関係ある。
        - ド派手なデバグスクリーンを表示させる【Sledge::Plugin::DebugScreen】(2181) - MF::TokuLog
        http://tokuhirom.dnsalias.org/~tokuhirom/tokulog/2181.html
        [sledge debug test framework interface perl catalyst]Catalystやrailsについてるデバッグ画面のsledge版実装
        - MoFedge::Plugin::TokuLog! - Sledge::Plugin::DebugScreen で die もスタックトレースとれるようになった
        http://d.hatena.ne.jp/tokuhirom/20051212/1134368932
        [sledge perl test debug]
        - die しても Sledge::Plugin::DebugScreen で出しましょう - にぽたん研究所
        http://blog.livedoor.jp/nipotan/archives/50342811.html
        [sledge debug perl]SIG{__DIE__},Devel::StackTrace
        - die しても Sledge::Plugin::DebugScreen で出しましょう 2 - にぽたん研究所
        http://blog.livedoor.jp/nipotan/archives/50342898.html
        [sledge debug perl]前後3行表示パッチ
        - Google Homepage API - Overview
        http://www.google.com/apis/homepage/
        [google api]personal pageに貼れるモジュール作成のためのAPI。

"* clip:"がブックマークのメモで、タイトル、URL、コメント(option)の繰り返しです。コメントはこの前作ったText::MetaComment::Defaultなフォーマットで書いています。
あとはひたすらChangeLogMemoを解析していくだけです。フォーマットパース部はText::ChangeLogなモジュールがあると期待してたのですが、なさそうだったので泥臭く解析してます。もう少し美しくなりそうな気がするんだけど。Net::Deliciousが楽で楽で。何も考えずに使えました。あとDamian Conwayがコマンドラインインターフェースについて語ってたの思い出してGetopt::Long慣れするために使ってみました。
とりあえずこんな感じか?なノリで書いて見てなんとなく動いてるのでテストはロクにしてないです。今del.icio.usが不安定、ってのもテストできない理由として無理やりあげておきます。del.icio.usが不安定なのは以前も遭遇したことあるけど、これだけ長いのは初めてだと思います。Yahoo!とごにょごにょし始めたんですかね。

#!/usr/local/bin/perl

package ClipItem;
use strict;
use warnings;
use lib '/home/koyachi/lib';
use base qw( Class::Accessor::Fast );
__PACKAGE__->mk_accessors( qw(url title tags comment) );

sub get_tags {
    my $self = shift;
    return wantarray ? @{$self->{tags} || []} : $self->{tags};
}
1;


package main;
use strict;
use warnings;
use utf8;
use lib '/home/koyachi/lib';
use Getopt::Long;
use IO::File;
use Text::MetaComment;
use Text::MetaComment::Result;
use Net::Delicious;
use Encode qw(from_to);

use constant {
    PS_INIT => 0,
    PS_CLIP => 1,
    PS_OTHER => 0xFFFFFFFF,

    CPS_ITEM_INIT => 0,
    CPS_ITEM_TITLE => 1,
    CPS_ITEM_ADDR  => 2,
    CPS_ITEM_COMMENT => 3,

    DELICIOUS_ID => 'id',
    DELICIOUS_PASS => 'pass',
};

my $file_name = '/home/koyachi/memo/diary.clm';
my $day_range = 7;
my $clip_tag  = 'clip';
my $encoding  = 'EUC-JP';            # !!!!!!!!!!これ対応しないと!from_toとか。

GetOptions( 'file=s' => \$file_name,
            'recent=i' => \$day_range,
            'tag=s' => \$clip_tag,
            'encoding=s' => \$encoding );
print "file = $file_name, recent = $day_range, tag = $clip_tag enc = $encoding\n";

my @clips;
my $clips_index = 0;
my $fh = IO::File->new;
if ( $fh->open( "< $file_name" ) ) {
    my $day_counter = 0;
    my $parse_state = PS_INIT;
    my $clip_parse_state = CPS_ITEM_INIT;
    my $date;

    my $current_clip = ClipItem->new;

    while ( <$fh> ) {
        # ここでencoding変換したい
        my $line = $_;

        from_to( $line, $encoding, "UTF-8" );

        if ( $line =~ /^(\d{4}\-\d{2}\-\d{2}\s{2}).*$/ ) {
            $date = $1;
            $day_counter++;
            if ( $day_counter > $day_range ) {
                last;
            }
        } elsif ( $line =~ /^\t\*\s(.*?):.*/ ) {
            if ( $1 eq $clip_tag ) {
                $parse_state = PS_CLIP;
                $clip_parse_state = CPS_ITEM_TITLE;

#               print "\n\nfound clip!($date) ------------------------\n";
            } else {
                $parse_state = PS_OTHER;
            }
        } else {
            if ( $parse_state == PS_CLIP ) {
                $line =~ s/\n//;

                if ( $clip_parse_state == CPS_ITEM_TITLE ) {
                    my $title = get_item_title( $line );
                    if ( $title ) {
                        $current_clip->title( $title );
                        $clip_parse_state = CPS_ITEM_ADDR;
                    }

                } elsif ( $clip_parse_state == CPS_ITEM_ADDR ) {
                    if ( $line =~ /^\t(.*)/ ) {
                        my $addr = $1;
#                       print "[url]$addr\n";
                        $current_clip->url( $addr );
                        $clip_parse_state = CPS_ITEM_COMMENT;
                    } else {
                        warn "Invalid Changelog format."
                    }
                } elsif ( $clip_parse_state == CPS_ITEM_COMMENT ) {
                    my $title = get_item_title( $line );
                    if ( !$title ) {
                        if ( $line =~ /^\t(.*)/ ) {
                            my $comment = $1;
                            my $meta_comment = Text::MetaComment->parse( $comment );
                            my $tag_string = join ', ', $meta_comment->tags;
                            my $comment_string = $meta_comment->comment;

                            $current_clip->tags( [$meta_comment->tags] );
                            $current_clip->comment( $meta_comment->comment );

#                           print "[tags]    $tag_string\n";
#                           print "[comment] $comment_string\n";

                            push @clips, $current_clip;
                            $current_clip = ClipItem->new;
                            $clip_parse_state = CPS_ITEM_TITLE;
                        }

                    } else {
                        push @clips, $current_clip;
                        $current_clip = ClipItem->new;
                        $current_clip->title( $title );
                        $clip_parse_state = CPS_ITEM_ADDR;
                    }
                }
            }
        }
    }
    $fh->close;

    my $delicious = Net::Delicious->new({ user => DELICIOUS_ID,
                                          pswd => DELICIOUS_PASS });
    # debug
    print "\n#\n### DEBUG ###\n#\n";
    my $i = 0;
    foreach my $clip ( @clips ) {
        print "-----------------------\n";
        print "No.$i\n";
        print "title   : ", $clip->title, "\n";
        print "url     : ", $clip->url, "\n";
        print "tags    : ", join ', ', $clip->get_tags, "\n";
        print "comment : ", $clip->comment, "\n";

        $delicious->add_post({ url => $clip->{url},
                               description => $clip->{title},
                               extended => $clip->{comment},
                               tags => join ' ', @{$clip->{tags}},
                              });


        $i++;
    }
}

sub get_item_title {
    my $line = shift;

    if ( $line =~ /^\t\-\s(.*?)$/ ) {
        return $1;
    } else {
        return 0;
    }
}