#!/usr/bin/env perl

# mutt-mailto - use Mutt on mailto URIs, e.g. with browsers like Firefox
# Copyright 2005-2020 Vincent Lefevre <vincent@vinc17.net>.

# To use this script with Firefox, at least under GNU/Linux, open the
# Preferences -> Applications dialog, and for "mailto" content type,
# choose "Use other..." and select this script.
# Note: after that, the mimeTypes.rdf file in the Firefox profile
# should contain something like:
#   <RDF:Description RDF:about="urn:handler:local:/path/to/mutt-mailto"
#     NC:prettyName="mutt-mailto" NC:path="/path/to/mutt-mailto"/>
#   <RDF:Description RDF:about="urn:scheme:externalApplication:mailto"
#     NC:prettyName="mutt-mailto" NC:path="/path/to/mutt-mailto"/>

# 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.

# You should have received a copy of the GNU General Public License along
# with this program; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.

# History:
#   2005-01-14  Initial version.
#   2006-02-17  If not in a terminal, use emacs instead of uxterm.
#   2009-02-18  If not in a terminal, force UTF-8.
#   2009-05-22  If provided body, use /dev/fd or File::Temp instead of /proc.
#   2020-05-06  When forcing UTF-8: replaced "en_US.UTF-8" by "C.UTF-8".

use strict;
use Fcntl qw/F_SETFD/;
use IO::Handle;
use URI;

my ($proc) = '$Id: mutt-mailto 127329 2020-05-06 13:55:16Z vinc17/zira $'
  =~ /^.Id: (\S+) / or die;

$ARGV[0] =~ /^mailto:/ or die "Usage: $proc <mailtoURI>\n";

my $u = URI->new($ARGV[0]);
my %headers = $u->headers;
my $to = $u->to;
my @cmd = -t STDIN ? qw/mutt/ :
  qw/env LC_CTYPE=C.UTF-8 LC_CHARMAP=UTF-8 emacs -l emacs-mutt.el/;
# (qw/uxterm +sb -sl 0 -n mutt-mailto -T/, "Mutt $to", qw/-e mutt/);
my $body;
while (my ($k,$v) = each %headers)
  {
    lc($k) eq 'bcc' and push @cmd, '-b', $v;
    lc($k) eq 'cc' and push @cmd, '-c', $v;
    lc($k) eq 'subject' and push @cmd, '-s', $v;
    lc($k) eq 'body' and $body = $v;
  }

if ($body ne '')
  {
    chomp $body;
    open TMP, '>', undef
      or die "$proc: can't create temporary file\n$!\n";
    autoflush TMP 1;
    print TMP "$body\n"
      or die "$proc: can't print to temporary file\n$!\n";
    fcntl(TMP, F_SETFD, 0)
      or die "$proc: can't clear close-on-exec flag on temporary file\n$!\n";
    my $fname = "/dev/fd/".fileno(TMP);
    open FILE, $fname
      or die "$proc: can't reopen temporary file\n$!\n";
    my $empty = <FILE> eq '';
    close FILE;
    my $tmp;
    if ($empty)  # occurs under Mac OS X Tiger
      {
        # Fallback to File::Temp (the temporary file is visible and
        # will not be destroyed if mutt-mailto is killed).
        require File::Temp;
        $tmp = File::Temp->new();
        $fname = $tmp->filename;
        open TMP, '>', $fname
          or die "$proc: can't create temporary file\n$!\n";
        print TMP "$body\n"
          or die "$proc: can't print to temporary file\n$!\n";
      }
    system @cmd, '-i', $fname, $to;
    close TMP or die "$proc: can't close temporary file\n$!\n";
  }
else
  { exec @cmd, $to }

# Test on:
# mailto:a1@x?To=a2@x&Cc=a3@x&Bcc=a4@x&Subject=mailto%20test
# mailto:a1@x?To=a2@x&Cc=a3@x&Bcc=a4@x&Subject=mailto%20test&body=The%20body.