1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
# -----------------------------------------------------------------------------
# $Id: File.pm 11365 2008-05-10 14:58:28Z topia $
# -----------------------------------------------------------------------------
# copyright (C) 2004 Topia <topia@clovery.jp>. all rights reserved.
package Log::Writer::File;
use strict;
use warnings;
use IO::File;
use File::Spec;
use Module::Use qw(Log::Writer::Base);
use base qw(Log::Writer::Base);
use File::Path;
sub new {
my ($class, $parent, $uri, %options) = @_;
my $this = $class->SUPER::new($parent, $uri, %options);
$this->{file_mode} = $this->first_defined($options{file_mode},
_oct($options{file_mode_oct}),
0600);
$this->{dir_mode} = $this->first_defined($options{dir_mode},
_oct($options{dir_mode_oct}),
0700);
$this;
}
sub capability {
my ($class, $type, @args) = @_;
my $supported = $class->SUPER::capability($type, @args);
return 1 if $supported;
if ($type eq 'fallback') {
return 1;
}
return 0;
}
sub _file {
my $this = shift;
if (!defined $this->{file}) {
$this->mkdirs($this->path);
$this->path =~ /^(.+)$/; # untaint
$this->{file} = IO::File->new($1,
O_CREAT | O_APPEND | O_WRONLY,
$this->file_mode);
}
$this->{file};
}
sub scheme {
'file';
}
*name = \&scheme;
*supported_schemes = \&scheme;
__PACKAGE__->define_attr_accessor(0, qw(file_mode dir_mode));
sub real_flush {
my $this = shift;
my $file = $this->_file;
if (!defined $file) {
$this->_notify_warn('can\'t open file');
return 0;
}
my $ret = 0;
my $size = 1;
while ($size && $this->has_data) {
# use buffer directly; perhaps reduce memory allocation
$size = $file->syswrite($this->{buffer}, $this->length);
if (defined $size) {
substr($this->{buffer}, 0, $size) = '';
$ret = 1;
} else {
$this->_notify_warn($!);
}
}
return $ret;
}
sub real_destruct {
my ($this, $force) = @_;
# make useless efforts
$this->real_flush;
if (!defined $this->has_data) {
$this->_notify_warn('has can\'t flush data; will lost!');
}
if (defined $this->{file}) {
# not use ->file. we don't need new allocation.
$this->{file}->close;
}
return 1;
}
sub _oct {
map { defined $_ ? oct("0$_") : undef } @_;
}
sub mkdirs {
my ($this,$file) = @_;
my (undef,$directories,undef) = File::Spec->splitpath($file);
# 直接の親が存在するか
if ($directories eq '' || -d $directories) {
# これ以上辿れないか、存在するので終了。
return;
}
else {
# 存在しないので作成
eval { mkpath($directories, 0, $this->dir_mode) };
if ($@) {
$this->_notify_warn("mkpath failed; Couldn't create $directories: $@");
}
}
}
1;
|
