Commit | Line | Data |
4536f655 |
1 | # File: Stem/Log/File.pm |
2 | |
3 | # This file is part of Stem. |
4 | # Copyright (C) 1999, 2000, 2001 Stem Systems, Inc. |
5 | |
6 | # Stem is free software; you can redistribute it and/or modify |
7 | # it under the terms of the GNU General Public License as published by |
8 | # the Free Software Foundation; either version 2 of the License, or |
9 | # (at your option) any later version. |
10 | |
11 | # Stem is distributed in the hope that it will be useful, |
12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of |
13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
14 | # GNU General Public License for more details. |
15 | |
16 | # You should have received a copy of the GNU General Public License |
17 | # along with Stem; if not, write to the Free Software |
18 | # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
19 | |
20 | # For a license to use the Stem under conditions other than those |
21 | # described here, to purchase support for this software, or to purchase a |
22 | # commercial warranty contract, please contact Stem Systems at: |
23 | |
24 | # Stem Systems, Inc. 781-643-7504 |
25 | # 79 Everett St. info@stemsystems.com |
26 | # Arlington, MA 02474 |
27 | # USA |
28 | |
29 | use strict ; |
30 | |
31 | use IO::File ; |
32 | use File::Basename ; |
33 | |
34 | |
35 | package Stem::Log::File ; |
36 | |
37 | ######################### |
38 | ######################### |
39 | # add stuff for file rotation, number suffix, etc. |
40 | ######################### |
41 | ######################### |
42 | |
43 | my $attr_spec_log = [ |
44 | |
45 | { |
46 | 'name' => 'path', |
47 | 'required' => 1, |
48 | 'help' => <<HELP, |
49 | The path for the physical log file |
50 | HELP |
51 | }, |
52 | { |
53 | 'name' => 'strftime', |
54 | 'default' => '%Y%m%d%H%M%S', |
55 | 'help' => <<HELP, |
56 | Format passed to strftime to print the log file suffix timestamp |
57 | HELP |
58 | }, |
59 | { |
60 | 'name' => 'use_gmt', |
61 | 'default' => 1, |
62 | 'type' => 'boolean', |
63 | 'help' => <<HELP, |
64 | Make strftime use gmtime instead of localtime for the suffix timestamp |
65 | HELP |
66 | }, |
67 | |
68 | { |
69 | 'name' => 'rotate', |
70 | 'type' => 'hash', |
71 | 'help' => <<HELP, |
72 | This is a list of option key/value pairs that can be applied to log rotation. |
73 | HELP |
74 | }, |
75 | |
76 | ] ; |
77 | |
78 | |
79 | sub new { |
80 | |
81 | my( $class ) = shift ; |
82 | |
83 | my $self = Stem::Class::parse_args( $attr_spec_log, @_ ) ; |
84 | return $self unless ref $self ; |
85 | |
86 | if ( my $rotate_options = $self->{'rotate'} ) { |
87 | |
88 | if ( ref $rotate_options eq 'ARRAY' ) { |
89 | |
90 | $self->{'rotate'} = { @{$rotate_options} } ; |
91 | } |
92 | } |
93 | |
94 | $self->{'base_path'} = $self->{'path'} ; |
95 | ( $self->{'log_dir'}, $self->{'file_name'} ) = |
96 | File::Basename::fileparse( $self->{'path'} ) ; |
97 | |
98 | my $err = $self->_open_file() ; |
99 | return $err if $err ; |
100 | |
101 | return( $self ) ; |
102 | } |
103 | |
104 | |
105 | sub write { |
106 | |
107 | my( $self, $text ) = @_ ; |
108 | |
109 | $self->{'fh'}->print( $text ) ; |
110 | |
111 | $self->{'size'} += length( $text ) ; |
112 | |
113 | my $rotate_options = $self->{'rotate'} ; |
114 | |
115 | if ( $rotate_options && |
116 | $self->{'size'} >= $rotate_options->{'max_size'} ) { |
117 | |
118 | $self->_rotate() ; |
119 | } |
120 | } |
121 | |
122 | sub status_cmd { |
123 | |
124 | |
125 | } |
126 | |
127 | sub rotate_cmd { |
128 | |
129 | my ( $self ) = @_ ; |
130 | |
131 | $self->_rotate() ; |
132 | } |
133 | |
134 | sub _rotate { |
135 | |
136 | my ( $self ) = @_ ; |
137 | |
138 | my $fh = $self->{'fh'} ; |
139 | |
140 | close( $fh ) ; |
141 | |
142 | $self->_open_file() ; |
143 | } |
144 | |
145 | |
146 | sub _open_file { |
147 | |
148 | my ( $self ) = @_ ; |
149 | |
150 | my $open_path = $self->{'base_path'} ; |
151 | |
152 | if ( $self->{'rotate'} ) { |
153 | |
154 | my $suffix = $self->_get_last_suffix() || |
155 | $self->_generate_suffix() ; |
156 | |
157 | |
158 | $open_path .= ".$suffix" ; |
159 | } |
160 | |
161 | $self->{'open_path'} = $open_path ; |
162 | |
163 | my $fh = IO::File->new( ">>$open_path" ) or |
164 | return "Can't append to log file '$open_path' $!" ; |
165 | |
166 | $self->{'size'} = -s $fh ; |
167 | |
168 | $fh->autoflush( 1 ) ; |
169 | |
170 | $self->{'fh'} = $fh ; |
171 | |
172 | return ; |
173 | } |
174 | |
175 | sub _get_last_suffix { |
176 | |
177 | my ( $self ) = @_ ; |
178 | |
179 | my $log_dir = $self->{'log_dir'} ; |
180 | my $file_name = $self->{'file_name'} ; |
181 | |
182 | local( *DH ) ; |
183 | |
184 | opendir( DH, $log_dir ) || return '' ; |
185 | |
186 | my @files = sort grep { /^$file_name/ } readdir(DH) ; |
187 | |
188 | # return the latest file suffix |
189 | |
190 | if ( @files ) { |
191 | |
192 | return $1 if $files[-1] =~ /\.(\d+$)/ ; |
193 | } |
194 | |
195 | return '' ; |
196 | } |
197 | |
198 | |
199 | sub _generate_suffix { |
200 | |
201 | my ( $self ) = @_ ; |
202 | |
203 | require POSIX ; |
204 | |
205 | my @time = ( $self->{'use_gmt'} ) ? gmtime : localtime ; |
206 | |
207 | return POSIX::strftime( $self->{'strftime'}, @time ) ; |
208 | } |
209 | |
210 | 1 ; |