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

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

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