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

Last change on this file since 2402 was 2402, checked in by nanardon, 4 years ago

Fix pod syntax
  • Property svn:keywords set to Id
File size: 15.6 KB
Line 
1package LATMOS::Accounts::Cli;
2
3# $Id: Cli.pm 2145 2018-08-29 18:15:46Z nanardon $
4
5use strict;
6use warnings;
7use Moose;
8use LATMOS::Accounts::Log;
9use LATMOS::Accounts::Utils;
10use Term::ReadLine;
11use Text::ParseWords;
12use Getopt::Long;
13use LATMOS::Accounts::Cli::Object;
14
15extends 'LATMOS::Accounts::Cli::Base';
16
17=head1 NAME
18
19LATMOS::Accounts::Cli - Command line interface functions
20
21=head1 DESCRIPTION
22
23This module handle envirronment and functons for L<la-cli> tools.
24
25=cut
26
27=head1 FUNCTIONS
28
29=cut
30
31=head2 globalenv
32
33Return the main envirronement object
34
35=cut
36
37sub _create_from_handle {
38    my ($self, $fh, $otype, $objname) = @_;
39
40    my $labase = $self->base;
41
42    my %attr = LATMOS::Accounts::Utils::parse_obj_file($fh);
43    if ($objname && (my $obj = $labase->get_object($otype, $objname))) {
44         warn "Object $otype $objname already exists, aborting\n";
45         return;
46    } else {
47        if ($objname) {
48            my $res = $labase->create_c_object($otype, $objname, %attr);
49            if($res) {
50                $self->print("Changes applied\n");
51                $labase->commit;
52                return 1;
53            }
54            return 0;
55        } else {
56            my $ochelper = $labase->ochelper($otype);
57
58            my $info = {
59                contents => { %attr },
60            };
61            if ($attr{name}) {
62                $info->{name}{content} = $attr{name};
63            }
64
65            $ochelper->Automate($info) or do {
66                warn "Cannot create object:" . LATMOS::Accounts::Log::lastmessage() . "\n";
67                return;
68            };
69            return 1;
70        } 
71    }
72}
73
74=head1 CLI FUNCTIONS
75
76=head2 GLOBAL FUNCTIONS
77
78=cut
79
80sub BUILD {
81    my ( $self ) = @_;
82
83    my $labase = $self->base;
84
85    $self->add_func('ls', {
86            help => 'ls object_type - list object of type object_type', 
87            completion => sub {
88                if(!$_[2]) {
89                    return $_[0]->base->list_supported_objects
90                } else { () }
91            },
92            code => sub {
93                my $env = shift;
94                my @args = $self->getoption(
95                    {
96                        'fmt=s'      => \my $fmt,
97                        'filefmt=s'  => \my $filefmt,
98                    }, @_
99                );
100
101                my $otype = $args[0] or do {
102                    $self->print("Object type missing\n");
103                    return 1;
104                };
105
106                if ($filefmt){
107                    open(my $hfmt, '<', $filefmt) or do {
108                       warn "Cannot open $filefmt\n";
109                       return;
110                    };
111                    $fmt ||= ''; # avoid undef warning
112                    while (<$hfmt>) {
113                        chomp($fmt .= $_);
114                    }
115                    close $hfmt;
116                }
117
118                if ($fmt) {
119                    foreach ($env->base->list_objects($otype)) {
120                        my $obj = $env->base->get_object($otype, $_) or next;
121                        $self->print($obj->queryformat($fmt));
122                    }
123                    $self->print("\n");
124                } else {
125                    $self->print(map { "$_\n" } $env->base->list_objects($otype));
126                }
127            },
128        });
129    $self->add_func('search', {
130            help => 'search objecttype filter1 [filter2...] - search object according filter',
131            completion => sub {
132                my ($self, $ritem, $rotype) = @_;
133                if(!$_[2]) {
134                    return $self->base->list_supported_objects
135                } else {
136                    my $parse;
137                    $parse = sub {
138                        my ($otype, $item) = @_;
139                        $item ||= '';
140                        my ($NegFilter, $attr, $dot, $attrref, $operator, $val) = $item =~ /^([\!\+\-]?)(\w+)(?:(\.)([\.\w]+))?(?:([^\w*]+)(.+))?$/;
141                        if ($dot) {
142                            my $attribute = $self->base->attribute($otype, $attr) or
143                                return ($self->base->list_canonical_fields( $otype, 'r' ) );
144                            my $refotype  = $attribute->reference;
145                            return map { "$attr." . $_ } $parse->($refotype, "$attrref$operator$val" );
146                        } else {
147                            return($self->base->list_canonical_fields($otype, 'r'));
148                        }
149
150                    };
151                    return(
152                        map { $_, "!$_", "-$_", "+$_" }
153                        map { ( $_ . '=', $_ . '~' ) } $parse->( $rotype, $ritem )
154                    );
155                }
156            },
157            code => sub {
158                my ($self, @args) = @_;
159                if ($_[1]) {
160                    my @res = $self->base->search_objects(@args);
161                    $self->print(map { "$_\n" } @res);
162                    $self->{_lastsearch} = \@res;
163                    $self->{_lastsearchtype} = $args[0];
164                } else {
165                    $self->print("Object type missing\n");
166                }
167            },
168        });
169    $self->add_func('expired', {
170        help => 'expired [delay] - list expired account more than delay (default is now)',
171        code => sub {
172            my ($self, $expire) = @_;
173            my @users = $self->base->find_expired_users($expire);
174            $self->print(map { "$_\n" } @users);
175            $self->{_lastsearchtype} = 'user';
176            $self->{_lastsearch} = \@users;
177        },
178    }) if ($self->base->can('find_expired_users'));
179    $self->add_func('expires', {
180        help => 'expires [delay] - list account expiring before delay (default is 1 month)',
181        code => sub {
182            my ($self, $expire) = @_;
183            my @users = $self->base->find_next_expire_users($expire);
184            $self->print(map { "$_\n" } @users);
185            $self->{_lastsearchtype} = 'user';
186            $self->{_lastsearch} = \@users;
187        },
188    }) if ($self->base->can('find_next_expire_users'));
189    $self->add_func('select', {
190            help => 'select object_type - select objects to perform action on it',
191            completion => sub {
192                if ($_[2]) {
193                    return $_[0]->base->list_objects($_[2]);
194                } else {
195                    return '@', $_[0]->base->list_supported_objects;
196                }
197            },
198            code => sub {
199                my ($self, $otype, @ids) = @_;
200                my @objs;
201                if ($otype eq '@') {
202                    if (@{$self->{_lastsearch} || []}) {
203                        $otype = $self->{_lastsearchtype};
204                        @ids = @{$self->{_lastsearch}};
205                    } else {
206                        $self->print("No results store from previous search\n");
207                        return;
208                    }
209                }
210                if (!@ids) {
211                    $self->print('not enough arguments' . "\n");
212                    return;
213                }
214                foreach (@ids) {
215                    my $obj = $self->base->get_object($otype, $_) or do {
216                        $self->print("Cannot get $otype $_\n");
217                        return;
218                    };
219                    push(@objs, $obj);
220                }
221                $self->print("Selecting $otype " . join(', ', @ids) . "\n");
222                LATMOS::Accounts::Cli::Object->new(
223                    Parent  => $self,
224                    Context => $self->Context,
225                    otype   => $otype,
226                    objs    => \@objs,
227                )->cli();
228            },
229        });
230
231=head3 create
232
233Create object
234
235
236=over 4
237
238=item -i
239
240    interactive: will prompt for attribute
241
242=item -f FILE
243
244    Read file for attribute value
245
246=item -e
247
248    open an epty file instead instead attribute list
249
250=item --ro
251
252    Open an empty with attribute even read-only one
253
254=back
255
256=cut
257
258    $self->add_func('create', {
259            code => sub {
260                my $self = shift;
261                my ($otype, $objname) = $self->getoption(
262                    {
263                        'i'   => \my $interactive,
264                        'f=s' => \my $inputfile,
265                        'ro'  => \my $with_ro,
266                        'e'   => \my $empty_file,
267                    }, @_
268                );
269
270                if ( $interactive ) {
271                    my $helper = $self->base->ochelper($otype);
272                    my $info = undef;
273                    while (1) {
274                        my $status;
275                        ($status, $info) = $helper->step($info);
276
277                        if ($status ne 'NEEDINFO') {
278                            if ($status eq 'CREATED') {
279                                $self->print("Object created\n");
280                                $self->commit;
281                            } else {
282                                $self->print("Nothing done\n");
283                                $self->rollback;
284                            }
285                            return;
286                        }
287
288                        if ($info->{name}{ask}) {
289                            my $line = $self->Context->Term->readline("Name of the object ?");
290                            $info->{name}{content} = $line;
291                        }
292                        foreach my $attr (@{$info->{ask} || []}) {
293                            $self->Context->Term->Attribs->{completion_function} = sub {
294                                $info->{contents}{$attr}
295                            };
296                            my $line = $self->Context->Term->readline(sprintf('  %s %s? ',
297                                    $attr,
298                                    $info->{contents}{$attr}
299                                    ? '(' . $info->{contents}{$attr} . ') '
300                                    : ''
301                                ));
302                            $info->{contents}{$attr} = $line if($line);
303                        }
304                    }
305                } elsif ($inputfile) {
306                    my $handle;
307                    open($handle, '<', $inputfile) or do {
308                        warn "Cannot open input file $@\n";
309                        return;
310                    };
311                    my $res = $self->_create_from_handle($handle, $otype, $objname);
312                    close($handle);
313                    $self->commit if($res);
314                    return($res);
315                } else {
316                    return LATMOS::Accounts::Utils::dump_read_temp_file(
317                        sub {
318                            my ($fh) = @_;
319                            $labase->text_empty_dump($fh, $otype,
320                                {
321                                    only_rw => !$with_ro,
322                                }
323                            ) unless($empty_file);
324                        },
325                        sub {
326                            my ($fh) = @_;
327                            if (my $res = $self->_create_from_handle($fh, $otype, $objname)) {
328                                 $self->commit;
329                                 return $res;
330                             } else {
331                                 return;
332                             }
333                        }
334                    );
335                }
336            },
337            completion => sub {
338                my ($self, $carg, @args) = @_;
339                my @options = ();
340                push( @options, qw(-i -f)  ) unless ( grep { $_ =~ /^-[fi]$/ } @args );
341                push( @options, qw(-e --ro)) unless ( grep { $_ eq '-f' } @args );
342
343                if (($args[-1] || '') eq '-f') {
344                    my $attribs = $self->Context->Term->Attribs;
345                    return $self->Context->Term->completion_matches($carg, $attribs->{'filename_completion_function'});
346                } else {
347                    return (@options, $self->base->list_supported_objects);
348                }
349            },
350        }
351    );
352    $self->add_func('exchangeip', 
353        {
354            help => 'Exchange two IP on host',
355            code => sub {
356                my ($self, @args) = @_;
357                my ($ip1, $ip2) =
358                    grep { $_ && $_ =~ /\d+\.\d+\.\d+\.\d+/ } @args;
359                if (!$ip2) {
360                    $self->print("Need two ip to exchange\n");
361                    return;
362                }
363                if ($self->base->nethost_exchange_ip($ip1, $ip2)) {
364                    $self->print("$ip1 and $ip2 get exchange\n");
365                    $self->commit;
366                } else {
367                    $self->rollback;
368                }   
369            },
370            completion => sub {
371                my ($self, $carg, @args) = @_;
372                if ($args[-1] && $args[-1] !~ m/\d+\.\d+\.\d+\.\d+/) {
373                    if (my $obj = $self->base->get_object('nethost', $args[-1])) {
374                        return $obj->get_attributes('ip');
375                    }
376                } else {
377                    my @list = 
378                    ($self->base->attributes_summary('nethost', 'ip'),
379                        $self->base->list_objects('nethost'));
380                    return @list;
381                }
382            },
383        }
384    );
385
386    $self->add_func('loadcsv',
387        {
388            help => 'Load CSV file to create object',
389            code => sub {
390                my ($self, $otype, $file) = @_;
391
392                open(my $fh, '<', $file) or do {
393                   warn "Cannot open  $file $!\n";
394                   return;
395                };
396
397                my @ids;
398
399                loadCSV(
400                    $fh,
401                    cb => sub {
402                        my ($res, $linecount) = @_;
403
404                        my $ochelper = $labase->ochelper($otype);
405
406                        my $info = {
407                            contents => $res
408                        };
409                        if ($res->{name}) {
410                            $info->{name}{content} = $res->{name};
411                        }
412
413                        if (my $id = $ochelper->Automate($info)) {
414                            push(@ids, $id);
415                        } else {
416                            warn "Cannot create object line $linecount (not enough information ?)\n";
417                        }
418                    },
419                );
420
421                close($fh);
422
423                my @objs;
424                foreach (@ids) {
425                    my $obj = $self->base->get_object($otype, $_) or do {
426                        $self->print("Cannot get $otype $_\n");
427                        return;
428                    };
429                    push(@objs, $obj);
430                }
431
432                $self->print("Selecting $otype " . join(', ', @ids) . "\n");
433                LATMOS::Accounts::Cli::Object->new(
434                    Parent  => $self,
435                    Context => $self->Context,
436                    otype   => $otype,
437                    objs    => \@objs,
438                )->cli();
439            },
440            completion => sub {
441                if ($_[2]) {
442                    return Term::ReadLine::Gnu::filename_list(@_);
443                } else {
444                    return '@', $_[0]->base->list_supported_objects;
445                }
446            },
447        }
448    );
449
450    $self->add_func('user',  { alias => [qw'select user' ] });
451    $self->add_func('group', { alias => [qw'select group'] });
452    return $self
453}
454
4551;
456
457__END__
458
459=head1 SEE ALSO
460
461L<LATMOS::Accounts>
462
463=head1 AUTHOR
464
465Olivier Thauvin, E<lt>olivier.thauvin@latmos.ipsl.frE<gt>
466
467=head1 COPYRIGHT AND LICENSE
468
469Copyright (C) 2008, 2009, 2010, 2011, 2012 CNRS SA/CETP/LATMOS
470
471This library is free software; you can redistribute it and/or modify
472it under the same terms as Perl itself, either Perl version 5.10.0 or,
473at your option, any later version of Perl 5 you may have available.
474
475=cut
Note: See TracBrowser for help on using the repository browser.