Upload by email handler to send notes to pinboard.in

upload-note-by-email.pl

#!/usr/bin/env perl

# For example:
# $> cat test.eml | perl upload-note-by-email.pl -c pinboard.cfg

use strict;
use Getopt::Std;

# All I can tell you is these are all available by
# default on pair.com so it's not really that big a
# deal...

use Config::Simple;
use Email::MIME;
use WWW::Mechanize;

{
    &main();
    exit;
}

sub main {

    my $txt = '';
    my %opts = ();

    # 'c' is the path to your config file
    # 'p' if present means make this public

    getopts('c:p', \%opts);

    if (! -f $opts{'c'}){
	warn "Not a valid config file";
	return 0;
    }

    # Your config file should look like this:
    #
    # [pinboard]
    # username=USERNAME
    # password=S33KRET

    my $cfg = Config::Simple->new($opts{'c'});

    # It's true. This should have some kind of automatic
    # kill switch...

    while (<STDIN>){
	$txt .= $_;
    }

    my $ok = 0;

    if (my $note = parse_email($txt)){
	my $public = ($opts{'p'}) ? 1 : 0;
	$ok = post_note($cfg, $note, $public);
    }
    
    return $ok;
}

# Everyone hates Perl until you have to parse
# email...

sub parse_email {
    my $txt = shift;

    my $email = Email::MIME->new($txt);
    my @parts = $email->parts;

    my $note = undef;

    foreach my $p (@parts){

	my $type = $p->content_type;

	# See below inre: Instapaper – maybe some day
	# we will parse HTML notes... but why?

	if ($type !~ m!^text/plain!){
	    next;
	}

	# TO DO: encoding - as of this writing it
	# is still squirrel-y (20121029/straup)

	my $body = $p->body;
	$body =~ s/\r/\n/g;

	if ($body =~ /via Instapaper/mi){
	    $note = parse_instapaper($body);
	}

	# See this? It means the only thing we're 
	# accounting for at the moment is Instapaper

	last;
    }

    if (! $note){
	warn "Can't find note...";
	return undef;
    }

    return $note;
}

# This may not be the cleverest way to do things but it works; and
# I'm still working on the morning's first coffee; and I'm sitting
# here waiting for the power to go out in advance of angry sky
# god's advance on new york city...

sub parse_instapaper {
    my $txt = shift;

    my @parts = split("\n", $txt);

    my %note = (
	'tags' => 'from:instapaper',
	);

    my @body = ();

    foreach my $ln (@parts){

	if (! $ln){
	    next;
	}

	if (! $note{'title'}){
	    $note{'title'} = $ln;
	    next;
	}

	if (! $note{'url'}){
	    $note{'url'} = $ln;
	    next;
	}

	if ($ln =~ /via Instapaper/i){
	    $note{'body'} = join("\n", @body);
	    last;
	}

	push @body, $ln;
    }

    return \%note;
}

# See also: https://gist.github.com/3968495

sub post_note {
    my $cfg = shift;
    my $note = shift;
    my $public = shift;

    my $username = $cfg->param('pinboard.username');
    my $password = $cfg->param('pinboard.password');

    my $title = $note->{'title'};
    my $tags = join(",", ("highlights", $note->{'tags'}));
    my $body = join("\n\n", ($note->{'body'}, $note->{'url'}));

    # Go!

    my $action = ($public) ? 'save_public' : 'save_private';
    my $button = ($public) ? 'save public' : 'save private';

    # Yes, that's right – it's necessary or LWP::UA
    # will freak out and die

    $ENV{'PERL_LWP_SSL_VERIFY_HOSTNAME'} = 0;

    my $m = WWW::Mechanize->new();
    $m->get("https://pinboard.in/");

    $m->field('username', $username);
    $m->field('password', $password);
    $m->submit();

    # There's actually not much in the way of error checking
    # the login but at least we can see if the server freaks
    # out

    if ($m->status != 200){
	warn "failed to log in: " . $m->message;
	return 0;
    }

    # Now add the note - see also:
    # http://search.cpan.org/~jesse/WWW-Mechanize/lib/WWW/Mechanize/FAQ.pod#I_submitted_a_form,_but_the_server_ignored_everything!_I_got_an_empty_form_back!

    $m->get("https://pinboard.in/note/add/");

    $m->field('title', $title);
    $m->field('tags', $tags);
    $m->field('note', $body);
    $m->field('action', $action);
    $m->click_button('value', $button);

    if ($m->status != 200){
	warn "failed to post note: " . $m->message;
	return 0;
    }

    return 1;
}