package Fripost::Commands::add_alias;

use 5.010_000;
use strict;
use warnings;
use utf8;

=head1 NAME

add_alias - Add a new virtual alias

=cut

use FindBin qw($Bin);
use lib "$Bin/lib";

use Email::Valid;
use Fripost::Prompt;
use Fripost::Schema;
use Fripost::Email;

our $VERSION = '0.01';

sub main {
    my $ldap = shift;
    my $conf = shift;

    my $goto = shift;
    my @addr = @_;

    prompt_if_undefined ( "Alias goto address: ", \$goto,
        [ rewrite => sub { fix_username $_ }
        , 'Invalid e-mail' => sub { Email::Valid->address('fake'.$_) }
        ]
    );

    # Since we don't have that many users and aliases for the time
    # being, it's probably better to load the whole graph of aliases in
    # memory, not to make too many queries to the LDAP server.
    my $graph = &build_alias_graph( $ldap->alias->search()->entries );

    prompt_if_undefined ( "Alias from address(es): ", \@addr,
        [ rewrite => sub { fix_username $_ }
        , 'Invalid e-mail' => sub { Email::Valid->address('fake'.$_) }
        , 'Unknown domain' => sub { $ldap->domain->search({
                                        domain => (split /\@/, $_, 2)[1]
                                    })->count }
        , 'User exists'    => sub { $ldap->user->search({
                                       username => $_
                                    })->count == 0 }
        , 'Alias exists'   => sub { $conf->{force} or
                                    $ldap->alias->search({
                                       address => $_
                                    })->count == 0 }
        , "Is already an alias for `$goto'" =>
                sub { $ldap->alias->search({
                          address => $_, goto => $goto
                      })->count == 0 }
        , "Reachable from `$goto'" =>
                sub { !&search_path ($graph, $goto, $_, ($conf->{debug} or
                                                         $conf->{verbose})) }
        ]
    );
    unless (@addr) {
        say "All right, not much to do.";
        exit 0;
    }

    say "Goto adress: $goto";
    say "From adress(es): " . (join ", ", @addr);
    confirm_or_abort();

    my $msg = new_alias_info_message ($conf, $goto, \@addr);

    ## Insert alias
    for my $addr (@addr) {
        if ($conf->{pretend}) {
            say STDERR "Did not create alias since we are pretending."
                if $conf->{verbose} or $conf->{debug};
        }
        else {
            $ldap->alias->add({ address => $addr, goto => $goto,
                                isActive => 'TRUE' });
            say "New alias added from $addr to $goto.";
        }
    }

    if ($conf->{pretend}) {
        say STDERR "Did not send confirmation since we are pretending."
            if $conf->{verbose} or $conf->{debug};
    }
    else {
        if (confirm "Send confirmation? ") {
            $msg->send();
            say "Sent confirmation (". (security_status $msg) .").";
        }
    }
}


# Build the graph of aliases. It is a hash where the keys are the 'from'
# part of the aliases, and the values are array references of the 'goto'
# part.
# For 'search_path' it is better to do it that way, as for a given
# 'from' the list of 'goto' is likely to be of length one only. (Hence
# the stack won't blow up.)
sub build_alias_graph {
    my $graph;
    foreach (@_) {
        my $to = $_->{goto};
        foreach my $from (@{$_->{address}}) {
            push @{$graph->{$from}}, $to;
        }
    }
    return $graph;
}


# Search a path in the given graph.
sub search_path {
    my ($graph, $from, $to, $verbose) = @_;

    my @stack;
    push @stack, [$from];

    while (@stack) {
        my $path = pop @stack;
        my $last = @{$path}[$#$path];
        if ($last eq $to) {
            say STDERR 'Path found: ', join (' -> ', @$path) if $verbose;
            return @$path;
        }

        foreach (@{$graph->{$last}}) {
            push @stack, [@$path,$_];
        }
    }
}


=head1 AUTHOR

Stefan Kangas C<< <skangas at skangas.se> >>

Guilhem Moulin C<< <guilhem at fripost.org> >>

=head1 COPYRIGHT

Copyright 2010,2011 Stefan Kangas.

Copyright 2012 Guilhem Moulin.

=head1 LICENSE

This program is free software; you can redistribute it and/or modify it
under the same terms as perl itself.

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.

=cut

1; # End of add_alias.pm

__END__