Add fripost-adduser.pl

3 files changed, 191 insertions, 0 deletions

diff --git a/fripost-adduser.pl b/fripost-adduser.pl
new file mode 100755
index 0000000..d6ebe53
--- /dev/null
+++ b/fripost-adduser.pl
@@ -0,0 +1,101 @@
+#!/usr/bin/perl
+
+use 5.010_000;
+use warnings;
+use strict;
+
+=head1 NAME
+
+fripost-adduser.pl - Add a new mailbox to the system
+
+=head1 DESCRIPTION
+
+This script eases the burden of adding a new user to the system.
+
+Necessary steps to add a user to the system:
+1. Create the Maildir (ensuring proper permissions)
+2. Add him to the MySQL database
+3. Send welcome message
+4. Ensure welcome message has arrived
+
+=cut
+
+our $VERSION = '0.01';
+
+use Data::Dumper;
+use DateTime;
+use Email::Valid;
+use Fripost::Schema;
+use IO::Prompt;
+use Getopt::Long;
+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},
+) 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
+);
+
+my %user;
+
+# Get the full e-mail of the user (aka e-mail)
+while (not defined $user{username}) {
+    $user{username} = prompt "Enter the full e-mail: ";
+    if (!Email::Valid->address($user{username})) {
+        undef $user{username};
+        say "This is not a vaild e-mail address. Try again."
+    }
+}
+
+# Full name of user
+$user{name} = prompt "Full (real) name: ";
+
+# Extrapolate domain from full e-mail
+my @parts = split /\@/, $user{username};
+my $username = $parts[0];
+my $domain   = $parts[1];
+
+print "Username: $username\nDomain:$domain\n";
+
+die;
+
+# Set domain name
+$user{domain} = $domain;
+
+# Construct maildir from domain and user
+$user{maildir} = "$domain/$username/Maildir";
+
+# Set dates
+my $now = DateTime->now();
+$user{create_date} = $now;
+$user{change_date} = $now;
+
+$user{active} = 1;
+
+my $user = $schema->resultset('Mailbox')->new(\%user);
+
+# Make the insert into database
+$user->insert;
+
+=head1 AUTHOR
+
+Stefan Kangas C<< <skangas at skangas.se> >>
+
+=head1 COPYRIGHT
+
+Copyright 2010 Stefan Kangas, all rights reserved.
+
+=head1 LICENSE
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as perl itself.
+
+=cut
diff --git a/lib/Fripost/Schema.pm b/lib/Fripost/Schema.pm
new file mode 100755
index 0000000..5e171e2
--- /dev/null
+++ b/lib/Fripost/Schema.pm
@@ -0,0 +1,36 @@
+package Fripost::Schema;
+
+use 5.010_000;
+use warnings;
+use strict;
+
+use base qw/DBIx::Class::Schema/;
+our $VERSION = '0.01';
+
+  __PACKAGE__->load_namespaces();
+
+1;
+
+=head1 NAME
+
+Fripost::Schema - 
+
+=head1 AUTHOR
+
+Stefan Kangas C<< <skangas at skangas.se> >>
+
+=head1 COPYRIGHT
+
+Copyright 2010 Stefan Kangas, all rights reserved.
+
+=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 of Schema.pm
+
+__END__
+
diff --git a/lib/Fripost/Schema/Result/Mailbox.pm b/lib/Fripost/Schema/Result/Mailbox.pm
new file mode 100644
index 0000000..577c350
--- /dev/null
+++ b/lib/Fripost/Schema/Result/Mailbox.pm
@@ -0,0 +1,54 @@
+package Fripost::Schema::Result::Mailbox;
+
+use 5.010_000;
+use warnings;
+use strict;
+
+use base qw/DBIx::Class::Core/;
+
+# mysql> describe mailbox;
+# +-------------+--------------+------+-----+---------------------+-------+
+# | Field       | Type         | Null | Key | Default             | Extra |
+# +-------------+--------------+------+-----+---------------------+-------+
+# | username    | varchar(255) | NO   | PRI |                     |       | 
+# | password    | varchar(255) | NO   |     |                     |       | 
+# | name        | varchar(255) | NO   |     |                     |       | 
+# | maildir     | varchar(255) | NO   |     |                     |       | 
+# | domain      | varchar(255) | NO   |     |                     |       | 
+# | create_date | datetime     | NO   |     | 0000-00-00 00:00:00 |       | 
+# | change_date | datetime     | NO   |     | 0000-00-00 00:00:00 |       | 
+# | active      | tinyint(4)   | NO   |     | 1                   |       | 
+# +-------------+--------------+------+-----+---------------------+-------+
+# 8 rows in set (0.00 sec)
+
+__PACKAGE__->load_components(qw/InflateColumn::DateTime/);
+
+__PACKAGE__->table('mailbox');
+__PACKAGE__->add_columns(qw/ username password name maildir domain active /);
+__PACKAGE__->add_columns(
+    create_date => { data_type => 'datetime', timezone => "Europe/Stockholm", locale => "se_SV" },
+    change_date => { data_type => 'datetime', timezone => "Europe/Stockholm", locale => "se_SV" }
+);
+  
+__PACKAGE__->set_primary_key('username');
+
+=head1 NAME
+
+Fripost::Schema::Result::Mailbox - 
+
+=head1 AUTHOR
+
+Stefan Kangas C<< <skangas at skangas.se> >>
+
+=head1 COPYRIGHT
+
+Copyright 2010 Stefan Kangas, all rights reserved.
+
+=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 of Mailbox.pm