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

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

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