view release on metacpan or  search on metacpan

lib/RRD/Daemon/Util.pm  view on Meta::CPAN

package RRD::Daemon::Util;

use strict;
use warnings;
use feature  qw( :5.10 );

=head1 NAME

RRD::Daemon::Util - utilities for RRD::Daemon

=cut

use base  qw( Exporter );
our @EXPORT_OK = qw( ff fdur ftime
                     debug error fatal trace info lwrite warn warning
                     ddump ddumps ddumpc ddumpcs
                     tdump tdumps tdumpc tdumpcs
                     DUMP_SINGLE_LINE DUMP_MULTI_LINE
                     FTIME_INC_EPOCH FTIME_SHORT
                     init_log4perl mlhash
                  );


use Carp                   qw( cluck );
use File::Spec::Functions  qw( rel2abs );
use FindBin                qw( $Script );
use IO::All                qw( io );
use Log::Log4perl          qw( :levels get_logger ); # grr, cannot import levels individually even from ::Level
use Params::Validate       qw( validate_pos
                               HASHREF SCALAR SCALARREF );
use POSIX                  qw( strftime );


# ----------------------------------------------------------------------------

use constant DUMP_SINGLE_LINE => \1; # value is == only to itself - not even == another \1
use constant DUMP_MULTI_LINE  => \2; # value is == only to itself

use constant FTIME_INC_EPOCH  => 1;
use constant FTIME_SHORT      => 2;

BEGIN {
  Log::Log4perl::Layout::PatternLayout::add_global_cspec
    ('D', sub { strftime '%s %a %F %I:%M:%S %p GMT', gmtime });
}

use constant DEFAULT_LOGGING_CONF => <<'LOG4PERL';
log4perl.rootLogger=WARN, SCREEN, LOGFILE
log4perl.category.Placeholder.For.ScreenD.Appender=NONE, SCREEND, LOGFILED

log4perl.appender.SCREEN=Log::Log4perl::Appender::Screen
log4perl.appender.SCREEN.layout=PatternLayout::Multiline
log4perl.appender.SCREEN.layout.ConversionPattern=[%d{EEEdd}Z%d{HH:mm:ss}] %5p> %m%n
log4perl.appender.SCREEN.Threshold=INFO

log4perl.appender.LOGFILE=Log::Dispatch::FileRotate
log4perl.appender.LOGFILE.DatePattern=yyyy-MM-dd
log4perl.appender.LOGFILE.filename=sub { use FindBin '$Script'; join '/', ($ENV{join '_', $Script, 'LOGDIR'} // join('/', '/tmp', (getpwuid $<)[0], 'logs')), "$Script.log" }
log4perl.appender.LOGFILE.max=10
log4perl.appender.LOGFILE.mode=append
log4perl.appender.LOGFILE.TZ=UTC
log4perl.appender.LOGFILE.layout=PatternLayout::Multiline
log4perl.appender.LOGFILE.layout.ConversionPattern=[%D] %5p> %m%n
log4perl.appender.LOGFILE.Threshold=INFO


log4perl.appender.SCREEND=Log::Log4perl::Appender::Screen
log4perl.appender.SCREEND.layout=PatternLayout::Multiline
log4perl.appender.SCREEND.layout.ConversionPattern=[%d{EEEdd}Z%d{hh:mm:ss}] %5p> %M(%L) - %m%n
# log4perl.appender.SCREEND.Threshold=NONE

log4perl.appender.LOGFILED=Log::Dispatch::FileRotate
log4perl.appender.LOGFILED.DatePattern=yyyy-MM-dd
log4perl.appender.LOGFILED.filename=sub { use FindBin '$Script'; join '/', ($ENV{join '_', $Script, 'LOGDIR'} // join('/', '/tmp', (getpwuid $<)[0], 'logs')), "$Script.log" }
log4perl.appender.LOGFILED.max=10
log4perl.appender.LOGFILED.mode=append
log4perl.appender.LOGFILED.TZ=UTC
log4perl.appender.LOGFILED.layout=PatternLayout::Multiline
log4perl.appender.LOGFILED.layout.ConversionPattern=[%D] %5p> %M(%L) - %m%n
LOG4PERL

# ----------------------------------------------------------------------------

sub ff (@) {
  my @args = @_;

  cluck sprintf "%s called with no args\n", (caller 0)[3]
    if 0 == @args;
  cluck sprintf "undef passed to %s >>%s<<\n",
        (caller 0)[3],
        Data::Dumper->new(\@_)->Maxdepth(3)->Indent(0)->Terse(1)->Dump
    if grep !defined, @args;

  my $text;
  if ( 1 == @args ) {
    if ( UNIVERSAL::isa($args[0], 'HASH') ) {
      my $dd = Data::Dumper->new(\@args);
      $text = $dd->Maxdepth(3)->Indent(wantarray ? 1 : 0)->Terse(1)->Dump;
    } elsif ( UNIVERSAL::isa($args[0], 'ARRAY') ) {
      my $dd = Data::Dumper->new(\@args);
      $text = $dd->Maxdepth(3)->Indent(wantarray ? 1 : 0)->Terse(1)->Dump;
    } else {
      $text = $args[0];
    }
  } else {
    if ( DUMP_SINGLE_LINE eq $args[0] or DUMP_MULTI_LINE eq $args[0]) {
      if ( 'ARRAY' eq ref $args[1] or 2 < @args ) {
        my @a = 2 == @args ? @{$args[1]} : @args[1..$#args];
        $text = join DUMP_SINGLE_LINE eq $args[0] ? ' ' : "\n",
                     map Data::Dumper->new([$a[$_*2+1]],[$a[$_*2]])->Maxdepth(3)->Indent(0)->Terse(0)->Dump,
                         0..$#a/2;
      } elsif ( 'HASH' eq ref $args[1] ) {
        $text = join DUMP_SINGLE_LINE eq $args[0] ? ' ' : "\n",
                     map Data::Dumper->new([$args[1]->{$_}],[$_])->Maxdepth(3)->Indent(0)->Terse(0)->Dump,
                         sort keys %{$args[1]};
      } else {
        $text = join DUMP_SINGLE_LINE eq $args[0] ? ' ' : "\n",
                     Data::Dumper->new([@args[1..$#args]])->Maxdepth(3)->Indent(DUMP_MULTI_LINE eq $args[0])->Terse(1)->Dump;
      }
    } else {
      # beware sprintf's prototype of ($@), which means that sprintf @args
      # would place the first arg in a scalar context - so taking a single arg
      # being the size of the list
      $text = sprintf $args[0], @args[1..$#args];
    }
  }

  return wantarray ? split(/\n/, $text) : $text
}

# -------------------------------------

sub _lwrite ($$@) {
  my ($methname, $level, @msg) = @_;