libexo-1-0 0.10.7-1 / usr / lib / x86_64-linux-gnu / xfce4 / exo-1 / exo-compose-mail-1

#!/usr/bin/env perl
#
# exo-compose-mail-1 - Perl script to parse mailto:-URIs and invoke the
#                      various included MailReaders with the appropriate
#                      parameters.
#
# Copyright (c) 2006 Benedikt Meurer <benny@xfce.org>.
#
# 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; version 2 of the License ONLY.
#
# 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 Street, Fifth Floor, Boston,
# MA 02110-1301 USA
#

use URI::Escape;
use URI::file;
use URI::URL;
use strict;

# check number of arguments
if ($#ARGV != 2) {
	print STDERR "Usage: $0 <style> <binary> <mailto>\n";
	exit 1;
}

# determine arguments
my $style = $ARGV[0];
my $binary = $ARGV[1];
my $mailtoUrl = url($ARGV[2]);

# mailto:-components
my @to = ();
my @cc = ();
my @bcc = ();
my $subject = undef;
my $body = undef;
my @attachments = ();

# parse the mailto:-address
my @headers = $mailtoUrl->headers();
for (my $n = 0; $n < $#headers; $n += 2) {
	if ($headers[$n] =~ /^to$/i) {
		push (@to, $headers[$n + 1]);
	}
	elsif ($headers[$n] =~ /^cc$/i ) {
		push (@cc, $headers[$n + 1]);
	}
	elsif ($headers[$n] =~ /^bcc$/i ) {
		push (@bcc, $headers[$n + 1]);
	}
	elsif ($headers[$n] =~ /^subject$/i ) {
		$subject = $headers[$n + 1];
	}
	elsif ($headers[$n] =~ /^body$/i ) {
		$body = $headers[$n + 1];
	}
	elsif ($headers[$n] =~ /^attach$/i ) {
		# be sure to add as file:-URI
		my $f = $headers[$n + 1];
		push(@attachments, ($f =~ m/^file:\//) ? URI->new($f) : URI::file->new_abs($f));
	}
}

# start with only the binary name
my @argv = ($binary);

# add style-specific parameters
if ($style eq 'mozilla') {
	# similar to mozilla-remote, but with --compose
	my $command = "to='" . join(",", @to) . "'";
	$command .= ",cc='" . join(",", @cc) . "'";
	$command .= ",bcc='" . join(",", @bcc) . "'";
	$command .= ",attachment='" . join(",", @attachments) . "'";
	$subject and $command .= ",subject='$subject'";
	$body and $command .= ",body='$body'";

	# and add the parameters to the argv
	push (@argv, '-compose');
	push (@argv, $command);
}
elsif ($style eq 'mozilla-remote') {
	# generate xfeDoCommand(composeMessage, ...) string
	my $command = 'xfeDoCommand(composeMessage';
	$command .= ",to='" . join(",", @to) . "'";
	$command .= ",cc='" . join(",", @cc) . "'";
	$command .= ",bcc='" . join(",", @bcc) . "'";
	$command .= ",attachment='" . join(",", @attachments) . "'";
	$subject and $command .= ",subject='$subject'";
	$body and $command .= ",body='$body'";
	$command .= ')';

	# and add the parameters to the argv
	push (@argv, '-remote');
	push (@argv, $command);
}
elsif ($style eq 'evolution') {
	# generate the mailto:-URI for evolution
	my $mailto = undef;
	for my $to (@to) {
		if ($mailto) {
			$mailto .= 'to=' . uri_escape($to) . '&';
		}
		else {
			$mailto = 'mailto:' . uri_escape($to) . '?';
		}
	}
	for my $cc (@cc) {
		$mailto .= 'cc=' . uri_escape($cc) . '&';
	}
	for my $bcc (@bcc) {
		$mailto .= 'bcc=' . uri_escape($bcc) . '&';
	}
	for my $attachment (@attachments) {
		$mailto .= "attach=$attachment&";
	}
	$subject and $mailto .= 'subject=' . uri_escape($subject) . '&';
	$body and $mailto .= 'body=' . uri_escape($body);

	# and add the parameter to the argv
	push (@argv, $mailto);
}
elsif ($style eq 'kmail') {
	# generate the parameters for kmail
	for (my $n = 1; $n < @to; $n++) {
		push (@argv, '--cc', $to[$n]);
	}
	for my $cc (@cc) {
		push (@argv, '--cc', $cc);
	}
	for my $bcc (@bcc) {
		push (@argv, '--bcc', $bcc);
	}
	for my $attachment (@attachments) {
		push (@argv, '--attach', $attachment);
	}
	$subject and push (@argv, '--subject', $subject);
	$body and push (@argv, '--body', $body);
	push (@argv, '--composer');
	(@to > 0) and push (@argv, $to[0]);
    print @argv;
}
elsif ($style eq 'sylpheed') {
	# generate the mailto:-URI (somewhat like Evolution)
	my $mailto = 'mailto:' . ((@to > 0) ? $to[0] : "") . '?';
	for (my $n = 1; $n < @to; $n++) {
		$mailto .= 'cc=' . $to[$n] . '&';
	}
	for my $cc (@cc) {
		$mailto .= 'cc=' . $cc . '&';
	}
	for my $bcc (@bcc) {
		$mailto .= 'bcc=' . $bcc . '&';
	}
	$subject and $mailto .= 'subject=' . uri_escape($subject) . '&';
	$body and $mailto .= 'body=' . uri_escape($body);

	# and add the parameters to the argv
	push (@argv, '--compose', $mailto);
	if (@attachments > 0) {
		push (@argv, '--attach');
		for my $uri (@attachments) {
			# claws-mail supports URIs, sylpheed and older claws need 
			# unescaped local paths
			if ($binary eq 'claws-mail') {
				push (@argv, $uri);
			} else {
				push (@argv, uri_unescape ($uri->path ()));
			}
		}
	}
}
elsif ($style eq 'balsa') {
	# same story with balsa
	my $mailto = 'mailto:' . ((@to > 0) ? uri_escape($to[0]) : "") . '?';
	for (my $n = 1; $n < @to; $n++) {
		$mailto .= 'cc=' . uri_escape($to[$n]) . '&';
	}
	for my $cc (@cc) {
		$mailto .= 'cc=' . uri_escape($cc) . '&';
	}
	for my $bcc (@bcc) {
		$mailto .= 'bcc=' . uri_escape($bcc) . '&';
	}
	$subject and $mailto .= 'subject=' . uri_escape($subject) . '&';
	$body and $mailto .= 'body=' . uri_escape($body);

	# and add the parameters to the argv
	push (@argv, '--compose', $mailto);
	for my $uri (@attachments) {
		push (@argv, '--attach', $uri->path ());
	}
}
elsif ($style eq 'mutt') {
	# generate the parameters for mutt
	for my $cc (@cc) {
		push (@argv, '-c', $cc);
	}
	for my $bcc (@bcc) {
		push (@argv, '-b', $bcc);
	}
	for my $uri (@attachments) {
		push (@argv, '-a', $uri->path ());
	}
	$subject and push (@argv, '-s', $subject);
	for my $to (@to) {
		push (@argv, $to);
	}

	# mutt needs an address, if we don't have
	# any, just append an empty string and mutt
	# will prompt for the To: address
	(not @to) and push (@argv, '');
}
else {
	print STDERR "$0: Unsupported style '$style'.\n";
	exit 1;
}

# try to execute the generated command
exec @argv;

# something went wrong
exit 1;