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 Term::ReadKey;
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;

    $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) {
                if ( $_ eq '@' ) {
                    foreach ( @{ $self->{_lastsearch} || [] } ) {
                        $ids{ $_ } and next;
                        $ids{ $_ } = 1;
                        my $o = $env->base->get_object($env->{_otype}, $_) or next;
                        push(@{$env->{_objects}}, $o);
                    }
                    next;
                }
                $ids{$_} and next;
                $ids{$_} = 1;
                my $o = $env->base->get_object($env->{_otype}, $_) or next;
                push(@{$env->{_objects}}, $o);
            }
            $self->printf("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 = ();
            foreach ( @ids ) {
                if ( $_ eq '@' ) {
                    foreach ( @{ $self->{_lastsearch} || [] } ) {
                        $ids{ $_ } = 1;
                    }
                } else {
                    $ids{ $_ } = 1;
                }
            }
            my @newobjs = grep { !$ids{$_->id} } @{$env->{_objects}};

            if (!@newobjs) {
                $self->print( "This would remove all objects from the list...\n" );
                return;
            } else {
                @{$env->{_objects}} = @newobjs;
            }
            $self->printf( "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}});
        },
        }
    );
    $self->add_func('search', {
        help => 'search objecttype filter1 [filter2...] - search object according filter',
        completion => sub {
            return(
                map { $_, "!$_", "-$_", "+$_" }
                map { ( $_ . '=', $_ . '~' ) } $_[0]->base->list_canonical_fields($_[0]->{_otype}, 'r')
            );
        },
        code => sub {
            my ($self, @args) = @_;
            if ($_[1]) {
                my @res = $self->base->search_objects($self->{_otype}, @args);
                $self->print( map { "$_\n" } @res );
                $self->{_lastsearch} = \@res;
                $self->{_lastsearchtype} = $self->{_otype};
            } else {
                $self->print( "Object type missing\n" );
            }
        },
    });
    $self->add_func('filter', {
        help => 'filter filter1 [filter2...] - filter object according filter',
        completion => sub {
            return(
                map { ( $_ . '=', $_ . '~' ) } $_[0]->base->list_canonical_fields($_[0]->{_otype}, 'r')
            );
        },
        code => sub {
            my ($self, @args) = @_;
            if ($_[1]) {
                my %ids = map { $_->id => 1 } @{$self->{_objects}};
                my @res = grep { $ids{ $_ } } $self->base->search_objects($self->{_otype}, @args);
                $self->print( map { "$_\n" } @res );
                $self->{_lastsearch} = \@res;
                $self->{_lastsearchtype} = $self->{_otype};
            } else {
                $self->print( "Object type missing\n" );
            }
        },
    });

=head3 clone

Create sub envirronment with same list of object

=cut

    $self->add_func('clone', {
        code => sub {
            my ($self) = @_;
            my $totype = $self->{_otype};

            LATMOS::Accounts::Cli::Object->new(
                Parent  => $self,
                Context => $self->Context,
                otype   => $totype,
                objs    => [ @{ $self->{_objects} } ],
            )->cli();
        },
    } );

    $self->add_func('sort', {
        help => 'Sort the selection according attribute',
        code => sub {
            my ($env, $attribute) = @_;

            if ($attribute) {
                @{$env->{_objects}} =
                    sort { ($a->get_attributes($attribute) || '') cmp ($b->get_attributes($attribute) || '') }
                    @{$env->{_objects}};
            } else {
                @{$env->{_objects}} =
                    sort { $a->id cmp $b->id }
                    @{$env->{_objects}};
            }

            $self->printf("select is now %s: %s\n", $env->{_otype}, join(', ', map {
                $_->id } @{$env->{_objects}}));
        },
        completion => sub {
            if (!$_[2]) {
                my $flag = $_[1] =~ /^_/ ? 'ra' : 'r';
                return $_[0]->base->list_canonical_fields($_[0]->{_otype}, $flag)
            }
        },
        }
    );
    $self->add_func('sortr', {
        help => 'Sort the selection (reverse) according attribute',
        code => sub {
            my ($env, $attribute) = @_;

            if ($attribute) {
                @{$env->{_objects}} =
                    sort { ($b->get_attributes($attribute) || '') cmp ($a->get_attributes($attribute) || '') }
                    @{$env->{_objects}};
            } else {
                @{$env->{_objects}} =
                    sort { $b->id cmp $a->id }
                    @{$env->{_objects}};
            }

            $self->printf( "select is now %s: %s\n", $env->{_otype}, join(', ', map {
                $_->id } @{$env->{_objects}}));
        },
        completion => sub {
            if (!$_[2]) {
                my $flag = $_[1] =~ /^_/ ? 'ra' : 'r';
                return $_[0]->base->list_canonical_fields($_[0]->{_otype}, $flag)
            }
        },
        }
    );
    $self->add_func('sortn', {
        help => 'Sort numeric the selection according attribute',
        code => sub {
            my ($env, $attribute) = @_;

            if ($attribute) {
                @{$env->{_objects}} =
                    sort { ($a->get_attributes($attribute) || 0) <=> ($b->get_attributes($attribute) || 0) }
                    @{$env->{_objects}};
            } else {
                @{$env->{_objects}} =
                    sort { $a->_get_ikey <=> $b->_get_ikey }
                    @{$env->{_objects}};
            }

            $self->printf( "select is now %s: %s\n", $env->{_otype}, join(', ', map {
                $_->id } @{$env->{_objects}}) );
        },
        completion => sub {
            if (!$_[2]) {
                my $flag = $_[1] =~ /^_/ ? 'ra' : 'r';
                return $_[0]->base->list_canonical_fields($_[0]->{_otype}, $flag)
            }
        },
        }
    );
    $self->add_func('sortnr', {
        help => 'Sort numeric reverse the selection according attribute',
        code => sub {
            my ($env, $attribute) = @_;

            if ($attribute) {
                @{$env->{_objects}} =
                    sort { ($b->get_attributes($attribute) || 0) <=> ($a->get_attributes($attribute) || 0) }
                    @{$env->{_objects}};
            } else {
                @{$env->{_objects}} =
                    sort { $b->_get_ikey <=> $a->_get_ikey }
                    @{$env->{_objects}};
            }

            $self->printf( "select is now %s: %s\n", $env->{_otype}, join(', ', map {
                $_->id } @{$env->{_objects}}) );
        },
        completion => sub {
            if (!$_[2]) {
                my $flag = $_[1] =~ /^_/ ? 'ra' : 'r';
                return $_[0]->base->list_canonical_fields($_[0]->{_otype}, $flag)
            }
        },
        }
    );

=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}}) {
                    $self->print( $_->dump );
                }
            } else {
                foreach my $u (@{$env->{_objects}}) {
                    $self->print( 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)) {
                $self->print( "no format given" );
                return;
            }
            foreach (@{$env->{_objects}}) {
                $self->print( $_->queryformat($fmt) . "\n" );
            }
        },
    });
    $self->add_func('unset', {
        help => 'unset attribute - unset specified attribute',
        code => sub {
            my ($env, $attr) = @_;
            $attr or do {
                $self->print( "Attributes must be specified" );
                return;
            };
            foreach (@{$env->{_objects}}) {
                defined $_->set_c_fields($attr => undef) or do {
                    $self->print( "cannot unset attributes $attr for " . $_->id . "\n");
                    return;
                };
            }
            $env->commit;
            $self->print( "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 {
                $self->print( "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;
                    $self->printf ("Cannot set $attr to %s for %s\n", join(', ',
                        @value), $_->id);
                    return;
                };
            }
            $env->commit;
            $self->print( "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('sed', {
        help => 'Apply regular expression on curent attribute',
        code => sub {
            my ($env, $attr, $reg) = @_;
            $reg or do {
                $self->print( "attribute and value must be specified\n" );
                return;
            };
            foreach (@{$env->{_objects}}) {
                my @newvalues;
                my $Change = 0;
                foreach my $val ($_->get_attributes($attr)) {
                    my $nval = $val;
                    eval "\$nval =~ $reg;";
                    if ($@) {
                        $self->print("$@No change done\n");
                        $env->rollback;
                        return;
                    }
                    if ($val ne $nval) {
                        $self->printf("%s: %s => %s\n", $_->id, $val, $nval);
                        $Change ++;
                    }
                    push(@newvalues, $nval) if($nval);
                }
                if ( $Change ) {
                    defined $_->set_c_fields($attr => @newvalues <= 1 ? $newvalues[0] : \@newvalues) or do {
                        $_->base->rollback;
                        $self->printf ("Cannot set $attr to %s for %s\n", join(', ', @newvalues), $_->id);
                        return;
                    };
                } else {
                    $self->printf("No change for %s\n", $_->id);
                }
            }
            $env->commit;
            $self->print( "Done.\n" );
        },
        completion => sub {
            my ($env, $lastw, @args) = @_;
            if (!$args[0]) {
                return $env->base->list_canonical_fields($env->{_otype}, 'w')
            }
        },
    });
    $self->add_func('add', {
        help => 'add a value to an attribute',
        code => sub {
            my ($env, $attr, @value) = @_;
            @value or do {
                $self->print( "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;
                    $self->printf( "Cannot set $attr to %s for %s\n", join(', ',
                        @value), $_->id );
                    return;
                };
            }
            $env->commit;
            $self->print( "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 {
                $self->print( "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;
                    $self->printf( "Cannot set $attr to %s for %s\n", join(', ',
                        @value), $_->id );
                    return;
                };
            }
            $env->commit;
            $self->print( "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 @allargs = @_;
            my @args = $self->getoption(
                {
                    'fmt=s'      => \my $fmt,
                    'filefmt=s'  => \my $filefmt,
                    'r'          => \my $recur,
                }, @allargs
            );

            if ($recur) {
                $self->Traverse( undef, sub {
                    $_[0]->Parent or return;
                    $_[0]->run('list', grep { $_ ne '-r' } @allargs);
                } );
                return;
            }

            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}}) {
                    $self->print( $_->queryformat($fmt) );
                }
                $self->print( "\n" );
            } else {
                $self->printf("%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 {
                        $self->print( "$id is not part of selected objects\n" );
                        return;
                    };
                } elsif (@{$env->{_objects}} == 1) {
                    $obj = $env->{_objects}[0]
                } else {
                    $self->print( "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) {
                            $self->print( "Changes applied\n" );
                            $env->commit;
                        }
                        else { $self->print( "Error applying changes\n" ) }
                        return $res ? 1 : 0;
                    }
                );
            },
        });
    $self->add_func('delete', {
        help => 'delete - delete selected object',
        code => sub {
            my ($env) = @_;
            $self->printf("%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 {
                        $self->print( "Cannot delete " . $_->id . "\n" );
                        return;
                    };
                }
                $env->commit;
                return "EXIT";
            } else {
                $self->print( "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 $totype;
                if ( $attrname eq '@' ) {
                    $totype = $env->{_otype};
                    @objects = @{ $self->{_lastsearch} || [] };
                } else {
                    my $attr = $env->base->attribute(
                        $env->{_otype},
                        $attrname
                    ) or do {
                        $self->print( "No attribute $attrname" );
                        return;
                    };
                    $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);
                $self->print( "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') {

=head2 USER OBJECT FUCNTION

=cut

        $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 {
                                $self->print( "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 {
                            $self->print( 'invalid action' . "\n" );
                            return;
                        }
                        defined $obj->set_c_fields('memberOf' => [ keys %gr ]) or do {
                            $self->print( "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');
                    }
                }
            },
        });

=head3 lock

Lock user account making it not usable

=cut

        $self->add_func('lock', {
            code => sub {
                my ( $env, $ban ) = @_;
                foreach my $obj (@{$env->{_objects}}) {
                    $obj->set_c_fields('locked', 1);
                    if ($ban) {
                        $obj->banCurrentPassword;
                    }
                }
                $env->commit;
            },
            completion => sub {
                if (!$_[2]) {
                    return (qw(ban));
                }
            },
        });

=head3 unlock

Unlock user account making it usable again

=cut

        $self->add_func('unlock', {
            code => sub {
                my ( $env, $ban ) = @_;
                foreach my $obj (@{$env->{_objects}}) {
                    $obj->set_c_fields('locked', undef);
                    if ($ban) {
                        $obj->banCurrentPassword;
                    }
                }
                $env->commit;
            },
            completion => sub {
                if (!$_[2]) {
                    return (qw(ban));
                }
            },
        });

=head3 banpasswd

Ban current password making it not usable by user

=cut

        $self->add_func('banpasswd', {
            code => sub {
                my ( $env ) = @_;
                foreach my $obj (@{$env->{_objects}}) {
                    $obj->banCurrentPassword;
                }
                $env->commit;
            },
            completion => sub {},
        });

=head3 passwd

Set password to selected user. If multiple users are selected the same password will be set to all users

Options:

=over 4

=item -f|--force Ignore password quality check

=item -r|--random Generate a random password for each users

=item -o|--output Write login:password into a file (usefull with --random)

=back

=cut

        $self->add_func('passwd', {
            code => sub {
                my $env = shift;
                my %gen_options = ();
                my ( $password ) = $self->getoption(
                    {
                        'f|force'  => \my $force,
                        'r|random' => \my $random,
                        'p'        => \$gen_options{nonalpha},
                        'syl'      => \$gen_options{syllables},
                        'l=i'      => \$gen_options{length},
                        'o=s'      => \my $output,

                    }, @_
                );

                if (!($password || $random)) {
                    ReadMode('noecho');
                    $self->print( "Enter password: " );
                    $password = ReadLine(0);
                    ReadMode 0;
                    $self->print( "\n" );
                    chomp($password);
                }

                $password ||= '';
                my %resPasswd = ();

                my $sbase = $self->La->sync_access();

                foreach my $obj (@{$env->{_objects}}) {
                    my $sobj = $sbase->get_object($obj->type, $obj->id);
                    if ($random) {
                        $password = LATMOS::Accounts::Utils::genpassword(
                            %gen_options
                        );
                    }

                    my $res = $sobj->check_password($password);
                    if ($res ne 'ok') {
                        warn "Password quality: $res\n";
                        if (!$force) {
                            warn "Cannot set bad password, use --force to bypass security\n";
                            return;
                        }
                    }
                    if ($sobj->set_password($password)) {
                        $resPasswd{$obj->id} = $password;
                        $self->print( "Password succefully changed\n" );
                        $env->commit;
                        return 1;
                    } else {
                        warn "Error when trying to change password\n";
                        return 0;
                    }
                }

                if ($output) {
                    open(my $handle, '>', $output) or do {
                        warn "Cannot open $output: $!";
                        return;
                    };
                    foreach (sort keys %resPasswd) {
                        print $handle $_ . ':' . $resPasswd{$_} . "\n";
                    }
                    close($handle);
                }
            },
            completion => sub {
                return (qw(-f --force -r --random -p --syl -l -o));
            },
        });

        $self->add_func('summary', {
            code => sub {
                my $env = shift;

                foreach my $obj (@{$env->{_objects}}) {
                    print $obj->id . "\n";
                    foreach my $emp ($obj->EmploymentSummary) {
                        $self->printf( ("    %s - %s %s\n",
                            $emp->{firstday},
                            $emp->{lastday} || '        ',
                            $emp->{contratType}
                        ) );
                    }
                }
                return 1;
            },
            completion => sub {
                return (qw(-f --force -r --random -p --syl -l -o));
            },
        });

    } elsif ($self->otype eq 'group') {

=head2 GROUP OBJECT FUNCTIONS

=cut

        $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 {
                        $self->print( 'invalid action' . "\n" );
                        return;
                    }
                    defined $obj->set_c_fields('memberUID' => [ keys %gr ]) or do {
                        $self->print( "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}}) {
                    $self->print( $obj->dump({ recur => 1 }) );
                }
                $env->rollback;
            },
        });
    }

    return $self;
}

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

    my @otypes;

    $self->Traverse( undef, sub { push(@otypes, $_[0]->otype) if($_[0]->Parent) } );
    sprintf("%s %s/%s",
        $self->base->label,
        join('/', @otypes),
        @{$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
