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

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

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