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

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 _create_from_handle {
    my ($self, $fh, $otype, $objname) = @_;

    my $labase = $self->base;

    my %attr = LATMOS::Accounts::Utils::parse_obj_file($fh);
    if ($objname && (my $obj = $labase->get_object($otype, $objname))) {
         warn "Object $otype $objname already exists, aborting\n";
         return;
    } else {
        if ($objname) {
            my $res = $labase->create_c_object($otype, $objname, %attr);
            if($res) {
                $self->print("Changes applied\n");
                $labase->commit;
                return 1;
            }
            return 0;
        } else {
            my $ochelper = $labase->ochelper($otype);

            my $info = {
                contents => { %attr },
            };
            if ($attr{name}) {
                $info->{name}{content} = $attr{name};
            }

            $ochelper->Automate($info) or do {
                warn "Cannot create object:" . LATMOS::Accounts::Log::lastmessage() . "\n";
                return;
            };
            return 1;
        } 
    }
}

=head1 CLI FUNCTIONS

=head2 GLOBAL FUNCTIONS

=cut

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

    my $labase = $self->base;

    $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 {
                my $env = shift;
                my @args = $self->getoption(
                    {
                        'fmt=s'      => \my $fmt,
                        'filefmt=s'  => \my $filefmt,
                    }, @_
                );

                my $otype = $args[0] or do {
                    $self->print("Object type missing\n");
                    return 1;
                };

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

                if ($fmt) {
                    foreach ($env->base->list_objects($otype)) {
                        my $obj = $env->base->get_object($otype, $_) or next;
                        $self->print($obj->queryformat($fmt));
                    }
                    $self->print("\n");
                } else {
                    $self->print(map { "$_\n" } $env->base->list_objects($otype));
                }
            },
        });
    $self->add_func('search', {
            help => 'search objecttype filter1 [filter2...] - search object according filter',
            completion => sub {
                my ($self, $ritem, $rotype) = @_;
                if(!$_[2]) {
                    return $self->base->list_supported_objects
                } else {
                    my $parse;
                    $parse = sub {
                        my ($otype, $item) = @_;
                        $item ||= '';
                        my ($NegFilter, $attr, $dot, $attrref, $operator, $val) = $item =~ /^([\!\+\-]?)(\w+)(?:(\.)([\.\w]+))?(?:([^\w*]+)(.+))?$/;
                        if ($dot) {
                            my $attribute = $self->base->attribute($otype, $attr) or
                                return ($self->base->list_canonical_fields( $otype, 'r' ) );
                            my $refotype  = $attribute->reference;
                            return map { "$attr." . $_ } $parse->($refotype, "$attrref$operator$val" );
                        } else {
                            return($self->base->list_canonical_fields($otype, 'r'));
                        }

                    };
                    return(
                        map { $_, "!$_", "-$_", "+$_" }
                        map { ( $_ . '=', $_ . '~' ) } $parse->( $rotype, $ritem )
                    );
                }
            },
            code => sub {
                my ($self, @args) = @_;
                if ($_[1]) {
                    my @res = $self->base->search_objects(@args);
                    $self->print(map { "$_\n" } @res);
                    $self->{_lastsearch} = \@res;
                    $self->{_lastsearchtype} = $args[0];
                } else {
                    $self->print("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);
            $self->print(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);
            $self->print(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 {
                        $self->print("No results store from previous search\n");
                        return;
                    }
                }
                if (!@ids) {
                    $self->print('not enough arguments' . "\n");
                    return;
                }
                foreach (@ids) {
                    my $obj = $self->base->get_object($otype, $_) or do {
                        $self->print("Cannot get $otype $_\n");
                        return;
                    };
                    push(@objs, $obj);
                }
                $self->print("Selecting $otype " . join(', ', @ids) . "\n");
                LATMOS::Accounts::Cli::Object->new(
                    Parent  => $self,
                    Context => $self->Context,
                    otype   => $otype,
                    objs    => \@objs,
                )->cli();
            },
        });

=head3 create

Create object


=over 4

=item -i

    interactive: will prompt for attribute

=item -f FILE

    Read file for attribute value

=item -e

    open an epty file instead instead attribute list

=item --ro

    Open an empty with attribute even read-only one

=back

=cut

    $self->add_func('create', {
            code => sub {
                my $self = shift;
                my ($otype, $objname) = $self->getoption(
                    {
                        'i'   => \my $interactive,
                        'f=s' => \my $inputfile,
                        'ro'  => \my $with_ro,
                        'e'   => \my $empty_file,
                    }, @_
                );

                if ( $interactive ) {
                    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') {
                                $self->print("Object created\n");
                                $self->commit;
                            } else {
                                $self->print("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);
                        }
                    }
                } elsif ($inputfile) {
                    my $handle;
                    open($handle, '<', $inputfile) or do {
                        warn "Cannot open input file $@\n";
                        return;
                    };
                    my $res = $self->_create_from_handle($handle, $otype, $objname);
                    close($handle);
                    $self->commit if($res);
                    return($res);
                } else {
                    return LATMOS::Accounts::Utils::dump_read_temp_file(
                        sub {
                            my ($fh) = @_;
                            $labase->text_empty_dump($fh, $otype,
                                {
                                    only_rw => !$with_ro,
                                }
                            ) unless($empty_file);
                        },
                        sub {
                            my ($fh) = @_;
                            if (my $res = $self->_create_from_handle($fh, $otype, $objname)) {
                                 $self->commit;
                                 return $res;
                             } else {
                                 return;
                             }
                        }
                    );
                }
            },
            completion => sub {
                my ($self, $carg, @args) = @_;
                my @options = ();
                push( @options, qw(-i -f)  ) unless ( grep { $_ =~ /^-[fi]$/ } @args );
                push( @options, qw(-e --ro)) unless ( grep { $_ eq '-f' } @args );

                if (($args[-1] || '') eq '-f') {
                    my $attribs = $self->Context->Term->Attribs;
                    return $self->Context->Term->completion_matches($carg, $attribs->{'filename_completion_function'});
                } else {
                    return (@options, $self->base->list_supported_objects);
                }
            },
        }
    );
    $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) {
                    $self->print("Need two ip to exchange\n");
                    return;
                }
                if ($self->base->nethost_exchange_ip($ip1, $ip2)) {
                    $self->print("$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('loadcsv',
        {
            help => 'Load CSV file to create object',
            code => sub {
                my ($self, $otype, $file) = @_;

                open(my $fh, '<', $file) or do {
                   warn "Cannot open  $file $!\n";
                   return;
                };

                my @ids;

                loadCSV(
                    $fh,
                    cb => sub {
                        my ($res, $linecount) = @_;

                        my $ochelper = $labase->ochelper($otype);

                        my $info = {
                            contents => $res
                        };
                        if ($res->{name}) {
                            $info->{name}{content} = $res->{name};
                        }

                        if (my $id = $ochelper->Automate($info)) {
                            push(@ids, $id);
                        } else {
                            warn "Cannot create object line $linecount (not enough information ?)\n";
                        }
                    },
                );

                close($fh);

                my @objs;
                foreach (@ids) {
                    my $obj = $self->base->get_object($otype, $_) or do {
                        $self->print("Cannot get $otype $_\n");
                        return;
                    };
                    push(@objs, $obj);
                }

                $self->print("Selecting $otype " . join(', ', @ids) . "\n");
                LATMOS::Accounts::Cli::Object->new(
                    Parent  => $self,
                    Context => $self->Context,
                    otype   => $otype,
                    objs    => \@objs,
                )->cli();
            },
            completion => sub {
                if ($_[2]) {
                    return Term::ReadLine::Gnu::filename_list(@_);
                } else {
                    return '@', $_[0]->base->list_supported_objects;
                }
            },
        }
    );

    $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