#    $Id: Trivial.pm,v 1.17 2007-09-01 17:43:00 adam Exp $

package Log::Trivial;

use 5.006;
use strict;
use warnings;
use Fcntl qw(:DEFAULT :flock :seek);
use Carp;

our $VERSION = '0.31';

#
#    NEW
#

sub new {
    my $class  = shift;
    my %args   = @_;
    my $object = bless {
        _file => $args{log_file} || q{},           # The Log File
        _mode   => 1,     # File logging mode 1=multi thread, 0=single
        _handle => undef, # File Handle if in single mode
        _level         => $args{log_level} || '3', # Logging level
        _error_message => q{},                     # Store error messages here
        _debug         => undef,                   # debug flag
        _o_sync => 1,    # Use POSIX O_SYNC for writing, 1=on (default), 0=off
        _log_tag => $args{log_tag}
            || q{},      # Variable to tag this instance in the log file
    }, $class;

    return $object;
}

sub set_log_file {
    my $self     = shift;
    my $log_file = shift;
    if ( $self->_check_file($log_file) ) {
        $self->{_file} = $log_file;
        $self->{_self} = 0;
        return $self;
    }
    else {
        return;
    }
}

sub set_log_mode {
    my $self = shift;
    my $mode = shift;

    if ( $mode =~ /m/imx ) {
        $self->{_mode} = 1;
    }
    else {
        $self->{_mode} = 0;
    }

    return $self;
}

sub set_log_level {
    my $self  = shift;
    my $level = shift;

    $self->{_level} = $level if defined $level;

    return $self;
}

sub set_write_mode {
    my $self = shift;
    my $mode = shift;

    if ( $mode =~ /s/imx ) {
        $self->{_o_sync} = 1;
    }
    else {
        $self->{_o_sync} = 0;
    }
    return $self;
}

sub write {
    my $self = shift;
    my $message;
    if ( @_ > 1 ) {
        my %args  = @_;
        my $level = $args{level};
        return if $level && $self->{_level} < $level;
        $message = $args{comment} || q{.};
    }
    else {
        $message = shift;
    }

    return $self->_raise_error('Nothing message sent to log')
        unless $message;

    if ( $self->{_log_tag} ) {
        $message = localtime() . "\t" . $self->{_log_tag} . "\t" . $message;
    }
    else {
        $message = localtime() . "\t" . $message;
    }
    my $file = $self->{_file};
    return $self->_raise_error('No Log file specified yet') unless $file;

    if ( -e $file && !-w _ ) {
        return $self->_raise_error(
            "Insufficient permissions to write to: $file");
    }

    if ( $self->{_mode} ) {
        my $log = $self->_open_log_file($file);
        $self->_write_log( $log, $message );
        close $log;
    }
    else {
        if ( !$self->{_handle} ) {
            $self->{_handle} = $self->_open_log_file($file);
        }
        $self->_write_log( $self->{_handle}, $message );
    }
    return $message;
}

sub get_error {
    my $self = shift;
    return $self->{_error_message};
}

#
#    Private Stuff
#

sub _check_file {
    my $self = shift;
    my $file = shift;
    return $self->_raise_error('File error: No file name supplied')
        unless $file;
    return $self;
}

sub _open_log_file {
    my $self = shift;
    my $file = shift;
    my $log;

    if ( $self->{_o_sync} ) {
        sysopen $log, $file, O_WRONLY | O_CREAT | O_SYNC | O_APPEND
            or return $self->_raise_error("Unable to open Log File: $file");
    }
    else {
        sysopen $log, $file, O_WRONLY | O_CREAT | O_APPEND
            or return $self->_raise_error("Unable to open Log File: $file");
    }
    flock $log, LOCK_EX;
    return $log;

}

sub _write_log {
    my $self   = shift;
    my $handle = shift;
    my $string = shift() . "\n";

    my $bytes = length $string;
    sysseek $handle, 0, SEEK_END;
    syswrite $handle, $string, $bytes;
    return $self->_raise_error('Write Error') unless $bytes == length $string;
    return $bytes;
}

sub _raise_error {
    my $self    = shift;
    my $message = shift;
    carp $message if $self->{_debug};    # DEBUG:  warn with the message
    $self->{_error_message} = $message;  # NORMAL: set the message
    return;
}

1;

__END__


=head1 NAME

Log::Trivial - Very simple tool for writing very simple log files

=head1 SYNOPSIS

  use Log::Trivial;
  my $logger = Log::Trivial->new(log_file => "path/to/my/file.log");
  $logger->set_level(3);
  $logger->write(comment => "foo");

=head1 DESCRIPTION

Use this module when you want use "Yet Another" very simple, light
weight log file writer.

=head1 SUBROUTINES/METHODS

=head2 new

The constructor can be called empty or with a number of optional
parameters.

  $logger = Log::Trivial->new();

or

  $logger = Log::Trivial->new(
    log_file  => "/my/config/file",
    log_tag   => $$,
    log_level => "2");

The log_tag is an optional string that is written to every log event
between the date at the comment, and is intended to help separate logging
events in environments when multiple applictions are simultaneously
writing to the same log file. For example you could pass the PID of
the applications, as shown in the example above.

=head2 set_log_file

The log file can be set after the constructor has been called.
Simply set the path to the file you want to use as the log file.

  $logger->set_log_file("/path/to/log.file");

=head2 set_log_mode

Log::Trivial runs in two modes. The default mode is Multi mode: in
this mode the file will be opened and closed for each log file write.
This may be slower but allows multiple applications to write to the log
file at the same time. The alternative mode is called single mode:
once you start to write to the log no other application honouring
flock will write to the log. Single mode is potentially faster, and
may be appropriate if you know that only one copy of your application
can should be writing to the log at any given point in time.

WARNING: Not all system honour flock.

  $logger->set_log_mode("multi");    # Sets multi mode (the default)

or

  $logger->set_log_mode("single");    # Sets single mode

=head2 set_log_level

Log::Trivial uses very simple arbitrary logging level logic. Level 0
is the highest priority log level, the lowest is the largest number
possible in Perl on your platform. You set the global log level for
your application using this function, and only log events of this
level or higher priority will be logged. The default level is 3.

  $logger->set_log_level(4);

=head2 set_write_mode

Log::Trivial write log enteries using the POSIX synchronous mode
by default. This mode ensures that the data has actually been
written to the disk. This feature is not supported in all
operating systems and will slow down the disk write. By default
this mode is enabled, in future it may be disabled by default.

  $logger->set_write_mode('s');     # sets synchronous (default)
  $logger->set_write_mode('a');     # sets asynchronous

=head2 write

Write a log file entry.

  $logger->write(
    comment => "My comment to be logged",
    level   => 3);

or

  $logger->write("My comment to be logged");

It will fail if the log file hasn't be defined, or isn't
writable. It will return the string written on success.

If you don't specify a log level, it will default to the current
log level and therefore log the event. Therefore if you always
wish to log something either specify a level of 0 or never
specify a log level.

Log file entries are time stamped and have a newline carriage
return added automatically.

=head2 get_error

In normal operation the module should never die. All errors are
non-fatal. If an error occurs it will be stored internally within
the object and the method will return undef. The error can be read
with the get_error method. Only the most recent error is stored.

  $logger->write("Log this") || print $logger->get_error;

=head1 LOG FORMAT

The log file format is very simple and fixed:

Time & date [tab] Your log comment [carriage return new line]

If you have enabled a log_tag then the log format will have an extra
element inserted in it.

Time & date [tab] log_tag [tab] Your log comment [carriage return new line]

=head2 DEPENDENCIES

At the moment the module only uses core modules. The test suite optionally uses
C<Pod::Coverage>, C<Test::Pod::Coverage> and C<Test::Pod>, which will be skipped
if you don't have them.

=head2 History

See Changes file.

=head1 BUGS AND LIMITATIONS

By default log write are POSIX synchronous, it is very unlikely that it will run
on any OS that does not support POSIX synchronous file writing, this means it
probably won't run on a VAX, Windows or other antique system. It does run under
Windows/Cygwin. To use non-POSIX systems you need to turn off synchronous write.

Patches Welcome... ;-)

=head2 To Do

=over

=item *

Much better test suite.

=item *

See if it's possible to work on non-POSIX like systems automatically

=back

=head1 EXPORT

None.

=head1 AUTHOR

Adam Trickett, E<lt>atrickett@cpan.orgE<gt>

=head1 SEE ALSO

L<perl>, L<Log::Agent>, L<Log::Log4perl>, L<Log::Dispatch>, L<Log::Simple>

=head1 LICENSE AND COPYRIGHT

C<Log::Trivial>, Copyright iredale consulting 2005-2007

OSI Certified Open Source Software.
Free Software Foundation Free Software.

This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>.

=cut
