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

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

Add la-cli sed(), Fill Changes
File size: 33.5 KB
Line 
1package LATMOS::Accounts::Cli::Object;
2
3# $Id: Cli.pm 2145 2018-08-29 18:15:46Z nanardon $
4
5use strict;
6use warnings;
7use Moose;
8use LATMOS::Accounts::Log;
9use LATMOS::Accounts::Utils;
10use Term::ReadLine;
11use 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('sed', {
383        help => 'Apply regular expression on curent attribute',
384        code => sub {
385            my ($env, $attr, $reg) = @_;
386            $reg or do {
387                $self->print( "attribute and value must be specified\n" );
388                return;
389            };
390            foreach (@{$env->{_objects}}) {
391                my @newvalues;
392                my $Change = 0;
393                foreach my $val ($_->get_attributes($attr)) {
394                    my $nval = $val;
395                    eval "\$nval =~ $reg;";
396                    if ($@) {
397                        $self->print("$@No change done\n");
398                        $env->rollback;
399                        return;
400                    }
401                    if ($val ne $nval) {
402                        $self->printf("%s: %s => %s\n", $_->id, $val, $nval);
403                        $Change ++;
404                    }
405                    push(@newvalues, $nval) if($nval);
406                }
407                if ( $Change ) {
408                    defined $_->set_c_fields($attr => @newvalues <= 1 ? $newvalues[0] : \@newvalues) or do {
409                        $_->base->rollback;
410                        $self->printf ("Cannot set $attr to %s for %s\n", join(', ', @newvalues), $_->id);
411                        return;
412                    };
413                } else {
414                    $self->printf("No change for %s\n", $_->id);
415                }
416            }
417            $env->commit;
418            $self->print( "Done.\n" );
419        },
420        completion => sub {
421            my ($env, $lastw, @args) = @_;
422            if (!$args[0]) {
423                return $env->base->list_canonical_fields($env->{_otype}, 'w')
424            }
425        },
426    });
427    $self->add_func('add', {
428        help => 'add a value to an attribute',
429        code => sub {
430            my ($env, $attr, @value) = @_;
431            @value or do {
432                $self->print( "attribute and value must be specified\n" );
433                return;
434            };
435            foreach (@{$env->{_objects}}) {
436                my @attrv = grep { $_ } $_->get_attributes($attr);
437                defined $_->set_c_fields($attr => [ @attrv, @value ]) or do {
438                    $_->base->rollback;
439                    $self->printf( "Cannot set $attr to %s for %s\n", join(', ',
440                        @value), $_->id );
441                    return;
442                };
443            }
444            $env->commit;
445            $self->print( "done\n" );
446        },
447        completion => sub {
448            my ($env, $lastw, @args) = @_;
449            if (!$args[0]) {
450                return grep {
451                    $env->base->attribute($env->{_otype}, $_)->{multiple}
452                } $env->base->list_canonical_fields($env->{_otype}, 'w')
453            } else {
454                my $attr = $env->base->attribute($env->{_otype}, $args[0]);
455                if ($attr->has_values_list) {
456                    $attr->can_values;
457                } elsif (@{$env->{_objects}} == 1) {
458                    return
459                    $env->{_objects}[0]->get_attributes($args[0]);
460                }
461            }
462        },
463    });
464    $self->add_func('remove', {
465        help => 'remove a value from an attribute',
466        code => sub {
467            my ($env, $attr, @value) = @_;
468            @value or do {
469                $self->print( "attribute and value must be specified\n" );
470                return;
471            };
472            foreach (@{$env->{_objects}}) {
473                my @attrv = grep { $_ } $_->get_attributes($attr);
474                foreach my $r (@value) {
475                    @attrv = grep { $_ ne $r } @attrv;
476                }
477                defined $_->set_c_fields($attr => @attrv ? [ @attrv ] : undef) or do {
478                    $_->rollback;
479                    $self->printf( "Cannot set $attr to %s for %s\n", join(', ',
480                        @value), $_->id );
481                    return;
482                };
483            }
484            $env->commit;
485            $self->print( "done\n" );
486        },
487        completion => sub {
488            my ($env, $lastw, @args) = @_;
489            if (!$args[0]) {
490                return grep {
491                    $env->base->attribute($env->{_otype}, $_)->{multiple}
492                } $env->base->list_canonical_fields($env->{_otype}, 'w')
493            } else {
494                my $attr = $env->base->attribute($env->{_otype}, $args[0]);
495                if (@{$env->{_objects}} == 1) {
496                    return
497                    $env->{_objects}[0]->get_attributes($args[0]);
498                }
499            }
500        },
501    });
502    $self->add_func('list', {
503        help => 'list current selected objects',
504        code => sub {
505
506            my $env = shift;
507            my @allargs = @_;
508            my @args = $self->getoption(
509                {
510                    'fmt=s'      => \my $fmt,
511                    'filefmt=s'  => \my $filefmt,
512                    'r'          => \my $recur,
513                }, @allargs
514            );
515
516            if ($recur) {
517                $self->Traverse( undef, sub {
518                    $_[0]->Parent or return;
519                    $_[0]->run('list', grep { $_ ne '-r' } @allargs);
520                } );
521                return;
522            }
523
524            if ($filefmt){
525                open(my $hfmt, '<', $filefmt) or die "Cannot open $filefmt\n";
526                $fmt ||= ''; # avoid undef warning
527                while (<$hfmt>) {
528                    chomp($fmt .= $_);
529                }
530                close $hfmt;
531            }
532
533            if ($fmt) {
534                foreach (@{$env->{_objects}}) {
535                    $self->print( $_->queryformat($fmt) );
536                }
537                $self->print( "\n" );
538            } else {
539                $self->printf("%s: %s\n", $env->{_otype}, join(' ', map { $_->id } @{$env->{_objects}}));
540            }
541        }
542    });
543    $self->add_func('ls',  { alias => [ qw'list' ] });
544    $self->add_func('edit', {
545            help => 'edit [object] - edit selected object using vi',
546            completion => sub {
547                return map { $_->id } @{$_[0]->{_objects}}
548            },
549            code => sub {
550                my ($env, $id) = @_;
551                my $obj;
552                if ($id) {
553                    $obj = grep { $_->id = $id } @{$env->{_objects}} or do {
554                        $self->print( "$id is not part of selected objects\n" );
555                        return;
556                    };
557                } elsif (@{$env->{_objects}} == 1) {
558                    $obj = $env->{_objects}[0]
559                } else {
560                    $self->print( "multiple objects selected but can edit only one,"
561                    . "please specify which one\n" );
562                    return;
563                }
564                my $res = LATMOS::Accounts::Utils::dump_read_temp_file(
565                    sub {
566                        my ($fh) = @_;
567                        $obj->text_dump($fh,
568                            {
569                                empty_attr => 1,
570                                only_rw => 1,
571                            }
572                        );
573                    },
574                    sub {
575                        my ($fh) = @_;
576                        my %attr = LATMOS::Accounts::Utils::parse_obj_file($fh);
577                        my $res = $obj->set_c_fields(%attr);
578                        if ($res) {
579                            $self->print( "Changes applied\n" );
580                            $env->commit;
581                        }
582                        else { $self->print( "Error applying changes\n" ) }
583                        return $res ? 1 : 0;
584                    }
585                );
586            },
587        });
588    $self->add_func('delete', {
589        help => 'delete - delete selected object',
590        code => sub {
591            my ($env) = @_;
592            $self->printf("%s: %s\ndelete selected objects ? (yes/NO)\n",
593            $env->{_otype}, join(', ', map { $_->id } @{$env->{_objects}}));
594            my $reply = <STDIN> || ''; chomp($reply);
595            if ($reply eq 'yes') {
596                foreach (@{$env->{_objects}}) {
597                    $env->base->delete_object($env->{_otype}, $_->id) or do {
598                        $self->print( "Cannot delete " . $_->id . "\n" );
599                        return;
600                    };
601                }
602                $env->commit;
603                return "EXIT";
604            } else {
605                $self->print( "cancel !\n" );
606            }
607        },
608    });
609    if (grep { $self->base->attribute($self->otype, $_)->reference }
610        $self->base->list_canonical_fields($self->otype, 'r')) {
611        $self->add_func('select', {
612            help => 'select attribute [object]',
613            code => sub {
614                my ($env, $attrname, @objects) = @_;
615
616                my $totype;
617                if ( $attrname eq '@' ) {
618                    $totype = $env->{_otype};
619                    @objects = @{ $self->{_lastsearch} || [] };
620                } else {
621                    my $attr = $env->base->attribute(
622                        $env->{_otype},
623                        $attrname
624                    ) or do {
625                        $self->print( "No attribute $attrname" );
626                        return;
627                    };
628                    $totype = $attr->reference or return;
629
630                    if (! @objects) {
631                        @objects = grep { $_ }
632                          map { $_->get_attributes($attrname) } @{$env->{_objects}};
633                    }
634                    {
635                        my %uniq = map { $_ => 1 } @objects;
636                        @objects = keys %uniq;
637                    }
638                }
639                my @objs = (grep { $_ } map { $env->base->get_object($totype, $_) } @objects);
640                return if (!@objs);
641                $self->print( "Selecting $totype " . join(' ', map { $_->id } @objs) . "\n" );
642                LATMOS::Accounts::Cli::Object->new(
643                    Parent  => $self,
644                    Context => $env->Context,
645                    otype   => $totype,
646                    objs    => \@objs
647                )->cli();
648            },
649            completion => sub {
650                if ($_[2]) {
651                    my $totype = $_[0]->base->attribute($_[0]->{_otype},
652                        $_[2])->reference or return;
653                    return grep { $_ }
654                           map { $_->get_attributes($_[2]) }
655                           @{$_[0]->{_objects}};
656                } else {
657                    my $flag = $_[1] =~ /^_/ ? 'ra' : 'r';
658                    return grep { $_[0]->base->attribute($self->otype, $_)->reference }
659                    $_[0]->base->list_canonical_fields($self->otype, $flag);
660                }
661            },
662            }
663        );
664    }
665
666    if (lc($self->otype) eq 'user') {
667
668=head2 USER OBJECT FUCNTION
669
670=cut
671
672        $self->add_func('group', {
673            help => 'group add|remove|primary goupname',
674            code => sub {
675                my ($env, $action, @groups) = @_;
676                foreach my $obj (@{$env->{_objects}}) {
677                    if ($action eq 'primary') {
678                        my $gid = $groups[0];
679                        if ($gid !~ /^\d/) {
680                            my $gobj = $env->base->get_object('group', $gid) or
681                            do {
682                                $self->print( "Cannot find group $gid\n" );
683                                return;
684                            };
685                            $gid = $gobj->get_attributes('gidNumber');
686                        }
687                        $obj->set_c_fields('gidNumber', $gid);
688                    } else {
689                        my %gr;
690                        foreach ($obj->get_attributes('memberOf')) {
691                            $gr{$_} = 1;
692                        }
693                        if ($action eq 'add') {
694                            $gr{$_} = 1 foreach(@groups);
695                        } elsif ($action eq 'remove') {
696                            delete($gr{$_}) foreach(@groups);
697                        } else {
698                            $self->print( 'invalid action' . "\n" );
699                            return;
700                        }
701                        defined $obj->set_c_fields('memberOf' => [ keys %gr ]) or do {
702                            $self->print( "cannot set memberOf attributes for " .
703                            $obj->id . "\n" );
704                            return;
705                        };
706                    }
707                }
708                $env->commit;
709            },
710            completion => sub {
711                if (!$_[2]) {
712                    return (qw(add remove primary));
713                } else {
714                    if ($_[2] eq 'remove') {
715                        my %uniq = map { $_ => 1 }
716                            grep { $_ }
717                            map { $_->get_attributes('memberOf') }
718                            @{$_[0]->{_objects}};
719                        return sort keys %uniq;
720                    } else {
721                        return $_[0]->base->search_objects('group');
722                    }
723                }
724            },
725        });
726
727=head3 lock
728
729Lock user account making it not usable
730
731=cut
732
733        $self->add_func('lock', {
734            code => sub {
735                my ( $env, $ban ) = @_;
736                foreach my $obj (@{$env->{_objects}}) {
737                    $obj->set_c_fields('locked', 1);
738                    if ($ban) {
739                        $obj->banCurrentPassword;
740                    }
741                }
742                $env->commit;
743            },
744            completion => sub {
745                if (!$_[2]) {
746                    return (qw(ban));
747                }
748            },
749        });
750
751=head3 unlock
752
753Unlock user account making it usable again
754
755=cut
756
757        $self->add_func('unlock', {
758            code => sub {
759                my ( $env, $ban ) = @_;
760                foreach my $obj (@{$env->{_objects}}) {
761                    $obj->set_c_fields('locked', undef);
762                    if ($ban) {
763                        $obj->banCurrentPassword;
764                    }
765                }
766                $env->commit;
767            },
768            completion => sub {
769                if (!$_[2]) {
770                    return (qw(ban));
771                }
772            },
773        });
774
775=head3 banpasswd
776
777Ban current password making it not usable by user
778
779=cut
780
781        $self->add_func('banpasswd', {
782            code => sub {
783                my ( $env ) = @_;
784                foreach my $obj (@{$env->{_objects}}) {
785                    $obj->banCurrentPassword;
786                }
787                $env->commit;
788            },
789            completion => sub {},
790        });
791
792=head3 passwd
793
794Set password to selected user. If multiple users are selected the same password will be set to all users
795
796Options:
797
798=over 4
799
800=item -f|--force Ignore password quality check
801
802=item -r|--random Generate a random password for each users
803
804=item -o|--output Write login:password into a file (usefull with --random)
805
806=back
807
808=cut
809
810        $self->add_func('passwd', {
811            code => sub {
812                my $env = shift;
813                my %gen_options = ();
814                my ( $password ) = $self->getoption(
815                    {
816                        'f|force'  => \my $force,
817                        'r|random' => \my $random,
818                        'p'        => \$gen_options{nonalpha},
819                        'syl'      => \$gen_options{syllables},
820                        'l=i'      => \$gen_options{length},
821                        'o=s'      => \my $output,
822
823                    }, @_
824                );
825
826                if (!($password || $random)) {
827                    ReadMode('noecho');
828                    $self->print( "Enter password: " );
829                    $password = ReadLine(0);
830                    ReadMode 0;
831                    $self->print( "\n" );
832                    chomp($password);
833                }
834
835                $password ||= '';
836                my %resPasswd = ();
837
838                my $sbase = $self->La->sync_access();
839
840                foreach my $obj (@{$env->{_objects}}) {
841                    my $sobj = $sbase->get_object($obj->type, $obj->id);
842                    if ($random) {
843                        $password = LATMOS::Accounts::Utils::genpassword(
844                            %gen_options
845                        );
846                    }
847
848                    my $res = $sobj->check_password($password);
849                    if ($res ne 'ok') {
850                        warn "Password quality: $res\n";
851                        if (!$force) {
852                            warn "Cannot set bad password, use --force to bypass security\n";
853                            return;
854                        }
855                    }
856                    if ($sobj->set_password($password)) {
857                        $resPasswd{$obj->id} = $password;
858                        $self->print( "Password succefully changed\n" );
859                        $env->commit;
860                        return 1;
861                    } else {
862                        warn "Error when trying to change password\n";
863                        return 0;
864                    }
865                }
866
867                if ($output) {
868                    open(my $handle, '>', $output) or do {
869                        warn "Cannot open $output: $!";
870                        return;
871                    };
872                    foreach (sort keys %resPasswd) {
873                        print $handle $_ . ':' . $resPasswd{$_} . "\n";
874                    }
875                    close($handle);
876                }
877            },
878            completion => sub {
879                return (qw(-f --force -r --random -p --syl -l -o));
880            },
881        });
882
883        $self->add_func('summary', {
884            code => sub {
885                my $env = shift;
886
887                foreach my $obj (@{$env->{_objects}}) {
888                    print $obj->id . "\n";
889                    foreach my $emp ($obj->EmploymentSummary) {
890                        $self->printf( ("    %s - %s %s\n",
891                            $emp->{firstday},
892                            $emp->{lastday} || '        ',
893                            $emp->{contratType}
894                        ) );
895                    }
896                }
897                return 1;
898            },
899            completion => sub {
900                return (qw(-f --force -r --random -p --syl -l -o));
901            },
902        });
903
904    } elsif ($self->otype eq 'group') {
905
906=head2 GROUP OBJECT FUNCTIONS
907
908=cut
909
910        $self->add_func('member', {
911            help => 'member add|remove user',
912            code => sub {
913                my ($env, $action, @groups) = @_;
914                foreach my $obj (@{$env->{_objects}}) {
915                    my %gr;
916                    foreach ($obj->get_attributes('memberUID')) {
917                        $gr{$_} = 1;
918                    }
919                    if ($action eq 'add') {
920                        $gr{$_} = 1 foreach(@groups);
921                    } elsif ($action eq 'remove') {
922                        delete($gr{$_}) foreach(@groups);
923                    } else {
924                        $self->print( 'invalid action' . "\n" );
925                        return;
926                    }
927                    defined $obj->set_c_fields('memberUID' => [ keys %gr ]) or do {
928                        $self->print( "cannot set memberUID attributes for " .
929                        $obj->id . "\n" );
930                        return;
931                    };
932                }
933                $env->commit;
934            },
935            completion => sub {
936                if (!$_[2]) {
937                    return (qw(add remove));
938                } else {
939                    if ($_[2] eq 'remove') {
940                        my %uniq = map { $_ => 1 }
941                            grep { $_ }
942                            map { $_->get_attributes('member') }
943                            @{$_[0]->{_objects}};
944                        return sort keys %uniq;
945                    } else {
946                        return $_[0]->base->search_objects('user');
947                    }
948                }
949            },
950        });
951    }
952    if (1) { # TODO test SQL base
953        $self->add_func('extract', {
954            help => 'extract information about objects',
955            code => sub {
956                my ($env, $action) = @_;
957                foreach my $obj (sort @{$env->{_objects}}) {
958                    $self->print( $obj->dump({ recur => 1 }) );
959                }
960                $env->rollback;
961            },
962        });
963    }
964
965    return $self;
966}
967
968sub promptPrefix {
969    my ($self) = @_;
970
971    my @otypes;
972
973    $self->Traverse( undef, sub { push(@otypes, $_[0]->otype) if($_[0]->Parent) } );
974    sprintf("%s %s/%s",
975        $self->base->label,
976        join('/', @otypes),
977        @{$self->objs} > 1
978            ? '(' . scalar(@{$self->objs}) . ' obj.)'
979            : $self->objs->[0]->id,
980    );
981}
982
983around run => sub {
984    my $next = shift;
985    my $self = shift;
986
987    my $name = shift or return;
988
989    if (my $otype = $self->{funcs}{$name}{proxy}) {
990         $self->Context->{objs} = $self->objs;
991         LATMOS::Accounts::Cli->new(
992            Parent  => $self, # Look useless
993            Context => $self->Context,
994        )->run(
995            $name,
996            '-o', $self->otype,
997            @_,
998        );
999        $self->Context->{objs} = undef;
1000    } else {
1001        return $self->$next($name, @_);
1002    }
1003};
1004
10051;
1006
1007__END__
1008
1009=head1 SEE ALSO
1010
1011L<LATMOS::Accounts>
1012
1013=head1 AUTHOR
1014
1015Olivier Thauvin, E<lt>olivier.thauvin@latmos.ipsl.frE<gt>
1016
1017=head1 COPYRIGHT AND LICENSE
1018
1019Copyright (C) 2008, 2009, 2010, 2011, 2012 CNRS SA/CETP/LATMOS
1020
1021This library is free software; you can redistribute it and/or modify
1022it under the same terms as Perl itself, either Perl version 5.10.0 or,
1023at your option, any later version of Perl 5 you may have available.
1024
1025=cut
Note: See TracBrowser for help on using the repository browser.