| Subject: | support binmode parameter |
| Date: | Fri, 13 Aug 2010 00:01:40 +0900 |
| To: | bug-Log-Dispatch-File-Stamped [...] rt.cpan.org |
| From: | Tokuhiro Matsuno <tokuhirom [...] gmail.com> |
Log::Dispatch::File supports binmode parameter, but
Log;:Dispatch::File::Stamped does not supported it.
It is very useful parameter for non-english people. Please support it.
diff --git a/lib/Log/Dispatch/File/Stamped.pm b/lib/Log/Dispatch/File/Stamped.pm
index 6fba106..be7e447 100644
--- a/lib/Log/Dispatch/File/Stamped.pm
+++ b/lib/Log/Dispatch/File/Stamped.pm
@@ -21,6 +21,9 @@ sub new
# stamp format
$self->{stamp_fmt} = delete $params{stamp_fmt} || '%Y%m%d';
+
+ # binmode
+ $self->{binmode} = delete $params{binmode};
# only append mode is supported
$params{mode} = 'append';
@@ -63,7 +66,11 @@ sub _make_handle
# close previous open logfile
close $self->{fh} if $self->{fh};
# open new logfile
- $self->SUPER::_make_handle(filename => $filename, mode => 'append');
+ $self->SUPER::_make_handle(
+ filename => $filename,
+ mode => 'append',
+ ( $self->{'binmode'} ? ( 'binmode' => $self->{'binmode'} ) : () )
+ );
}
}
@@ -118,6 +125,10 @@ tokens.
Defaults to '%Y%m%d'.
+=item * binmode ($)
+
+A layer name to be passed to binmode, like ":utf8" or ":raw".
+
=item -- mode ($)
This parameter is ignored, and is forced to 'append'.
diff --git a/t/binmode.t b/t/binmode.t
new file mode 100644
index 0000000..fc56162
--- /dev/null
+++ b/t/binmode.t
@@ -0,0 +1,48 @@
+#!/usr/bin/perl
+#
+#$Id: basic.t,v 1.1 2004-09-15 11:55:26 eric Exp $
+
+use strict;
+use File::Spec::Functions qw(catfile);
+use FindBin qw($Bin);
+use Test::More tests => 7;
+
+use_ok('Log::Dispatch');
+use_ok('Log::Dispatch::File::Stamped');
+
+my ($hour,$mday,$mon,$year) = (localtime)[2..5];
+my @files;
+
+my %params = (
+ name => 'file',
+ min_level => 'debug',
+ filename => catfile($Bin, 'logfile.txt'),
+);
+my @tests = (
+ { expected => sprintf("logfile-%04d%02d%02d.txt", $year+1900, $mon+1, $mday),
+ params => {%params, 'binmode' => ':encoding(cp932)'},
+ message => "foo bar\x{307b}",
+ expected_message => "foo bar\x82\xd9",
+ },
+);
+for my $t (@tests) {
+ my $dispatcher = Log::Dispatch->new;
+ ok($dispatcher);
+ my $file = catfile($Bin, $t->{expected});
+ push @files, $file;
+ my $stamped = Log::Dispatch::File::Stamped->new(%{$t->{params}});
+ ok($stamped);
+ $dispatcher->add($stamped);
+ $dispatcher->log( level => 'info', message => $t->{message} );
+ ok(-e $file);
+ open my $fh, "<$file";
+ ok($fh);
+ local $/ = undef;
+ my $line = <$fh>;
+ close $fh;
+ is($line, $t->{expected_message}, 'output');
+}
+END {
+ unlink @files if @files;
+};
+__END__