#!/usr/bin/perl use 5.010_000; use warnings; use strict; =head1 NAME fripost-adduser - Add a new mailbox to the system =cut our $VERSION = '0.02'; use FindBin qw($Bin); use lib "$Bin/lib"; use Data::Dumper; use File::Slurp qw(slurp); use Fripost::Password; use Fripost::Prompt; use Fripost::Schema; use IO::Prompt; use Getopt::Long; use MIME::Lite; use YAML::Syck; # Prompt for user info sub read_user_info { my $username = prompt_username("New username: "); my $name = prompt "Full (real) name: "; my $domain = (split /\@/, $username)[1]; my $maildir = "$domain/". (split /\@/, $username)[0] . "/Maildir/"; # trailing slash important my $active = 1; my $password = prompt_password(); # Show the information that will be inserted my $user = { username => $username, name => $name, domain => $domain, maildir => $maildir, active => $active, password => $password, }; print Dumper $user; return $user; } ## 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 ); say "Adding a new virtual user."; my $user = read_user_info(); ask_if_ok_or_abort(); if ($conf->{pretend}) { say "Nothing to do since we are pretending..."; exit 0; } die "User already exists" if ($schema->resultset('Mailbox')->search({ username => $user->{username} })->count); ## Insert user into database my $db_user = $schema->resultset('Mailbox')->new($user); $db_user->insert; say "New account $user->{username} added."; ## Send email my $msg = MIME::Lite->new( From => 'admin@fripost.org', To => $user->{username}, Subject => 'Välkommen till Fripost!', Data => scalar slurp('templ/new_user_mail.tt'), # TODO: actually use TT ); $msg->send(); say "Sent welcome message: "; say $msg->as_string; =head1 AUTHOR Stefan Kangas C<< >> =head1 COPYRIGHT Copyright 2010 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