source: trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Cli/Base.pm @ 2442

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

la-cli: Add alias '?' to help command
File size: 25.4 KB
Line 
1package LATMOS::Accounts::Cli::Base;
2
3# $Id: Cli.pm 2145 2018-08-29 18:15:46Z nanardon $
4
5use strict;
6use warnings;
7use Moose;
8use LATMOS::Accounts::Cli::Context;
9use LATMOS::Accounts::Log;
10use LATMOS::Accounts::Utils;
11use Term::ReadLine;
12use Text::ParseWords;
13use Getopt::Long;
14use Pod::Select;
15use Pod::Text::Termcap;
16use File::Temp;
17
18=head1 NAME
19
20LATMOS::Accounts::Cli - Command line interface functions
21
22=head1 DESCRIPTION
23
24This module handle envirronment and functons for L<la-cli> tools.
25
26=cut
27
28has Context => ( is => 'ro', isa => 'LATMOS::Accounts::Cli::Context' );
29has Parent  => ( is => 'ro' );
30
31=head1 FUNCTIONS
32
33=cut
34
35=head1 CLI FUNCTIONS
36
37=head2 GLOBAL FUNCTIONS
38
39=cut
40
41sub BUILD {
42    my $self = shift;
43
44=head3 help
45
46    help [command] - print help about command
47
48=cut
49
50    $self->add_func('help', {
51        completion => sub {
52            if (!$_[2]) { return sort keys %{ $_[0]->{funcs} || {}} }
53        },
54        code => sub {
55            my $env = shift;
56
57            $env->Help(@_);
58        },
59    });
60
61$self->add_func('?',  { alias => [ qw'help' ] });
62
63=head3 config
64
65=over 4
66
67=item config objects
68
69List supported objects type
70
71=item config objects OTYPE
72
73List attribute for OTYPE
74
75=back
76
77=cut
78
79    $self->add_func('config', {
80        completion => sub {
81            if (!$_[2]) {
82                return qw(objects);
83            } elsif ( $_[2] eq 'objects' ) {
84                if (! $_[3] ) {
85                    return $_[0]->base->list_supported_objects;
86                }
87            }
88        },
89        code => sub {
90            my ($self, $cmd, @args) = @_;
91            if (!$cmd) {
92                $self->print("No command given\n");
93            } elsif ($cmd eq 'objects') {
94                if ( $args[0] ) {
95                    my $labase = $_[0]->base;
96                    foreach(sort $labase->list_canonical_fields($args[0], 'a')) {
97                        my $attr = $labase->attribute($args[0], $_);
98                        $self->printf(
99                            "%s   %s%s\n",
100                            ($attr ? ($attr->ro ? 'r ' : 'rw') : '  '),
101                            $_,
102                            $attr->reference ? ' (=> ' . $attr->reference . ')' : '',
103                        );
104                    }
105                } else {
106                    $self->print("Supported objects type: ");
107                    $self->print(join(', ', $self->base->list_supported_objects));
108                    $self->print("\n");
109                }
110            } else {
111                $self->print("wrong argument\n");
112            }
113        },
114    });
115
116=head3 unexported
117
118    unexported yes|no|show
119
120switch or show base mode regarding' unexported objects behavior
121
122=cut
123
124    $self->add_func('unexported', {
125        completion => sub {
126            if (!$_[2]) {
127                return qw(yes no show);
128            }
129        },
130        code => sub {
131            my ($self, $arg) = @_;
132            if (!$arg) {
133                $self->print( "Unexported objects is" . 
134                    ($self->base->unexported ? "enable" : "disable") . "\n"
135                );
136            } elsif ($arg eq 'yes') {
137                $self->base->unexported(1);
138                $self->print("Unexported are now show\n");
139            } elsif ($arg eq 'no') {
140                $self->base->unexported(0);
141                $self->print("Unexported are no longer show\n");
142            } elsif ($arg eq 'show') {
143                $self->print("Unexported objects is" .
144                    ($self->base->unexported ? "enable" : "disable") . "\n"
145                );
146            } else {
147                $self->print("wrong argument\n");
148            }
149        },
150    });
151
152=head3 quit
153
154Exit from C<CLI> tools
155
156=cut
157
158    $self->add_func('quit', {
159            code => sub { $self->print("\n"); exit(0) }, });
160
161=head3 exit
162
163Exit from current selection context
164
165=cut
166
167    $self->add_func('exit', {
168            code => sub { return "EXIT" }, });
169
170=head3 !
171
172    ! [command [arg]]
173
174Open a shell command or run command under shell
175
176=cut
177
178    $self->add_func('!', {
179            code => sub {
180                my ($env, $name, @args) = @_;
181                if ($name) {
182                    system('/bin/bash', '-ic', $env->Context->{_line});
183                } else {
184                    system('/bin/bash', '-i');
185                }
186            },
187    } );
188
189    if ($self->base->is_transactionnal) {
190
191=head2 TRANSACTIONS FUNCTIONS
192
193    transaction [on|off]
194
195Enable or disable the transaction mode: ie automatic commit
196
197=cut
198
199        $self->add_func(
200            'transaction', {
201                code => sub {
202                    $self->Context->TransMode($_[1] eq 'on' ? 1 : 0);
203                },
204                completion => sub {
205                    $self->Context->TransMode == 0 ? 'on' : 'off';
206                },
207            }
208        );
209
210=head3 begin
211
212Start a transaction, meaning changes will be saved only by C<commit> and canceled by C<rollback>
213
214=cut
215
216        $self->add_func(
217            'begin', {
218                code => sub {
219                    $self->Context->TransStarted(1);
220                },
221            }
222        );
223
224=head3 commit
225
226Save pending changes in transaction mode or following C<begin>
227
228=cut
229
230        $self->add_func(
231            'commit', {
232                code => sub {
233                    $_[0]->_commit;
234                },
235            }
236        );
237
238=head3 rollback
239
240Cancel pending changes following a C<begin> or in transaction mode
241
242=cut
243
244        $self->add_func(
245            'rollback', {
246                code => sub {
247                    $_[0]->_rollback;
248                },
249            }
250        );
251    }
252
253=head3 setting
254
255    Set la-cli settings
256
257    setting: list settings
258    setting PARAM: show this settings
259    setting PARAM VALUE:  set the setting to this value
260    setting PARAM default: back setting to default
261
262=cut
263
264    $self->add_func( 'setting',
265        {
266            code => sub {
267                my ( $self, $setting, $value ) = @_;
268                if (! $setting ) {
269                    foreach $setting ( $self->Context->DefaultSetting() ) {
270                        $self->printf("%s (def %s): %s\n", $setting, $self->Context->DefaultSetting( $setting ), $self->Context->Setting( $setting ) );
271                    }
272                } elsif ( $setting ) {
273                    if (!defined( $self->Context->DefaultSetting( $setting ) ) ) {
274                        $self->printf("unknown setting $setting\n");
275                        return;
276                    }
277                    $self->printf("%s (def %s): %s\n", $setting, $self->Context->DefaultSetting( $setting ), $self->Context->Setting( $setting ) );
278                } elsif ($value) {
279                    my $default = $self->Context->DefaultSetting( $setting );
280                    if (!defined( $default ) ) {
281                        $self->printf("unknown setting $setting\n");
282                        return;
283                    }
284                    $self->printf(
285                        "%s (def %s): %s => %s\n",
286                        $setting,
287                        $self->Context->DefaultSetting( $setting ),
288                        $self->Context->Setting( $setting, $value ),
289                        $value,
290                    );
291                }
292            },
293            completion => sub {
294                my ($self, undef, $setting, $value) = @_;
295                if ( ! $setting ) {
296                    return $self->Context->DefaultSetting();
297                }
298            },
299        }
300    );
301
302=head3 collection
303
304Manage saved objects list:
305
306    collection list
307    collection save
308    collection load
309    collection delete
310
311=cut
312
313    $self->add_func( 'collection',
314        {
315            code => sub {
316                my ( $self, $subcommand, @args ) = @_;
317                $subcommand ||= '';
318                $self->Context->Preferences->{Collections} ||= {};
319                my $Collections = $self->Context->Preferences->{Collections};
320                if ( $subcommand eq 'list' || !$subcommand ) {
321                    foreach my $c ( sort keys %{ $Collections } ) {
322                        my @objlist = @{ $Collections->{$c}{objs} || []};
323                        $self->printf(
324                            "%s: %s, %s\n",
325                            $c,
326                            $Collections->{$c}{otype},
327                            (@objlist >= 1 ? scalar(@objlist) . ' objs.' : $objlist[0]),
328                        );
329                    }
330                } elsif ($subcommand eq 'load') {
331                    my $c = $args[0] or do {
332                        $self->print("No collection name given\n");
333                        return;
334                    };
335                    if (! $Collections->{$c} ) {
336                        $self->print("This collection does not exists\n");
337                        return;
338                    }
339                    my $otype = $Collections->{ $c }{otype};
340                    my @objs;
341                    foreach (@{ $Collections->{ $c }{ objs } || []}) {
342                        my $obj = $self->base->get_object($otype, $_) or do {
343                            $self->print("Cannot get $otype $_\n");
344                            return;
345                        };
346                        push(@objs, $obj);
347                    }
348                    if (@objs) {
349                        $self->print("Selecting $otype " . join(', ', map { $_->id } @objs) . "\n");
350                        LATMOS::Accounts::Cli::Object->new(
351                            Parent  => $self,
352                            Context => $self->Context,
353                            otype   => $otype,
354                            objs    => \@objs,
355                        )->cli();
356                    } else {
357                        $self->print("No objects to load\n");
358                    }
359                } elsif ($subcommand eq 'clear') {
360                    $self->Context->Preferences->{Collections} = {};
361                } elsif ($subcommand =~ m/^(delete|del)$/) {
362                    my ( $name ) = @args;
363                    delete( $Collections->{$name} );
364                } elsif ($subcommand eq 'save' ) {
365                    my ( $name, $what ) = @args;
366                    $what ||= '';
367
368                    if ( $what eq '@' ) {
369                        if (! $self->{_lastsearch} ) {
370                            $self->print("No previous search found, nothing saved\n");
371                            return;
372                        }
373                        $Collections->{ $name } = {
374                            otype => $self->{_lastsearchtype},
375                            objs =>  [ @{$self->{_lastsearch}} ],
376                        }
377                    } elsif ($self->can('otype')) {
378                        $Collections->{ $name } = {
379                            otype => $self->otype,
380                            objs =>  [ map { $_->id } @{ $self->objs || [] } ],
381                        };
382                    } else {
383                        $self->print("No objects to save");
384                    }
385                }
386            },
387            completion => sub {
388                my ($self, undef, $command, $name, $what) = @_;
389                $command ||= '';
390                my $Collections = $self->Context->Preferences->{Collections} || {};
391                if ( ! $command ) {
392                    return qw(list load save delete clear);
393                } elsif ( $command =~ /^(load|delete|del)$/ ) {
394                    return sort keys %{ $Collections };
395                } elsif ( $command eq 'save' ) {
396                    if ($name) {
397                        return qw( @ );
398                    }
399                } else {
400                    return;
401                }
402            },
403        }
404    );
405
406=head2 GLOBAL and OBJECTS FUNCTION
407
408=head3 query
409
410    query objectname [attribute]
411    query [attribute]
412
413Show attribute
414
415options:
416
417=over 4
418
419=item -o|--otype objecttype
420
421In global context specify the object type (default: user)
422
423=item -e|--empty
424
425Show empty/unset attributes
426
427=item --ro
428
429Show readonly attributes
430
431=item --fmt format
432
433Instead displaying attribute list use C<format> as formating string
434
435=item --recur
436
437Dump object and all related objects
438
439=back
440
441=cut
442
443    $self->add_func( 'query' => {
444            proxy => '*',
445            completion => sub { },
446            code => sub {
447                my $env = shift;
448                my @args = $self->getoption(
449                    {
450                        'o|object=s' => \my $otype,
451                        'e|empty'    => \my $empty_attr,
452                        'ro'         => \my $with_ro,
453                        'fmt=s'      => \my $fmt,
454                        'filefmt=s'  => \my $filefmt,
455                        'recur'      => \my $recur,
456                        'subotype=s' => \my @SubOtype,
457                    }, @_
458                );
459                $otype ||= 'user';
460
461                my $objs = $self->Context->{objs};
462
463                if (! $objs ) {
464                    foreach my $name (@args) {
465                        my $obj = $self->base->get_object( $otype, $name) or do {
466                            $self->print("Cannot get object $otype/$name\n");
467                            next;
468                        };
469                        push(@{ $objs }, $obj);
470                    }
471                }
472
473                if ($filefmt){
474                    open(my $hfmt, '<', $filefmt) or die "Cannot open $filefmt\n";
475                    $fmt ||= ''; # avoid undef warning
476                    while (<$hfmt>) {
477                        chomp($fmt .= $_);
478                    }
479                    close $hfmt;
480                }
481
482                foreach (@{ $objs }) {
483                    if ($fmt) {
484                        $self->print($_->queryformat($fmt));
485                    } else {
486                        $_->text_dump( $self->Context->Out, {
487                            recur => $recur,
488                            empty_attr => $empty_attr,
489                            only_rw => !$with_ro,
490                            SubOtype => \@SubOtype,
491                        } );
492                    }
493                }
494            },
495    } );
496
497=head3 log
498
499    log [[-o otype ] object [object [...]]]
500
501Show global log or log for the object given in arguments
502
503=cut
504
505    $self->add_func('log' => {
506        proxy => '*',
507        completion => sub {
508            my ( $self, @args ) = @_;
509            if ($args[-1] =~ /^(-o|--object)/) {
510                return $self->base->list_supported_objects;
511            } else {
512                my @args = $self->getoption({
513                    'o|object=s' => \my $otype,
514                }, @_);
515                $otype ||= 'user';
516                return ('-o', $self->base->list_objects( $otype ));
517            }
518        },
519        code => sub {
520            my $env = shift;
521            my @args = $self->getoption({
522                'o|object=s' => \my $otype,
523            }, @_);
524            $otype ||= 'user';
525
526            if (!@args && $env->Context->{objs}) {
527                @args = map { $_->id } @{ $env->Context->{objs} };
528                $otype = $env->Context->{objs}[0]->type;
529            }
530
531            my @logs = @args
532                ? $self->base->getobjectlogs($otype, @args)
533                : $self->base->getlogs();
534
535            foreach (@logs) {
536                $self->printf(
537                    "%s (%d), %s: %s/%s (%d) %s\n",
538                    $_->{logdate},
539                    $_->{irev} || -1,
540                    $_->{username},
541                    $_->{otype},
542                    $_->{name},
543                    $_->{ikey},
544                    $_->{message}
545                );
546            }
547        },
548    } ) if ($self->base->can('getobjectlogs'));
549
550    if ($self->base->can('CreateAlias')) {
551
552=head2 OBJECT ALIASES FUNCTION
553
554=head3 newalias
555
556    newalias objectType Name Object
557
558Create an object alias named C<Name> for object C<Object>.
559
560=cut
561
562        $self->add_func(
563            'newalias', {
564                code => sub {
565                    my ($self, $otype, $name, $for) = @_;
566                    if ($self->base->CreateAlias($otype, $name, $for)) {
567                        $self->print( "Alias $otype/$name Created\n" );
568                        $self->commit;
569                    }
570                },
571                completion => sub {
572                    if ($_[3]) {
573                        return $_[0]->base->list_objects($_[2]);
574                    } elsif (!$_[2]) {
575                        return $_[0]->base->list_supported_objects;
576                    } else {
577                        return;
578                    }
579                }
580            },
581        );
582
583=head3 rmalias
584
585    rmalias objectType Name
586
587Delete alias named C<Name>.
588
589=cut
590
591        $self->add_func(
592            'rmalias', {
593                code => sub {
594                    my ($self, $otype, $name) = @_;
595                    if ($self->base->RemoveAlias($otype, $name)) {
596                        $self->print("Alias $otype/$name Removed\n");
597                        $self->commit;
598                    }
599                },
600                completion => sub {
601                    if (!$_[2]) {
602                        return $_[0]->base->list_supported_objects;
603                    } else {
604                        return $_[0]->base->search_objects($_[2], 'oalias=*');
605                    }
606                }
607            },
608        );
609
610=head3 updalias
611
612    updalias objectType Name Object
613
614Change the destination of an existing object alias
615
616=cut
617
618        $self->add_func(
619            'updalias', {
620                code => sub {
621                    my ($self, $otype, $name, $for) = @_;
622                    my $obj = $self->base->GetAlias($otype, $name) or do {
623                        $self->print( "No alias $otype/$name found" );
624                        return;
625                    };
626                    if ($obj->set_c_fields(oalias => $for)) {
627                        $self->print( "Alias $otype/$name Updated\n" );
628                        $self->commit;
629                    }
630                },
631                completion => sub {
632                    if ($_[3]) {
633                        return $_[0]->base->list_objects($_[2]);
634                    } elsif($_[2]) {
635                        return $_[0]->base->search_objects($_[2], 'oalias=*');
636                    } else {
637                        return $_[0]->base->list_supported_objects;
638                    }
639                }
640            },
641        );
642    }
643}
644
645=head2 base
646
647Return the attached base object.
648
649=cut
650
651sub La           { $_[0]->Context->La   }
652sub base         { $_[0]->Context->base }
653sub term         { $_[0]->Context->Term }
654sub Interractive { $_[0]->Context->Interactive }
655sub print        { shift->Context->print (@_) }
656sub printf       { shift->Context->printf(@_) }
657
658sub Top {
659    my ( $self ) = @_;
660
661    if ($self->Parent) {
662        return $self->Parent->Top;
663    } else {
664        return $self;
665    }
666}
667
668sub Traverse {
669    my ( $self, $Before, $After ) = @_;
670
671    $Before->($self) if ($Before);
672    if ($self->Parent) {
673        $self->Parent->Traverse($Before, $After);
674    }
675    $After->($self) if ($After);
676}
677
678sub _parse_cmd_line {
679    my ( $self, $cmdLine ) = @_;
680
681    my ($op, $shellLine, $internalLine);
682
683    if ($cmdLine =~ /^(.*?)(?<![\S\\|])([\|\>])\s*([^\|].*)?$/) {
684        $internalLine = $1;
685        $op = $2;
686        $shellLine = $3;
687    } else {
688        $internalLine = $cmdLine;
689    }
690
691    return ( $op, $shellLine, shellwords($internalLine) );
692
693}
694
695=head2 topCli
696
697Entry point for cli
698
699=cut
700
701sub topCli {
702    my ( $self ) = @_;
703
704    $self->Context->ReadPreferences();
705    $self->Context->ReadHistory();
706    $self->cli();
707    if (! $self->Context->WriteHistory() ) {
708        warn "Cannot write history:  $!\n";
709    }
710    $self->Context->WritePreferences();
711}
712
713=head2 cli
714
715Start the main loop
716
717=cut
718
719sub cli {
720    my ($self) = @_;
721
722    my $term = $_[0]->Context->Term;
723
724    while (1) {
725        $term->Attribs->{completion_function} = sub {
726            my ($Op, $Shell, @args) = $self->_parse_cmd_line(substr($_[1], 0, $_[2]));
727            $Op ||= '';
728            my $attribs = $self->Context->Term->Attribs;
729            if ($Op eq '>') {
730                $term->completion_matches($Shell, $attribs->{'filename_completion_function'});
731            } elsif ($Op eq '|') {
732                $term->completion_matches($Shell, $attribs->{'filename_completion_function'});
733            } else  {
734                $self->complete($_[0], @args);
735            }
736        };
737        defined (my $line = $term->readline($self->prompt)) or do {
738            $self->print("\n");
739            return;
740        };
741        $_[0]->Context->{_line} = $line;
742        $term->addhistory($line) if ($line =~ /\S/);
743        my ($Op, $Shell, @args) = $self->_parse_cmd_line($line);
744        my $Handle;
745        if ($Op) {
746            open($Handle, "$Op $Shell") or next;
747            $self->Context->TempOut($Handle);
748        }
749        my $res = $self->run(@args);
750        if ($Handle) {
751            $self->Context->TempOut(undef);
752            close($Handle);
753        }
754        $self->rollback if (!$self->Context->TransMode);
755        if ($res && $res eq 'EXIT') { $self->print("\n"); return }
756    }
757}
758
759=head2 prompt
760
761Wait user to input command
762
763=cut
764
765sub promptPrefix {
766    my $self = shift;
767    return sprintf('%s cli', $self->base->label)
768}
769
770sub prompt {
771    my ($self) = @_;
772    my $pr = $self->promptPrefix;
773    return sprintf(
774        "%s%s%s ",
775        $pr,
776        $self->Context->TransStarted ? '-' : '=',
777        $self->Context->TransMode  ? '#' : '>',
778    );
779}
780
781=head2 add_func ($name, $param)
782
783Add new function in the envirronment
784
785=cut
786
787# TODO: hide this
788
789sub add_func {
790    my ($self, $name, $param) = @_;
791    my (undef, $file) = caller(0);
792    $param->{podfile} = $file;
793    $self->{funcs}{$name} = $param;
794}
795
796=head2 Help
797
798Display help of given function
799
800=cut
801
802sub Help {
803    my ($self, $name) = @_;
804    if (!$name) {
805        $self->print(join(', ', sort keys %{ $self->{funcs} || {}}) . "\n");
806    } elsif ($self->{funcs}{$name}{alias}) {
807        $self->print("$name is an alias for " . join(' ', @{$self->{funcs}{$name}{alias}}) . "\n");
808    } elsif ($self->{funcs}{$name}{help}) {
809        $self->print($self->{funcs}{$name}{help} . "\n");
810    } else {
811        my $fh = File::Temp->new();
812        my $parser = Pod::Text::Termcap->new( sentence => 0, width => 78 );
813
814        podselect(
815            {-output => $fh, -sections => ["CLI FUNCTIONS/.*/\Q$name"]},
816            $self->{funcs}{$name}{podfile}
817        );
818        seek($fh, 0, 0);
819        $parser->parse_from_filehandle($fh, $self->Context->Out);
820    }
821}
822
823=head2 getoption ($opt, @args)
824
825Parse commmand line
826
827=cut
828
829sub getoption {
830    my ($self, $opt, @args) = @_;
831    local @ARGV = @args;
832    Getopt::Long::Configure("pass_through");
833    GetOptions(%{ $opt });
834
835    return @ARGV;
836}
837
838=head2 complete
839
840Return possible words according current entered words
841
842=cut
843
844sub complete {
845    my ($self, $lastw, $name, @args) = @_;
846    if (!$name) {
847        $lastw ||= ''; # avoid undef warning
848        if ($lastw =~ m!^(\.\./*)(.*)$!) {
849            if ($self->Parent) {
850                my $dot = $1;
851                $dot .= '/' unless($dot =~ m!/$!);
852                return map { "$dot$_" } $self->Parent->complete($2, $name, @args);
853            } else {
854                return ();
855            }
856        } elsif ($lastw =~ m!(^/+)(.*)$!) {
857            return map { "$1$_" } $self->Top->complete($2, $name, @args);
858        } else {
859            return grep { /^\Q$lastw\E/ } sort
860                (keys %{ $self->{funcs} || {}});
861        }
862    } elsif ($name =~ m!^\.\./(.*)$!) {
863        if ($self->Parent) {
864            return $self->Parent->complete($lastw, $1, @args);
865        } else {
866            return ();
867        }
868    } elsif ($name =~ m!^/+(.*)$!) {
869        return $self->Top->complete($lastw, $1, @args);
870    } elsif ($self->{funcs}{$name}{alias}) {
871        $self->complete($lastw, @{$self->{funcs}{$name}{alias}}, @args);
872    } elsif ($self->{funcs}{$name}{completion}) {
873        return map { my $t = $_; $t =~ s/\s/\\ /g; $t } grep { $_ && /^\Q$lastw\E/ } $self->{funcs}{$name}{completion}->($self, $lastw, @args);
874    } else {
875        return ();
876    }
877}
878
879=head2 run ($name, @args)
880
881Run functions
882
883=cut
884
885sub run {
886    my ($self, $name, @args) = @_;
887    return if (!$name);
888
889    if ($name =~ m!^\.\./+(.*)$!) {
890        if ($self->Parent) {
891            $self->Parent->run($1, @args);
892        } else {
893            $self->print("No parent envirronment to call function\n");
894        }
895    } elsif ($name =~ m!^/+(.*)$!) {
896        $self->Top->run($1, @args);
897    } elsif (grep { m/^(-h|--help)$/ } @args) {
898        $self->Help($name);
899    } elsif (!exists($self->{funcs}{$name})) {
900        $self->print("No command $name found\n");
901    } elsif ($self->{funcs}{$name}{alias}) {
902        $self->run(@{$self->{funcs}{$name}{alias}}, @args);
903    } elsif ($self->{funcs}{$name}{code}) {
904        $self->{funcs}{$name}{code}->($self, @args);
905    } else {
906        $self->print("No command $name found\n");
907    }
908}
909
910=head2 commit
911
912Call commit to base unelss in transaction mode
913
914=cut
915
916sub commit {
917    my ($self) = @_;
918    $self->Context->commit;
919}
920
921sub _commit {
922    my ($self) = @_;
923    $self->Context->_commit;
924}
925
926=head2 rollback
927
928Perform rollback unless in transaction mode
929
930=cut
931
932sub rollback {
933    my ($self) = @_;
934    $self->Context->rollback;
935}
936
937sub _rollback {
938    my ($self) = @_;
939    $self->Context->_rollback;
940}
941
9421;
943
944__END__
945
946=head1 SEE ALSO
947
948L<LATMOS::Accounts>
949
950=head1 AUTHOR
951
952Olivier Thauvin, E<lt>olivier.thauvin@latmos.ipsl.frE<gt>
953
954=head1 COPYRIGHT AND LICENSE
955
956Copyright (C) 2008, 2009, 2010, 2011, 2012 CNRS SA/CETP/LATMOS
957
958This library is free software; you can redistribute it and/or modify
959it under the same terms as Perl itself, either Perl version 5.10.0 or,
960at your option, any later version of Perl 5 you may have available.
961
962=cut
Note: See TracBrowser for help on using the repository browser.