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

Last change on this file since 2255 was 2241, checked in by nanardon, 5 years ago

Add --fmt option to list
File size: 19.0 KB
Line 
1package LATMOS::Accounts::Cli::Object;
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;
13
14extends 'LATMOS::Accounts::Cli::Base';
15
16=head1 NAME
17
18LATMOS::Accounts::Cli - Command line interface functions
19
20=head1 DESCRIPTION
21
22This module handle envirronment and functons for L<la-cli> tools.
23
24=cut
25
26=head1 FUNCTIONS
27
28=cut
29
30has otype => ( is => 'ro' );
31has objs  => ( is => 'rw' );
32
33=head1 CLI FUNCTIONS
34
35=head2 OBJECT COLLECTION FUNCTIONS
36
37=cut
38
39sub BUILD {
40    my ( $self ) = @_;
41
42    my $labase = $self->base;
43    my $OUT = $self->Context->Out;
44
45    $self->{_otype} = $self->otype;
46    $self->{_objects} = $self->objs;
47
48=head3 +
49
50add item to selection
51
52=cut
53
54    $self->add_func('+', {
55        code => sub {
56            my ($env, @ids) = @_;
57            my %ids = map { $_->id => 1 } @{$env->{_objects}};
58            foreach (@ids) {
59                $ids{$_} and next;
60                my $o = $env->base->get_object($env->{_otype}, $_) or next;
61                push(@{$env->{_objects}}, $o);
62            }
63            printf $OUT "select is now %s: %s\n", $env->{_otype}, join(', ', map {
64                $_->id } @{$env->{_objects}});
65        },
66        completion => sub {
67            my ($env, undef, @ids) = @_;
68            my %ids = map { $_->id => 1 } @{$env->{_objects}};
69            return ( grep { ! $ids{$_} } $env->base->list_objects($env->{_otype}));
70        },
71        }
72    );
73    $self->add_func('-', {
74        help => 'add item to selection',
75        code => sub {
76            my ($env, @ids) = @_;
77            my %ids = map { $_ => 1 } @ids;
78            my @newobjs = grep { !$ids{$_->id} } @{$env->{_objects}};
79
80            if (!@newobjs) {
81                print $OUT "This would remove all objects from the list...\n";
82                return;
83            } else {
84                @{$env->{_objects}} = @newobjs;
85            }
86            printf $OUT "select is now %s: %s\n", $env->{_otype}, join(', ', map {
87                $_->id } @{$env->{_objects}});
88        },
89        completion => sub {
90            my ($env, undef, @ids) = @_;
91            my %ids = map { $_ => 1 } @ids;
92            grep { !$ids{$_} } map { $_->id } @{$env->{_objects}};
93        },
94        }
95    );
96
97=head3 show
98
99    show
100    show [atttribute]
101
102Show an attributes of selected objects
103
104=cut
105
106    $self->add_func('show', {
107        code => sub {
108            my ($env, $attr) = @_;
109            if (!$attr) {
110                foreach (@{$env->{_objects}}) {
111                    print $OUT $_->dump;
112                }
113            } else {
114                foreach my $u (@{$env->{_objects}}) {
115                    print $OUT sort map { $u->id . ': ' .($_ || '') . "\n" } $u->get_attributes($attr);
116                }
117            }
118        },
119        completion => sub {
120            if (!$_[2]) {
121                my $flag = $_[1] =~ /^_/ ? 'ra' : 'r';
122                return $_[0]->base->list_canonical_fields($_[0]->{_otype}, $flag)
123            }
124        },
125    });
126    $self->add_func('print', {
127        help => 'print fmt - show attributes using template',
128        code => sub {
129            my ($env, $fmt) = @_;
130            if (!defined($fmt)) {
131                print $OUT "no format given";
132                return;
133            }
134            foreach (@{$env->{_objects}}) {
135                print $OUT $_->queryformat($fmt) . "\n";
136            }
137        },
138    });
139    $self->add_func('unset', {
140        help => 'unset attribute - unset specified attribute',
141        code => sub {
142            my ($env, $attr) = @_;
143            $attr or do {
144                print $OUT "Attributes must be specified";
145                return;
146            };
147            foreach (@{$env->{_objects}}) {
148                defined $_->set_c_fields($attr => undef) or do {
149                    print $OUT "cannot unset attributes $attr for " . $_->id .
150                    "\n";
151                    return;
152                };
153            }
154            $env->commit;
155            print $OUT "Changes applied\n";
156        },
157        completion => sub {
158            my ($env, $lastw, @args) = @_;
159            if (!$args[0]) {
160                return $env->base->list_canonical_fields($env->{_otype}, 'w')
161            }
162        },
163    });
164    $self->add_func('set', {
165        help => 'set attribute value - set an attributes to single value "value"',
166        code => sub {
167            my ($env, $attr, @value) = @_;
168            @value or do {
169                print $OUT "attribute and value must be specified\n";
170                return;
171            };
172            foreach (@{$env->{_objects}}) {
173                defined $_->set_c_fields($attr => @value <= 1 ? $value[0] :
174                    \@value) or do {
175                    $_->base->rollback;
176                    printf $OUT "Cannot set $attr to %s for %s\n", join(', ',
177                        @value), $_->id;
178                    return;
179                };
180            }
181            $env->commit;
182            print $OUT "Done.\n";
183        },
184        completion => sub {
185            my ($env, $lastw, @args) = @_;
186            if (!$args[0]) {
187                return $env->base->list_canonical_fields($env->{_otype}, 'w')
188            } else {
189                my $attr = $env->base->attribute($env->{_otype}, $args[0]);
190                if ($attr->has_values_list) {
191                    $attr->can_values;
192                } elsif (@{$env->{_objects}} == 1) {
193                    return
194                    $env->{_objects}[0]->get_attributes($args[0]);
195                }
196            }
197        },
198    });
199    $self->add_func('add', {
200        help => 'add a value to an attribute',
201        code => sub {
202            my ($env, $attr, @value) = @_;
203            @value or do {
204                print $OUT "attribute and value must be specified\n";
205                return;
206            };
207            foreach (@{$env->{_objects}}) {
208                my @attrv = grep { $_ } $_->get_attributes($attr);
209                defined $_->set_c_fields($attr => [ @attrv, @value ]) or do {
210                    $_->base->rollback;
211                    printf $OUT "Cannot set $attr to %s for %s\n", join(', ',
212                        @value), $_->id;
213                    return;
214                };
215            }
216            $env->commit;
217            print $OUT "done\n";
218        },
219        completion => sub {
220            my ($env, $lastw, @args) = @_;
221            if (!$args[0]) {
222                return grep {
223                    $env->base->attribute($env->{_otype}, $_)->{multiple}
224                } $env->base->list_canonical_fields($env->{_otype}, 'w')
225            } else {
226                my $attr = $env->base->attribute($env->{_otype}, $args[0]);
227                if ($attr->has_values_list) {
228                    $attr->can_values;
229                } elsif (@{$env->{_objects}} == 1) {
230                    return
231                    $env->{_objects}[0]->get_attributes($args[0]);
232                }
233            }
234        },
235    });
236    $self->add_func('remove', {
237        help => 'remove a value from an attribute',
238        code => sub {
239            my ($env, $attr, @value) = @_;
240            @value or do {
241                print $OUT "attribute and value must be specified\n";
242                return;
243            };
244            foreach (@{$env->{_objects}}) {
245                my @attrv = grep { $_ } $_->get_attributes($attr);
246                foreach my $r (@value) {
247                    @attrv = grep { $_ ne $r } @attrv;
248                }
249                defined $_->set_c_fields($attr => @attrv ? [ @attrv ] : undef) or do {
250                    $_->rollback;
251                    printf $OUT "Cannot set $attr to %s for %s\n", join(', ',
252                        @value), $_->id;
253                    return;
254                };
255            }
256            $env->commit;
257            print $OUT "done\n";
258        },
259        completion => sub {
260            my ($env, $lastw, @args) = @_;
261            if (!$args[0]) {
262                return grep {
263                    $env->base->attribute($env->{_otype}, $_)->{multiple}
264                } $env->base->list_canonical_fields($env->{_otype}, 'w')
265            } else {
266                my $attr = $env->base->attribute($env->{_otype}, $args[0]);
267                if (@{$env->{_objects}} == 1) {
268                    return
269                    $env->{_objects}[0]->get_attributes($args[0]);
270                }
271            }
272        },
273    });
274    $self->add_func('list', {
275        help => 'list current selected objects',
276        code => sub {
277
278            my $env = shift;
279            my @args = $self->getoption(
280                {
281                    'fmt=s'      => \my $fmt,
282                    'filefmt=s'  => \my $filefmt,
283                }, @_
284            );
285
286            if ($filefmt){
287                open(my $hfmt, '<', $filefmt) or die "Cannot open $filefmt\n";
288                $fmt ||= ''; # avoid undef warning
289                while (<$hfmt>) {
290                    chomp($fmt .= $_);
291                }
292                close $hfmt;
293            }
294
295            if ($fmt) {
296                foreach (@{$env->{_objects}}) {
297                    print $OUT $_->queryformat($fmt);
298                }
299                print $OUT "\n";
300            } else {
301                printf $OUT "%s: %s\n", $env->{_otype}, join(', ', map { $_->id } @{$env->{_objects}});
302            }
303        }
304    });
305    $self->add_func('ls',  { alias => [ qw'list' ] });
306    $self->add_func('edit', {
307            help => 'edit [object] - edit selected object using vi',
308            completion => sub {
309                return map { $_->id } @{$_[0]->{_objects}}
310            },
311            code => sub {
312                my ($env, $id) = @_;
313                my $obj;
314                if ($id) {
315                    $obj = grep { $_->id = $id } @{$env->{_objects}} or do {
316                        print $OUT "$id is not part of selected objects\n";
317                        return;
318                    };
319                } elsif (@{$env->{_objects}} == 1) {
320                    $obj = $env->{_objects}[0]
321                } else {
322                    print $OUT "multiple objects selected but can edit only one,"
323                    . "please specify which one\n";
324                    return;
325                }
326                my $res = LATMOS::Accounts::Utils::dump_read_temp_file(
327                    sub {
328                        my ($fh) = @_;
329                        $obj->text_dump($fh,
330                            {
331                                empty_attr => 1,
332                                only_rw => 1,
333                            }
334                        );
335                    },
336                    sub {
337                        my ($fh) = @_;
338                        my %attr = LATMOS::Accounts::Utils::parse_obj_file($fh);
339                        my $res = $obj->set_c_fields(%attr);
340                        if ($res) {
341                            print $OUT "Changes applied\n";
342                            $env->commit;
343                        }
344                        else { print $OUT "Error applying changes\n" }
345                        return $res ? 1 : 0;
346                    }
347                );
348            },
349        });
350    $self->add_func('delete', {
351        help => 'delete - delete selected object',
352        code => sub {
353            my ($env) = @_;
354            printf $OUT "%s: %s\ndelete selected objects ? (yes/NO)\n",
355            $env->{_otype}, join(', ', map { $_->id } @{$env->{_objects}});
356            my $reply = <STDIN> || ''; chomp($reply);
357            if ($reply eq 'yes') {
358                foreach (@{$env->{_objects}}) {
359                    $env->base->delete_object($env->{_otype}, $_->id) or do {
360                        print $OUT "Cannot delete " . $_->id . "\n";
361                        return;
362                    };
363                }
364                $env->commit;
365                return "EXIT";
366            } else {
367                print $OUT "cancel !\n"
368            }
369        },
370    });
371    if (grep { $self->base->attribute($self->otype, $_)->reference }
372        $self->base->list_canonical_fields($self->otype, 'r')) {
373        $self->add_func('select', {
374            help => 'select attribute [object]',
375            code => sub {
376                my ($env, $attrname, @objects) = @_;
377
378                my $attr = $env->base->attribute(
379                    $env->{_otype},
380                    $attrname
381                ) or do {
382                    print $OUT "No attribute $attrname";
383                    return;
384                };
385                my $totype = $attr->reference or return;
386
387                if (! @objects) {
388                    @objects = grep { $_ } 
389                      map { $_->get_attributes($attrname) } @{$env->{_objects}};
390                }
391                {
392                    my %uniq = map { $_ => 1 } @objects;
393                    @objects = keys %uniq;
394                }
395                my @objs = (grep { $_ } map { $env->base->get_object($totype, $_) }
396                        @objects);
397                return if (!@objs);
398                print $OUT "Selecting $totype " . join(', ', map { $_->id } @objs) . "\n";
399                LATMOS::Accounts::Cli::Object->new(
400                    Parent  => $self,
401                    Context => $env->Context,
402                    otype   => $totype,
403                    objs    => \@objs
404                )->cli();
405            },
406            completion => sub {
407                if ($_[2]) {
408                    my $totype = $_[0]->base->attribute($_[0]->{_otype},
409                        $_[2])->reference or return;
410                    return grep { $_ }
411                           map { $_->get_attributes($_[2]) }
412                           @{$_[0]->{_objects}};
413                } else {
414                    my $flag = $_[1] =~ /^_/ ? 'ra' : 'r';
415                    return grep { $_[0]->base->attribute($self->otype, $_)->reference }
416                    $_[0]->base->list_canonical_fields($self->otype, $flag);
417                }
418            },
419            }
420        );
421    }
422
423    if (lc($self->otype) eq 'user') {
424        $self->add_func('group', {
425            help => 'group add|remove|primary goupname',
426            code => sub {
427                my ($env, $action, @groups) = @_;
428                foreach my $obj (@{$env->{_objects}}) {
429                    if ($action eq 'primary') {
430                        my $gid = $groups[0];
431                        if ($gid !~ /^\d/) {
432                            my $gobj = $env->base->get_object('group', $gid) or
433                            do {
434                                print $OUT "Cannot find group $gid\n";
435                                return;
436                            };
437                            $gid = $gobj->get_attributes('gidNumber');
438                        }
439                        $obj->set_c_fields('gidNumber', $gid);
440                    } else {
441                        my %gr;
442                        foreach ($obj->get_attributes('memberOf')) {
443                            $gr{$_} = 1;
444                        }
445                        if ($action eq 'add') {
446                            $gr{$_} = 1 foreach(@groups);
447                        } elsif ($action eq 'remove') {
448                            delete($gr{$_}) foreach(@groups);
449                        } else {
450                            print $OUT 'invalid action' . "\n";
451                            return;
452                        }
453                        defined $obj->set_c_fields('memberOf' => [ keys %gr ]) or do {
454                            print $OUT "cannot set memberOf attributes for " .
455                            $obj->id . "\n";
456                            return;
457                        };
458                    }
459                }
460                $env->commit;
461            },
462            completion => sub {
463                if (!$_[2]) {
464                    return (qw(add remove primary));
465                } else {
466                    if ($_[2] eq 'remove') {
467                        my %uniq = map { $_ => 1 }
468                            grep { $_ }
469                            map { $_->get_attributes('memberOf') }
470                            @{$_[0]->{_objects}};
471                        return sort keys %uniq;
472                    } else {
473                        return $_[0]->base->search_objects('group');
474                    }
475                }
476            },
477        });
478    } elsif ($self->otype eq 'group') {
479        $self->add_func('member', {
480            help => 'member add|remove user',
481            code => sub {
482                my ($env, $action, @groups) = @_;
483                foreach my $obj (@{$env->{_objects}}) {
484                    my %gr;
485                    foreach ($obj->get_attributes('memberUID')) {
486                        $gr{$_} = 1;
487                    }
488                    if ($action eq 'add') {
489                        $gr{$_} = 1 foreach(@groups);
490                    } elsif ($action eq 'remove') {
491                        delete($gr{$_}) foreach(@groups);
492                    } else {
493                        print $OUT 'invalid action' . "\n";
494                        return;
495                    }
496                    defined $obj->set_c_fields('memberUID' => [ keys %gr ]) or do {
497                        print $OUT "cannot set memberUID attributes for " .
498                        $obj->id . "\n";
499                        return;
500                    };
501                }
502                $env->commit;
503            },
504            completion => sub {
505                if (!$_[2]) {
506                    return (qw(add remove));
507                } else {
508                    if ($_[2] eq 'remove') {
509                        my %uniq = map { $_ => 1 }
510                            grep { $_ }
511                            map { $_->get_attributes('member') }
512                            @{$_[0]->{_objects}};
513                        return sort keys %uniq;
514                    } else {
515                        return $_[0]->base->search_objects('user');
516                    }
517                }
518            },
519        });
520    }
521
522    return $self;
523}
524
525sub promptPrefix {
526    my ($self) = @_;
527
528    sprintf("%s %s/%s",
529        $self->base->label,
530        $self->otype,
531        @{$self->objs} > 1
532            ? '(' . scalar(@{$self->objs}) . ' obj.)'
533            : $self->objs->[0]->id,
534    );
535}
536
537around run => sub {
538    my $next = shift;
539    my $self = shift;
540
541    my $name = shift or return;
542
543    if (my $otype = $self->{funcs}{$name}{proxy}) {
544         $self->Context->{objs} = $self->objs;
545         LATMOS::Accounts::Cli->new(
546            Parent  => $self, # Look useless
547            Context => $self->Context,
548        )->run(
549            $name,
550            '-o', $self->otype,
551            @_,
552        );
553        $self->Context->{objs} = undef;
554    } else {
555        return $self->$next($name, @_);
556    }
557};
558
5591;
560
561__END__
562
563=head1 SEE ALSO
564
565L<LATMOS::Accounts>
566
567=head1 AUTHOR
568
569Olivier Thauvin, E<lt>olivier.thauvin@latmos.ipsl.frE<gt>
570
571=head1 COPYRIGHT AND LICENSE
572
573Copyright (C) 2008, 2009, 2010, 2011, 2012 CNRS SA/CETP/LATMOS
574
575This library is free software; you can redistribute it and/or modify
576it under the same terms as Perl itself, either Perl version 5.10.0 or,
577at your option, any later version of Perl 5 you may have available.
578
579=cut
Note: See TracBrowser for help on using the repository browser.