# Copyright 2002-2008 Josh Clark and Global Moxie, LLC. This code cannot be
# redistributed without permission from globalmoxie.com.  For more
# information, consult your Big Medium license.
#
# $Id: Log.pm 3162 2008-07-07 11:37:41Z josh $

package BigMed::Log;
use strict;
use warnings;
use utf8;
use Carp;
our @EXPORT = qw(log add_log log_data_tag);
use base qw(Exporter);
use Log::Dispatch;
use Log::Dispatch::File;
use UNIVERSAL::require;
use Class::ISA;
use BigMed::DiskUtil qw(bm_file_path  bm_confirm_dir bm_write_file
  bm_file_chmod bm_datafile_chmod bm_move_file bm_delete_file);
use BigMed::Error;

my $ROOT_LOG;
my %CLASS_LOG;
my %REGISTERED_OUTPUTS = ( '__ROOT' => [] );

#log rotation constants
my $MAX_SIZE    = 1 * 1_048_576;    #1 meg
my $MAX_ARCHIVE = 3;                #3 backup logs

my %LEVEL = (
    emergency => 1,
    alert     => 1,
    critical  => 1,
    error     => 1,
    warning   => 1,
    notice    => 1,
    info      => 1,
    debug     => 1,
);

# EXPORTED ROUTINES -----------------------------

sub log {
    my $self = shift;
    my ( $level, $message ) = @_;
    carp "Unrecognized log level $level" if !$LEVEL{$level};
    return                               if !$message;

    my $class = ref $self || $self;
    foreach my $log ( _find_logs($class) ) {
        $log->{_dispatch}->log( level => $level, message => $message )
        if $log->{_dispatch};
    }
    return;
}

sub add_log {
    my $self    = shift;
    my $class   = ref $self || $self;
    my %param   = @_;
    my @outputs =
        ref $param{outputs} eq 'ARRAY' ? @{ $param{outputs} }
      : ref $param{outputs} eq 'HASH'  ? ( $param{outputs} )
      : croak 'add_log requires outputs parameter with one or more hash refs';

    if ($ROOT_LOG) {    #exists, go ahead and add them now
        my $log =
          $param{limit_to_class}
          ? ( $CLASS_LOG{$class} ||= BigMed::Log->new() )
          : $ROOT_LOG;
        $log->_update_dispatcher(@outputs);
    }
    else {              #hold til the log is called up; best to wait as long
                        #as possible to create root log so that bigmed has
                        #time to instantiate if possible
        my $key = $param{limit_to_class} ? $class : '__ROOT';
        push @{ $REGISTERED_OUTPUTS{$key} }, @outputs;
    }
    return;

}

sub log_data_tag {
    my $self  = shift;
    my $obj   = shift;
    my $class = ref $obj or return '';
    my $title =
      $obj->can('name') ? $obj->name : $obj->can('title') ? $obj->title : '';
    $title ||= 'untitled item';
    my $site = $class->systemwide ? '' : ';site:' . ( $obj->site || 'no-id' );
    return qq|"$title"{$class | . ($obj->id || 'no-id' ) . "$site}";
}

# AVAILABLE VIA BigMed::Log CLASS/OBJECT METHOD ---

sub logdir {
    my $root_log = _root_log();
    return $root_log->{_logdir};
}

sub webdir {
    my $root_log = _root_log();
    return $root_log->{_webdir};
}

sub rotate_logs {
    my $self = shift;
    my ( $max_size, $max_archive ) = @_;
    $max_size    ||= $MAX_SIZE;
    $max_archive ||= $MAX_ARCHIVE;
    my $root_log = _root_log();
    my $err;
    foreach my $dir ( $root_log->{_logdir}, $root_log->{_webdir} ) {
        next if !$dir;
        my ( $DIR, $file );
        if ( !opendir( $DIR, $dir ) ) {
            my $err = "Log: Error trying to rotate logs in $dir: $!";
            BigMed::Log->log( error => $err );
            carp $err;
            next;
        }
        my @to_rotate;
        while ( defined( $file = readdir $DIR ) ) {

            #ignore dot files and archive files
            next if $file =~ /^[.]/ms || $file =~ /[.]\d+$/ms;
            my $path = bm_file_path( $dir, $file );
            push @to_rotate, $path if -s $path > $max_size;
        }
        closedir $DIR;
        foreach my $logfile (@to_rotate) {
            $err = 1 if !_rotate_log( $logfile, $max_archive );
        }
    }
    return if $err;
    return 1;
}

# THE REST ARE FOR INTERNAL USE -------------------

sub new {
    my $class = shift;
    my $self = bless { _dispatch => Log::Dispatch->new() }, $class;
    return $self;
}

sub _root_log {
    return $ROOT_LOG if $ROOT_LOG;
    $ROOT_LOG = BigMed::Log->new();

    #get email/directory info from bigmed object and be sure directories
    #exist
    require BigMed;
    my $bm = BigMed->bigmed();
    return $ROOT_LOG if !$bm->env('MOXIEDATA');    #not configured yet
    $ROOT_LOG->{_logdir} = bm_file_path( $bm->env('MOXIEDATA'),  'logs' );
    $ROOT_LOG->{_webdir} = bm_file_path( $bm->env('BMADMINDIR'), 'logs' );
    _init_dirs( $ROOT_LOG->{_logdir}, $ROOT_LOG->{_webdir} )
      or BigMed::Error->error_stop;

    #add default logs
    $ROOT_LOG->_update_dispatcher(
        {                                          #basic system log
            name     => 'bm_syslog',
            filename => 'bm_syslog.txt',
        },
        {                                          #emergency email
            name               => 'bm_admin_alert',
            module             => 'BigMed::Log::Email',
            min_level          => 'alert',
            from               => $bm->env('ADMINEMAIL'),
            to                 => $bm->env('ADMINEMAIL'),
            subject            => 'Big Medium: Urgent notice',
            buffered           => 0,
            suppress_timestamp => 1,
        },
        @{ delete $REGISTERED_OUTPUTS{'__ROOT'} },
    );

    #add any previously registered class-specific outputs
    foreach my $class ( keys %REGISTERED_OUTPUTS ) {
        my $log = ( $CLASS_LOG{$class} ||= BigMed::Log->new() );
        $log->_update_dispatcher( @{ $REGISTERED_OUTPUTS{$class} } );
    }

    return $ROOT_LOG;
}

sub _init_dirs {
    my ( $logdir, $webdir ) = @_;

    #make sure that the log and web log directories exist, and
    #put a blank file as the index for the public log dir
    bm_confirm_dir( $logdir, { data => 1, build_path => 1 } ) or return;
    bm_confirm_dir( $webdir, { build_path => 1 } ) or return;
    my $index_file = bm_file_path( $webdir, 'index.shtml' );
    if ( !-e $index_file ) {
        bm_write_file( $index_file, '<!-- not allowed here -->' ) or return;
    }
    return 1;
}

sub _update_dispatcher {
    my $log              = shift;
    my @dispatch_loggers = @_;
    foreach my $logger (@dispatch_loggers) {
        my $module = delete $logger->{module};
        $module ||= 'Log::Dispatch::File';
        croak $UNIVERSAL::require::ERROR if !$module->require;

        #default to data permissions, except for web directory
        $logger->{permissions}
          ||= ( $logger->{for_web} ? bm_file_chmod() : bm_datafile_chmod() );

        #default to info level
        $logger->{min_level} ||= 'info';

        #always close after writing so that we can rotate
        $logger->{close_after_write} = 1;

        #always append to log (actually, close_after_write forces this, but
        #we'll be explicit).
        $logger->{mode} = 'append';

        #add to appropriate web directory
        if ( $logger->{filename} ) {
            my $root = _root_log();
            $logger->{filename} =
              $logger->{for_web}
              ? bm_file_path( $root->{_webdir}, $logger->{filename} )
              : bm_file_path( $root->{_logdir}, $logger->{filename} );
        }

        #add timestamp by default
        if ( $logger->{suppress_timestamp} ) {
            delete $logger->{prepend_timestamp};
        }
        else {
            push @{ $logger->{callbacks} }, \&_prepend_timestamp;
        }

        #add newline by default
        if ( $logger->{suppress_newline} ) {
            delete $logger->{suppress_newline};
        }
        else {
            push @{ $logger->{callbacks} }, \&_append_newline;
        }

        $log->{_dispatch}->add( $module->new( %{$logger} ) );
    }
    return;
}

sub _find_logs {
    my $req_class = shift;
    my @logs;

    #seems like this should get cached...?
    foreach my $isa_class ( $req_class, Class::ISA::super_path($req_class) ) {
        no strict 'refs';
        push @logs, $CLASS_LOG{$isa_class} if $CLASS_LOG{$isa_class};
    }
    push @logs, _root_log();

    return @logs;
}

sub _append_newline {
    my %hash = @_;
    chomp $hash{message};
    return "$hash{message}\n";
}

sub _prepend_timestamp {
    my %hash = @_;
    return '[' . BigMed->bigmed_time . " GMT][$hash{level}] $hash{message}";
}

sub _rotate_log {
    my ( $logfile, $max_archive ) = @_;
    $max_archive ||= $MAX_ARCHIVE;
    my $last_archive = "$logfile.$MAX_ARCHIVE";
    if ( -e $last_archive ) {    #kill it to make room for newer archives
        if ( !bm_delete_file($last_archive) ) {
            my $err = "Log: Error trying to delete archive log $last_archive";
            BigMed::Log->log( error => $err );
            carp $err;
        }
        else {
            BigMed::Log->log(
                info => "Log: Deleted archive log $last_archive" );
        }
    }
    for ( my $i = $MAX_ARCHIVE - 1; $i > 0; $i-- ) {
        my $old = "$logfile.$i";
        next if !-e $old;
        my $new = "$logfile." . ( $i + 1 );
        _rename_log( $old, $new ) or return;
    }
    _rename_log( $logfile, "$logfile.1" ) or return;
    BigMed::Log->log( info => "Log: Rotated logfile $logfile" );
    return 1;
}

sub _rename_log {
    my ( $old, $new ) = @_;
    if ( !bm_move_file( $old, $new ) ) {
        my $err = "Log: Error trying to move archive log $old";
        BigMed::Log->log( error => $err );
        carp $err;
        return;
    }
    return 1;
}

1;

__END__


=head1 BigMed::Log

Adds systemwide logging support (via Log::Dispatch) to any Big Medium module.

=head1 SYNOPSIS

    package Foo;
    use BigMed::Log;
    
    #add messages to the default system log
    Foo->log(notice => 'This is a notice-level message');
    Foo->log(warning => 'This is a warning-level message');
    Foo->log(error => 'This is a error-level message');
    Foo->log(critical => 'This is a critical-level message');
    
    #alert and emergency-level messages are e-mailed to the Big Medium
    #admin email address, in addition to being logged in the 
    #system log
    Foo->log(alert => 'This is a notice-level message');
    Foo->log(emergency => 'This is an emergency-level message');

    #add an additional log output to capture debug-level log messages
    #from all packages that use BigMed::Log
    Foo->add_log(
        outputs => {
            name => 'debugger',
            min_level => 'debug',
            max_level => 'debug',
            filename  => 'debugger.txt',
        },
    );
    
    #add an additional log output to capture only messages originating
    #from the caller's package and subclasses:
    Foo->add_log(
        limit_to_class => 1,
        outputs => {
            name => 'foolog',
            filename => 'foolog.txt',
        },
    );


=head1 DESCRIPTION

BigMed::Log maintains a systemwide singleton Log::Dispatch object to manage
logging from any package that uses BigMed::Log. The module exports three
methods, log, add_log and log_data_tag. These methods allow you to write log
messages and add additional log configurations Class-specific logs may be
added to capture only log messages from specific classes (and their
subclasses).

=head1 THE LOGS

By default, BigMed::Log establishes two global logs. Any package that uses
BigMed::Log feeds messages into these logs, providing that they fit their
criteria:

=over 4

=item * System log: C<moxiedata/logs/bm_syslog.txt>

This log includes messages of all log levels (see below) from info and
higher. That is, any log message added from any package using BigMed::Log
that is not a debug message will be added to this log.

The name of this output in the global log dispatcher is C<bm_syslog>.

=item * E-mail alert

Any message at the alert or emergency level is automatically e-mailed to
the administrator e-mail address registered in the BigMed configuration.

The name of this output in the global log dispatcher is C<bm_admin_email>.

=back

Additional logs may be added via the C<add_log> method.

=head1 EXPORTED METHODS

=head2 log

    Foo->log(debug => 'This is a notice-level message');
    Foo->log(notice => 'This is a notice-level message');
    Foo->log(warning => 'This is a warning-level message');
    Foo->log(error => 'This is a error-level message');
    Foo->log(critical => 'This is a critical-level message');
    Foo->log(alert => 'This is a notice-level message');
    Foo->log(emergency => 'This is an emergency-level message');

This method adds a log message to the global system log and any class-specific
logs in the calling package's ISA chain.

There are seven log levels. In ascending order of severity, they are:

=over 4

=item 1. debug

=item 2. info

=item 3. notice

=item 4. warning

=item 5. error

=item 6. critical

=item 7. alert

=item 8. emergency

=back

=head2 log_data_tag

    my $tag = Foo->log_data_tag($page_obj);
    Foo->log( notice => "Saved changes to $page_obj" );

Returns a specially formatted tag to refer to BigMed::Data objects. The
format looks like this:

    #for site-specific objects (like BigMed::Content::Page objects)
    "Page title"{BigMed::Content::Page $id;site:$siteid}

This allows a consistent reference to objects that is human readable
but easily parsed for post-processing of logs if you wish.

=head2 add_log

    #add two new global log outputs
    Foo->add_log(
        outputs => [

            #email messages of 'error' or greater severity
            {   name               => 'foo-mailer',
                module             => 'BigMed::Log::Email',
                min_level          => 'error',
                from               => BigMed->bigmed->env('ADMINEMAIL'),
                to                 => [qw(foo@bar.com bar@baz.org )],
                subject            => 'Oh No!!!!!!!!!!',
                suppress_newline   => 1,
                suppress_timestamp => 1,
            },

            #add a text file that records all non-debug messages
            {   name     => 'foo-text',
                filename => 'foo-text.txt',
            },
        ]
    );


    #add one class-specific log output for Foo and its subclasses
    Foo->add_log(
        limit_to_class => 1,
        outputs => {
            name      => 'foo-only',
            filename  => 'foo-only.txt',
        },
    );

This method adds one or more additional log outputs for messages submitted
via the C<log> method. These outputs can be at the global level (which means
that all packages using BigMed::Log will use the new output) or at the 
class-specific level (which means that these outputs will contain messages
only from the class or its subclasses).

The method accepts two parameters:

=head3 limit_to_class

If true, the new output will be added as a class-specific log. Only messages
from the calling class and its subclasses will be sent to this output.
(All messages from the class will nevertheless continue to go to the global
log outputs, too).

The default value of this parameter is false.

=head3 outputs

A hash reference or a reference to an array of hash references. The values
of the hash reference specify the type of each new log output and the relevant
parameters for that output. Each hash reference may have the following
key/value pairs:

=over 4

=item * name

Required. The name of this log output. If another log output already has this
name at the level being registered (global or class-specific), it will be
replaced by the new log output.

=item * module

BigMed::Log uses Log::Dispatch to manage its logs, and so each new log output
is represented by a Log::Dispatch::* object. The module parameter specifies
the name of the Log::Dispatch::* class to use. The default is
Log::Dispatch::File.

Some Log::Dispatch::* class may have additional parameters beyond those listed
here. Check the documentation for the relevant class for details.

=item * filename

For Log::Dispatch::File objects (the default), this parameter specifies
the name of the log file, relative to the moxiedata/logs directory.
(If the for_web parameter is true, then the name is relative to the
bmadmin/logs directory).

=item * min_level

The minimum level (debug, info, notice, etc) required for a log message to be
included in the log output. The default is: info.

=item * max_level

The maximum level allowed for a log message to be included in the log output.
The default is the highest level, emergency.

=item * mode

'append' or 'write' -- the default is 'append', which adds log messages
to the end of the log file (creating it if necessary). 'write' starts
the log from scratch with each new BigMed::Log session (in a CGI
context, this means a new log file for every new http request).

=item * for_web

If true, the log file for this output (if any) will be placed in a
web-accessible location (specifically, bmadmin/logs). The default is false.

If this option is not selected, log files for Log::Dispatch::File objects
(the default) are placed in the moxiedata/logs directory.

=item * suppress_timestamp

By default, a timestamp is added to each log entry, along with the log level.
If this parameter is true, no timestamp or log level will be added to this
log output.

=item * suppress_newline

By default, a newline is added after each log message. If this parameter
is true, no timestamp will be added to this log output.

=back

=head1 OTHER METHODS

=head2 logdir

    my $directory = BigMed::Log->logdir;

Returns the path for the directory where log files are saved.

=head2 webdir

    my $directory = BigMed::Log->webdir;

Returns the path for the directory where web-accessible log files are
saved (for log outputs with the C<for_web> parameter).

=head2 rotate_logs

    #use default max size (3Mb) and default max number of archives (3)
    $success = BigMed::Log->rotate_logs();
    
    #specify a custom max size in bytes and custom max number of archives
    $success = BigMed::Log->rotate_logs($max_bytes, $max_num);

Checks to see if any logs in the log directory or weblog directory exceed
a maximum size and, if so, rotates them, discarding backups after they
have exceeded a maximum number.

=head1 SEE ALSO

L<Log::Dispatch>, L<Log::Dispatch::File>

=head1 AUTHOR & COPYRIGHTS

This module and all Big Medium modules are copyright Josh Clark
and Global Moxie. All rights reserved.

Use of this module and the Big Medium content
management system are governed by Global Moxie's software licenses
and may not be used outside of the terms and conditions outlined
there.

For more information, visit the Global Moxie website at
L<http://globalmoxie.com/>.

Big Medium and Global Moxie are service marks of Global Moxie
and Josh Clark. All rights reserved.

=cut