package LATMOS::Accounts::Cli;

# $Id$

use strict;
use warnings;
use LATMOS::Accounts::Log;
use LATMOS::Accounts::Utils;
use Term::ReadLine;
use Text::ParseWords;
use Getopt::Long;

=head1 NAME

LATMOS::Accounts::Cli - Command line interface functions

=head1 DESCRIPTION

This module handle envirronment and functons for L<la-cli> tools.

=cut

{
    open (my $fh, "/dev/tty" )
        or eval 'sub Term::ReadLine::findConsole { ("&STDIN", "&STDERR") }';
    die $@ if $@;
    close ($fh);
}

my $term = Term::ReadLine->new('LA CLI');
$term->MinLine(99999);
my $OUT = $term->OUT || \*STDOUT;

my $trans_mode = 0;

=head1 FUNCTIONS

=cut

=head2 globalenv

Return the main envirronement object

=cut

sub globalenv {
    my ($labase) = @_;
    my $env = LATMOS::Accounts::Cli->new({ prompt => sub { $_[0]->base->label . " cli > " }, },
        $labase);
    $env->add_func('unexported', {
        help => 'unexported yes|no|show - switch or show base mode regarding' .
            ' unexported objects',
        completion => sub {
            if (!$_[2]) {
                return qw(yes no show);
            }
        },
        code => sub {
            my ($env, $arg) = @_;
            if ($arg eq 'yes') {
                $env->base->unexported(1);
                print $OUT "Unexported are now show\n";
            } elsif ($arg eq 'no') {
                $env->base->unexported(0);
                print $OUT "Unexported are no longer show\n";
            } elsif ($arg eq 'show') {
                print $OUT "Unexported objects " . ($env->base->unexported ?
                "enable" : "disable") . "\n";
            } else {
                print $OUT "wrong argument\n";
            }
        },
    });
    $env->add_func('ls', {
            help => 'ls object_type - list object of type object_type', 
            completion => sub {
                if(!$_[2]) {
                    return $_[0]->base->list_supported_objects
                } else { () }
            },
            code => sub {
                if ($_[1]) {
                    print $OUT map { "$_\n" } $_[0]->base->list_objects($_[1]);
                } else {
                    print $OUT "Object type missing\n";
                }
            },
        });
    $env->add_func('search', {
            help => 'search objecttype filter1 [filter2...] - search object according filter',
            completion => sub {
                if(!$_[2]) {
                    return $_[0]->base->list_supported_objects
                } else { return() }
            },
            code => sub {
                my ($env, @args) = @_;
                if ($_[1]) {
                    my @res = $env->base->search_objects(@args);
                    print $OUT map { "$_\n" } @res;
                    $env->{_lastsearch} = \@res;
                    $env->{_lastsearchtype} = $args[0];
                } else {
                    print $OUT "Object type missing\n";
                }
            },
        });
    $env->add_func('expired', {
        help => 'expired [delay] - list expired account more than delay (default is now)',
        code => sub {
            my ($env, $expire) = @_;
            my @users = $env->base->find_expired_users($expire);
            print $OUT map { "$_\n" } @users;
            $env->{_lastsearchtype} = 'user';
            $env->{_lastsearch} = \@users;
        },
    }) if ($env->base->can('find_expired_users'));
    $env->add_func('expires', {
        help => 'expires [delay] - list account expiring before delay (default is 1 month)',
        code => sub {
            my ($env, $expire) = @_;
            my @users = $env->base->find_next_expire_users($expire);
            print $OUT map { "$_\n" } @users;
            $env->{_lastsearchtype} = 'user';
            $env->{_lastsearch} = \@users;
        },
    }) if ($env->base->can('find_next_expire_users'));
    $env->add_func('select', {
            help => 'select object_type - select objects to perform action on it',
            completion => sub {
                if ($_[2]) {
                    return $_[0]->base->list_objects($_[2]);
                } else {
                    return '@', $_[0]->base->list_supported_objects;
                }
            },
            code => sub {
                my ($env, $otype, @ids) = @_;
                my @objs;
                if ($otype eq '@') {
                    if (@{$env->{_lastsearch}}) {
                        $otype = $env->{_lastsearchtype};
                        @ids = @{$env->{_lastsearch}};
                    } else {
                        print $OUT "No results store from previous search\n";
                        return;
                    }
                }
                if (!@ids) {
                    print $OUT 'not enough arguments' . "\n";
                    return;
                }
                foreach (@ids) {
                    my $obj = $env->base->get_object($otype, $_) or do {
                        print $OUT "Cannot get $otype $_\n";
                        return;
                    };
                    push(@objs, $obj);
                }
                print $OUT "Selecting $otype " . join(', ', @ids) . "\n";
                objenv($_[0]->base, $otype, @objs)->cli();
            },
        });
    $env->add_func('create', {
            code => sub {
                my ($env, $otype) = @_;
                my $helper = $env->base->ochelper($otype);
                my $info = undef;
                while (1) {
                    my $status;
                    ($status, $info) = $helper->step($info);

                    if ($status ne 'NEEDINFO') {
                        if ($status eq 'CREATED') {
                            print $OUT "Object created\n";
                            $env->commit;
                        } else {
                            print $OUT "Nothing done\n";
                            $env->rollback;
                        }
                        return;
                    }

                    if ($info->{name}{ask}) {
                        my $line = $term->readline("Name of the object ?");
                        $info->{name}{content} = $line;
                    }
                    foreach my $attr (@{$info->{ask} || []}) {
                        $term->Attribs->{completion_function} = sub {
                            $info->{contents}{$attr}
                        };
                        my $line = $term->readline(sprintf('  %s %s? ',
                                $attr,
                                $info->{contents}{$attr}
                                ? '(' . $info->{contents}{$attr} . ') '
                                : ''
                            ));
                        $info->{contents}{$attr} = $line if($line);
                    }
                }
            },
        }
    );
    $env->add_func('exchangeip', 
        {
            help => 'Exchange two IP on host',
            code => sub {
                my ($env, @args) = @_;
                my ($ip1, $ip2) =
                    grep { $_ && $_ =~ /\d+\.\d+\.\d+\.\d+/ } @args;
                if (!$ip2) {
                    print $OUT "Need two ip to exchange\n";
                    return;
                }
                if ($env->base->nethost_exchange_ip($ip1, $ip2)) {
                    print $OUT "$ip1 and $ip2 get exchange\n";
                    $env->commit;
                } else {
                    $env->rollback;
                }   
            },
            completion => sub {
                my ($env, $carg, @args) = @_;
                if ($args[-1] && $args[-1] !~ m/\d+\.\d+\.\d+\.\d+/) {
                    if (my $obj = $env->base->get_object('nethost', $args[-1])) {
                        return $obj->get_attributes('ip');
                    }
                } else {
                    my @list = 
                    ($env->base->attributes_summary('nethost', 'ip'),
                        $env->base->list_objects('nethost'));
                    return @list;
                }
            },
        }
    );
    $env->add_func('user',  { alias => [qw'select user' ] });
    $env->add_func('group', { alias => [qw'select group'] });
    return $env
}

=head2 objenv ($labase, $otype, @objs)

Return a C<cli> envirronment over object.

=cut

sub objenv {
    my ($labase, $otype, @objs) = @_;
    my $objenv = LATMOS::Accounts::Cli->new(
        {
            prompt => sub {
                sprintf("%s %s/%s > ",
                    $_[0]->base->label,
                    $_[0]->{_otype},
                    @{$_[0]->{_objects}} > 1 ? '(' .
                    scalar(@{$_[0]->{_objects}}) . ' obj.)' : $_[0]->{_objects}[0]->id,
                );
            },
        },
        $labase
    );
    $objenv->{_otype} = $otype;
    $objenv->{_objects} = [ @objs ];
    $objenv->add_func('+', {
        help => 'add item to selection',
        code => sub {
            my ($env, @ids) = @_;
            my %ids = map { $_->id => 1 } @{$env->{_objects}};
            foreach (@ids) {
                $ids{$_} and next;
                my $o = $env->base->get_object($env->{_otype}, $_) or next;
                push(@{$env->{_objects}}, $o);
            }
            printf $OUT "select is now %s: %s\n", $env->{_otype}, join(', ', map {
                $_->id } @{$env->{_objects}});
        },
        completion => sub {
            my ($env, undef, @ids) = @_;
            my %ids = map { $_->id => 1 } @{$env->{_objects}};
            return ( grep { ! $ids{$_} } $env->base->list_objects($env->{_otype}));
        },
        }
    );
    $objenv->add_func('-', {
        help => 'add item to selection',
        code => sub {
            my ($env, @ids) = @_;
            my %ids = map { $_ => 1 } @ids;
            my @newobjs = grep { !$ids{$_->id} } @{$env->{_objects}};

            if (!@newobjs) {
                print $OUT "This would remove all objects from the list...\n";
                return;
            } else {
                @{$env->{_objects}} = @newobjs;
            }
            printf $OUT "select is now %s: %s\n", $env->{_otype}, join(', ', map {
                $_->id } @{$env->{_objects}});
        },
        completion => sub {
            my ($env, undef, @ids) = @_;
            my %ids = map { $_ => 1 } @ids;
            grep { !$ids{$_} } map { $_->id } @{$env->{_objects}};
        },
        }
    );
    $objenv->add_func('show', {
        help => 'show attributes - show an attributes of object',
        code => sub {
            my ($env, $attr) = @_;
            if (!$attr) {
                foreach (@{$env->{_objects}}) {
                    print $OUT $_->dump;
                }
            } else {
                foreach my $u (@{$env->{_objects}}) {
                    print $OUT sort map { $u->id . ': ' .($_ || '') . "\n" } $u->get_attributes($attr);
                }
            }
        },
        completion => sub {
            if (!$_[2]) {
                return $_[0]->base->list_canonical_fields($_[0]->{_otype}, 'r')
            }
        },
    });
    $objenv->add_func('print', {
        help => 'print fmt - show attributes using template',
        code => sub {
            my ($env, $fmt) = @_;
            if (!defined($fmt)) {
                print $OUT "no format given";
                return;
            }
            foreach (@{$env->{_objects}}) {
                print $OUT $_->queryformat($fmt) . "\n";
            }
        },
    });
    $objenv->add_func('unset', {
        help => 'unset attribute - unset specified attribute',
        code => sub {
            my ($env, $attr) = @_;
            $attr or do {
                print $OUT "Attributes must be specified";
                return;
            };
            foreach (@{$env->{_objects}}) {
                defined $_->set_c_fields($attr => undef) or do {
                    print $OUT "cannot unset attributes $attr for " . $_->id .
                    "\n";
                    return;
                };
            }
            $env->commit;
            print $OUT "Changes applied\n";
        },
        completion => sub {
            my ($env, $lastw, @args) = @_;
            if (!$args[0]) {
                return $env->base->list_canonical_fields($env->{_otype}, 'w')
            }
        },
    });
    $objenv->add_func('set', {
        help => 'set attribute value - set an attributes to single value "value"',
        code => sub {
            my ($env, $attr, @value) = @_;
            @value or do {
                print $OUT "attribute and value must be specified\n";
                return;
            };
            foreach (@{$env->{_objects}}) {
                defined $_->set_c_fields($attr => @value <= 1 ? $value[0] :
                    \@value) or do {
                    $_->base->rollback;
                    printf $OUT "Cannot set $attr to %s for %s\n", join(', ',
                        @value), $_->id;
                    return;
                };
            }
            $env->commit;
            print $OUT "Done.\n";
        },
        completion => sub {
            my ($env, $lastw, @args) = @_;
            if (!$args[0]) {
                return $env->base->list_canonical_fields($env->{_otype}, 'w')
            } else {
                my $attr = $env->base->attribute($env->{_otype}, $args[0]);
                if ($attr->has_values_list) {
                    $attr->can_values;
                } elsif (@{$env->{_objects}} == 1) {
                    return
                    $env->{_objects}[0]->get_attributes($args[0]);
                }
            }
        },
    });
    $objenv->add_func('add', {
        help => 'add a value to an attribute',
        code => sub {
            my ($env, $attr, @value) = @_;
            @value or do {
                print $OUT "attribute and value must be specified\n";
                return;
            };
            foreach (@{$env->{_objects}}) {
                my @attrv = grep { $_ } $_->get_attributes($attr);
                defined $_->set_c_fields($attr => [ @attrv, @value ]) or do {
                    $_->rollback;
                    printf $OUT "Cannot set $attr to %s for %s\n", join(', ',
                        @value), $_->id;
                    return;
                };
            }
            $env->commit;
            print $OUT "done\n";
        },
        completion => sub {
            my ($env, $lastw, @args) = @_;
            if (!$args[0]) {
                return grep {
                    $env->base->attribute($env->{_otype}, $_)->{multiple}
                } $env->base->list_canonical_fields($env->{_otype}, 'w')
            } else {
                my $attr = $env->base->attribute($env->{_otype}, $args[0]);
                if ($attr->has_values_list) {
                    $attr->can_values;
                } elsif (@{$env->{_objects}} == 1) {
                    return
                    $env->{_objects}[0]->get_attributes($args[0]);
                }
            }
        },
    });
    $objenv->add_func('remove', {
        help => 'remove a value from an attribute',
        code => sub {
            my ($env, $attr, @value) = @_;
            @value or do {
                print $OUT "attribute and value must be specified\n";
                return;
            };
            foreach (@{$env->{_objects}}) {
                my @attrv = grep { $_ } $_->get_attributes($attr);
                foreach my $r (@value) {
                    @attrv = grep { $_ ne $r } @attrv;
                }
                defined $_->set_c_fields($attr => @attrv ? [ @attrv ] : undef) or do {
                    $_->rollback;
                    printf $OUT "Cannot set $attr to %s for %s\n", join(', ',
                        @value), $_->id;
                    return;
                };
            }
            $env->commit;
            print $OUT "done\n";
        },
        completion => sub {
            my ($env, $lastw, @args) = @_;
            if (!$args[0]) {
                return grep {
                    $env->base->attribute($env->{_otype}, $_)->{multiple}
                } $env->base->list_canonical_fields($env->{_otype}, 'w')
            } else {
                my $attr = $env->base->attribute($env->{_otype}, $args[0]);
                if (@{$env->{_objects}} == 1) {
                    return
                    $env->{_objects}[0]->get_attributes($args[0]);
                }
            }
        },
    });
    $objenv->add_func('list', {
        help => 'list current selected objects',
        code => sub {
            printf $OUT "%s: %s\n", $_[0]->{_otype}, join(', ', map { $_->id }
            @{$_[0]->{_objects}});
        }
    });
    $objenv->add_func('edit', {
            help => 'edit [object] - edit selected object using vi',
            completion => sub {
                return map { $_->id } @{$_[0]->{_objects}}
            },
            code => sub {
                my ($env, $id) = @_;
                my $obj;
                if ($id) {
                    $obj = grep { $_->id = $id } @{$env->{_objects}} or do {
                        print $OUT "$id is not part of selected objects\n";
                        return;
                    };
                } elsif (@{$env->{_objects}} == 1) {
                    $obj = $env->{_objects}[0]
                } else {
                    print $OUT "multiple objects selected but can edit only one,"
                    . "please specify which one\n";
                    return;
                }
                my $res = LATMOS::Accounts::Utils::dump_read_temp_file(
                    sub {
                        my ($fh) = @_;
                        $obj->text_dump($fh,
                            {
                                empty_attr => 1,
                                only_rw => 1,
                            }
                        );
                    },
                    sub {
                        my ($fh) = @_;
                        my %attr = LATMOS::Accounts::Utils::parse_obj_file($fh);
                        my $res = $obj->set_c_fields(%attr);
                        if ($res) {
                            print $OUT "Changes applied\n";
                            $env->commit;
                        }
                        else { print $OUT "Error applying changes\n" }
                        return $res ? 1 : 0;
                    }
                );
            },
        });
    $objenv->add_func('delete', {
        help => 'delete - delete selected object',
        code => sub {
            my ($env) = @_;
            printf $OUT "%s: %s\ndelete selected objects ? (yes/NO)\n",
            $env->{_otype}, join(', ', map { $_->id } @{$env->{_objects}});
            my $reply = <STDIN> || ''; chomp($reply);
            if ($reply eq 'yes') {
                foreach (@{$env->{_objects}}) {
                    $env->base->delete_object($env->{_otype}, $_->id) or do {
                        print $OUT "Cannot delete " . $_->id . "\n";
                        return;
                    };
                }
                $env->commit;
                return "EXIT";
            } else {
                print $OUT "cancel !\n"
            }
        },
    });
    if (grep { $objenv->base->attribute($otype, $_)->reference }
        $objenv->base->list_canonical_fields($otype, 'r')) {
        $objenv->add_func('select', {
            help => 'select attribute [object]',
            code => sub {
                my ($env, $attrname, @objects) = @_;
                my $totype = $env->base->attribute($env->{_otype},
                    $attrname)->reference or return;

                if (! @objects) {
                    @objects = grep { $_ } 
                      map { $_->get_attributes($attrname) } @{$env->{_objects}};
                }
                {
                    my %uniq = map { $_ => 1 } @objects;
                    @objects = keys %uniq;
                }
                my @objs = (grep { $_ } map { $env->base->get_object($totype, $_) }
                        @objects);
                return if (!@objs);
                print $OUT "Selecting $otype " . join(', ', map { $_->id } @objs) . "\n";
                objenv($_[0]->base, $totype, @objs)->cli();
            },
            completion => sub {
                if ($_[2]) {
                    my $totype = $_[0]->base->attribute($_[0]->{_otype},
                        $_[2])->reference or return;
                    return grep { $_ }
                           map { $_->get_attributes($_[2]) }
                           @{$_[0]->{_objects}};
                } else {
                    return grep { $_[0]->base->attribute($otype, $_)->reference }
                    $_[0]->base->list_canonical_fields($otype, 'r');
                }
            },
            }
        );
    }

    if (lc($otype) eq 'user') {
        $objenv->add_func('group', {
            help => 'group add|remove|primary goupname',
            code => sub {
                my ($env, $action, @groups) = @_;
                foreach my $obj (@{$env->{_objects}}) {
                    if ($action eq 'primary') {
                        my $gid = $groups[0];
                        if ($gid !~ /^\d/) {
                            my $gobj = $env->base->get_object('group', $gid) or
                            do {
                                print $OUT "Cannot find group $gid\n";
                                return;
                            };
                            $gid = $gobj->get_attributes('gidNumber');
                        }
                        $obj->set_c_fields('gidNumber', $gid);
                    } else {
                        my %gr;
                        foreach ($obj->get_attributes('memberOf')) {
                            $gr{$_} = 1;
                        }
                        if ($action eq 'add') {
                            $gr{$_} = 1 foreach(@groups);
                        } elsif ($action eq 'remove') {
                            delete($gr{$_}) foreach(@groups);
                        } else {
                            print $OUT 'invalid action' . "\n";
                            return;
                        }
                        defined $obj->set_c_fields('memberOf' => [ keys %gr ]) or do {
                            print $OUT "cannot set memberOf attributes for " .
                            $obj->id . "\n";
                            return;
                        };
                    }
                }
                $env->commit;
            },
            completion => sub {
                if (!$_[2]) {
                    return (qw(add remove primary));
                } else {
                    if ($_[2] eq 'remove') {
                        my %uniq = map { $_ => 1 }
                            grep { $_ }
                            map { $_->get_attributes('memberOf') }
                            @{$_[0]->{_objects}};
                        return sort keys %uniq;
                    } else {
                        return $_[0]->base->search_objects('group');
                    }
                }
            },
        });
    } elsif ($otype eq 'group') {
        $objenv->add_func('member', {
            help => 'member add|remove user',
            code => sub {
                my ($env, $action, @groups) = @_;
                foreach my $obj (@{$env->{_objects}}) {
                    my %gr;
                    foreach ($obj->get_attributes('memberUID')) {
                        $gr{$_} = 1;
                    }
                    if ($action eq 'add') {
                        $gr{$_} = 1 foreach(@groups);
                    } elsif ($action eq 'remove') {
                        delete($gr{$_}) foreach(@groups);
                    } else {
                        print $OUT 'invalid action' . "\n";
                        return;
                    }
                    defined $obj->set_c_fields('memberUID' => [ keys %gr ]) or do {
                        print $OUT "cannot set memberUID attributes for " .
                        $obj->id . "\n";
                        return;
                    };
                }
                $env->commit;
            },
            completion => sub {
                if (!$_[2]) {
                    return (qw(add remove));
                } else {
                    if ($_[2] eq 'remove') {
                        my %uniq = map { $_ => 1 }
                            grep { $_ }
                            map { $_->get_attributes('member') }
                            @{$_[0]->{_objects}};
                        return sort keys %uniq;
                    } else {
                        return $_[0]->base->search_objects('user');
                    }
                }
            },
        });
    }

    return $objenv;
}

=head1 OBJECT FUNCTIONS

=head2 new ($env, $labase)

Create an envirronment object.

C<$env> is functions descriptions.

=cut

sub new {
    my ($class, $env, $labase) = @_;
    bless($env, $class);
    $env->{_labase} = $labase;

    if ($labase->is_transactionnal) {
        $env->add_func(
            'transaction', {
                help => 'change transaction mode',
                code => sub {
                    $trans_mode = $_[1] eq 'on' ? 1 : 0;
                },
                completion => sub {
                    $trans_mode == 0 ? 'on' : 'off';
                },
            }
        );
        $env->add_func(
            'commit', {
                help => 'commit pending change',
                code => sub {
                    $_[0]->_commit;
                },
            }
        );
        $env->add_func(
            'rollback', {
                help => 'commit pending change',
                code => sub {
                    $_[0]->_rollback;
                },
            }
        );
    }
    $env->add_func('quit', { help => 'quit - exit the tool',
            code => sub { print "\n"; exit(0) }, });
    $env->add_func('exit', { help => "exit current mode",
            code => sub { return "EXIT" }, });
    $env->add_func('help', {
        help => 'help [command] - print help about command',
        completion => sub {
            if (!$_[2]) { return sort keys %{ $_[0]->{funcs} || {}} }
        },
        code => sub {
            my ($self, $name) = @_;
            if (!$name) {
                print $OUT join(', ', sort keys %{ $self->{funcs} || {}}) . "\n";
            } elsif ($self->{funcs}{$name}{alias}) {
                print $OUT "$name is an alias for " . join(' ',
                    @{$self->{funcs}{$name}{alias}}) . "\n";
            } elsif ($self->{funcs}{$name}{help}) {
                print $OUT $self->{funcs}{$name}{help} . "\n";
            } else {
                print $OUT "No help availlable\n";
            }
        },
    });

    $env;
}

=head2 base

Return the attached base object.

=cut

sub base { $_[0]->{_labase} }

=head2 cli

Start the main loop

=cut

sub cli {
    my ($self) = @_;
    while (1) {
        $term->Attribs->{completion_function} = sub {
            $self->complete($_[0], shellwords(substr($_[1], 0, $_[2])));
        };
        defined (my $line = $term->readline($self->prompt)) or do {
            print $OUT "\n";
            return;
        };
        $term->addhistory($line);
        my $res = $self->run(shellwords($line));
        $self->rollback if (!$trans_mode);
        if ($res && $res eq 'EXIT') { print $OUT "\n"; return }
    }
}

=head2 prompt

Wait user to input command

=cut

sub prompt {
    my ($self) = @_;
    if (!$self->{prompt}) {
        return "LA cli > ";
    } else {
        $self->{prompt}->($self);
    }
}

=head2 add_func ($name, $param)

Add new function in the envirronment

=cut

# TODO: hide this

sub add_func {
    my ($self, $name, $param) = @_;
    $self->{funcs}{$name} = $param;
}

=head2 getoption ($opt, @args)

Parse commmand line

=cut

# TODO: hide this

sub getoption {
    my ($self, $opt, @args) = @_;
    local @ARGV = @args;
    Getopt::Long::Configure("pass_through");
    GetOptions(%{ $opt });

    return @ARGV;
}

# TODO: useless ?

sub _parse_arg {
    my ($self, $name, @args) = @_;
    return @args;
}

=head2 complete

Return possible words according current entered words

=cut

sub complete {
    my ($self, $lastw, $name, @args) = @_;
    if (!$name) {
        return grep { /^\Q$lastw\E/ } sort
            (keys %{ $self->{funcs} || {}});
    } elsif ($self->{funcs}{$name}{alias}) {
        $self->complete($lastw, @{$self->{funcs}{$name}{alias}}, @args);
    } elsif ($self->{funcs}{$name}{completion}) {
        my @pargs = $self->_parse_arg($name, @args);
        return map { my $t = $_; $t =~ s/\s/\\ /g; $t } grep { $_ && /^\Q$lastw\E/ } $self->{funcs}{$name}{completion}->($self, $lastw, @pargs);
    } else {
        return ();
    }
}

=head2 run ($name, @args)

Run functions

=cut

sub run {
    my ($self, $name, @args) = @_;
    return if (!$name);
    if (!exists($self->{funcs}{$name})) {
        print $OUT "No command $name found\n";
    } elsif ($self->{funcs}{$name}{alias}) {
        $self->run(@{$self->{funcs}{$name}{alias}}, @args);
    } elsif ($self->{funcs}{$name}{code}) {
        my @pargs = $self->_parse_arg($name, @args);
        $self->{funcs}{$name}{code}->($self, @args);
    } else {
        print $OUT "No command $name found\n";
    }
}

=head2 commit

Call commit to base unelss in transaction mode

=cut

sub commit {
    my ($self) = @_;
    if ($trans_mode) {
    } else {
        $self->_commit;
    }
}

sub _commit {
    my ($self) = @_;
    $self->base->commit;
}

=head2 rollback

Perform rollback unless in transaction mode

=cut

sub rollback {
    my ($self) = @_;
    if ($trans_mode) {
        print $OUT "All pending changes get rollback\n";
    }
    $self->_rollback;
}

sub _rollback {
    my ($self) = @_;
    $self->base->rollback;
}

1;

__END__

=head1 SEE ALSO

L<LATMOS::Accounts>

=head1 AUTHOR

Olivier Thauvin, E<lt>olivier.thauvin@latmos.ipsl.frE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2008, 2009, 2010, 2011, 2012 CNRS SA/CETP/LATMOS

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.10.0 or,
at your option, any later version of Perl 5 you may have available.

=cut