File Coverage

lib/Class/Usul/TraitFor/OutputLogging.pm

Criterion	Covered	Total	%
statement	54	72	75.0
branch	11	22	50.0
condition	6	19	31.5
subroutine	16	18	88.8
pod	8	8	100.0
total	95	139	68.3

package Class::Usul::TraitFor::OutputLogging;

use namespace::autoclean;

use Class::Usul::Constants qw( BRK FAILED FALSE NUL TRUE WIDTH );
use Class::Usul::Functions qw( abs_path emit emit_err throw );
use Class::Usul::Types     qw( Bool SimpleStr );
use Text::Autoformat       qw( autoformat );
use Moo::Role;
use Class::Usul::Options;

requires qw( config log );

# Public attributes
option 'locale'   => is => 'lazy', isa => SimpleStr, format => 's',
   documentation  => 'Loads the specified language message catalogue',
   builder        => sub { $_[ 0 ]->config->locale }, short => 'L';

option 'quiet'    => is => 'ro',   isa => Bool, default => FALSE,
   documentation  => 'Quiet the display of information messages',
   reader         => 'quiet_flag', short => 'q';

# Private attributes
has '_quiet_flag' => is => 'rw', isa => Bool,
   builder        => sub { $_[ 0 ]->quiet_flag },
   lazy           => TRUE, writer => '_set__quiet_flag';

# Private methods
my $_loc = sub {
   my ($self, $text, $opts, $quote) = @_; $opts //= {};

   return $self->localize( $text // '[no message]', {
      locale               => $self->locale,
      no_quote_bind_values => $quote // $opts->{no_quote_bind_values} // FALSE,
      params               => $opts->{args} // [] } );
};

# Public methods
sub add_leader {
   my ($self, $text, $opts) = @_; $text or return NUL; $opts //= {};

   my $leader = $opts->{no_lead} ? NUL : (ucfirst $self->config->name).BRK;

   if ($opts->{fill}) {
      my $width = $opts->{width} // WIDTH;

      $text = autoformat $text, { right => $width - 1 - length $leader };
   }

   return join "\n", map { (m{ \A $leader }mx ? NUL : $leader).$_ }
                     split  m{ \n }mx, $text;
}

sub error {
   my ($self, $text, $opts) = @_; $text = $self->$_loc( $text, $opts );

   $self->log->error( $_ ) for (split m{ \n }mx, "${text}");

   emit_err $self->add_leader( $text, $opts );

   return TRUE;
}

sub fatal {
   my ($self, $text, $opts) = @_; my (undef, $file, $line) = caller 0;

   my $posn = ' at '.abs_path( $file )." line ${line}";

   $text = $self->$_loc( $text, $opts ).$posn;

   $self->log->alert( $_ ) for (split m{ \n }mx, $text);

   emit_err $self->add_leader( $text, $opts );

   exit FAILED;
}

sub info {
   my ($self, $text, $opts) = @_;

   $opts //= {}; $text = $self->$_loc( $text, $opts, TRUE );

   $self->log->info( $_ ) for (split m{ [\n] }mx, $text);

   $self->quiet or $opts->{quiet} or emit $self->add_leader( $text, $opts );

   return TRUE;
}

sub loc {
   my $self = shift; return $self->l10n->localizer( $self->locale, @_ );
}

sub output {
   my ($self, $text, $opts) = @_;

   $opts //= {}; $text = $self->$_loc( $text, $opts, TRUE );

   my $code = sub {
      $opts->{to} && $opts->{to} eq 'err' ? emit_err( @_ ) : emit( @_ );
   };

   $code->() if $opts->{cl};
   $code->( $self->add_leader( $text, $opts ) );
   $code->() if $opts->{nl};
   return TRUE;
}

sub quiet {
   my ($self, $v) = @_; defined $v or return $self->_quiet_flag; $v = !!$v;

   $v != TRUE and throw 'Cannot turn quiet mode off';

   return $self->_set__quiet_flag( $v );
}

sub warning {
   my ($self, $text, $opts) = @_;

   $opts //= {}; $text = $self->$_loc( $text, $opts );

   $self->log->warn( $_ ) for (split m{ \n }mx, $text);

   $self->quiet or $opts->{quiet} or emit $self->add_leader( $text, $opts );

   return TRUE;
}

1;

__END__

=pod

=encoding utf-8

=head1 Name

Class::Usul::TraitFor::OutputLogging - Localised logging and command line output methods

=head1 Synopsis

   use Moo;

   extends 'Class::Usul';
   with    'Class::Usul::TraitFor::OutputLogging';

=head1 Description

Localised logging and command line output methods

=head1 Configuration and Environment

Requires the following;

=over 3

=item C<config>

=item C<log>

=back

Defines the following command line options;

=over 3

=item C<L locale>

Print text and error messages in the selected language. If no language
catalogue is supplied prints text and errors in terse English. Defaults
to C<en>

=item C<q quiet_flag>

Quietens the usual started/finished information messages

=back

=head1 Subroutines/Methods

=head2 add_leader

   $leader = $self->add_leader( $text, $opts );

Prepend C<< $self->config->name >> to each line of C<$text>. If
C<< $opts->{no_lead} >> exists then do nothing. Return C<$text> with
leader prepended

=head2 error

   $self->error( $text, $opts );

Calls L<Class::Usul::localize|Class::Usul/localize> with
the passed options. Logs the result at the error level, then adds the
program leader and prints the result to I<STDERR>

=head2 fatal

   $self->fatal( $text, $opts );

Calls L<Class::Usul::localize|Class::Usul/localize> with
the passed options. Logs the result at the alert level, then adds the
program leader and prints the result to I<STDERR>. Exits with a return
code of one

=head2 info

   $self->info( $text, $opts );

Calls L<Class::Usul::localize|Class::Usul/localize> with
the passed options. Logs the result at the info level, then adds the
program leader and prints the result to I<STDOUT>

=head2 loc

   $localized_text = $self->loc( $message, @options );

Localises the message. Calls L<localizer|Class::Usul::L10N/localizer>. The
domains to search are in the C<l10n_domains> configuration attribute. Adds
C<< $self->locale >> to the arguments passed to C<localizer>

=head2 output

   $self->output( $text, $opts );

Calls L<Class::Usul::localize|Class::Usul/localize> with
the passed options. Adds the program leader and prints the result to
I<STDOUT>

=head2 quiet

   $bool = $self->quiet( $bool );

Custom accessor/mutator for the C<quiet_flag> attribute. Will throw if you try
to turn quiet mode off

=head2 warning

   $self->warning( $text, $opts );

Calls L<Class::Usul::localize|Class::Usul/localize> with
the passed options. Logs the result at the warning level, then adds the
program leader and prints the result to I<STDOUT>

=head1 Diagnostics

None

=head1 Dependencies

=over 3

=item L<Class::Usul::Options>

=item L<Text::Autoformat>

=item L<Moo::Role>

=back

=head1 Incompatibilities

There are no known incompatibilities in this module

=head1 Bugs and Limitations

There are no known bugs in this module. Please report problems to
http://rt.cpan.org/NoAuth/Bugs.html?Dist=Class-Usul.
Patches are welcome

=head1 Acknowledgements

Larry Wall - For the Perl programming language

=head1 Author

Peter Flanigan, C<< <[e-mail]> >>

=head1 License and Copyright

Copyright (c) 2017 Peter Flanigan. All rights reserved

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself. See L<perlartistic>

This program is distributed in the hope that it will be useful,
but WITHOUT WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE

=cut

# Local Variables:
# mode: perl
# tab-width: 3
# End:
# vim: expandtab shiftwidth=3: