liblog-loglite-perl-0.82/0040755000175000017500000000000007604541310013446 5ustar rcprcpliblog-loglite-perl-0.82/MANIFEST0100644000175000017500000000010507240763300014571 0ustar rcprcpChanges LogLite.pm NullLogLite.pm Makefile.PL MANIFEST test.pl READMEliblog-loglite-perl-0.82/LogLite.pm0100644000175000017500000002054207544054463015356 0ustar rcprcppackage Log::LogLite; use strict; use vars qw($VERSION); $VERSION = 0.82; use Carp; use IO::LockedFile 0.21; my $TEMPLATE = '[] <> '; my $LOG_LINE_NUMBERS = 0; # by default we do not log the line numbers ########################################## # new($filepath) # new($filepath,$level) # new($filepath,$level,$default_message) ########################################## # the constructor sub new { my $proto = shift; # get the class name my $class = ref($proto) || $proto; my $self = {}; # private data $self->{FILE_PATH} = shift; # get the file path of the config file $self->{LEVEL} = shift || 5; # the default level is 5 # report when: # 0 the application is unusable # 1 the application is going to be unusable # 2 critical conditions # 3 error conditions # 4 warning conditions # 5 normal but significant condition # 6 informational # 7+ debug-level messages $self->{DEFAULT_MESSAGE} = shift || ""; # the default message $self->{TEMPLATE} = shift || $TEMPLATE; # the template $self->{LOG_LINE_NUMBERS} = $LOG_LINE_NUMBERS; # we create IO::LockedFile object that can be locked later $self->{FH} = new IO::LockedFile({ lock => 0 }, ">>".$self->{FILE_PATH}); unless ($self->{FH}->opened) { croak("Log::LogLite: Cannot open the log file $self->{FILE_PATH}"); } bless ($self, $class); return $self; } # of new ########################## # write($message, $level) ########################## # will log the message in the log file only if $level>=LEVEL sub write { my $self = shift; my $message = shift; # get the message are informational my $level = shift || "-"; if ($level ne "-" && $level > $self->{LEVEL}) { # if the level of this message is higher # then the deafult level - do nothing return; } # lock the log file before we append $self->{FH}->lock(); # parse the template my $line = $self->{TEMPLATE}; $line =~ s!!date_string()!igoe; $line =~ s!!$level!igo; $line =~ s!!$self->called_by()!igoe; $line =~ s!!$self->{DEFAULT_MESSAGE}!igo; $line =~ s!!$message!igo; print {$self->{FH}} $line; # unlock the file $self->{FH}->unlock(); } # of write ########################## # template() # template($template) ########################## sub template { my $self = shift; if (@_) { $self->{TEMPLATE} = shift } return $self->{TEMPLATE}; } # of template ########################## # level() # level($level) ########################## # an interface to LEVEL sub level { my $self = shift; if (@_) { $self->{LEVEL} = shift } return $self->{LEVEL}; } # of level ########################### # default_message() # default_message($message) ########################### # an interface to DEFAULT_MESSAGE sub default_message { my $self = shift; if (@_) { $self->{DEFAULT_MESSAGE} = shift } return $self->{DEFAULT_MESSAGE}; } # of default_message ########################## # log_line_numbers() # log_line_numbers($log_line_numbers) ########################## # an interface to LOG_LINE_NUMBERS sub log_line_numbers { my $self = shift; if (@_) { $self->{LOG_LINE_NUMBERS} = shift } return $self->{LOG_LINE_NUMBERS}; } # of log_line_numbers ####################### # date_string() ####################### sub date_string { my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); # note that there is no Y2K bug here. see localtime in perlfunc. return sprintf("%02d/%02d/%04d %02d:%02d:%02d", $mday, $mon + 1, $year + 1900, $hour, $min, $sec); } # of date_string ####################### # called_by ####################### sub called_by { my $self = shift; my $depth = 2; my $args; my $pack; my $file; my $line; my $subr; my $has_args; my $wantarray; my $evaltext; my $is_require; my $hints; my $bitmask; my @subr; my $str = ""; while (1) { ($pack, $file, $line, $subr, $has_args, $wantarray, $evaltext, $is_require, $hints, $bitmask) = caller($depth); unless (defined($subr)) { last; } $depth++; $line = ($self->{LOG_LINE_NUMBERS}) ? "$file:".$line."-->" : ""; push(@subr, $line.$subr); } @subr = reverse(@subr); foreach $subr (@subr) { $str .= $subr; $str .= " > "; } $str =~ s/ > $/: /; return $str; } # of called_by 1; __END__ ############################################################################ =head1 NAME Log::LogLite - The C class helps us create simple logs for our application. =head1 SYNOPSIS use Log::LogLite; my $LOG_DIRECTORY = "/where/ever/our/log/file/should/be"; my $ERROR_LOG_LEVEL = 6; # create new Log::LogLite object my $log = new Log::LogLite($LOG_DIRECTORY."/error.log", $ERROR_LOG_LEVEL); ... # we had an error $log->write("Could not open the file ".$file_name.": $!", 4); =head1 DESCRIPTION In order to have a log we have first to create a C object. The c object is created with a logging level. The default logging level is 5. After the C object is created, each call to the C method may write a new line in the log file. If the level of the message is lower or equal to the logging level, the message will be written to the log file. The format of the logging messages can be controled by changing the template, and by defining a default message. The class uses the IO::LockedFile class. =head1 CONSTRUCTOR =over 4 =item new ( FILEPATH [,LEVEL [,DEFAULT_MESSAGE ]] ) The constructor. FILEPATH is the path of the log file. LEVEL is the defined logging level - the LEVEL data member. DEFAULT_MESSAGE will define the DEFAULT_MESSAGE data member - a message that will be added to the message of each entry in the log (according to the TEMPLATE data member, see below). The levels can be any levels that the user chooses to use. There are, though, recommended levels: 0 the application is unusable 1 the application is going to be unusable 2 critical conditions 3 error conditions 4 warning conditions 5 normal but significant condition 6 informational 7+ debug-level messages The default value of LEVEL is 5. The default value of DEFAULT_MESSAGE is "". Returns the new object. =back =head1 METHODS =over 4 =item write( MESSAGE [, LEVEL ] ) If LEVEL is less or equal to the LEVEL data member, or if LEVEL is undefined, the string in MESSAGE will be written to the log file. Does not return anything. =item level( [ LEVEL ] ) Access method to the LEVEL data member. If LEVEL is defined, the LEVEL data member will get its value. Returns the value of the LEVEL data member. =item default_message( [ MESSAGE ] ) Access method to the DEFAULT_MESSAGE data member. If MESSAGE is defined, the DEFAULT_MESSAGE data member will get its value. Returns the value of the DEFAULT_MESSAGE data member. =item log_line_numbers( [ BOOLEAN ] ) If this flag is set to true, the string will hold the file that calls the subroutine and the line where the call is issued. The default value is zero. =item template( [ TEMPLATE ] ) Access method to the TEMPLATE data member. The TEMPLATE data member is a string that defines how the log entries will look like. The default TEMPLATE is: '[] <> ' Where: will be replaced by a string that represent the date. For example: 09/01/2000 17:00:13 will be replaced by the level of the entry. will be replaced by a call trace string. For example: CGIDaemon::listen > MyCGIDaemon::accepted will be replaced by the value of the DEFAULT_MESSAGE data member. will be replaced by the message string that is sent to the C method. Returns the value of the TEMPLATE data member. =head1 AUTHOR Rani Pinchuk, rani@cpan.org =head1 COPYRIGHT Copyright (c) 2001-2002 Ockham Technology N.V. & Rani Pinchuk. All rights reserved. This package is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L =cut liblog-loglite-perl-0.82/test.pl0100644000175000017500000000474707240764762015011 0ustar rcprcp# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' BEGIN { $| = 1; print "1..6\n"; } END {print "not ok 1\n" unless $loaded;} use Log::LogLite; use Log::NullLogLite; $loaded = 1; print "ok 1\n"; # create a log file with default level 5 my $log = new Log::LogLite("test.log"); $log->write("message number 1"); # should be in the log $log->write("message number 2", 4); # should be in the log $log->write("message number 3", 5); # should be in the log $log->write("message number 4", 6); # should not be in the log $log = undef; # close the log # read the log file and check it. open(LOG, "test.log"); my @lines = ; close(LOG); if ($lines[0] =~ /\[[^\]]+\] <\-> message number 1/ && $lines[1] =~ /\[[^\]]+\] <4> message number 2/ && $lines[2] =~ /\[[^\]]+\] <5> message number 3/) { print "ok 2\n"; } else { print "not ok 2\n"; } # remove the log file unlink("test.log"); # create a new log with 6 as default level $log = new Log::LogLite("test.log", 6); $log->write("message number 5", 6); # should be in the log $log->write("message number 6", 7); # should not be in the log $log = undef; # close the log # read the log file and check it open(LOG, "test.log"); @lines = ; close(LOG); if ($lines[0] =~ /\[[^\]]+\] <6> message number 5/) { print "ok 3\n"; } else { print "not ok 3\n"; } # remove the log file unlink("test.log"); # create a new log $log = new Log::LogLite("test.log"); # change the default message $log->default_message("message "); $log->write("number 7"); # should be in the log $log = undef; # close the log # read the log file and check it open(LOG, "test.log"); @lines = ; close(LOG); if ($lines[0] =~ /\[[^\]]+\] <\-> message number 7/) { print "ok 4\n"; } else { print "not ok 4\n"; } # remove the log file unlink("test.log"); # create a new log $log = new Log::LogLite("test.log"); # change the template $log->template(":[]: \n"); $log->write("message number 8"); # should be in the log $log = undef; # close the log # read the log file and check it open(LOG, "test.log"); @lines = ; close(LOG); if ($lines[0] =~ /\-:\[[^\]]+\]: message number 8/) { print "ok 5\n"; } else { print "not ok 5\n"; } # remove the log file unlink("test.log"); # create a null log $log = new Log::NullLogLite(); $log->write("this message will never be written"); print "ok 6\n"; # if we are here, it must be ok. liblog-loglite-perl-0.82/Changes0100644000175000017500000000170407544054604014750 0ustar rcprcpRevision history for Perl extension Log::LogLite. 0.82 Tue Sep 24 14:23:49 CEST 2002 - Just fixed the copyright notice 0.81 Thu Jan 31 13:16:52 CET 2002 - Fixed that the log file will not be opened already locked. Thanks to Tilman Mueller-Gerbes! 0.8 Thu Jan 3 14:57:22 CET 2002 - For the new year, I got lucky, and found out the obvious: there is a function called "caller" build in Perl. So no more use of the annoying Devel::CallerItem! Besides, I upgraded the VERSION number to 0.8, because we use this class for quite a time now, and had no problems. 0.3 Mon Jul 2 21:30:35 CEST 2001 - OK, now it is written correctly - the log file is opened when we construct the object. It is locked everytime we write into it, and it is closed in the destructor. Thanks Rob Napier for guiding me to do it that way. 0.2 Fri Feb 9 15:21:28 CET 2001 - first distribution on CPAN liblog-loglite-perl-0.82/NullLogLite.pm0100644000175000017500000000675407544054510016213 0ustar rcprcppackage Log::NullLogLite; use strict; use vars qw($VERSION @ISA); $VERSION = 0.82; # According to the Null pattern. # # Log::NullLogLite inherits from Log::LogLite and implement the Null # Object Pattern. use Log::LogLite; @ISA = ("Log::LogLite"); package Log::NullLogLite; use strict; ########################################## # new($filepath) # new($filepath,$level) # new($filepath,$level,$default_message) ########################################## # the constructor sub new { my $proto = shift; # get the class name my $class = ref($proto) || $proto; my $self = {}; bless ($self, $class); return $self; } # of new ######################## # write($message, $level) ######################## # will log the message in the log file only if $level>=LEVEL sub write { my $self = shift; } # of write ########################## # level() # level($level) ########################## # an interface to LEVEL sub level { my $self = shift; return -1; } # of level ########################### # default_message() # default_message($message) ########################### # an interface to DEFAULT_MESSAGE sub default_message { my $self = shift; return ""; } # of default_message 1; __END__ ############################################################################ =head1 NAME Log::NullLogLite - The C class implements the Null Object pattern for the C class. =head1 SYNOPSIS use Log::NullLogLite; # create new Log::NullLogLite object my $log = new Log::NullLogLite(); ... # we had an error (this entry will not be written to the log # file because we use Log::NullLogLite object). $log->write("Could not open the file ".$file_name.": $!", 4); =head1 DESCRIPTION The C class is derived from the C class and implement the Null Object Pattern to let us to use the C class with B C objects. We might want to do that if we use a C object in our code, and we do not want always to actually define a C object (i.e. not always we want to write to a log file). In such a case we will create a C object instead of the C object, and will use that object instead. The object has all the methods that the C object has, but those methods do nothing. Thus our code will continue to run without any change, yet we will not have to define a log file path for the C object, and no log will be created. =head1 CONSTRUCTOR =over 4 =item new ( FILEPATH [,LEVEL [,DEFAULT_MESSAGE ]] ) The constructor. The parameters will not have any affect. Returns the new Log::NullLogLite object. =back =head1 METHODS =over 4 =item write( MESSAGE [, LEVEL ] ) Does nothing. The parameters will not have any affect. Returns nothing. =item level( [ LEVEL ] ) Does nothing. The parameters will not have any affect. Returns -1. =item default_message( [ MESSAGE ] ) Does nothing. The parameters will not have any affect. Returns empty string (""). =head1 AUTHOR Rani Pinchuk, rani@cpan.org =head1 COPYRIGHT Copyright (c) 2001-2002 Ockham Technology N.V. & Rani Pinchuk. All rights reserved. This package is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L, The Null Object Pattern - Bobby Woolf - PLoP96 - published in Pattern Languages of Program Design 3 (http://cseng.aw.com/book/0,,0201310112,00.html) =cut liblog-loglite-perl-0.82/README0100644000175000017500000000435507544054467014351 0ustar rcprcp Log::LogLite Log::NullLogLite Copyright (c) 2001-2002 Ockham Technology N.V. & Rani Pinchuk. All rights reserved. This package is free software; you can redistribute it and/or modify it under the same terms as Perl itself. DESCRIPTION The Log::LogLite class helps us create simple logs for our application. The Lite suffix refers mainly to the ease of use of this class, although the class is quite simple anyway. Example for the use of the class: use Log::LogLite; my $LOG_DIRECTORY = "/where/ever/our/log/file/should/be"; my $ERROR_LOG_LEVEL = 6; # create new Log::LogLite object my $log = new Log::LogLite($LOG_DIRECTORY."/error.log", $ERROR_LOG_LEVEL); ... # we had an error $log->write("Could not open the file ".$file_name.": $!", 4); The line that is added to the log file might look like: [09/02/2001 13:02:07] <4> Could not open the file bla: no such file The Log::NullLogLiteThe class is derived from the `Log::LogLite' class and implement the Null Object pattern to let us to use the `Log::LogLite' class with null `Log::LogLite' objects. We might want to do that if we use a `Log::LogLite' object in our code, and we do not want always to actually define a `Log::LogLite' object (i.e. not always we want to write to a log file). In such a case we will create a `Log::NullLogLite' object instead of the `Log::LogLite' object, and will use that object instead. The object has all the methods that the `Log::LogLite' object has, but those methods do nothing. Thus our code will continue to run without any change, yet we will not have to define a log file path for the `Log::LogLite' object, and no log will be created. PREREQUISITES IO::LockedFile INSTALLATION Follow the standard installation procedure for Perl modules, which is to type the following commands: perl Makefile.PL make make test make install You'll probably need to do the last as root. AUTHOR NOTES Thess classes are used for quite a long time in our company. Yet, it is very new in CPAN. If there are problems, suggestions or comments - please email me. Rani Pinchuk rani@cpan.org liblog-loglite-perl-0.82/Makefile.PL0100644000175000017500000000043507415061770015426 0ustar rcprcpuse ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => 'Log::LogLite', 'VERSION_FROM' => 'LogLite.pm', # finds $VERSION 'PREREQ_PM' => { IO::LockedFile => 0.2 }, );