view release on metacpan or  search on metacpan

lib/Log/Dispatch/TextTable.pm  view on Meta::CPAN

#pod =head1 SYNOPSIS
#pod
#pod   use Log::Dispatch;
#pod   use Log::Dispatch::TextTable;
#pod  
#pod   my $log = Log::Dispatch->new;
#pod  
#pod   $log->add(Log::Dispatch::TextTable->new(
#pod     name      => 'text_table',
#pod     min_level => 'debug',
#pod     flush_if  => sub { (shift)->event_count >= 60 },
#pod   ));
#pod  
#pod   while (@events) {
#pod     # every 60 events, a formatted table is printed to the screen
#pod     $log->warn($_);
#pod   }
#pod
#pod =head1 DESCRIPTION
#pod
#pod This provides a Log::Dispatch log output system that builds logged events into
#pod a textual table and, when done, does something with the table.  By default, it
#pod will print the table.
#pod
#pod =method new
#pod
#pod  my $table_log = Log::Dispatch::TextTable->new(\%arg);
#pod
#pod This method constructs a new Log::Dispatch::TextTable output object.  Valid
#pod arguments are:
#pod
#pod   send_to  - a coderef indicating where to send the logging table (optional)
#pod              defaults to print to stdout; see transmit method
#pod   flush_if - a coderef indicating whether, if ever, to flush (optional)
#pod              defaults to never flush; see should_flush and flush methods
#pod   columns  - an arrayref of columns to include in the table; message, level,
#pod              and time are always provided
#pod
#pod =cut

sub new {
  my ($class, %arg) = @_;

  # when done, by default, print out the passed-in table
  $arg{send_to} ||= sub { print $_[0] };

  # construct the column list, using the default if no columns were given
  my @columns = $arg{columns} ? @{ $arg{columns} } : qw(time level message);
  my @header  = map { $_, \q{ | } } @columns;
  $#header--; # drop the final |-divider

  my $table = Text::Table->new(@header);

  my $self = {
    columns  => \@columns,
    table    => $table,
    send_to  => $arg{send_to},
    flush_if => $arg{flush_if},
  };

  bless $self => $class;

  # this is our duty as a well-behaved Log::Dispatch plugin
  $self->_basic_init(%arg);

  return $self;
}

#pod =method log_message
#pod
#pod This is the method which performs the actual logging, as detailed by
#pod Log::Dispatch::Output.  It adds the data to the table and may flush.  (See
#pod L</should_flush>.)
#pod
#pod =cut

sub log_message {
  my ($self, %p) = @_;
  $p{time} = localtime unless exists $p{time};

  $self->table->add(
    @p{ @{ $self->{columns} } }
  );

  $self->flush(\%p) if $self->should_flush;
}

#pod =method table
#pod
#pod This method returns the Text::Table object being used for the log's logging.
#pod
#pod =cut

sub table { return $_[0]->{table} }

#pod =method entry_count
#pod
#pod This method returns the current number of entries in the table.
#pod
#pod =cut

sub entry_count {
  my ($self) = @_;
  $self->table->body_height;
}

#pod =method flush
#pod
#pod This method transmits the current table and then clears it.  This is useful for
#pod emptying large tables every now and then.
#pod
#pod =cut

sub flush {
  my ($self) = @_;
  $self->transmit;
  $self->table->clear;
}

#pod =method should_flush
#pod