view release on metacpan or  search on metacpan

lib/Log/Log4perl/Tiny.pm  view on Meta::CPAN

      push @message, sprintf " at %s line %d.\n", $file, $line
         if substr($message[-1], -1, 1) ne "\n";

      # go for it!
      CORE::warn(@message);
   }

   return
} ## end sub logwarn

sub logdie {
   my $self = shift;

   my @message;
   @message = __expand_message_list({message => \@_})
      if $self->is_fatal() || $LOGDIE_MESSAGE_ON_STDERR;

   $self->fatal(@message);

   if ($LOGDIE_MESSAGE_ON_STDERR) {
      # default die message when nothing is passed to die
      push @message, "Died" unless @message;

      # add 'at <file> line <line>' unless argument ends in "\n";
      my (undef, $file, $line) = caller(1);
      push @message, sprintf " at %s line %d.\n", $file, $line
         if substr($message[-1], -1, 1) ne "\n";

      # go for it!
      CORE::die(@message);
   }

   $self->_exit();
} ## end sub logdie

sub logexit {
   my $self = shift;
   $self->fatal(@_);
   $self->_exit();
}

sub _carpstuff {
   my $self = shift;
   my $renderer = shift;
   my $emitter  = shift;
   my $log_level = shift;

   my $emit_log = $self->can("is_$log_level")->($self);

   require Carp;
   local $Carp::Internal{'' . __PACKAGE__} = 1;
   local $Carp::CarpLevel = $Carp::CarpLevel + 2;

   my @message;
   @message = __expand_message_list({message => \@_})
      if $emit_log || $LOGDIE_MESSAGE_ON_STDERR;

   if ($emit_log) {    # avoid unless we're allowed to emit
      my $message = Carp->can($renderer)->(@message);
      my $method = $self->can($log_level);
      $self->$method($_) for split m{\n}mxs, $message;
   }
   if ($LOGDIE_MESSAGE_ON_STDERR) {
      Carp->can($emitter)->(@message);
   }

   return;
}

sub logcarp {
   my $self = shift;
   return $self->_carpstuff(qw< shortmess carp warn >, @_);
} ## end sub logcarp

sub logcluck {
   my $self = shift;
   return $self->_carpstuff(qw< longmess cluck warn >, @_);
} ## end sub logcluck

sub logcroak {
   my $self = shift;
   $self->_carpstuff(qw< shortmess croak fatal >, @_);
   $self->_exit();
} ## end sub logcroak

sub logconfess {
   my $self = shift;
   $self->_carpstuff(qw< longmess confess fatal >, @_);
   $self->_exit();
} ## end sub logconfess

sub level {
   my $self = shift;
   $self = $_instance unless ref $self;
   if (@_) {
      my $level = shift;
      return unless exists $id_for{$level};
      $self->{level} = $id_for{$level};
      $self->{_count}++;
   } ## end if (@_)
   return $self->{level};
} ## end sub level

sub _set_level_if_first {
   my ($self, $level) = @_;
   if (!$self->{_count}) {
      $self->level($level);
      delete $self->{_count};
   }
   return;
} ## end sub _set_level_if_first

sub __expand_message_list {
   join(
      (defined $, ? $, : ''),
      map { ref($_) eq 'CODE' ? $_->() : $_; } @{shift->{message}}
   );
}

BEGIN {