perl-template-basic

config.pl

#!/usr/bin/perl -w
# VP 2021

# use strict;
# use warnings;
use Cwd 'abs_path';
use File::Basename;

# enable (1) if debug
# our $debug = 0;
our $debug = 1;
# enable (1) if devel
#our $devel        = 0;
our $devel = 1;

our $cur_dir = dirname(abs_path($0));
chomp $cur_dir;

if ($devel) {
  print "Devel\n";
  print "cur_dir: $cur_dir \n";
  print "debug: $debug\n";

  if ($debug == 1) {
    # example for config used while debuggin
  }
} else {
  print "Ostra\n";
  print "cur_dir: $cur_dir\n";
}

1;

logger.pl

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

# https://gist.github.com/vprusa/ebf77847388eba721ad7d77c100a8db5

package main;

=pod
Description:
Usage:
Date created: 2020-07
Author: Vojtech Prusa
=cut

use strict;
use warnings;
use experimental 'smartmatch';

use Data::Dumper qw(Dumper);

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

# konstanty pro vypis. DEB je specialita, pridaval jsem je ciste pro debug, v ramci debugu je doporucuji mazat
# dle potreby, ale vetsina by mela byt znovu pouzitelna
use constant {
  # => '',
  INFO          => 'INFO',
  ARGS          => 'ARGS',
  HELP          => 'HELP',
  INFO_CMD      => 'INFO_CMD',
  INFO_CMD_OK   => 'INFO_CMD_OK',
  NOTE          => 'NOTE',
  NONE          => 'NONE',
  WARN          => 'WARN',
  ERR           => 'ERR',
  DEB           => 'DEB',
  DEB_SKIP      => 'DEB_SKIP',
  DEB_DONT_SKIP => 'DEB_DONT_SKIP',
};

my @SHOULD_LOG = (
  INFO, WARN, ERR, ARGS, HELP,
  # DEB,
  # DEB_SKIP,
  DEB_DONT_SKIP,
);

# my @SHOULD_LOG_STR = @SHOULD_LOG;
my @SHOULD_LOG_STR = (
  INFO, WARN, ERR, ARGS, HELP,
  # DEB,
  # DEB_SKIP,
  DEB_DONT_SKIP,
);

use Term::ANSIColor qw(:constants);
=pod
Zde je obarveni logu, pac perl neumi obarvit pomoci stejnych kodu jako bash pomoci print

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 || $name ~~ INFO_CMD || $name ~~ INFO_CMD_OK) {
    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 . ": ";
  }
}

my $debugOnlyLogFile = "./debugOnly.log";
my $cmd = "rm -rf $debugOnlyLogFile";
print "" . $cmd . "\n";
# print `$cmd` . "\n";

=pod
Logging subroutine,
also if used INFO_CMD or INFO_CMD_OK executes command and logs the result..
INFO_CMD_OK does not deal with return codes and assumes command was successfull
=cut
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:";
        if ($name ~~ DEB || $prefix[0] ~~ DEB) {
          color $name;
          open(SOUBOR, ">> $debugOnlyLogFile");
          print SOUBOR $name . ": ";
          print SOUBOR @val;
          close(SOUBOR);
          print @val;
        } elsif ($name ~~ INFO_CMD || $name ~~ INFO_CMD_OK || $prefix[0] ~~ INFO_CMD || $prefix[0] ~~ INFO_CMD_OK) {
          if (@val) {
            color $name;
            print $val[0];
            print " exec: " . $val[1] . "\n";
            print WHITE, "\tVysledek: ", RESET;
            my $res = `$val[1]`;
            my $p = $? >> 8;
            if ($name ~~ INFO_CMD_OK) {
              print "OK-IDK\n", RESET;
            } else {
              print "OK\n" if ($p == 0);
              print RED, "KO\n", RESET if ($p != 0);
              # print `$val[1]` ;
            }
            if (exists($val[2])) {
              print $val[2];
            }
            return $res;
          }
        } elsif ($name ~~ INFO || $prefix[0] ~~ INFO) {
          if (@val) {
            color $name;
            print @val;
          }
        } else {
          color $name;
          print @val;
        }
      } else {
        # print "$name ";
        color $name;
        print Dumper(@val);
      }
    } else {
    }
  } else {
    # TODO print only if second argument is not empty, because if it is empty this is still
    # executed even when it should not pass "scalar(@_) > 1"
    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(@_);
}

template.pl

#!/usr/bin/perl
########################################################################
# perl template
########################################################################
# use strict;
# use warnings;

use Data::Dumper qw(Dumper);
use Getopt::Long qw(GetOptions);
use experimental 'smartmatch';

use 5.008003; # may be newer
########################################################################
my $VERSION = '0.8.0';

use POSIX qw/floor/;
use File::Basename;
use Cwd 'abs_path';

########################################################################
# shared variables
########################################################################

my $cur_dir = dirname(abs_path($0));
my $conf_path = $cur_dir . '/config.pl';
require $conf_path;
require $cur_dir . "/logger.pl";

our $debug;
our $devel;

# shared variable so I do not have to deinfe it locally..
my $cmd;

# Used in loops  like
# ```next if debugSkip($fileName)```
sub debugSkip {
  my ($fileName) = @_;
  return 0 if $fileName eq "";
  if ($debug == 1) {
    my $fileName = `basename $fileName`;
    chomp $fileName;
    if ("$fileName" ~~ @filesDebug) {
      Log(SLog->DEB_DONT_SKIP, "Using file $fileName\n");
      return 0;
    } else {
      Log(SLog->DEB_SKIP, "Skipping file $fileName\n");
      return 1;
    }
  }
  return 0;
}


## Set defaults for all the options, then read them in from command line
my %arg = (
  verbose => 0,
  quiet   => 0,
  debug   => 0,
  help    => 0,
  mode    => 0
);

########################################################################
my $result = GetOptions(
  \%arg,
  'verbose',
  'quiet',
  'debug',
  'help|h',
  'mode=s'
) or help();

$arg{help} and help();

sub printArgs() {
  Log(SLog->ARGS, "================\n");
  Log(SLog->ARGS, "ARG ARRAY => " . Dumper \%arg);
  Log(SLog->ARGS, "================\n");
}

########################################################################
sub main {
  printArgs();
  if ($arg{mode} eq 'god') {
    Log(SLog->INFO, "God mode\n");
    exit 0;
  }
}

########################################################################
sub help {
  Log(SLog->HELP, "Usage: $0 configfile [options]\n");
  Log(SLog->HELP, "    For full documentation, please visit:\n");
  Log(SLog->HELP, "    http://some_host\n");
  exit 0;
}

main();

#