#!/usr/bin/env perl

#
# message logging.
#

use strict;
use warnings;
use Data::Dumper;
use Test::More;
use Glib;
use Config;

if ($Config{archname} =~ m/^(x86_64|mipsel|mips|alpha)/
    and not Glib->CHECK_VERSION (2,2,4)) {
	# there is a bug in glib which makes g_log print messages twice
	# on 64-bit x86 platforms.  yosh has fixed this on the 2.2.x branch
	# and in 2.4.0 (actually 2.3.2).
	plan skip_all => "g_log doubles messages by accident on 64-bit platforms";
} else {
	plan tests => 30;
}

package Foo;

use Glib::Object::Subclass
    'Glib::Object';

package main;

$SIG{__WARN__} = sub { chomp (my $msg = $_[0]); ok(1, "in __WARN__: $msg"); };
#$SIG{__DIE__} = sub { ok(1, 'in __DIE__'); };

Glib->message (undef, 'whee message');
Glib->critical (undef, 'whee critical');
Glib->warning (undef, 'whee warning');

my $id =
Glib::Log->set_handler (__PACKAGE__,
                        [qw/ error critical warning message info debug /],
			sub {
				ok(1, "in custom handler $_[1][0]");
			});

Glib->message (__PACKAGE__, 'whee message');
Glib->critical (__PACKAGE__, 'whee critical');
Glib->warning (__PACKAGE__, 'whee warning');
Glib->log (__PACKAGE__, qw/ warning /, 'whee log warning');

Glib::Log->remove_handler (__PACKAGE__, $id);

SKIP: {
	# See <http://bugzilla.gnome.org/show_bug.cgi?id=577137>.
	skip 'using multiple log levels breaks g_log on some platforms', 2
		if (!Glib->CHECK_VERSION(2, 20, 1) &&
		    $Config{archname} =~ /powerpc|amd64|s390/);
	my $id = Glib::Log->set_handler (undef,
		[qw/ error critical warning message info debug /],
		sub {
			ok(1, "in custom handler $_[1][0]");
		});
	Glib->log (undef, [qw/ info debug /], 'whee log warning');
	Glib::Log->remove_handler (undef, $id);
}

# i would expect this to call croak, but it actually just aborts.  :-(
#eval { Glib->error (__PACKAGE__, 'error'); };

Glib::Log::default_handler ('Test-Domain', ['info'], 'ignore this message');
Glib::Log::default_handler ('Test-Domain', ['info'],
                            'another message to ignore', 'userdata');

SKIP: {
  skip "new 2.6 stuff", 18
    unless Glib->CHECK_VERSION (2,6,0);
  Glib->log ('An-Unknown-Domain', ['info'], 'this is a test message');

  is (Glib::Log->set_default_handler(undef),
      \&Glib::Log::default_handler,
      'default log handler: install undef, prev default');
  Glib->log ('An-Unknown-Domain', ['info'], 'this is a test message');

  is (Glib::Log->set_default_handler(\&Glib::Log::default_handler),
      \&Glib::Log::default_handler,
      'default log handler: install default, prev default');
  Glib->log ('An-Unknown-Domain', ['info'], 'this is another test message');

  # anon subs like $sub1 and $sub2 must refer to something like $x in the
  # environment or they're not gc-ed immediately
  my $x = 123;
  my $sub1 = sub {
    my @args = @_;
    is (scalar @args, 3, 'sub1 arg count');
    is ($args[0], 'An-Unknown-Domain', 'sub1 domain');
    isa_ok ($args[1], 'Glib::LogLevelFlags', 'sub1 flags type');
    ok ($args[1] == ['info'], 'sub1 flags value');
    is ($args[2], 'a message', 'sub1 message');
    return $x
  };
  is (Glib::Log->set_default_handler($sub1),
      \&Glib::Log::default_handler,
      'default log handler: install sub1, prev default');
  Glib->log ('An-Unknown-Domain', ['info'], 'a message');

  my $sub2 = sub {
    my @args = @_;
    is (scalar @args, 4, 'sub2 arg count');
    is ($args[0], 'Another-Unknown-Domain', 'sub2 domain');
    isa_ok ($args[1], 'Glib::LogLevelFlags', 'sub2 flags type');
    ok ($args[1] == ['warning'], 'sub2 flags value');
    is ($args[2], 'a message', 'sub2 message');
    is ($args[3], 'some userdata', 'sub2 userdata');
    return $x
  };
  is (Glib::Log->set_default_handler($sub2,'some userdata'), $sub1,
      'default log handler: install sub2, prev sub1');
  require Scalar::Util;
  Scalar::Util::weaken ($sub1);
  is ($sub1, undef,
      'sub1 garbage collected by weakening');
  Glib->log ('Another-Unknown-Domain', ['warning'], 'a message');

  is (Glib::Log->set_default_handler(undef), $sub2,
      'default log handler: install undef, prev sub2');
  Glib->log ('Another-Unknown-Domain', ['info'], 'this is a test message');

  is (Glib::Log->set_default_handler(undef),
      \&Glib::Log::default_handler,
      'default log handler: install undef, prev default');
  Glib->log ('Another-Unknown-Domain', ['info'], 'this is yet another a test message');

  # test that a custom log handler can safely call the default log handler
  Glib::Log->set_default_handler(sub { Glib::Log::default_handler (@_); });
  Glib->log ('Another-Unknown-Domain', ['info'], 'custom to default test');
  Glib::Log->set_default_handler(undef);
}


# when you try to connect to a non-existant signal, you get a CRITICAL
# log message...
my $object = Foo->new;
{
ok(1, 'attempting to connect a non-existant signal');
local $SIG{__WARN__} = sub { ok( $_[0] =~ /nonexistant/, 'should warn' ); };
$object->signal_connect (nonexistant => sub { ok(0, "shouldn't get here") });
delete $SIG{__WARN__};
}

## try that again with a fatal mask
#Glib::Log->set_always_fatal (['critical', 'fatal-mask']);
#{
#local $SIG{__DIE__} = sub { ok(1, 'should die'); };
#eval {
#$object->signal_connect (nonexistant => sub { ok(0, "shouldn't get here") });
#};
#print "$@\n";
#}

# Check that messages with % chars make it through unaltered and don't cause
# crashes
{
	my $id = Glib::Log->set_handler (
		__PACKAGE__,
		qw/debug/,
		sub { is($_[2], '%s %d %s', 'a message with % chars'); });

	Glib->log (__PACKAGE__, qw/debug/, '%s %d %s');

	Glib::Log->remove_handler (__PACKAGE__, $id);
}

Glib::Log->set_fatal_mask (__PACKAGE__, [qw/ warning message /]);
Glib::Log->set_always_fatal ([qw/ info debug /]);

__END__

Copyright (C) 2003, 2009 by the gtk2-perl team (see the file AUTHORS for the
full list)

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

This library 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 Library General Public License for more
details.

You should have received a copy of the GNU Library General Public License along
with this library; if not, write to the Free Software Foundation, Inc.,
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.