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

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

Add setting command to la-cli

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