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

Last change on this file since 2473 was 2473, checked in by nanardon, 3 years ago

Add rename() to la-cli
  • Property svn:keywords set to Id
File size: 16.9 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 ($args[0]) {
160                    if (!$self->base->is_supported_object($args[0])) {
161                        $self->print("$args[0] is an usupported object type\n");
162                    } else {
163                        my @res = $self->base->search_objects(@args);
164                        $self->print(map { "$_\n" } @res);
165                        $self->{_lastsearch} = \@res;
166                        $self->{_lastsearchtype} = $args[0];
167                    }
168                } else {
169                    $self->print("Object type missing\n");
170                }
171            },
172        });
173    $self->add_func('expired', {
174        help => 'expired [delay] - list expired account more than delay (default is now)',
175        code => sub {
176            my ($self, $expire) = @_;
177            my @users = $self->base->find_expired_users($expire);
178            $self->print(map { "$_\n" } @users);
179            $self->{_lastsearchtype} = 'user';
180            $self->{_lastsearch} = \@users;
181        },
182    }) if ($self->base->can('find_expired_users'));
183
184    $self->add_func('expires', {
185        help => 'expires [delay] - list account expiring before delay (default is 1 month)',
186        code => sub {
187            my ($self, $expire) = @_;
188            my @users = $self->base->find_next_expire_users($expire);
189            $self->print(map { "$_\n" } @users);
190            $self->{_lastsearchtype} = 'user';
191            $self->{_lastsearch} = \@users;
192        },
193    }) if ($self->base->can('find_next_expire_users'));
194
195    $self->add_func(
196        'select',
197        {
198            help => 'select object_type - select objects to perform action on it',
199            completion => sub {
200                if ($_[2]) {
201                    return $_[0]->base->list_objects($_[2]);
202                } else {
203                    return '@', $_[0]->base->list_supported_objects;
204                }
205            },
206            code => sub {
207                my ($self, $otype, @ids) = @_;
208                my @objs;
209                if ($otype eq '@') {
210                    if (@{$self->{_lastsearch} || []}) {
211                        $otype = $self->{_lastsearchtype};
212                        @ids = @{$self->{_lastsearch}};
213                    } else {
214                        $self->print("No results store from previous search\n");
215                        return;
216                    }
217                }
218                if (!@ids) {
219                    $self->print('not enough arguments' . "\n");
220                    return;
221                }
222                foreach (@ids) {
223                    my $obj = $self->base->get_object($otype, $_) or do {
224                        $self->print("Cannot get $otype $_\n");
225                        return;
226                    };
227                    push(@objs, $obj);
228                }
229                $self->print("Selecting $otype " . join(', ', map { $_->id } @objs) . "\n");
230                LATMOS::Accounts::Cli::Object->new(
231                    Parent  => $self,
232                    Context => $self->Context,
233                    otype   => $otype,
234                    objs    => \@objs,
235                )->cli();
236            },
237        }
238    );
239
240=head3 rename
241
242Rename an object
243
244=cut
245
246    $self->add_func(
247        'rename',
248        {
249            help => 'Rename an object',
250            completion => sub {
251                if ($_[2] && !$_[3]) {
252                    return $_[0]->base->list_objects($_[2]);
253                } else {
254                    return $_[0]->base->list_supported_objects;
255                }
256            },
257            code => sub {
258                my ($self, $otype, $from, $to) = @_;
259                if (!$to) {
260                    $self->print('not enough arguments' . "\n");
261                    return;
262                }
263                if ( $self->base->rename_object($otype, $from, $to) ) {
264                    $self->print("Object $otype/$from renamed to $to\n");
265                    $self->commit; 
266                } else {
267                    $self->rollback;
268                }
269            },
270        }
271    );
272
273=head3 create
274
275Create object
276
277
278=over 4
279
280=item -i
281
282    interactive: will prompt for attribute
283
284=item -f FILE
285
286    Read file for attribute value
287
288=item -e
289
290    open an epty file instead instead attribute list
291
292=item --ro
293
294    Open an empty with attribute even read-only one
295
296=back
297
298=cut
299
300    $self->add_func('create', {
301            code => sub {
302                my $self = shift;
303                my ($otype, $objname) = $self->getoption(
304                    {
305                        'i'   => \my $interactive,
306                        'f=s' => \my $inputfile,
307                        'ro'  => \my $with_ro,
308                        'e'   => \my $empty_file,
309                    }, @_
310                );
311
312                if (!$otype) {
313                    $self->print("No object type given\n");
314                    return;
315                }
316
317                if ( $interactive ) {
318                    my $helper = $self->base->ochelper($otype);
319                    my $info = undef;
320                    while (1) {
321                        my $status;
322                        ($status, $info) = $helper->step($info);
323
324                        if ($status ne 'NEEDINFO') {
325                            if ($status eq 'CREATED') {
326                                $self->print("Object created\n");
327                                $self->commit;
328                            } else {
329                                $self->print("Nothing done\n");
330                                $self->rollback;
331                            }
332                            return;
333                        }
334
335                        if ($info->{name}{ask}) {
336                            my $line = $self->Context->Term->readline("Name of the object ?");
337                            $info->{name}{content} = $line;
338                        }
339                        foreach my $attr (@{$info->{ask} || []}) {
340                            $self->Context->Term->Attribs->{completion_function} = sub {
341                                $info->{contents}{$attr}
342                            };
343                            my $line = $self->Context->Term->readline(sprintf('  %s %s? ',
344                                    $attr,
345                                    $info->{contents}{$attr}
346                                    ? '(' . $info->{contents}{$attr} . ') '
347                                    : ''
348                                ));
349                            $info->{contents}{$attr} = $line if($line);
350                        }
351                    }
352                } elsif ($inputfile) {
353                    my $handle;
354                    open($handle, '<', $inputfile) or do {
355                        warn "Cannot open input file $@\n";
356                        return;
357                    };
358                    my $res = $self->_create_from_handle($handle, $otype, $objname);
359                    close($handle);
360                    $self->commit if($res);
361                    return($res);
362                } else {
363                    return LATMOS::Accounts::Utils::dump_read_temp_file(
364                        sub {
365                            my ($fh) = @_;
366                            $labase->text_empty_dump($fh, $otype,
367                                {
368                                    only_rw => !$with_ro,
369                                }
370                            ) unless($empty_file);
371                        },
372                        sub {
373                            my ($fh) = @_;
374                            if (my $res = $self->_create_from_handle($fh, $otype, $objname)) {
375                                 $self->commit;
376                                 return $res;
377                             } else {
378                                 return;
379                             }
380                        }
381                    );
382                }
383            },
384            completion => sub {
385                my ($self, $carg, @args) = @_;
386                my @options = ();
387                push( @options, qw(-i -f)  ) unless ( grep { $_ =~ /^-[fi]$/ } @args );
388                push( @options, qw(-e --ro)) unless ( grep { $_ eq '-f' } @args );
389
390                if (($args[-1] || '') eq '-f') {
391                    my $attribs = $self->Context->Term->Attribs;
392                    return $self->Context->Term->completion_matches($carg, $attribs->{'filename_completion_function'});
393                } else {
394                    return (@options, $self->base->list_supported_objects);
395                }
396            },
397        }
398    );
399
400    $self->add_func('exchangeip', 
401        {
402            help => 'Exchange two IP on host',
403            code => sub {
404                my ($self, @args) = @_;
405                my ($ip1, $ip2) =
406                    grep { $_ && $_ =~ /\d+\.\d+\.\d+\.\d+/ } @args;
407                if (!$ip2) {
408                    $self->print("Need two ip to exchange\n");
409                    return;
410                }
411                if ($self->base->nethost_exchange_ip($ip1, $ip2)) {
412                    $self->print("$ip1 and $ip2 get exchange\n");
413                    $self->commit;
414                } else {
415                    $self->rollback;
416                }   
417            },
418            completion => sub {
419                my ($self, $carg, @args) = @_;
420                if ($args[-1] && $args[-1] !~ m/\d+\.\d+\.\d+\.\d+/) {
421                    if (my $obj = $self->base->get_object('nethost', $args[-1])) {
422                        return $obj->get_attributes('ip');
423                    }
424                } else {
425                    my @list = 
426                    ($self->base->attributes_summary('nethost', 'ip'),
427                        $self->base->list_objects('nethost'));
428                    return @list;
429                }
430            },
431        }
432    );
433
434    $self->add_func('loadcsv',
435        {
436            help => 'Load CSV file to create object',
437            code => sub {
438                my ($self, $otype, $file) = @_;
439
440                open(my $fh, '<', $file) or do {
441                   warn "Cannot open  $file $!\n";
442                   return;
443                };
444
445                my @ids;
446
447                loadCSV(
448                    $fh,
449                    cb => sub {
450                        my ($res, $linecount) = @_;
451
452                        my $ochelper = $labase->ochelper($otype);
453
454                        my $info = {
455                            contents => $res
456                        };
457                        if ($res->{name}) {
458                            $info->{name}{content} = $res->{name};
459                        }
460
461                        if (my $id = $ochelper->Automate($info)) {
462                            push(@ids, $id);
463                        } else {
464                            warn "Cannot create object line $linecount (not enough information ?)\n";
465                        }
466                    },
467                );
468
469                close($fh);
470
471                my @objs;
472                foreach (@ids) {
473                    my $obj = $self->base->get_object($otype, $_) or do {
474                        $self->print("Cannot get $otype $_\n");
475                        return;
476                    };
477                    push(@objs, $obj);
478                }
479
480                $self->print("Selecting $otype " . join(', ', @ids) . "\n");
481                LATMOS::Accounts::Cli::Object->new(
482                    Parent  => $self,
483                    Context => $self->Context,
484                    otype   => $otype,
485                    objs    => \@objs,
486                )->cli();
487            },
488            completion => sub {
489                if ($_[2]) {
490                    return Term::ReadLine::Gnu::filename_list(@_);
491                } else {
492                    return '@', $_[0]->base->list_supported_objects;
493                }
494            },
495        }
496    );
497
498    $self->add_func('user',  { alias => [qw'select user' ] });
499    $self->add_func('group', { alias => [qw'select group'] });
500    return $self
501}
502
5031;
504
505__END__
506
507=head1 SEE ALSO
508
509L<LATMOS::Accounts>
510
511=head1 AUTHOR
512
513Olivier Thauvin, E<lt>olivier.thauvin@latmos.ipsl.frE<gt>
514
515=head1 COPYRIGHT AND LICENSE
516
517Copyright (C) 2008, 2009, 2010, 2011, 2012 CNRS SA/CETP/LATMOS
518
519This library is free software; you can redistribute it and/or modify
520it under the same terms as Perl itself, either Perl version 5.10.0 or,
521at your option, any later version of Perl 5 you may have available.
522
523=cut
Note: See TracBrowser for help on using the repository browser.