package LATMOS::Accounts::Cli::Context; # $Id: Cli.pm 2145 2018-08-29 18:15:46Z nanardon $ use strict; use warnings; use Moose; 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 tools. =cut { open (my $fh, "/dev/tty" ) or eval 'sub Term::ReadLine::findConsole { ("&STDIN", "&STDERR") }'; die $@ if $@; close ($fh); } has Term => ( is => 'ro', isa => 'Term::ReadLine' ); has TransMode => ( is => 'rw', isa => 'Bool', default => 0 ); has TransStarted => ( is => 'rw', isa => 'Bool', default => 0 ); has base => ( is => 'ro' ); has Out => ( is => 'ro' ); =head1 FUNCTIONS =head2 new ($env, $labase) Create an envirronment object. C<$env> is functions descriptions. =cut around BUILDARGS => sub { my $orig = shift; my $class = shift; my $term = Term::ReadLine->new('LA CLI'); $term->MinLine(99999); my $OUT = \*STDOUT; return $class->$orig( Out => $OUT, Term => $term, @_ ); }; =head2 print =cut sub print { my ( $self, $str, @args ) = @_; my $out = $self->Out; printf $out $str, @args; } =head2 commit Call commit to base unelss in transaction mode =cut sub commit { my ($self) = @_; if ($self->TransMode || $self->TransStarted) { $self->TransStarted(1); } else { $self->_commit; } } sub _commit { my ($self) = @_; $self->base->commit; $self->TransStarted(0); } =head2 rollback Perform rollback unless in transaction mode =cut sub rollback { my ($self) = @_; if ($self->TransMode) { $self->print("All pending changes get rollback\n"); } if (!$self->TransStarted) { $self->_rollback; } } sub _rollback { my ($self) = @_; $self->base->rollback; $self->TransStarted(0); } 1; __END__ =head1 SEE ALSO L =head1 AUTHOR Olivier Thauvin, Eolivier.thauvin@latmos.ipsl.frE =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