r35303 - in /branches/upstream/liblog-loglite-perl: ./ current/ current/Changes current/LogLite.pm current/MANIFEST current/Makefile.PL current/NullLogLite.pm current/README current/test.pl
ryan52-guest at users.alioth.debian.org
ryan52-guest at users.alioth.debian.org
Wed May 13 06:20:27 UTC 2009
Author: ryan52-guest
Date: Wed May 13 06:20:21 2009
New Revision: 35303
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=35303
Log:
[svn-inject] Installing original source of liblog-loglite-perl
Added:
branches/upstream/liblog-loglite-perl/
branches/upstream/liblog-loglite-perl/current/
branches/upstream/liblog-loglite-perl/current/Changes
branches/upstream/liblog-loglite-perl/current/LogLite.pm
branches/upstream/liblog-loglite-perl/current/MANIFEST
branches/upstream/liblog-loglite-perl/current/Makefile.PL
branches/upstream/liblog-loglite-perl/current/NullLogLite.pm
branches/upstream/liblog-loglite-perl/current/README
branches/upstream/liblog-loglite-perl/current/test.pl
Added: branches/upstream/liblog-loglite-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblog-loglite-perl/current/Changes?rev=35303&op=file
==============================================================================
--- branches/upstream/liblog-loglite-perl/current/Changes (added)
+++ branches/upstream/liblog-loglite-perl/current/Changes Wed May 13 06:20:21 2009
@@ -1,0 +1,24 @@
+Revision 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
Added: branches/upstream/liblog-loglite-perl/current/LogLite.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblog-loglite-perl/current/LogLite.pm?rev=35303&op=file
==============================================================================
--- branches/upstream/liblog-loglite-perl/current/LogLite.pm (added)
+++ branches/upstream/liblog-loglite-perl/current/LogLite.pm Wed May 13 06:20:21 2009
@@ -1,0 +1,297 @@
+package Log::LogLite;
+
+use strict;
+use vars qw($VERSION);
+
+$VERSION = 0.82;
+
+use Carp;
+use IO::LockedFile 0.21;
+
+my $TEMPLATE = '[<date>] <<level>> <called_by><default_message><message>
+';
+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>!date_string()!igoe;
+ $line =~ s!<level>!$level!igo;
+ $line =~ s!<called_by>!$self->called_by()!igoe;
+ $line =~ s!<default_message>!$self->{DEFAULT_MESSAGE}!igo;
+ $line =~ s!<message>!$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<Log::LogLite> 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<Log::LogLite> object.
+The c<Log::LogLite> object is created with a logging level. The default
+logging level is 5. After the C<Log::LogLite> object is created, each call
+to the C<write> 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 <called_by> 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:
+
+'[<date>] <<level>> <called_by><default_message><message>'
+
+Where:
+
+ <date> will be replaced by a string that represent
+ the date. For example: 09/01/2000 17:00:13
+ <level> will be replaced by the level of the entry.
+ <called_by> will be replaced by a call trace string. For
+ example:
+ CGIDaemon::listen > MyCGIDaemon::accepted
+ <default_message> will be replaced by the value of the
+ DEFAULT_MESSAGE data member.
+ <message> will be replaced by the message string that
+ is sent to the C<write> method.
+
+Returns the value of the TEMPLATE data member.
+
+=head1 AUTHOR
+
+Rani Pinchuk, rani at 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<IO::LockedFile(3)>
+
+=cut
Added: branches/upstream/liblog-loglite-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblog-loglite-perl/current/MANIFEST?rev=35303&op=file
==============================================================================
--- branches/upstream/liblog-loglite-perl/current/MANIFEST (added)
+++ branches/upstream/liblog-loglite-perl/current/MANIFEST Wed May 13 06:20:21 2009
@@ -1,0 +1,7 @@
+Changes
+LogLite.pm
+NullLogLite.pm
+Makefile.PL
+MANIFEST
+test.pl
+README
Added: branches/upstream/liblog-loglite-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblog-loglite-perl/current/Makefile.PL?rev=35303&op=file
==============================================================================
--- branches/upstream/liblog-loglite-perl/current/Makefile.PL (added)
+++ branches/upstream/liblog-loglite-perl/current/Makefile.PL Wed May 13 06:20:21 2009
@@ -1,0 +1,9 @@
+use 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 },
+);
Added: branches/upstream/liblog-loglite-perl/current/NullLogLite.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblog-loglite-perl/current/NullLogLite.pm?rev=35303&op=file
==============================================================================
--- branches/upstream/liblog-loglite-perl/current/NullLogLite.pm (added)
+++ branches/upstream/liblog-loglite-perl/current/NullLogLite.pm Wed May 13 06:20:21 2009
@@ -1,0 +1,145 @@
+package 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;
+ at 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<Log::NullLogLite> class implements the Null Object
+pattern for the C<Log::LogLite> 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<Log::NullLogLite> class is derived from the C<Log::LogLite> class
+and implement the Null Object Pattern to let us to use the C<Log::LogLite>
+class with B<null> C<Log::LogLite> objects.
+We might want to do that if we use a C<Log::LogLite> object in our code, and
+we do not want always to actually define a C<Log::LogLite> object (i.e. not
+always we want to write to a log file). In such a case we will create a
+C<Log::NullLogLite> object instead of the C<Log::LogLite> object, and will
+use that object instead.
+The object has all the methods that the C<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
+C<Log::LogLite> 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 at 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<Log::LogLite(3)>,
+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
Added: branches/upstream/liblog-loglite-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblog-loglite-perl/current/README?rev=35303&op=file
==============================================================================
--- branches/upstream/liblog-loglite-perl/current/README (added)
+++ branches/upstream/liblog-loglite-perl/current/README Wed May 13 06:20:21 2009
@@ -1,0 +1,72 @@
+ 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 at cpan.org
+
+
+
+
Added: branches/upstream/liblog-loglite-perl/current/test.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblog-loglite-perl/current/test.pl?rev=35303&op=file
==============================================================================
--- branches/upstream/liblog-loglite-perl/current/test.pl (added)
+++ branches/upstream/liblog-loglite-perl/current/test.pl Wed May 13 06:20:21 2009
@@ -1,0 +1,114 @@
+# 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 = <LOG>;
+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");
+ at lines = <LOG>;
+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");
+ at lines = <LOG>;
+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("<level>:[<date>]: <default_message><message>\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");
+ at lines = <LOG>;
+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.
+
+
+
More information about the Pkg-perl-cvs-commits
mailing list