package Fripost::Schema::Mail; =head1 NAME Mail.pm - Send clear, signed or encrypted e-mails. =head1 DESCRIPTION This module is adds GnuPG signing on top of MIME::Lite. Most of the code comes from Mail::GnuPG. =cut use 5.010_000; use strict; use warnings; use utf8; use MIME::Entity; use Mail::GnuPG; use Encode 'encode'; use Net::IDN::Encode 'email_to_ascii'; my $DEBUG = 0; sub new { my $class = shift; my $self = bless {}, $class; my %msg = @_; $msg{To} //= $ENV{USER}.'@localhost'; $msg{Encoding} //= 'quoted-printable'; $msg{Charset} //= 'utf-8'; $msg{From} = Encode::encode( 'MIME-Q', email_to_ascii($msg{From})) if $msg{From}; $msg{To} = Encode::encode( 'MIME-Q', email_to_ascii($msg{To})) if $msg{To}; $msg{Subject} = Encode::encode( 'MIME-Q', $msg{Subject}) if $msg{Subject}; my $msg = MIME::Entity::->build( %msg ); $msg->sign( Signature => $msg{Signature} ) if $msg{Signature}; $self->{_msg} = $msg; return $self; } sub sign { my $self = shift; my $sign_as = shift; my $msg = $self->{_msg}; # TODO: use a config option. my $gpg = Mail::GnuPG::->new( use_agent => 1 ); my $ret = $gpg->mime_sign( $msg ); map { warn "WARN: $_" } @{$gpg->{last_message}} if $ret; return $self; } sub send { my $self = shift; my $msg = $self->{_msg}; print STDERR $msg->as_string; # $msg->send; } =back =head1 AUTHOR Guilhem Moulin C<< >> =head1 COPYRIGHT Copyright 2013 Guilhem Moulin. =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as perl itself. =cut 1; __END__