source: trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Cli.pm @ 2216

package LATMOS::Accounts::Cli;

# $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;
use LATMOS::Accounts::Cli::Object;

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

=head2 globalenv

Return the main envirronement object

=cut

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

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

    $self->add_func('unexported', {
        help => 'unexported yes|no|show - switch or show base mode regarding' .
            ' unexported objects',
        completion => sub {
            if (!$_[2]) {
                return qw(yes no show);
            }
        },
        code => sub {
            my ($self, $arg) = @_;
            if ($arg eq 'yes') {
                $self->base->unexported(1);
                print $OUT "Unexported are now show\n";
            } elsif ($arg eq 'no') {
                $self->base->unexported(0);
                print $OUT "Unexported are no longer show\n";
            } elsif ($arg eq 'show') {
                print $OUT "Unexported objects " . ($self->base->unexported ?
                "enable" : "disable") . "\n";
            } else {
                print $OUT "wrong argument\n";
            }
        },
    });
    $self->add_func('ls', {
            help => 'ls object_type - list object of type object_type', 
            completion => sub {
                if(!$_[2]) {
                    return $_[0]->base->list_supported_objects
                } else { () }
            },
            code => sub {
                if ($_[1]) {
                    print $OUT map { "$_\n" } $_[0]->base->list_objects($_[1]);
                } else {
                    print $OUT "Object type missing\n";
                }
            },
        });
    $self->add_func('search', {
            help => 'search objecttype filter1 [filter2...] - search object according filter',
            completion => sub {
                if(!$_[2]) {
                    return $_[0]->base->list_supported_objects
                } else { return() }
            },
            code => sub {
                my ($self, @args) = @_;
                if ($_[1]) {
                    my @res = $self->base->search_objects(@args);
                    print $OUT map { "$_\n" } @res;
                    $self->{_lastsearch} = \@res;
                    $self->{_lastsearchtype} = $args[0];
                } else {
                    print $OUT "Object type missing\n";
                }
            },
        });
    $self->add_func('expired', {
        help => 'expired [delay] - list expired account more than delay (default is now)',
        code => sub {
            my ($self, $expire) = @_;
            my @users = $self->base->find_expired_users($expire);
            print $OUT map { "$_\n" } @users;
            $self->{_lastsearchtype} = 'user';
            $self->{_lastsearch} = \@users;
        },
    }) if ($self->base->can('find_expired_users'));
    $self->add_func('expires', {
        help => 'expires [delay] - list account expiring before delay (default is 1 month)',
        code => sub {
            my ($self, $expire) = @_;
            my @users = $self->base->find_next_expire_users($expire);
            print $OUT map { "$_\n" } @users;
            $self->{_lastsearchtype} = 'user';
            $self->{_lastsearch} = \@users;
        },
    }) if ($self->base->can('find_next_expire_users'));
    $self->add_func('select', {
            help => 'select object_type - select objects to perform action on it',
            completion => sub {
                if ($_[2]) {
                    return $_[0]->base->list_objects($_[2]);
                } else {
                    return '@', $_[0]->base->list_supported_objects;
                }
            },
            code => sub {
                my ($self, $otype, @ids) = @_;
                my @objs;
                if ($otype eq '@') {
                    if (@{$self->{_lastsearch} || []}) {
                        $otype = $self->{_lastsearchtype};
                        @ids = @{$self->{_lastsearch}};
                    } else {
                        print $OUT "No results store from previous search\n";
                        return;
                    }
                }
                if (!@ids) {
                    print $OUT 'not enough arguments' . "\n";
                    return;
                }
                foreach (@ids) {
                    my $obj = $self->base->get_object($otype, $_) or do {
                        print $OUT "Cannot get $otype $_\n";
                        return;
                    };
                    push(@objs, $obj);
                }
                print $OUT "Selecting $otype " . join(', ', @ids) . "\n";
                LATMOS::Accounts::Cli::Object->new(
                    Parent  => $self,
                    Context => $self->Context,
                    otype   => $otype,
                    objs    => \@objs,
                )->cli();
            },
        });
    $self->add_func('create', {
            code => sub {
                my ($self, $otype) = @_;
                my $helper = $self->base->ochelper($otype);
                my $info = undef;
                while (1) {
                    my $status;
                    ($status, $info) = $helper->step($info);

                    if ($status ne 'NEEDINFO') {
                        if ($status eq 'CREATED') {
                            print $OUT "Object created\n";
                            $self->commit;
                        } else {
                            print $OUT "Nothing done\n";
                            $self->rollback;
                        }
                        return;
                    }

                    if ($info->{name}{ask}) {
                        my $line = $self->Context->Term->readline("Name of the object ?");
                        $info->{name}{content} = $line;
                    }
                    foreach my $attr (@{$info->{ask} || []}) {
                        $self->Context->Term->Attribs->{completion_function} = sub {
                            $info->{contents}{$attr}
                        };
                        my $line = $self->Context->Term->readline(sprintf('  %s %s? ',
                                $attr,
                                $info->{contents}{$attr}
                                ? '(' . $info->{contents}{$attr} . ') '
                                : ''
                            ));
                        $info->{contents}{$attr} = $line if($line);
                    }
                }
            },
        }
    );
    $self->add_func('exchangeip', 
        {
            help => 'Exchange two IP on host',
            code => sub {
                my ($self, @args) = @_;
                my ($ip1, $ip2) =
                    grep { $_ && $_ =~ /\d+\.\d+\.\d+\.\d+/ } @args;
                if (!$ip2) {
                    print $OUT "Need two ip to exchange\n";
                    return;
                }
                if ($self->base->nethost_exchange_ip($ip1, $ip2)) {
                    print $OUT "$ip1 and $ip2 get exchange\n";
                    $self->commit;
                } else {
                    $self->rollback;
                }   
            },
            completion => sub {
                my ($self, $carg, @args) = @_;
                if ($args[-1] && $args[-1] !~ m/\d+\.\d+\.\d+\.\d+/) {
                    if (my $obj = $self->base->get_object('nethost', $args[-1])) {
                        return $obj->get_attributes('ip');
                    }
                } else {
                    my @list = 
                    ($self->base->attributes_summary('nethost', 'ip'),
                        $self->base->list_objects('nethost'));
                    return @list;
                }
            },
        }
    );
    $self->add_func('user',  { alias => [qw'select user' ] });
    $self->add_func('group', { alias => [qw'select group'] });
    return $self
}

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