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

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

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