cleaned up demo scripts locations
[urisagit/Stem.git] / lib / Stem / Log / File.pm
CommitLineData
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
29use strict ;
30
31use IO::File ;
32use File::Basename ;
33
34
35package Stem::Log::File ;
36
37#########################
38#########################
39# add stuff for file rotation, number suffix, etc.
40#########################
41#########################
42
43my $attr_spec_log = [
44
45 {
46 'name' => 'path',
47 'required' => 1,
48 'help' => <<HELP,
49The path for the physical log file
50HELP
51 },
52 {
53 'name' => 'strftime',
54 'default' => '%Y%m%d%H%M%S',
55 'help' => <<HELP,
56Format passed to strftime to print the log file suffix timestamp
57HELP
58 },
59 {
60 'name' => 'use_gmt',
61 'default' => 1,
62 'type' => 'boolean',
63 'help' => <<HELP,
64Make strftime use gmtime instead of localtime for the suffix timestamp
65HELP
66 },
67
68 {
69 'name' => 'rotate',
70 'type' => 'hash',
71 'help' => <<HELP,
72This is a list of option key/value pairs that can be applied to log rotation.
73HELP
74 },
75
76] ;
77
78
79sub 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
105sub 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
122sub status_cmd {
123
124
125}
126
127sub rotate_cmd {
128
129 my ( $self ) = @_ ;
130
131 $self->_rotate() ;
132}
133
134sub _rotate {
135
136 my ( $self ) = @_ ;
137
138 my $fh = $self->{'fh'} ;
139
140 close( $fh ) ;
141
142 $self->_open_file() ;
143}
144
145
146sub _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
175sub _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
199sub _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
2101 ;