#!perl
use strict;
use diagnostics;
use Encode;
use Encode::Locale;
use IO::Interactive qw/is_interactive/;
use POSIX qw/EXIT_SUCCESS/;
use MarpaX::Languages::M4;
use Log::Any;
use Log::Any::Adapter;
use Log::Any::Adapter::Callback;

# ABSTRACT: M4 implementation in Perl

our $VERSION = '0.015'; # VERSION

our $AUTHORITY = 'cpan:JDDPAUSE'; # AUTHORITY

# PODNAME: m4pp

#
# Get the numbers associated to levels
#
my @logging_methods = Log::Any->logging_methods;
my $i               = -1;
my %logging_levels
    = map { ++$i; $logging_methods[$i] => $i } ( 0 .. $#logging_methods );
#
# Set logger
#
Log::Any::Adapter->set(
    'Callback',
    min_level  => 'trace',
    logging_cb => \&_logging_cb
);
#
# Call implementation
#
my $m4 = MarpaX::Languages::M4->new_with_options();
if ( $m4->nbInputProcessed <= 0 ) {
    $m4->readFromStdin();
}
print $m4->value;
exit( $m4->rc );

sub _logging_cb {
    my ( $method, $self, $format, @params ) = @_;

    my $level = $logging_levels{$method};
    #
    # If level is >= error, then check debugfile
    #
    if ( !defined($level) ) {
        return;
    }
    #
    # If called within new_with_options(), $m4
    # is not yet setted
    #
    my $_m4 = $m4 || $MarpaX::Languages::M4::SELF;

    my $fh;
    open( $fh, '>>&STDERR' );
    my $fhName = 'STDERR';
    my $prefix;
    if ( $level >= $logging_levels{error} ) {
        my $debugfile = $_m4->impl_debugfile;
        if ( defined($debugfile) ) {
            if ( !open( $fh, '>>', $debugfile ) ) {
                #
                # Hmmm...
                #
                warn "Cannot open $debugfile, $!";
                $fh = \*STDERR;
            }
            else {
                $fhName = $debugfile;
            }
        }
        $prefix = 'm4error: ';
    }
    elsif ( $level >= $logging_levels{warning} ) {
        $prefix = '';
    }
    else {
        my $macroCallId = $MarpaX::Languages::M4::MACROCALLID;
        $prefix = 'm4trace: ';
        if ( defined($macroCallId) ) {
            $prefix .= sprintf( '-%d- ', $macroCallId );
        }
    }
    if ( $ENV{M4_ENCODE_LOCALE} ) {
        binmode $fh, ":encoding(console_out)" if ( is_interactive($fh) );
    }

    my $program = $_m4->builtin___program__;

    printf $fh "$prefix$format\n", @params;
    if ( !close($fh) ) {
        warn "Cannot close $fhName, $!";
    }
}

exit(EXIT_SUCCESS);

__END__

=pod

=encoding UTF-8

=head1 NAME

m4pp - M4 implementation in Perl

=head1 VERSION

version 0.015

=head1 AUTHOR

Jean-Damien Durand <jeandamiendurand@free.fr>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2015 by Jean-Damien Durand.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut
