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 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('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; warn @_; my @args = $self->getoption( { 'fmt=s' => \my $fmt, 'filefmt=s' => \my $filefmt, }, @_ ); my $otype = $args[0] or do { print $OUT "Object type missing\n"; return 1; }; 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->base->list_objects($otype)) { my $obj = $env->base->get_object($otype, $_) or next; print $OUT $obj->queryformat($fmt); } print $OUT "\n"; } else { print $OUT map { "$_\n" } $env->base->list_objects($otype); } }, }); $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 =head1 AUTHOR Olivier Thauvin, Eolivier.thauvin@latmos.ipsl.frE =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