perl-multilevel-logging.sketch.pl

perl-multilevel-logging.sketch.pl

#!/usr/bin/perl -w
# -*-mode:cperl -*-
package main;

=pod
Description:
Usage:
Date created: 2020-07
Author: Vojtech Prusa
=cut
use strict;
use warnings;
# TODO:

use Data::Dumper qw(Dumper);

use 5.016003; # current version
########################################################################
package SLog;
use Data::Dumper qw(Dumper);
use Term::ANSIColor qw(:constants);

use constant {
  L1a                          => 'Level1a',
  L1b                          => 'Level1b',
  L1b_L2A                      => 'Level1b_Level2A',
  L1c                          => 'Level1c',
  L1c_L2A                      => 'Level1c_Level2A',
  L1c_L2B                      => 'Level1c_Level2B',
  # => '',
};

# TODO: Here comment anyone line you do not want to log
# Commenting 'L1b_L2A' but keeping 'L1b' will still log 'L1b_L2A' because of its prefix
# current setup should Dump:
=pod
Level1a $VAR1 = 'SLog->L1a';
Level1b_Level2A $VAR1 = 'SLog->L1b_L2A';
Level1c $VAR1 = 'SLog->L1c';
Level1c_Level2A $VAR1 = 'SLog->L1c_L2A';
Level1c_Level2B $VAR1 = 'SLog->L1c_L2B';
=cut
my @SHOULD_LOG = (
  L1a,
  # L1b,
  L1b_L2A,
  L1c,
  # L1c_L2A,
  L1c_L2B
);

=pod
# another sample config
my @SHOULD_LOG = (
  INFO, WARN, ERR, DEB, DEB_a
);
=cut
=pod
# @SHOULD_LOG_STR for another config
my @SHOULD_LOG_STR = (
  INFO, WARN, ERR, DEB, DEB_
);
=cut

my @SHOULD_LOG_STR = @SHOULD_LOG;

=pod
https://metacpan.org/pod/Term::ANSIColor

The recognized normal foreground color attributes (colors 0 to 7) are:
black  red  green  yellow  blue  magenta  cyan  white

The corresponding bright foreground color attributes (colors 8 to 15) are:
bright_black  bright_red      bright_green  bright_yellow
bright_blue   bright_magenta  bright_cyan   bright_white

The recognized normal background color attributes (colors 0 to 7) are:
on_black  on_red      on_green  on yellow
on_blue   on_magenta  on_cyan   on_white

The recognized bright background color attributes (colors 8 to 15) are:
on_bright_black  on_bright_red      on_bright_green  on_bright_yellow
on_bright_blue   on_bright_magenta  on_bright_cyan   on_bright_white

=cut
sub color {
  my ($name) = @_;
  my @prefix = split("_", $name);

  if ( $name ~~ INFO ) {
    print WHITE, $name . ": ", RESET;
    # print $name . ": ";
  } elsif ( $name ~~ WARN ) {
    print YELLOW, $name . ": ", RESET;
    # print , $name . ": ", RESET;
  } elsif ( $name ~~ ERR ) {
    print RED, $name . ": ", RESET;
  } elsif ( $name ~~ DEB || $prefix[0] ~~ DEB ) {
    print MAGENTA, $name . ": ", RESET;
    # CYAN
  } else {
    print $name . ": ";
  }
}

=pod
Debug only file
=cut
my $debugOnlyLogFile = "./debugOnly.log";
my $cmd = "rm -rf $debugOnlyLogFile";
# remove old log
print "" . $cmd . "\n";
print `$cmd` . "\n";

sub Log {
  if (scalar(@_) > 1) {
    my ($name, @val) = @_;
    my @prefix = split("_", $name);
    if ( $name ~~ @SHOULD_LOG || $prefix[0] ~~ @SHOULD_LOG) {
      if($name ~~ @SHOULD_LOG_STR || $prefix[0] ~~ @SHOULD_LOG_STR) {
        # print "$name: ";
        color $name;
        if ( $name ~~ DEB || $prefix[0] ~~ DEB ) {
          open(SOUBOR, ">> $debugOnlyLogFile");
          print SOUBOR $name . ": ";
          print SOUBOR @val;
          close(SOUBOR);
        }
        print @val;
      }else{
        # print "$name ";
        color $name;
        print Dumper(@val);
      }
    } else {
    }
  } else {
    print Dumper(@_);
  }
}
package main;

# Wrapper for case when you do not want to call SLog::Log() but Log() because type speed matters
sub Log {
  SLog::Log(@_);
}

sub main {
  # if ($arg{mode} eq 'god') {
  #     print "God mode\n";
  #     exit 0;
  # }
  Log(SLog->L1a,"SLog->L1a");
  Log(SLog->L1b,"SLog->L1b");
  Log(SLog->L1b_L2A,"SLog->L1b_L2A");
  Log(SLog->L1c,"SLog->L1c");
  Log(SLog->L1c_L2A,"SLog->L1c_L2A");
  Log(SLog->L1c_L2B,"SLog->L1c_L2B");
}

main();

#