package LATMOS::Accounts::Cli::Object;

# $Id: Cli.pm 2145 2018-08-29 18:15:46Z nanardon $

use strict;
use warnings;
use Moose;
use LATMOS::Accounts::Log;
use LATMOS::Accounts::Utils;
use Term::ReadLine;
use Text::ParseWords;
use Getopt::Long;

extends 'LATMOS::Accounts::Cli::Base';

=head1 NAME

LATMOS::Accounts::Cli - Command line interface functions

=head1 DESCRIPTION

This module handle envirronment and functons for L<la-cli> tools.

=cut

=head1 FUNCTIONS

=cut

has otype => ( is => 'ro' );
has objs  => ( is => 'rw' );

=head1 CLI FUNCTIONS

=head2 OBJECT COLLECTION FUNCTIONS

=cut

sub BUILD {
    my ( $self ) = @_;

    my $labase = $self->base;
    my $OUT = $self->Context->Out;

    $self->{_otype} = $self->otype;
    $self->{_objects} = $self->objs;

=head3 +

add item to selection

=cut

    $self->add_func('+', {
        code => sub {
            my ($env, @ids) = @_;
            my %ids = map { $_->id => 1 } @{$env->{_objects}};
            foreach (@ids) {
                $ids{$_} and next;
                my $o = $env->base->get_object($env->{_otype}, $_) or next;
                push(@{$env->{_objects}}, $o);
            }
            printf $OUT "select is now %s: %s\n", $env->{_otype}, join(', ', map {
                $_->id } @{$env->{_objects}});
        },
        completion => sub {
            my ($env, undef, @ids) = @_;
            my %ids = map { $_->id => 1 } @{$env->{_objects}};
            return ( grep { ! $ids{$_} } $env->base->list_objects($env->{_otype}));
        },
        }
    );
    $self->add_func('-', {
        help => 'add item to selection',
        code => sub {
            my ($env, @ids) = @_;
            my %ids = map { $_ => 1 } @ids;
            my @newobjs = grep { !$ids{$_->id} } @{$env->{_objects}};

            if (!@newobjs) {
                print $OUT "This would remove all objects from the list...\n";
                return;
            } else {
                @{$env->{_objects}} = @newobjs;
            }
            printf $OUT "select is now %s: %s\n", $env->{_otype}, join(', ', map {
                $_->id } @{$env->{_objects}});
        },
        completion => sub {
            my ($env, undef, @ids) = @_;
            my %ids = map { $_ => 1 } @ids;
            grep { !$ids{$_} } map { $_->id } @{$env->{_objects}};
        },
        }
    );

=head3 show

    show
    show [atttribute]

Show an attributes of selected objects

=cut

    $self->add_func('show', {
        code => sub {
            my ($env, $attr) = @_;
            if (!$attr) {
                foreach (@{$env->{_objects}}) {
                    print $OUT $_->dump;
                }
            } else {
                foreach my $u (@{$env->{_objects}}) {
                    print $OUT sort map { $u->id . ': ' .($_ || '') . "\n" } $u->get_attributes($attr);
                }
            }
        },
        completion => sub {
            if (!$_[2]) {
                my $flag = $_[1] =~ /^_/ ? 'ra' : 'r';
                return $_[0]->base->list_canonical_fields($_[0]->{_otype}, $flag)
            }
        },
    });
    $self->add_func('print', {
        help => 'print fmt - show attributes using template',
        code => sub {
            my ($env, $fmt) = @_;
            if (!defined($fmt)) {
                print $OUT "no format given";
                return;
            }
            foreach (@{$env->{_objects}}) {
                print $OUT $_->queryformat($fmt) . "\n";
            }
        },
    });
    $self->add_func('unset', {
        help => 'unset attribute - unset specified attribute',
        code => sub {
            my ($env, $attr) = @_;
            $attr or do {
                print $OUT "Attributes must be specified";
                return;
            };
            foreach (@{$env->{_objects}}) {
                defined $_->set_c_fields($attr => undef) or do {
                    print $OUT "cannot unset attributes $attr for " . $_->id .
                    "\n";
                    return;
                };
            }
            $env->commit;
            print $OUT "Changes applied\n";
        },
        completion => sub {
            my ($env, $lastw, @args) = @_;
            if (!$args[0]) {
                return $env->base->list_canonical_fields($env->{_otype}, 'w')
            }
        },
    });
    $self->add_func('set', {
        help => 'set attribute value - set an attributes to single value "value"',
        code => sub {
            my ($env, $attr, @value) = @_;
            @value or do {
                print $OUT "attribute and value must be specified\n";
                return;
            };
            foreach (@{$env->{_objects}}) {
                defined $_->set_c_fields($attr => @value <= 1 ? $value[0] :
                    \@value) or do {
                    $_->base->rollback;
                    printf $OUT "Cannot set $attr to %s for %s\n", join(', ',
                        @value), $_->id;
                    return;
                };
            }
            $env->commit;
            print $OUT "Done.\n";
        },
        completion => sub {
            my ($env, $lastw, @args) = @_;
            if (!$args[0]) {
                return $env->base->list_canonical_fields($env->{_otype}, 'w')
            } else {
                my $attr = $env->base->attribute($env->{_otype}, $args[0]);
                if ($attr->has_values_list) {
                    $attr->can_values;
                } elsif (@{$env->{_objects}} == 1) {
                    return
                    $env->{_objects}[0]->get_attributes($args[0]);
                }
            }
        },
    });
    $self->add_func('add', {
        help => 'add a value to an attribute',
        code => sub {
            my ($env, $attr, @value) = @_;
            @value or do {
                print $OUT "attribute and value must be specified\n";
                return;
            };
            foreach (@{$env->{_objects}}) {
                my @attrv = grep { $_ } $_->get_attributes($attr);
                defined $_->set_c_fields($attr => [ @attrv, @value ]) or do {
                    $_->base->rollback;
                    printf $OUT "Cannot set $attr to %s for %s\n", join(', ',
                        @value), $_->id;
                    return;
                };
            }
            $env->commit;
            print $OUT "done\n";
        },
        completion => sub {
            my ($env, $lastw, @args) = @_;
            if (!$args[0]) {
                return grep {
                    $env->base->attribute($env->{_otype}, $_)->{multiple}
                } $env->base->list_canonical_fields($env->{_otype}, 'w')
            } else {
                my $attr = $env->base->attribute($env->{_otype}, $args[0]);
                if ($attr->has_values_list) {
                    $attr->can_values;
                } elsif (@{$env->{_objects}} == 1) {
                    return
                    $env->{_objects}[0]->get_attributes($args[0]);
                }
            }
        },
    });
    $self->add_func('remove', {
        help => 'remove a value from an attribute',
        code => sub {
            my ($env, $attr, @value) = @_;
            @value or do {
                print $OUT "attribute and value must be specified\n";
                return;
            };
            foreach (@{$env->{_objects}}) {
                my @attrv = grep { $_ } $_->get_attributes($attr);
                foreach my $r (@value) {
                    @attrv = grep { $_ ne $r } @attrv;
                }
                defined $_->set_c_fields($attr => @attrv ? [ @attrv ] : undef) or do {
                    $_->rollback;
                    printf $OUT "Cannot set $attr to %s for %s\n", join(', ',
                        @value), $_->id;
                    return;
                };
            }
            $env->commit;
            print $OUT "done\n";
        },
        completion => sub {
            my ($env, $lastw, @args) = @_;
            if (!$args[0]) {
                return grep {
                    $env->base->attribute($env->{_otype}, $_)->{multiple}
                } $env->base->list_canonical_fields($env->{_otype}, 'w')
            } else {
                my $attr = $env->base->attribute($env->{_otype}, $args[0]);
                if (@{$env->{_objects}} == 1) {
                    return
                    $env->{_objects}[0]->get_attributes($args[0]);
                }
            }
        },
    });
    $self->add_func('list', {
        help => 'list current selected objects',
        code => sub {

            my $env = shift;
            my @args = $self->getoption(
                {
                    'fmt=s'      => \my $fmt,
                    'filefmt=s'  => \my $filefmt,
                }, @_
            );

            if ($filefmt){
                open(my $hfmt, '<', $filefmt) or die "Cannot open $filefmt\n";
                $fmt ||= ''; # avoid undef warning
                while (<$hfmt>) {
                    chomp($fmt .= $_);
                }
                close $hfmt;
            }

            if ($fmt) {
                foreach (@{$env->{_objects}}) {
                    print $OUT $_->queryformat($fmt);
                }
                print $OUT "\n";
            } else {
                printf $OUT "%s: %s\n", $env->{_otype}, join(', ', map { $_->id } @{$env->{_objects}});
            }
        }
    });
    $self->add_func('ls',  { alias => [ qw'list' ] });
    $self->add_func('edit', {
            help => 'edit [object] - edit selected object using vi',
            completion => sub {
                return map { $_->id } @{$_[0]->{_objects}}
            },
            code => sub {
                my ($env, $id) = @_;
                my $obj;
                if ($id) {
                    $obj = grep { $_->id = $id } @{$env->{_objects}} or do {
                        print $OUT "$id is not part of selected objects\n";
                        return;
                    };
                } elsif (@{$env->{_objects}} == 1) {
                    $obj = $env->{_objects}[0]
                } else {
                    print $OUT "multiple objects selected but can edit only one,"
                    . "please specify which one\n";
                    return;
                }
                my $res = LATMOS::Accounts::Utils::dump_read_temp_file(
                    sub {
                        my ($fh) = @_;
                        $obj->text_dump($fh,
                            {
                                empty_attr => 1,
                                only_rw => 1,
                            }
                        );
                    },
                    sub {
                        my ($fh) = @_;
                        my %attr = LATMOS::Accounts::Utils::parse_obj_file($fh);
                        my $res = $obj->set_c_fields(%attr);
                        if ($res) {
                            print $OUT "Changes applied\n";
                            $env->commit;
                        }
                        else { print $OUT "Error applying changes\n" }
                        return $res ? 1 : 0;
                    }
                );
            },
        });
    $self->add_func('delete', {
        help => 'delete - delete selected object',
        code => sub {
            my ($env) = @_;
            printf $OUT "%s: %s\ndelete selected objects ? (yes/NO)\n",
            $env->{_otype}, join(', ', map { $_->id } @{$env->{_objects}});
            my $reply = <STDIN> || ''; chomp($reply);
            if ($reply eq 'yes') {
                foreach (@{$env->{_objects}}) {
                    $env->base->delete_object($env->{_otype}, $_->id) or do {
                        print $OUT "Cannot delete " . $_->id . "\n";
                        return;
                    };
                }
                $env->commit;
                return "EXIT";
            } else {
                print $OUT "cancel !\n"
            }
        },
    });
    if (grep { $self->base->attribute($self->otype, $_)->reference }
        $self->base->list_canonical_fields($self->otype, 'r')) {
        $self->add_func('select', {
            help => 'select attribute [object]',
            code => sub {
                my ($env, $attrname, @objects) = @_;

                my $attr = $env->base->attribute(
                    $env->{_otype},
                    $attrname
                ) or do {
                    print $OUT "No attribute $attrname";
                    return;
                };
                my $totype = $attr->reference or return;

                if (! @objects) {
                    @objects = grep { $_ } 
                      map { $_->get_attributes($attrname) } @{$env->{_objects}};
                }
                {
                    my %uniq = map { $_ => 1 } @objects;
                    @objects = keys %uniq;
                }
                my @objs = (grep { $_ } map { $env->base->get_object($totype, $_) }
                        @objects);
                return if (!@objs);
                print $OUT "Selecting $totype " . join(', ', map { $_->id } @objs) . "\n";
                LATMOS::Accounts::Cli::Object->new(
                    Parent  => $self,
                    Context => $env->Context,
                    otype   => $totype,
                    objs    => \@objs
                )->cli();
            },
            completion => sub {
                if ($_[2]) {
                    my $totype = $_[0]->base->attribute($_[0]->{_otype},
                        $_[2])->reference or return;
                    return grep { $_ }
                           map { $_->get_attributes($_[2]) }
                           @{$_[0]->{_objects}};
                } else {
                    my $flag = $_[1] =~ /^_/ ? 'ra' : 'r';
                    return grep { $_[0]->base->attribute($self->otype, $_)->reference }
                    $_[0]->base->list_canonical_fields($self->otype, $flag);
                }
            },
            }
        );
    }

    if (lc($self->otype) eq 'user') {
        $self->add_func('group', {
            help => 'group add|remove|primary goupname',
            code => sub {
                my ($env, $action, @groups) = @_;
                foreach my $obj (@{$env->{_objects}}) {
                    if ($action eq 'primary') {
                        my $gid = $groups[0];
                        if ($gid !~ /^\d/) {
                            my $gobj = $env->base->get_object('group', $gid) or
                            do {
                                print $OUT "Cannot find group $gid\n";
                                return;
                            };
                            $gid = $gobj->get_attributes('gidNumber');
                        }
                        $obj->set_c_fields('gidNumber', $gid);
                    } else {
                        my %gr;
                        foreach ($obj->get_attributes('memberOf')) {
                            $gr{$_} = 1;
                        }
                        if ($action eq 'add') {
                            $gr{$_} = 1 foreach(@groups);
                        } elsif ($action eq 'remove') {
                            delete($gr{$_}) foreach(@groups);
                        } else {
                            print $OUT 'invalid action' . "\n";
                            return;
                        }
                        defined $obj->set_c_fields('memberOf' => [ keys %gr ]) or do {
                            print $OUT "cannot set memberOf attributes for " .
                            $obj->id . "\n";
                            return;
                        };
                    }
                }
                $env->commit;
            },
            completion => sub {
                if (!$_[2]) {
                    return (qw(add remove primary));
                } else {
                    if ($_[2] eq 'remove') {
                        my %uniq = map { $_ => 1 }
                            grep { $_ }
                            map { $_->get_attributes('memberOf') }
                            @{$_[0]->{_objects}};
                        return sort keys %uniq;
                    } else {
                        return $_[0]->base->search_objects('group');
                    }
                }
            },
        });
    } elsif ($self->otype eq 'group') {
        $self->add_func('member', {
            help => 'member add|remove user',
            code => sub {
                my ($env, $action, @groups) = @_;
                foreach my $obj (@{$env->{_objects}}) {
                    my %gr;
                    foreach ($obj->get_attributes('memberUID')) {
                        $gr{$_} = 1;
                    }
                    if ($action eq 'add') {
                        $gr{$_} = 1 foreach(@groups);
                    } elsif ($action eq 'remove') {
                        delete($gr{$_}) foreach(@groups);
                    } else {
                        print $OUT 'invalid action' . "\n";
                        return;
                    }
                    defined $obj->set_c_fields('memberUID' => [ keys %gr ]) or do {
                        print $OUT "cannot set memberUID attributes for " .
                        $obj->id . "\n";
                        return;
                    };
                }
                $env->commit;
            },
            completion => sub {
                if (!$_[2]) {
                    return (qw(add remove));
                } else {
                    if ($_[2] eq 'remove') {
                        my %uniq = map { $_ => 1 }
                            grep { $_ }
                            map { $_->get_attributes('member') }
                            @{$_[0]->{_objects}};
                        return sort keys %uniq;
                    } else {
                        return $_[0]->base->search_objects('user');
                    }
                }
            },
        });
    }
    if (1) { # TODO test SQL base
        $self->add_func('extract', {
            help => 'extract information about objects',
            code => sub {
                my ($env, $action) = @_;
                foreach my $obj (sort @{$env->{_objects}}) {
                    print $OUT $obj->dump({ recur => 1 });
                }
                $env->rollback;
            },
        });
    }

    return $self;
}

sub promptPrefix {
    my ($self) = @_;

    sprintf("%s %s/%s",
        $self->base->label,
        $self->otype,
        @{$self->objs} > 1
            ? '(' . scalar(@{$self->objs}) . ' obj.)'
            : $self->objs->[0]->id,
    );
}

around run => sub {
    my $next = shift;
    my $self = shift;

    my $name = shift or return;

    if (my $otype = $self->{funcs}{$name}{proxy}) {
         $self->Context->{objs} = $self->objs;
         LATMOS::Accounts::Cli->new(
            Parent  => $self, # Look useless
            Context => $self->Context,
        )->run(
            $name,
            '-o', $self->otype,
            @_,
        );
        $self->Context->{objs} = undef;
    } else {
        return $self->$next($name, @_);
    }
};

1;

__END__

=head1 SEE ALSO

L<LATMOS::Accounts>

=head1 AUTHOR

Olivier Thauvin, E<lt>olivier.thauvin@latmos.ipsl.frE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2008, 2009, 2010, 2011, 2012 CNRS SA/CETP/LATMOS

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.10.0 or,
at your option, any later version of Perl 5 you may have available.

=cut