#!/usr/bin/perl use 5.010_000; use strict; use warnings; use utf8; =head1 NAME fripost-newalias - Add a new alias to the system =head1 SYNOPSIS fripost-newalias fripost-newalias GOTO FROM... =cut use FindBin qw($Bin); use lib "$Bin/lib"; use Encode qw(encode); use Email::Valid; use Fripost::Password; use Fripost::Prompt; use Fripost::Schema; use IO::Prompt; use Getopt::Long; use MIME::Base64; use MIME::Lite; use MIME::QuotedPrint; use Template; use YAML::Syck; ## Get command line options our $conf = LoadFile('default.yml'); GetOptions( 'dbi_dsn' => \$conf->{dbi_dsn}, 'admuser=s' => \$conf->{admuser}, 'admpass=s' => \$conf->{admpass}, 'pretend' => \$conf->{pretend}, ) or die "Unable to get command line options."; # Connect to the database my $schema = Fripost::Schema->connect( $conf->{dbi_dsn}, $conf->{admuser}, $conf->{admpass}, {} #\%dbi_params ); # Get information my $goto = fix_username(shift @ARGV); my @addr = @ARGV; $goto //= prompt_username("Alias goto address: "); @addr || push @addr, prompt "Alias address: "; # Show goto adress say "goto adress: $goto"; # Show from adresses @addr = grep { if (Email::Valid->address($_)) { 1; } else { say "WARN: skipping invalid address $_"; undef; } } @addr; if (@addr == 0) { say "No valid destination adresses. Aborting..."; exit 1; } say "from adress: " . (join " ", @addr); confirm_or_abort(); ## Insert alias into database for my $addr (@addr) { my $rs = $schema->resultset('Alias')->search({ address => $addr, }); if (!$rs->count) { my $db_alias = $schema->resultset('Alias')->new({ address => $addr, goto => $goto, domain => (split /\@/, $addr)[1], }); if (!$conf->{pretend}) { $db_alias->insert; say "New alias added from $addr to $goto."; } else { say "Pretending, will not add alias." } } else { say "There already exists an alias for $addr."; } } ### Prepare sending emails my $tt = Template->new({ INCLUDE_PATH => "$Bin/templ", INTERPOLATE => 1, }) || die "$Template::ERROR\n"; my $msg = MIME::Lite->new( From => encode('MIME-Q', 'Friposts administratörer') . ' ', Subject => encode('MIME-Q', 'Nya alias till din inkorg'), Encoding => 'quoted-printable', ); { my ($vars, $data); $vars = { addrs => \@addr, }; $tt->process('new_alias.tt', $vars, \$data) || die $tt->error(), '\n'; $msg->data($data); $msg->replace(To => $goto); if (!$conf->{pretend}) { confirm_or_abort("Send confirmation? "); $msg->send; say "Sent verification."; } else { say "Pretending, will not send verification."; } } =head1 AUTHOR Stefan Kangas C<< >> =head1 COPYRIGHT Copyright 2010,2011 Stefan Kangas. =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as perl itself. =cut