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

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

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