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

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

Add EmploymentSummary?() feature
File size: 24.6 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 Term::ReadKey;
12use Text::ParseWords;
13use Getopt::Long;
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
31has otype => ( is => 'ro' );
32has objs  => ( is => 'rw' );
33
34=head1 CLI FUNCTIONS
35
36=head2 OBJECT COLLECTION FUNCTIONS
37
38=cut
39
40sub BUILD {
41    my ( $self ) = @_;
42
43    my $labase = $self->base;
44    my $OUT = $self->Context->Out;
45
46    $self->{_otype} = $self->otype;
47    $self->{_objects} = $self->objs;
48
49=head3 +
50
51add item to selection
52
53=cut
54
55    $self->add_func('+', {
56        code => sub {
57            my ($env, @ids) = @_;
58            my %ids = map { $_->id => 1 } @{$env->{_objects}};
59            foreach (@ids) {
60                $ids{$_} and next;
61                my $o = $env->base->get_object($env->{_otype}, $_) or next;
62                push(@{$env->{_objects}}, $o);
63            }
64            printf $OUT "select is now %s: %s\n", $env->{_otype}, join(', ', map {
65                $_->id } @{$env->{_objects}});
66        },
67        completion => sub {
68            my ($env, undef, @ids) = @_;
69            my %ids = map { $_->id => 1 } @{$env->{_objects}};
70            return ( grep { ! $ids{$_} } $env->base->list_objects($env->{_otype}));
71        },
72        }
73    );
74    $self->add_func('-', {
75        help => 'add item to selection',
76        code => sub {
77            my ($env, @ids) = @_;
78            my %ids = map { $_ => 1 } @ids;
79            my @newobjs = grep { !$ids{$_->id} } @{$env->{_objects}};
80
81            if (!@newobjs) {
82                print $OUT "This would remove all objects from the list...\n";
83                return;
84            } else {
85                @{$env->{_objects}} = @newobjs;
86            }
87            printf $OUT "select is now %s: %s\n", $env->{_otype}, join(', ', map {
88                $_->id } @{$env->{_objects}});
89        },
90        completion => sub {
91            my ($env, undef, @ids) = @_;
92            my %ids = map { $_ => 1 } @ids;
93            grep { !$ids{$_} } map { $_->id } @{$env->{_objects}};
94        },
95        }
96    );
97
98=head3 show
99
100    show
101    show [atttribute]
102
103Show an attributes of selected objects
104
105=cut
106
107    $self->add_func('show', {
108        code => sub {
109            my ($env, $attr) = @_;
110            if (!$attr) {
111                foreach (@{$env->{_objects}}) {
112                    print $OUT $_->dump;
113                }
114            } else {
115                foreach my $u (@{$env->{_objects}}) {
116                    print $OUT sort map { $u->id . ': ' .($_ || '') . "\n" } $u->get_attributes($attr);
117                }
118            }
119        },
120        completion => sub {
121            if (!$_[2]) {
122                my $flag = $_[1] =~ /^_/ ? 'ra' : 'r';
123                return $_[0]->base->list_canonical_fields($_[0]->{_otype}, $flag)
124            }
125        },
126    });
127    $self->add_func('print', {
128        help => 'print fmt - show attributes using template',
129        code => sub {
130            my ($env, $fmt) = @_;
131            if (!defined($fmt)) {
132                print $OUT "no format given";
133                return;
134            }
135            foreach (@{$env->{_objects}}) {
136                print $OUT $_->queryformat($fmt) . "\n";
137            }
138        },
139    });
140    $self->add_func('unset', {
141        help => 'unset attribute - unset specified attribute',
142        code => sub {
143            my ($env, $attr) = @_;
144            $attr or do {
145                print $OUT "Attributes must be specified";
146                return;
147            };
148            foreach (@{$env->{_objects}}) {
149                defined $_->set_c_fields($attr => undef) or do {
150                    print $OUT "cannot unset attributes $attr for " . $_->id .
151                    "\n";
152                    return;
153                };
154            }
155            $env->commit;
156            print $OUT "Changes applied\n";
157        },
158        completion => sub {
159            my ($env, $lastw, @args) = @_;
160            if (!$args[0]) {
161                return $env->base->list_canonical_fields($env->{_otype}, 'w')
162            }
163        },
164    });
165    $self->add_func('set', {
166        help => 'set attribute value - set an attributes to single value "value"',
167        code => sub {
168            my ($env, $attr, @value) = @_;
169            @value or do {
170                print $OUT "attribute and value must be specified\n";
171                return;
172            };
173            foreach (@{$env->{_objects}}) {
174                defined $_->set_c_fields($attr => @value <= 1 ? $value[0] :
175                    \@value) or do {
176                    $_->base->rollback;
177                    printf $OUT "Cannot set $attr to %s for %s\n", join(', ',
178                        @value), $_->id;
179                    return;
180                };
181            }
182            $env->commit;
183            print $OUT "Done.\n";
184        },
185        completion => sub {
186            my ($env, $lastw, @args) = @_;
187            if (!$args[0]) {
188                return $env->base->list_canonical_fields($env->{_otype}, 'w')
189            } else {
190                my $attr = $env->base->attribute($env->{_otype}, $args[0]);
191                if ($attr->has_values_list) {
192                    $attr->can_values;
193                } elsif (@{$env->{_objects}} == 1) {
194                    return
195                    $env->{_objects}[0]->get_attributes($args[0]);
196                }
197            }
198        },
199    });
200    $self->add_func('add', {
201        help => 'add a value to an attribute',
202        code => sub {
203            my ($env, $attr, @value) = @_;
204            @value or do {
205                print $OUT "attribute and value must be specified\n";
206                return;
207            };
208            foreach (@{$env->{_objects}}) {
209                my @attrv = grep { $_ } $_->get_attributes($attr);
210                defined $_->set_c_fields($attr => [ @attrv, @value ]) or do {
211                    $_->base->rollback;
212                    printf $OUT "Cannot set $attr to %s for %s\n", join(', ',
213                        @value), $_->id;
214                    return;
215                };
216            }
217            $env->commit;
218            print $OUT "done\n";
219        },
220        completion => sub {
221            my ($env, $lastw, @args) = @_;
222            if (!$args[0]) {
223                return grep {
224                    $env->base->attribute($env->{_otype}, $_)->{multiple}
225                } $env->base->list_canonical_fields($env->{_otype}, 'w')
226            } else {
227                my $attr = $env->base->attribute($env->{_otype}, $args[0]);
228                if ($attr->has_values_list) {
229                    $attr->can_values;
230                } elsif (@{$env->{_objects}} == 1) {
231                    return
232                    $env->{_objects}[0]->get_attributes($args[0]);
233                }
234            }
235        },
236    });
237    $self->add_func('remove', {
238        help => 'remove a value from an attribute',
239        code => sub {
240            my ($env, $attr, @value) = @_;
241            @value or do {
242                print $OUT "attribute and value must be specified\n";
243                return;
244            };
245            foreach (@{$env->{_objects}}) {
246                my @attrv = grep { $_ } $_->get_attributes($attr);
247                foreach my $r (@value) {
248                    @attrv = grep { $_ ne $r } @attrv;
249                }
250                defined $_->set_c_fields($attr => @attrv ? [ @attrv ] : undef) or do {
251                    $_->rollback;
252                    printf $OUT "Cannot set $attr to %s for %s\n", join(', ',
253                        @value), $_->id;
254                    return;
255                };
256            }
257            $env->commit;
258            print $OUT "done\n";
259        },
260        completion => sub {
261            my ($env, $lastw, @args) = @_;
262            if (!$args[0]) {
263                return grep {
264                    $env->base->attribute($env->{_otype}, $_)->{multiple}
265                } $env->base->list_canonical_fields($env->{_otype}, 'w')
266            } else {
267                my $attr = $env->base->attribute($env->{_otype}, $args[0]);
268                if (@{$env->{_objects}} == 1) {
269                    return
270                    $env->{_objects}[0]->get_attributes($args[0]);
271                }
272            }
273        },
274    });
275    $self->add_func('list', {
276        help => 'list current selected objects',
277        code => sub {
278
279            my $env = shift;
280            my @args = $self->getoption(
281                {
282                    'fmt=s'      => \my $fmt,
283                    'filefmt=s'  => \my $filefmt,
284                }, @_
285            );
286
287            if ($filefmt){
288                open(my $hfmt, '<', $filefmt) or die "Cannot open $filefmt\n";
289                $fmt ||= ''; # avoid undef warning
290                while (<$hfmt>) {
291                    chomp($fmt .= $_);
292                }
293                close $hfmt;
294            }
295
296            if ($fmt) {
297                foreach (@{$env->{_objects}}) {
298                    print $OUT $_->queryformat($fmt);
299                }
300                print $OUT "\n";
301            } else {
302                printf $OUT "%s: %s\n", $env->{_otype}, join(', ', map { $_->id } @{$env->{_objects}});
303            }
304        }
305    });
306    $self->add_func('ls',  { alias => [ qw'list' ] });
307    $self->add_func('edit', {
308            help => 'edit [object] - edit selected object using vi',
309            completion => sub {
310                return map { $_->id } @{$_[0]->{_objects}}
311            },
312            code => sub {
313                my ($env, $id) = @_;
314                my $obj;
315                if ($id) {
316                    $obj = grep { $_->id = $id } @{$env->{_objects}} or do {
317                        print $OUT "$id is not part of selected objects\n";
318                        return;
319                    };
320                } elsif (@{$env->{_objects}} == 1) {
321                    $obj = $env->{_objects}[0]
322                } else {
323                    print $OUT "multiple objects selected but can edit only one,"
324                    . "please specify which one\n";
325                    return;
326                }
327                my $res = LATMOS::Accounts::Utils::dump_read_temp_file(
328                    sub {
329                        my ($fh) = @_;
330                        $obj->text_dump($fh,
331                            {
332                                empty_attr => 1,
333                                only_rw => 1,
334                            }
335                        );
336                    },
337                    sub {
338                        my ($fh) = @_;
339                        my %attr = LATMOS::Accounts::Utils::parse_obj_file($fh);
340                        my $res = $obj->set_c_fields(%attr);
341                        if ($res) {
342                            print $OUT "Changes applied\n";
343                            $env->commit;
344                        }
345                        else { print $OUT "Error applying changes\n" }
346                        return $res ? 1 : 0;
347                    }
348                );
349            },
350        });
351    $self->add_func('delete', {
352        help => 'delete - delete selected object',
353        code => sub {
354            my ($env) = @_;
355            printf $OUT "%s: %s\ndelete selected objects ? (yes/NO)\n",
356            $env->{_otype}, join(', ', map { $_->id } @{$env->{_objects}});
357            my $reply = <STDIN> || ''; chomp($reply);
358            if ($reply eq 'yes') {
359                foreach (@{$env->{_objects}}) {
360                    $env->base->delete_object($env->{_otype}, $_->id) or do {
361                        print $OUT "Cannot delete " . $_->id . "\n";
362                        return;
363                    };
364                }
365                $env->commit;
366                return "EXIT";
367            } else {
368                print $OUT "cancel !\n"
369            }
370        },
371    });
372    if (grep { $self->base->attribute($self->otype, $_)->reference }
373        $self->base->list_canonical_fields($self->otype, 'r')) {
374        $self->add_func('select', {
375            help => 'select attribute [object]',
376            code => sub {
377                my ($env, $attrname, @objects) = @_;
378
379                my $attr = $env->base->attribute(
380                    $env->{_otype},
381                    $attrname
382                ) or do {
383                    print $OUT "No attribute $attrname";
384                    return;
385                };
386                my $totype = $attr->reference or return;
387
388                if (! @objects) {
389                    @objects = grep { $_ } 
390                      map { $_->get_attributes($attrname) } @{$env->{_objects}};
391                }
392                {
393                    my %uniq = map { $_ => 1 } @objects;
394                    @objects = keys %uniq;
395                }
396                my @objs = (grep { $_ } map { $env->base->get_object($totype, $_) }
397                        @objects);
398                return if (!@objs);
399                print $OUT "Selecting $totype " . join(', ', map { $_->id } @objs) . "\n";
400                LATMOS::Accounts::Cli::Object->new(
401                    Parent  => $self,
402                    Context => $env->Context,
403                    otype   => $totype,
404                    objs    => \@objs
405                )->cli();
406            },
407            completion => sub {
408                if ($_[2]) {
409                    my $totype = $_[0]->base->attribute($_[0]->{_otype},
410                        $_[2])->reference or return;
411                    return grep { $_ }
412                           map { $_->get_attributes($_[2]) }
413                           @{$_[0]->{_objects}};
414                } else {
415                    my $flag = $_[1] =~ /^_/ ? 'ra' : 'r';
416                    return grep { $_[0]->base->attribute($self->otype, $_)->reference }
417                    $_[0]->base->list_canonical_fields($self->otype, $flag);
418                }
419            },
420            }
421        );
422    }
423
424    if (lc($self->otype) eq 'user') {
425
426=head2 USER OBJECT FUCNTION
427
428=cut
429
430        $self->add_func('group', {
431            help => 'group add|remove|primary goupname',
432            code => sub {
433                my ($env, $action, @groups) = @_;
434                foreach my $obj (@{$env->{_objects}}) {
435                    if ($action eq 'primary') {
436                        my $gid = $groups[0];
437                        if ($gid !~ /^\d/) {
438                            my $gobj = $env->base->get_object('group', $gid) or
439                            do {
440                                print $OUT "Cannot find group $gid\n";
441                                return;
442                            };
443                            $gid = $gobj->get_attributes('gidNumber');
444                        }
445                        $obj->set_c_fields('gidNumber', $gid);
446                    } else {
447                        my %gr;
448                        foreach ($obj->get_attributes('memberOf')) {
449                            $gr{$_} = 1;
450                        }
451                        if ($action eq 'add') {
452                            $gr{$_} = 1 foreach(@groups);
453                        } elsif ($action eq 'remove') {
454                            delete($gr{$_}) foreach(@groups);
455                        } else {
456                            print $OUT 'invalid action' . "\n";
457                            return;
458                        }
459                        defined $obj->set_c_fields('memberOf' => [ keys %gr ]) or do {
460                            print $OUT "cannot set memberOf attributes for " .
461                            $obj->id . "\n";
462                            return;
463                        };
464                    }
465                }
466                $env->commit;
467            },
468            completion => sub {
469                if (!$_[2]) {
470                    return (qw(add remove primary));
471                } else {
472                    if ($_[2] eq 'remove') {
473                        my %uniq = map { $_ => 1 }
474                            grep { $_ }
475                            map { $_->get_attributes('memberOf') }
476                            @{$_[0]->{_objects}};
477                        return sort keys %uniq;
478                    } else {
479                        return $_[0]->base->search_objects('group');
480                    }
481                }
482            },
483        });
484
485=head3 lock
486
487Lock user account making it not usable
488
489=cut
490
491        $self->add_func('lock', {
492            code => sub {
493                my ( $env, $ban ) = @_;
494                foreach my $obj (@{$env->{_objects}}) {
495                    $obj->set_c_fields('locked', 1);
496                    if ($ban) {
497                        $obj->banCurrentPassword;
498                    }
499                }
500                $env->commit;
501            },
502            completion => sub {
503                if (!$_[2]) {
504                    return (qw(ban));
505                }
506            },
507        });
508
509=head3 unlock
510
511Unlock user account making it usable again
512
513=cut
514
515        $self->add_func('unlock', {
516            code => sub {
517                my ( $env, $ban ) = @_;
518                foreach my $obj (@{$env->{_objects}}) {
519                    $obj->set_c_fields('locked', undef);
520                    if ($ban) {
521                        $obj->banCurrentPassword;
522                    }
523                }
524                $env->commit;
525            },
526            completion => sub {
527                if (!$_[2]) {
528                    return (qw(ban));
529                }
530            },
531        });
532
533=head3 banpasswd
534
535Ban current pasword making it not usable by user
536
537=cut
538
539        $self->add_func('banpasswd', {
540            code => sub {
541                my ( $env ) = @_;
542                foreach my $obj (@{$env->{_objects}}) {
543                    $obj->banCurrentPassword;
544                }
545                $env->commit;
546            },
547            completion => sub {},
548        });
549
550=head3 passwd
551
552Set password to selected user. If multiple users are selected the same password will be set to all users
553
554Options:
555
556=over 4
557
558=item -f|--force Ignore password quality check
559
560=item -r|--random Generate a random password for each users
561
562=item -o|--output Write login:password into a file (usefull with --random)
563
564=back
565
566=cut
567
568        $self->add_func('passwd', {
569            code => sub {
570                my $env = shift;
571                my %gen_options = ();
572                my ( $password ) = $self->getoption(
573                    {
574                        'f|force'  => \my $force,
575                        'r|random' => \my $random,
576                        'p'        => \$gen_options{nonalpha},
577                        'syl'      => \$gen_options{syllables},
578                        'l=i'      => \$gen_options{length},
579                        'o=s'      => \my $output,
580
581                    }, @_
582                );
583
584                if (!($password || $random)) {
585                    ReadMode('noecho');
586                    print "Enter password: ";
587                    $password = ReadLine(0);
588                    ReadMode 0;
589                    print "\n";
590                    chomp($password);
591                }
592
593                $password ||= '';
594                my %resPasswd = ();
595
596                my $sbase = $self->La->sync_access();
597
598                foreach my $obj (@{$env->{_objects}}) {
599                    my $sobj = $sbase->get_object($obj->type, $obj->id);
600                    if ($random) {
601                        $password = LATMOS::Accounts::Utils::genpassword(
602                            %gen_options
603                        );
604                    }
605
606                    my $res = $sobj->check_password($password);
607                    if ($res ne 'ok') {
608                        warn "Password quality: $res\n";
609                        if (!$force) {
610                            warn "Cannot set bad password, use --force to bypass security\n";
611                            return;
612                        }
613                    }
614                    if ($sobj->set_password($password)) {
615                        $resPasswd{$obj->id} = $password;
616                        print "Password succefully changed\n";
617                        $env->commit;
618                        return 1;
619                    } else {
620                        warn "Error when trying to change password\n";
621                        return 0;
622                    }
623                }
624
625                if ($output) {
626                    open(my $handle, '>', $output) or do {
627                        warn "Cannot open $output: $!";
628                        return;
629                    };
630                    foreach (sort keys %resPasswd) {
631                        print $handle $_ . ':' . $resPasswd{$_} . "\n";
632                    }
633                    close($handle);
634                }
635            },
636            completion => sub {
637                return (qw(-f --force -r --random -p --syl -l -o));
638            },
639        });
640
641        $self->add_func('summary', {
642            code => sub {
643                my $env = shift;
644
645                foreach my $obj (@{$env->{_objects}}) {
646                    print $obj->id . "\n";
647                    foreach my $emp ($obj->EmploymentSummary) {
648                        printf("    %s - %s %s\n",
649                            $emp->{firstday},
650                            $emp->{lastday} || '        ',
651                            $emp->{contratType}
652                        );
653                    }
654                }
655                return 1;
656            },
657            completion => sub {
658                return (qw(-f --force -r --random -p --syl -l -o));
659            },
660        });
661
662       
663
664    } elsif ($self->otype eq 'group') {
665
666=head2 GROUP OBJECT FUNCTIONS
667
668=cut
669
670        $self->add_func('member', {
671            help => 'member add|remove user',
672            code => sub {
673                my ($env, $action, @groups) = @_;
674                foreach my $obj (@{$env->{_objects}}) {
675                    my %gr;
676                    foreach ($obj->get_attributes('memberUID')) {
677                        $gr{$_} = 1;
678                    }
679                    if ($action eq 'add') {
680                        $gr{$_} = 1 foreach(@groups);
681                    } elsif ($action eq 'remove') {
682                        delete($gr{$_}) foreach(@groups);
683                    } else {
684                        print $OUT 'invalid action' . "\n";
685                        return;
686                    }
687                    defined $obj->set_c_fields('memberUID' => [ keys %gr ]) or do {
688                        print $OUT "cannot set memberUID attributes for " .
689                        $obj->id . "\n";
690                        return;
691                    };
692                }
693                $env->commit;
694            },
695            completion => sub {
696                if (!$_[2]) {
697                    return (qw(add remove));
698                } else {
699                    if ($_[2] eq 'remove') {
700                        my %uniq = map { $_ => 1 }
701                            grep { $_ }
702                            map { $_->get_attributes('member') }
703                            @{$_[0]->{_objects}};
704                        return sort keys %uniq;
705                    } else {
706                        return $_[0]->base->search_objects('user');
707                    }
708                }
709            },
710        });
711    }
712    if (1) { # TODO test SQL base
713        $self->add_func('extract', {
714            help => 'extract information about objects',
715            code => sub {
716                my ($env, $action) = @_;
717                foreach my $obj (sort @{$env->{_objects}}) {
718                    print $OUT $obj->dump({ recur => 1 });
719                }
720                $env->rollback;
721            },
722        });
723    }
724
725    return $self;
726}
727
728sub promptPrefix {
729    my ($self) = @_;
730
731    sprintf("%s %s/%s",
732        $self->base->label,
733        $self->otype,
734        @{$self->objs} > 1
735            ? '(' . scalar(@{$self->objs}) . ' obj.)'
736            : $self->objs->[0]->id,
737    );
738}
739
740around run => sub {
741    my $next = shift;
742    my $self = shift;
743
744    my $name = shift or return;
745
746    if (my $otype = $self->{funcs}{$name}{proxy}) {
747         $self->Context->{objs} = $self->objs;
748         LATMOS::Accounts::Cli->new(
749            Parent  => $self, # Look useless
750            Context => $self->Context,
751        )->run(
752            $name,
753            '-o', $self->otype,
754            @_,
755        );
756        $self->Context->{objs} = undef;
757    } else {
758        return $self->$next($name, @_);
759    }
760};
761
7621;
763
764__END__
765
766=head1 SEE ALSO
767
768L<LATMOS::Accounts>
769
770=head1 AUTHOR
771
772Olivier Thauvin, E<lt>olivier.thauvin@latmos.ipsl.frE<gt>
773
774=head1 COPYRIGHT AND LICENSE
775
776Copyright (C) 2008, 2009, 2010, 2011, 2012 CNRS SA/CETP/LATMOS
777
778This library is free software; you can redistribute it and/or modify
779it under the same terms as Perl itself, either Perl version 5.10.0 or,
780at your option, any later version of Perl 5 you may have available.
781
782=cut
Note: See TracBrowser for help on using the repository browser.