commit - c30e374147d6111ca19cdfac5961d4a8c8e6cf21
commit + c62b38f80091d571afd282be4822856bc16581c8
blob - /dev/null
blob + 6574369a2b1a80d1e05792537ffd8483e2ed934f (mode 644)
--- /dev/null
+++ lib/IRCNOW/Logger.pm
+package IRCNOW::Logger;
+use strict;
+use warnings;
+use POSIX qw(strftime);
+
+my $black = "\033[0;30m";
+my $red = "\033[0;31m";
+my $green = "\033[0;32m";
+my $yellow = "\033[0;33m";
+my $white = "\033[0;37m";
+my $nocolor = "\033[0m";
+my $blue = "\033[94m";
+my $magenta = "\033[35m";
+my $cyan = "\033[36m";
+
+our @EXPORT_OK = qw(
+ debug info warn error
+);
+# create debug tag so you can import the debug sub and messages
+# this enables loading lists of exports by tag like so:
+# use IRCNOW::IO qw(:DEBUG :FILEIO);
+our %EXPORT_TAGS = (
+ FILEIO=>[qw(readarray readstr writefile appendfile)],
+);
+
+use constant {
+ NONE => 0,
+ ERRORS => 1,
+ WARNINGS => 2,
+ INFO => 3,
+ DEBUG => 4,
+ ALL => 5,
+};
+
+use constant {
+ SUGAR => 0,
+ JSON => 1,
+};
+
+my $instance = undef;
+
+my $verbose = 5;
+
+sub logMessage {
+ my ($instance, $level, $package, $filename, $line, $msg) = @_;
+
+ my $levelString;
+
+ if ($level == NONE) {
+ $levelString = "NONE";
+ } elsif ($level == ERRORS) {
+ $levelString = "ERROR";
+ } elsif ($level == WARNINGS) {
+ $levelString = "WARN";
+ } elsif ($level == INFO) {
+ $levelString = "INFO";
+ } elsif ($level == DEBUG) {
+ $levelString = "DEBUG";
+ } else {
+ $levelString = "ALL";
+ }
+
+ if ($verbose >= $level) { $instance->printLog($level, $levelString, $package, $filename, $line, $msg); }
+}
+
+sub printLog {
+ my ($instance, $level, $levelString, $package, $filename, $line, $msg) = @_;
+
+ if ($instance->{'printType'} == JSON) {
+ $instance->printJSON($level, $levelString, $package, $filename, $line, $msg);
+ } elsif ($instance->{'printType'} == SUGAR) {
+ $instance->printSugar($level, $levelString, $package, $filename, $line, $msg);
+ }
+}
+
+sub printJSON {
+ my ($instance, $level, $levelString, $package, $filename, $line, $msg) = @_;
+
+ my $content = sprintf "{ \"level\": \"%s\", \"msg\": \"%s\", \"package\": \"%s\", \"file\": \"%s:%s\" }\n", $levelString, $msg, $package, $filename, $line;
+
+ print $content;
+}
+
+sub printSugar {
+ my ($instance, $level, $levelString, $package, $filename, $line, $msg) = @_;
+
+ my $formattedStr = $instance->format($level, $levelString, $package, $filename, $line, $msg);
+
+ print $formattedStr;
+
+}
+
+sub debug {
+ my ($instance, $msg) = @_;
+ my ($package, $filename, $line) = caller;
+
+ $instance->logMessage(DEBUG, $package, $filename, $line, $msg);
+}
+
+sub warn {
+ my ($instance, $msg) = @_;
+ my ($package, $filename, $line) = caller;
+
+ $instance->logMessage(WARNINGS, $package, $filename, $line, $msg);
+}
+
+sub info {
+ my ($instance, $msg) = @_;
+ my ($package, $filename, $line) = caller;
+
+ $instance->logMessage(INFO, $package, $filename, $line, $msg);
+}
+
+sub error {
+ my ($instance, $msg) = @_;
+ my ($package, $filename, $line) = caller;
+
+
+ $instance->logMessage(ERRORS, $package, $filename, $line, $msg);
+}
+
+sub format {
+ my ($instance, $level, $levelString, $package, $filename, $line, $msg) = @_;
+
+ my $data = {};
+ $data->{'package'} = $package;
+ $data->{'fileline'} = "$filename:$line";
+ $data->{'file'} = $filename;
+ $data->{'line'} = $line;
+ $data->{'msg'} = $msg;
+ $data->{'loglevel'} = $levelString;
+ $data->{"timestamp"} = strftime("%Y-%m-%d %H:%M:%S", localtime);
+
+ my $formattedStr = $instance->{'format'};
+ $formattedStr =~ s{\:(.+?(%\d+|)(?=([^a-zA-Z]|$)))}{ $instance->getDataValue($level, $data, $1) }ge;
+
+ return "$formattedStr\n";
+
+
+}
+
+sub applyColor {
+ my ($level, $field, $val) = @_;
+
+ if ($field eq "loglevel") {
+ if ($level == NONE) {
+ return "$nocolor$val$nocolor";
+ } elsif ($level == ERRORS) {
+ return "$red$val$nocolor";
+ } elsif ($level == WARNINGS) {
+ return "$yellow$val$nocolor";
+ } elsif ($level == INFO) {
+ return "$blue$val$nocolor";
+ } elsif ($level == DEBUG) {
+ return "$magenta$val$nocolor";
+ } else {
+ return "$blue$val$nocolor";
+ }
+ }
+ return $val;
+}
+
+sub applyLength {
+ my ($length, $value) = @_;
+
+ if (( $length eq "" )) {
+ return $value;
+ }
+
+ my $str = "";
+ my $len = int($length);
+ if ($len < length($value)) {
+ $len = length($value);
+ }
+ for my $i (0..$len-1) {
+ my $val = " ";
+ if ($i < length($value)) {
+ $val = substr($value, $i, 1);
+ }
+ $str .= $val;
+ }
+
+ return $str;
+}
+
+sub getDataValue {
+ my ($instance, $level, $data, $fieldStr) = @_;
+
+ my @fieldMatch = $fieldStr =~ /(.+?)(%|$)/g;
+ #print "\n$fieldMatch[2]\n";
+ my @fieldLength = $fieldStr =~ /.+?(%|$)(.+|$)/g;
+ my $length = $fieldLength[1];
+ my $field = $fieldMatch[0];
+ my $value = "";
+
+ if (defined $data->{$field}) {
+ $value = $data->{$field};
+ }
+
+ return applyColor($level, $field, applyLength($length, $value));
+
+}
+
+sub new {
+ my $class = shift;
+
+ $instance ||= bless {
+ 'printType' => JSON,
+ # timestamp [loglevel]
+ 'format' => ":timestamp [:loglevel%5] :package%8 :fileline%10 :msg",
+ }, $class;
+
+ my $passedPrintType = shift;
+ my $passedFormat = shift;
+
+ if (defined $passedPrintType) {
+ $instance->{'printType'} = $passedPrintType;
+ }
+ if (defined $passedFormat) {
+ $instance->{'format'} = $passedFormat;
+ }
+
+ return $instance;
+}
+
+
+1;
blob - 1b6cc6835eb3c2890d4b48fa81634ffdd9fc5ef1 (mode 644)
blob + /dev/null
--- lib/Logger.pm
+++ /dev/null
-package Logger;
-use strict;
-use warnings;
-use POSIX qw(strftime);
-
-my $black = "\033[0;30m";
-my $red = "\033[0;31m";
-my $green = "\033[0;32m";
-my $yellow = "\033[0;33m";
-my $white = "\033[0;37m";
-my $nocolor = "\033[0m";
-my $blue = "\033[94m";
-my $magenta = "\033[35m";
-my $cyan = "\033[36m";
-
-our @EXPORT_OK = qw(
- debug info warn error
-);
-# create debug tag so you can import the debug sub and messages
-# this enables loading lists of exports by tag like so:
-# use IRCNOW::IO qw(:DEBUG :FILEIO);
-our %EXPORT_TAGS = (
- FILEIO=>[qw(readarray readstr writefile appendfile)],
-);
-
-use constant {
- NONE => 0,
- ERRORS => 1,
- WARNINGS => 2,
- INFO => 3,
- DEBUG => 4,
- ALL => 5,
-};
-
-use constant {
- SUGAR => 0,
- JSON => 1,
-};
-
-my $instance = undef;
-
-my $verbose = 5;
-
-sub logMessage {
- my ($instance, $level, $package, $filename, $line, $msg) = @_;
-
- my $levelString;
-
- if ($level == NONE) {
- $levelString = "NONE";
- } elsif ($level == ERRORS) {
- $levelString = "ERROR";
- } elsif ($level == WARNINGS) {
- $levelString = "WARN";
- } elsif ($level == INFO) {
- $levelString = "INFO";
- } elsif ($level == DEBUG) {
- $levelString = "DEBUG";
- } else {
- $levelString = "ALL";
- }
-
- if ($verbose >= $level) { $instance->printLog($level, $levelString, $package, $filename, $line, $msg); }
-}
-
-sub printLog {
- my ($instance, $level, $levelString, $package, $filename, $line, $msg) = @_;
-
- if ($instance->{'printType'} == JSON) {
- $instance->printJSON($level, $levelString, $package, $filename, $line, $msg);
- } elsif ($instance->{'printType'} == SUGAR) {
- $instance->printSugar($level, $levelString, $package, $filename, $line, $msg);
- }
-}
-
-sub printJSON {
- my ($instance, $level, $levelString, $package, $filename, $line, $msg) = @_;
-
- my $content = sprintf "{ \"level\": \"%s\", \"msg\": \"%s\", \"package\": \"%s\", \"file\": \"%s:%s\" }\n", $levelString, $msg, $package, $filename, $line;
-
- print $content;
-}
-
-sub printSugar {
- my ($instance, $level, $levelString, $package, $filename, $line, $msg) = @_;
-
- my $formattedStr = $instance->format($level, $levelString, $package, $filename, $line, $msg);
-
- print $formattedStr;
-
-}
-
-sub debug {
- my ($instance, $msg) = @_;
- my ($package, $filename, $line) = caller;
-
- $instance->logMessage(DEBUG, $package, $filename, $line, $msg);
-}
-
-sub warn {
- my ($instance, $msg) = @_;
- my ($package, $filename, $line) = caller;
-
- $instance->logMessage(WARNINGS, $package, $filename, $line, $msg);
-}
-
-sub info {
- my ($instance, $msg) = @_;
- my ($package, $filename, $line) = caller;
-
- $instance->logMessage(INFO, $package, $filename, $line, $msg);
-}
-
-sub error {
- my ($instance, $msg) = @_;
- my ($package, $filename, $line) = caller;
-
-
- $instance->logMessage(ERRORS, $package, $filename, $line, $msg);
-}
-
-sub format {
- my ($instance, $level, $levelString, $package, $filename, $line, $msg) = @_;
-
- my $data = {};
- $data->{'package'} = $package;
- $data->{'fileline'} = "$filename:$line";
- $data->{'file'} = $filename;
- $data->{'line'} = $line;
- $data->{'msg'} = $msg;
- $data->{'loglevel'} = $levelString;
- $data->{"timestamp"} = strftime("%Y-%m-%d %H:%M:%S", localtime);
-
- my $formattedStr = $instance->{'format'};
- $formattedStr =~ s{\:(.+?(%\d+|)(?=([^a-zA-Z]|$)))}{ $instance->getDataValue($level, $data, $1) }ge;
-
- return "$formattedStr\n";
-
-
-}
-
-sub applyColor {
- my ($level, $field, $val) = @_;
-
- if ($field eq "loglevel") {
- if ($level == NONE) {
- return "$nocolor$val$nocolor";
- } elsif ($level == ERRORS) {
- return "$red$val$nocolor";
- } elsif ($level == WARNINGS) {
- return "$yellow$val$nocolor";
- } elsif ($level == INFO) {
- return "$blue$val$nocolor";
- } elsif ($level == DEBUG) {
- return "$magenta$val$nocolor";
- } else {
- return "$blue$val$nocolor";
- }
- }
- return $val;
-}
-
-sub applyLength {
- my ($length, $value) = @_;
-
- if (( $length eq "" )) {
- return $value;
- }
-
- my $str = "";
- my $len = int($length);
- if ($len < length($value)) {
- $len = length($value);
- }
- for my $i (0..$len-1) {
- my $val = " ";
- if ($i < length($value)) {
- $val = substr($value, $i, 1);
- }
- $str .= $val;
- }
-
- return $str;
-}
-
-sub getDataValue {
- my ($instance, $level, $data, $fieldStr) = @_;
-
- my @fieldMatch = $fieldStr =~ /(.+?)(%|$)/g;
- #print "\n$fieldMatch[2]\n";
- my @fieldLength = $fieldStr =~ /.+?(%|$)(.+|$)/g;
- my $length = $fieldLength[1];
- my $field = $fieldMatch[0];
- my $value = "";
-
- if (defined $data->{$field}) {
- $value = $data->{$field};
- }
-
- return applyColor($level, $field, applyLength($length, $value));
-
-}
-
-sub new {
- my $class = shift;
-
- $instance ||= bless {
- 'printType' => JSON,
- # timestamp [loglevel]
- 'format' => ":timestamp [:loglevel%5] :package%8 :fileline%10 :msg",
- }, $class;
-
- my $passedPrintType = shift;
- my $passedFormat = shift;
-
- if (defined $passedPrintType) {
- $instance->{'printType'} = $passedPrintType;
- }
- if (defined $passedFormat) {
- $instance->{'format'} = $passedFormat;
- }
-
- return $instance;
-}
-
-
-1;
