#!/usr/bin/perl
#############################################################################
# mt-moblog: email to MovableType entry gateway
# Copyright (C) 2003 Ben Compton (ben@randomlyhumming.com)
# modified slightly by Erik Benson (erik@mockerybird.com)
# modified slightly more by Owen Williams (ywwg@usa.net)
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
#############################################################################
#############################################################################
#
# More changes:
#
#   * don't bother with thumbnails
#   * rearrange the post format
#   * fixed bug where images ended up in base64 form.  don't need to encode it seems
#   * can post text without images
#
#
# Ben's original version of this script (named m2mt) is available here:
#     http://www.randomlyhumming.com/archives/000056.html
#
# The main idea for this comes from blogpost.pl, available here:
#     http://www.danger-island.com/~dav/writeon/archives/000340.html
#
# Thanks to dav for the starting point upon which I built, though what
# I ended up with is fairly substantially different than what I started with.
#
#  Revisions from dav's orignal blogpost.pl:
#     * took out the iso-2022-jp transcoding (I didn't need it)
#     * also took out the hiptop nation stuff (I don't use a hiptop)
#     * added uploading of any image attachments via the newMediaObject
#           XML-RPC call
#     * reorganized the code a lot
#     * replaced MIME::Explode with MIME::Parser and related modules
#     * various other minor things
#
#############################################################################
use strict;

use Data::Dumper;
use Getopt::Long;
use MIME::Base64 qw(encode_base64);
use MIME::Entity;
use MIME::Parser;
use XMLRPC::Lite;
#############################################################################
# USAGE
# This script is meant to be used in conjunction with procmail.
#
# Here's an example procmail recipie.
#
#     :0 c: mt-moblog.lock
#     * ^TOyour-blog-target-address@somewhere.com
#     |/path/to/mt-moblog
#
#   This example takes everything sent to
#        your-blog-target-address@somewhere.com and submits it as a blog entry.
#
# You might not want to be so permissive in what you allow to be posted,
# however.
#
# mt-moblog requires the existence of a .mt-moblog.cfg config file in your $HOME directory
# (the config file location can be overridden via the --config parameter)
#
# example .mt-moblog.cfg:
#     blogxmlrpc = http://www.randomlyhumming.com/mt/mt-xmlrpc.cgi
#     attachmentdir = images/moblog
#     tempdir = /home/ben/tmp/moblog
#     bloguser = yourusername
#     blogpass = yourpassword
#     blogid = 1
#     removenewlines = 1
#     removebottomnewlines = 1
#     publish = 1
#     category = 14
#
#
# Description of configuration values:
#      blogxmlrpc:    path to your xmlrpc script.
#      attachmentdir: subpath from your blog's root directory where you want
#                         your images stored
#      tempdir:       a directory suitable for dumping temporary files during
#                         processing
#      bloguser:      your MovableType username
#      blogpass:      your MovableType password
#      blogid:        the MovableType ID for the blog you want to post on
#                     via this script
#      removenewlines: nuke all of the newlines out of the email body
#      removebottomnewlines: remove only the newlines at the bottom of the body
#      publish:       do you want to publish the entry (1) or just make it a draft (0)
#                     note that your mt.cfg must have the line
#                        NoPublishMeansDraft 1
#                     in it for this option to work.  otherwise it will always publish
#      category:     this is the category NUMBER that the post will have. 
#
#############################################################################

# read the configuration from command line and rcfile
my %config = &getConfig;

my $parser = new MIME::Parser;
$parser->output_dir($config{tempdir});
my $entity = $parser->parse(\*STDIN);

my $subject = getSubject($entity);
my %data = parseEntity($entity);

my @urls;

foreach my $attachment (@{ $data{attachments} }) {
    push @urls, [ uploadFile($attachment) ] 
	unless $config{noSubmit};
}

my $Images = buildImageHtml(\@urls);

if (defined($subject) && ($data{bodyText} || $Images)
    && !$config{noSubmit}) {
    print STDERR "submitting post\n";
    submitPost($subject, $data{bodyText}, $Images);
}

if ($config{noSubmit}) {
    print STDERR "body is: $Images . $data{bodyText}\n";
}

# clean up
$entity->purge;

exit(0);

#############################################################################
#
# subroutines
#
#############################################################################

sub uploadFile {
    my $attachment = shift;

    # we'll put the file's contents in this variable, encoded in base64.
    my $bits;
    { # block to limit the scope of our local $/
	    my $handle = $attachment->open('r');

    	# this is a really risky way to do this if you can be using
    	# very large files.  Only do this if you have enough memory to
    	# hold the whole file in memory at once. I should probably
    	# change this s.t. it does it nicely in little chunks. +++
    	local($/) = undef;
    	#$bits = encode_base64($handle->getline);
	$bits = $handle->getline;
    	$handle->close();
    }

    my ($ext) = ($attachment->path =~ /\.(\w+)$/);
    my $rand = int(rand(2**24));

    my $rpCaller = new XMLRPC::Lite;
    my $result = $rpCaller
                	  ->proxy($config{blogxmlrpc})
	                  ->call('metaWeblog.newMediaObject',
           	          $config{blogid},
	                    $config{bloguser},
	                    $config{blogpass},
	                    {
		                    'bits' => $bits,
              		      'name' => "$config{attachmentdir}/$$.$rand.$ext",
		                    'type' => 'ignored'
            		      },
	                  );

    if ($result->fault) {
	    print STDERR "error uploading media object:" . Dumper($result) . "\n";
	    return undef;
    } else {
	    return $result->result->{url};
    }
}

sub buildImageHtml {
    #returns html for posting images

    my $urls = shift;

    if (!defined($urls)) {
	    return "";
    }

    my $results;
    my $i; #iterator
    for ($i = 0; $i < @$urls; $i++) {
	    my $pair = $urls->[$i];
	    $results .= "<div align=\"center\"><img src=\"$pair->[0]\" border=\"0\"></div><br>";
    }

#    print STDERR "image html: $results";
    return $results;
}

sub getSubject {
    my $mimeEntity = shift;

    my $head = $mimeEntity->head;
    chomp($subject = $head->get('subject', 0));

    return $subject;
}

sub submitPost {
    my ($subject, $body, $images) = @_;
    my $description = $images . $body;

#    print STDERR "subject: $subject desc: $description";
    
    my $rpCaller = new XMLRPC::Lite;
    my $result = $rpCaller
        ->proxy($config{blogxmlrpc})
        ->call('metaWeblog.newPost',
  	     $config{blogid},
  	     $config{bloguser},
             $config{blogpass},
  	     {
  	            'title'        => $subject,
  	            'description'  => $description
             },	$config{publish} );

    unless ($result->fault) {
        #if all went well, change the category 
        my $postid = $result->result();
        my $bool = $rpCaller
           ->proxy($config{blogxmlrpc})
           ->call('metaWeblog.setPostCategories',
  	         $postid,
  	         $config{bloguser},
  	         $config{blogpass},
  	         [{
		      'categoryId'  =>  $config{category},
		      'isPrimary'   =>  1
		 }]);
	    
	        print STDERR "New entry posted, id=$postid\n";
         	print STDERR "editing categories=$bool\n";
    }
}

sub parseEntity {
    my $mimeEntity = shift;

    my @attachments;
    my $body;

    # Handle the non-multipart messages
    if($mimeEntity->parts == 0) {
        $body = $mimeEntity->bodyhandle->as_string;
    }

    foreach my $part ($mimeEntity->parts) {
	  my $bodyHandle = $part->bodyhandle;

	  if (!defined($bodyHandle)) {
	        # could be a multipart/mixed message, which is what I get
	        # when I email with a pgp sig attachment. Now, you know,
	        # there are way too many variations on how the messages
	        # can be structured for me to handle any large number of
	        # cases. So I'm just going to handle the simple cases and
	        # this special case for myself.
	    if ($part->mime_type eq 'multipart/mixed') {
		      # recursive call!
		      return parseEntity($part);
	    } else {
		      next;
	    }
	  }

	  # We only care about text/plain parts and image/* parts.
	  # We'll assume we can deal with any image/* mime type.  Maybe
	  # this should be changed to do something more interesting like
	  # decide to choose the text/html portion over the text/plain
	  # portion if available. I'm planning on just putting html in
	  # my text/plain emails if I want the post to be HTMLified.
  	if ($part->mime_type eq 'text/plain') {
	    $body .= $bodyHandle->as_string;
#} elsif ($part->mime_type eq 'text/html') {
#    print "HTML! " . $bodyHandle->as_string;
  	} elsif ($part->mime_type =~ /^image/ ||
		  $part->mime_type eq 'application/octet-stream') {
	        # push the whole MIME::Body object into the array.. this is a
	        # useful structure to pass the file around in
	        push @attachments, $bodyHandle;
	    }
    }

    # get rid of the stupid cingular message
    my @bodySplit = split /^-+$/m, $body, 2;

    if ($config{removenewlines}) {
	    $bodySplit[0] =~ s/\n//g;
    }

    if ($config{removebottomnewlines}) {
        $bodySplit[0] =~ s/(\n)*$//;
    }

    return (bodyText => $bodySplit[0],
	    attachments => \@attachments);
}


sub usage {
    print <<EOUSAGE;
$0
        --config=<path/to/config/file>   Override the config file
        --help                           See this message

EOUSAGE
}


sub getConfig {

    my $rcfile;
    my $help = 0;
    my $noSubmit = 0;

    if (exists($ENV{HOME})) {
    	$rcfile = "$ENV{HOME}/.mt-moblog.cfg";
    }

    my $result = GetOptions("help|usage|?"    => \$help,
			    "rcfile|config=s" => \$rcfile,
			    "noSubmit"        => \$noSubmit);
    if (!$result || $help) {
    	exit(&usage);
    }

    if (!defined($rcfile)){
	    die "No configuration file defined, cannot continue... ".
	        '(maybe your $HOME environment variable is not defined?)';
    }

    if (!-e $rcfile) {
    	die "The configuration file specified ($rcfile) does not exist.\n";
    }

    my %config = readConfigFile($rcfile);

    if (! -e $config{tempdir}) {
	    system("mkdir -p $config{tempdir}");
    }

    if ($noSubmit) {
    	$config{noSubmit} = $noSubmit;
    }
    return %config;
}

sub readConfigFile {
    my ($rcfile) = @_;

    open (RCFILE, $rcfile)
    	or die "Couldn't open $rcfile: $!";
    my %config = map { split /\s*=\s*/, $_, 2 }  map { chomp; $_ }
    grep { $_ !~ /^$/ && $_ !~ /^#/ } <RCFILE>;

    close(RCFILE)
        or die "Couldn't close $rcfile: $!";

    return %config;
}