#!/usr/bin/perl
#
# hate2blogger.pl - make it possible to write Blogger like HatenaDiary
# 
# ver 0.1
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

use strict;
use warnings;

use LWP::UserAgent;
use HTTP::Headers;
use HTTP::Request::Common;
use HTTP::Cookies;
use Encode;

#---設定項目--------------------------------------------
# Bloggerでのハンドルネーム
my $name="";
# Bloggerアカウントのメールアドレス
my $email="";
# Bloggerアカウントのパスワード
my $password="";
# BlogのURL
my $url="";
# 続きを読む 記法で表示する文字(!日本語使う時はUTF-8に変換すること!)
my $readmore_string="続きを読む";
#------------------------------------------------------
my $debug=0;
Encode::from_to($readmore_string,"euc-jp","utf-8");

my $ua=LWP::UserAgent->new;
my $google_login_url="https://www.google.com/accounts/ClientLogin";
my $google_post_id="<blog_id>";
my $google_post_url="http://www.blogger.com/feeds/<blog_id>/posts/default";
my $auth;
my $blog_id;
my $post_content=<<EOM;
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<entry xmlns='http://www.w3.org/2005/Atom'>
  <title type='text'><!-- subject --></title>
  <!-- timestamp -->
  <content type='xhtml'>
<!-- post -->
  </content>
  <!-- category -->
  <author>
    <name>$name</name>
    <email>$email</email>
  </author>
</entry>
EOM

sub debug{
    print shift if($debug);
}
sub login{
    return if(defined $auth);
    my %form=(
	'accountType' => 'HOSTED_OR_GOOGLE',
	'Email'       => $email,
	'Passwd'      => $password,
	'service'     => 'blogger',
	'source'      => 'nawota-hate2blogger-test',);
    my $res=$ua->request(
	HTTP::Request::Common::POST("$google_login_url", \%form));
    $res->content() =~ m/^Auth=(.*)$/m;
    $auth=$1;
    debug "auth:$auth\n";
}
sub get_bid{
    return if(defined $blog_id);
    # get blog id
    my $res=$ua->request(
	HTTP::Request::Common::GET($url."feeds/posts/default"));
    $res->content() =~ m!<id>tag:blogger.com,1999:blog-(\d+)</id>!;
    $blog_id=$1;
    debug "blog_id:$blog_id\n";
}
sub post{
    my $method=shift;
    # post
    $google_post_url=~s/$google_post_id/$blog_id/;
    my $head=new HTTP::Headers('Content_Type' => 'application/atom+xml; charset=UTF-8',
			       'Authorization' => "GoogleLogin auth=$auth",);
    my $req;
    if($method eq "POST"){
	$req=HTTP::Request->new(POST => "$google_post_url",$head,$post_content);
    }else{
	$req=HTTP::Request->new(PUT => "$google_post_url",$head,$post_content);
    }
    debug $req->as_string,"\n";
    my $res=$ua->request($req);
    return $res->as_string;
}

# load diary
my $file=shift or die "Usage:$0 <file_to_post>";
my $body="";
open DIARY,"< $file";
my $subject=<DIARY>;chomp $subject;
my ($in_pre,$in_deflist,$in_table,$list_level,$readmore,@list_type)=(0,0,0,0,0,());
while(<DIARY>){
    if($in_pre){
	m/^\|\|<$/ and $in_pre=0,$body.="</pre>\n",next;
	s/&/&amp;/g;
	s/</&lt;/g;
	s/>/&gt;/g;
	$body.="$_";
	next;
    }
    if($in_deflist && $_!~m/^:/){$body.="</dl>\n";$in_deflist=0;}
    if($in_table && $_!~m/^\|/) {$body.="</tbody></table>\n";$in_table=0;}

    #isbn check

    if(/^([-+]*)(.*)$/){
	my $curlv=length($1);
	my $cur_type=(pop @list_type);
	my $tag= (substr($1,0,1) eq "-")?"ul":"ol";

	if(defined $cur_type){
	    $curlv=0 if($tag ne $cur_type);
	    push @list_type,$cur_type;
	}
	while($list_level>$curlv){
	    $body.="</li>\n</".(pop @list_type).">\n";
	    $list_level--;
	}
	$curlv=length($1);
	
	if($curlv){
	    if($curlv > $list_level){
		chomp $body;
		$body.="\n<$tag>\n";
		push @list_type,$tag;
		$list_level++;
	    }else{
		$body.="</li>\n";
	    }
	    my $item=$2;
	    unless(m/^(.*)\|<$/) {$body.="<li>$item";}
	    else {
		$body.="<li>$1";
		while($list_level>$curlv){
		    $body.="</li>\n</".(pop @list_type).">\n";
		    $list_level--;
		}
		$body.="</pre>\n";
	    }
	    next;
	}
    }
    
    m/^>>$/         and $body.="<blockquote><div>\n"  ,next;
    m/^<<$/         and $body.="</div></blockquote>\n" ,next;
    m/^>\|\|$/      and $in_pre=1,$body.="<pre>\n",next;
    m/^>\|$/        and $body.="<pre>\n"         ,next;
    m/^(.*)\|<$/    and $body.="$1</pre>\n"      ,next;
    m/^\*\*\*(.*)$/ and $body.="<h5>$1</h5>\n"   ,next;
    m/^\*\*(.*)$/   and $body.="<h4>$1</h4>\n"   ,next;

    if(m/^====$/ && !$readmore){
	$body.="<div class='fullpost'>\n<a name='readmore-anc' id='readmore-anc'></a>\n";
	$readmore=1;
	next;
    }
    
    if(m/^:(.*?):(.*)$/){
	$body.="<dl>\n" unless($in_deflist);
	$in_deflist=1;
	$body.="<dt>$1</dt>\n<dd>$2</dd>\n";
	next;
    }
    if(m/^(\|.*\|)$/){
	my $text=$1;
	$body.="<table><tbody>\n" unless($in_table);
	$in_table=1;
	while($text=~m/\|.+$/){
	    $text=~s/\|(.*?)\|/<td>$1<\/td>|/
		unless($text=~s/\|\*(.*?)\|/<th>$1<\/th>|/);
	}
	$text="<tr>$text";
	$text=~s/\|$/<\/tr>\n/;
	$body.=$text;
	next;
    }

    s/ \*/*/;s/ -/-/;s/ \+/+/;

    chomp;
    $body.="$_\n";
}
while($list_level){
    $body.="</li>\n</".(pop @list_type).">\n";
    $list_level--;
}
#$body.="</div>\n";
close DIARY;

get_bid;
login;

my $category="";
$category.="<category scheme='http://www.blogger.com/atom/ns#' term='$1'></category>" while($subject=~s/\[(.*?)\]//);

my $published="";
if($readmore){
    $body.="</div>\n<div class='readmore'>\n";
    $post_content=~s/<!-- subject -->/$subject/;
    my $res=post "POST";
    debug $res,"\n";
    $res =~ m!(<id>.*?</published>).*?<link rel='alternate' type='text/html' href='(.*?)'></link>.*?<link rel='edit' type='application/atom\+xml' href='(.*?)'></link>!;

    $published=$1;
    $body.="<a href='$2#readmore-anc'>$readmore_string</a>\n</div>";
    $google_post_url=$3;
}

for($post_content){
    s/<!-- subject -->/$subject/;
    s/<!-- post -->/$body/;
    s/<!-- category -->/$category/;
    #s/<!-- timestamp -->/$published/;
}
debug post "POST";