#!/usr/bin/perl

#   Maintain tumblog on www.tumblr.com by commandline.
#
#   By  accessing  this software,  tumblr,   you are  duly informed
#   of and  agree to be  bound  by the  conditions  described below
#   in this notice:
#
#   This software product, tumblr,   is developed by  Thomas Linden
#   and      copyrighted  (C) 2009     by  Thomas Linden,  with all
#   rights reserved.
#
#   There is  no charge for  tumblr software. You can redistribute
#   it and/or modify it under  the terms of the  GNU General Public
#   License, which is incorporated by reference herein.
#
#   tumblr is distributed WITHOUT ANY WARRANTY, IMPLIED OR EXPRESS,
#   OF  MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE or that
#   the  use of it will not infringe on any third party's intellec-
#   tual property rights.
#
#   You  should  have  received a  copy  of  the GNU General Public
#   License along with tumblr.   Copies  can also be obtained from:
#
#     http://www.gnu.org/copyleft/gpl.html
#
#   or by writing to:
#
#     Free Software Foundation, Inc.
#     59 Temple Place, Suite 330
#     Boston, MA 02111-1307
#     USA
#
#   Or contact:
#
#    "Thomas Linden" <tom |AT| cpan.org>
#

use lib qw(.);

use WWW::Tumblr;
use Config::General qw(ParseConfig);
use Getopt::Long;
use Data::Dumper;
use HTML::Entities;

$| = 1;

# defaults
my $cfgfile = "$ENV{HOME}/.tumblr";
my %conf;
my @images = qw(jpg jpeg png gif bmp tiff svg);
my @movies = qw(flv mpg mp4 wmv mov avi);
my @audios = qw(au mp3 aiff);

my ($edit, $delete, $update, $help, $config, $settitle);
Getopt::Long::Configure( qw(no_ignore_case));
if (! GetOptions (
	"edit|e=s"   => \$edit,
	"delete|d=s" => \$delete,
	"update|u:s" => \$update,
	"title|t:s"  => \$settitle,
	"help|h"     => \$help,
	"config|c=s" => \$config
	)) {
	&usage();
}

if($help) {
	&usage();
}

if($config) {
	$cfgfile = $config;
}

if(defined($update)) {
	if($update eq '') {
		$update = -1;
	}
}

if (-e $cfgfile) {
  %conf = ParseConfig(-ConfigFile => $cfgfile);
}
else {
  &gencfg;
}

my $filearg = $ARGV[0];

if(! exists($conf{email}) or ! exists($conf{password}) or ! exists($conf{url})) {
	print "Error: either 'email', 'password' or 'url' is missing or empty in $ENV{HOME}/.tumblr!\n";
	exit;
}

if(! exists($conf{editor})) {
  if (exists $ENV{EDITOR}) {
    $conf{editor} = $ENV{EDITOR};
  }
  elsif (exists $ENV{VISUAL}) {
    $conf{editor} = $ENV{VISUAL};
  }
  else {
    $conf{editor} = "vi";
  }
}

my $t = new WWW::Tumblr;

$t->email($conf{email});
$t->password($conf{password});
$t->url($conf{url});

if($edit) {
  if ($filearg) {
    &usefile($filearg, $edit);
  }
  else {
    &edit($edit);
  }
}
elsif($delete) {
  &del($delete);
}
elsif($update) {
  &update($update);
}
elsif ($filearg) {
  &usefile($filearg);
}
else {
  &create();
}


sub usefile {
  my ($file, $id) = @_;

  if ($file eq '-') {
    # read from stdin
    my $binary = join '', <STDIN>;

    # find type
    my $tmp = ".stdintmp$$";
    open TMP, ">$tmp" or die "Could not write stdin data to $tmp: $!\n";
    binmode TMP;
    print TMP $binary;
    close TMP;
    my $type = `file -bi $tmp`;
    chomp $type;

    if ($type =~ /text/) {
      # put as text posting
      &create($tmp);
    }
    elsif ($type =~ /image\/(.+?)$/) {
      # an image, name it accordingly
      my $ext = $1;
      system("mv $tmp $tmp.$ext");
      &usefile("$tmp.$ext");
      unlink "$tmp.$ext";
    }
    else {
      print "Unknown content-type: $type for data on STDIN!\n";
    }
    unlink $tmp;
    return;
  }

  if (! -e $file) {
    print "Error: $file doesn't exist or is unreadable!\n";
    exit 1;
  }

  my $regex = '(' . join('|', @images) . ')|(' . join('|', @audios) . ')|(' . join('|', @movies) . ')';

  my %p = map { $_ => 'photo' } @images;
  my %a = map { $_ => 'audio' } @audios;
  my %v = map { $_ => 'video' } @movies;
  my %type = (%a, %p, %v);

  if ($file =~ /\.($regex)$/i) {
    # binary data
    my $ext = $1;
    my $title;

    if ($file =~ /^\.stdin/) {
      # we cant ask for the title interactively, so if there has
      # not been defined one by -t, croak
      if ($settitle) {
	$title = $settitle;
      }
      else {
	print "Error: specify a title using -t!\n";
	exit 1;
      }
    }
    else {
      ($title, undef) = &findtitle();
    }

    print "Uploading $filearg ... ";

    my @arg;
    if ($id) {
      @arg = ('post-id', $id);
    }

    my $id = $t->write(type => $type{$ext}, caption => $title, data => $file, @arg);
    if ($id) {
      open POST, ">$id" or die "Could not open $id: $!\n";
      print POST "<!-- title: $title -->\n";
      print POST "<!-- fileurl: $file -->\n";
      close POST;
      system("cp $file $id.$ext") and die "Could not copy $file => $id.$ext: $!\n";
      print "done, wrote $id, saved $file as $id.$ext\n";
    }
    else {
      print "failed: " . $t->errstr() . "\n";
    }
  }
}


sub findtitle() {
  my($file) = @_;

  if (! $file) {
    if ($settitle) {
      return ($settitle, 0);
    }
    else {
      while () {
	print "Please enter a title: ";
	$title = <STDIN>;
	chomp $title;
	if($title) {
	  return ($title, 0);
	}
      }
    }
  }

  my $title;
  open POST, "<$file" or die "Could not open $file: $!\n";
  my $content = join '', <POST>;
  close POST;

  if ($settitle) {
    # override
    $content =~ s/^<!--(#?\s*title:)\s*.+?\s*-->/<!--$1 $settitle -->/;
    return($settitle, $content);
  }

  if($content =~ /^<!--\s*title:\s*(.+?)\s*-->/) {
    $title = $1;
  }
  elsif($content =~ /^<!--#\s*title:\s*(.+?)\s*-->/) {
    # markdown
    $title = $1;
  }
  else {
    print "No title found in posting (use <!-- title: TITLE --> in first line!\n";
    while () {
      print "Please enter a title: ";
      $title = <STDIN>;
      chomp $title;
      if($title) {
	$content = "<!-- title: $title -->\n" . $content;
	last;
      }
    }
  }
  return ($title, $content);
}

sub update {
        my $id = shift;
        if($id > 0) {
                # existing post, update only this one
                my $xml = $t->read('id' => $id, filter => 'none');
                &write($id, $xml);
        }
        else {
                # fetch all
                my $start = 0;
                while () {
                        my $xml = $t->read(start => $start, num => 10, filter => 'none');
                        if($xml =~ /<post id=/) {
                                $start += 10;
                                my @parts = split /<post id="/, $xml;
                                foreach my $post (@parts) {
                                        if($post =~ /^(\d+)/) {
                                                my $id = $1;
                                                &write($id, $post);
                                        }
                                }
                        }
                        else {
			  last;
                        }
                }
        }
}

sub write {
  my($id, $xml) = @_;

  print "Updating $id ... ";
  if($xml) {
    my ($title, $body, $date, $format, $file, $embed);
    $format = "html";
    if($xml =~ /unix-timestamp="(\d+?)"/si) {
      $date = $1;
    }
    if($xml =~ /<regular-title>(.*)<\/regular-title>/si) {
      $title = $1;
    }
    if($xml =~ /<regular-body>(.*)<\/regular-body>/si) {
      $body = decode_entities($1);
    }
    if($xml =~ / format="([a-z]+)"/si) {
      $format = $1;
    }
    if ($xml =~ /<photo-url[^>]*>(.+?)<\/photo-url>/si) {
      # the 1st one has original size
      $file = $1;
    }
    if ($xml =~ /<photo-caption>(.+?)<\/photo-caption>/si) {
      $title = $1;
    }
    if ($xml =~ /<video-caption>(.+?)<\/video-caption>/si) {
      $title = $1;
    }
    if ($xml =~ /<video-source>(.+?)<\/video-source>/si) {
      # we put embeded video as plain html post
      $embed  = decode_entities($1);
    }

    if($body and $title and $date) {
      open POST, ">$id" or die "Could not open $id: $!\n";
      if($format eq "html") {
	if ($body =~ /^<!--\s*title:/) {
	  $body =~ s/^(<!--\s*title:\s*)(.+?)(\s*-->)/$1 . $title . $3/ei;
	}
	else {
	  $body = "<!-- title: $title -->\n" . $body;
	}
      }
      else {
	$body =~ s/^(<!--#\s*title:\s*)(.+?)(\s*-->)/$1 . $title . $3/ei;
      }
      print POST "$body\n";
      close POST;
      utime $date, $date, ($id);
      print "done\n";
    }
    elsif ($file and $date) {
      open POST, ">$id" or die "Could not open $id: $!\n";
      print POST "<!-- title: $title -->\n";
      print POST "<!-- fileurl: $file -->\n";
      close POST;
      &fetchfile($date, $file, $id);
      print "done\n";
    }
    elsif ($embed and $date) {
      open POST, ">$id" or die "Could not open $id: $!\n";
      print POST "<!-- title: $title -->\n";
      print POST $embed;
      close POST;
      print "done\n";
    }
    else {
      print "Posting $id incomplete!\n";
      print $xml;
    }
  }
  else {
    print  print "failed: " . $t->errstr() . "\n";
  }
}


sub fetchfile {
  my($date, $uri, $id) = @_;
  my $ext;
  if ($uri =~ /\.([a-z]+)$/) {
    $ext = $1;
    system ("wget -q -O $id.$ext $uri") and die "Could not save $uri: $!\n";
  }
  else {
    print "$uri has no file extension!\n";
  }
}


sub usage {
	print qq(
Usage: $0 [-e <post-id>] [-d <post-id>] [-u [<post-id>]] [-c <config-file>] [-h]
  -e    edit (post-id required)
  -d    delete (post-id required)
  -u    update (update all unless post-id specified)
  -t    override the title for the post
  -c    use another config instead of ~/.tumblr
  -h    print help
);
	exit ;
}

sub gencfg {
  print "Config file $cfgfile not found, creating one ... ";
  open CFG, ">$cfgfile" or die "Could not open $cfgfile: $!\n";
  print CFG qq~# generated by tumblr
#
# url of your tumblog, eg http://foobar.tumblr.com
url      =

#
# email used for login to www.tumblr.com
email    =

# password for login
password = tui17

#
# template for new postings
template =<<EOF
<!--# title: REPLACETHIS -->
<!-- tags: -->

EOF

#
# favourite editor to be used to edit postings
# if not defined, $EDITOR, $VISUAL or vi will be
# used in this order
editor =
~;
  close CFG;
  print "done\nEdit the file $cfgfile and retry, thanks!\n";
  exit;
}


sub edit {
  my $id = shift;
  if(-e $id) {
    my $mtime1 = (stat($id))[9];
    system($conf{editor}, $id);
    my $mtime2 = (stat($id))[9];
    if($mtime1 != $mtime2) {
      my ($title, $modcontent) = &findtitle($id);
      if($modcontent ne $content) {
	# title added, re-saving file
	open POST, ">$id" or die "Could not open $id: $!\n";
	print POST $modcontent;
	close POST;
	$content = $modcontent;
      }

      if ($content =~ /(<object(.+?)<\/object>)/si) {
	# must be a video
	my $embed = $1;
	my $id = $t->write('post-id' => $id, type => 'video',
			   embed => $embed, caption => $title);
	if($id) {
	  print "done\n";
	}
	else {
	  print "failed: " . $t->errstr() . "\n";
	}
      }
      else {
	# text posting
	my $format = "html";
	if($content =~ /^<!--#/) {
	  $format = "markdown";
	}

	my $tags;
	if($modcontent =~ /^<!--\s*tags:\s*(.+?)\s*-->$/mi) {
	  $tags = $1;
	}

	print "Posting ... ";
	my $id = $t->write('post-id' => $id, type => "regular", tags => $tags,
			   title => $title, body => $content, format => $format);
	if($id) {
	  print "done\n";
	}
	else {
	  print "failed: " . $t->errstr() . "\n";
	}
      }
    }
    else {
      print "File unchanged, leaving\n";
      exit;
    }
  }
  else {
    print "Posting $id does not exist!\n";
    exit;
  }
}


sub del {
  my $id = shift;
  print "Deleting $id ... ";
  if($t->delete('post-id' => $id)) {
    if(-e $id) {
      unlink $id;
      print "done\n";
    }
  }
  else {
    print "Posting $id does not exist!\n";
    exit;
  }
}


sub create {
  # new post

  my ($infile) = @_;
  my $tmp;

  if ($infile) {
    $tmp = $infile;
  }
  else {
    my $tmp = ".tmp$$";
    if(exists $conf{template}) {
      open TMP, ">$tmp" or die "Could not open $tmp: $!\n";
      print TMP $conf{template};
      close TMP;
    }
    system($conf{editor}, $tmp);
  }

  if(-s $tmp) {
    open TMP, "<$tmp" or die "Could not open $tmp: $!\n";
    my $content = join '', <TMP>;
    close TMP;

    my $check = $content;
    $check =~ s/^<!--.*-->$//gm;
    if ($check =~ /^\s*$/s) {
      print "Unedited template, not posting!\n";
      exit 1;
    }

    my ($title, $modcontent) = &findtitle($tmp);

    print "Posting ... ";

    if ($content =~ /(<object(.+?)<\/object>)/si) {
      # must be a video
      my $embed = $1;
      my $id = $t->write(type => 'video', #'channel_id' => '8d1c4r6',
			 embed => $embed, caption => $title);
      if($id) {
	print "done\n";
      }
      else {
	print "failed: " . $t->errstr() . "\n";
      }
    }
    else {
      my $format = "html";
      if($modcontent =~ /^<!--#/) {
	$format = "markdown";
      }

      my $tags;
      if($modcontent =~ /^<!--\s*tags:\s*(.+?)\s*-->$/mi) {
	$tags = $1;
      }

      my $id = $t->write(type => "regular", title => $title, tags => $tags,'channel_id' => '8d1c4r6',
			 body => $modcontent, format => $format);
      if($id) {
	open POST, ">$id" or die "Could not write to $id: $!\n";
	print POST $content;
	close POST;
	print "done, wrote $id\n";
	unlink $tmp;
      }
      else {
	print "failed: " . $t->errstr() . " (keeping post in $tmp)\n";
      }
    }
  }
  else {
    print "Empty file, not posting!\n";
    exit;
  }
}
