lib/Stem/Log/File.pm

   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 ;