bicyclesonthemoon.info Git - ott/bsta/blob - oldlogs.1.pl

   1 ###RUN_PERL: #!/usr/bin/perl
   2
   3 # oldlogs is generated from oldlogs.1.pl.
   4 #
   5 # This script renames log files if they are big enough.
   6 # Compresses or removes older log files.
   7 #
   8 # Copyright (C) 2015, 2016, 2023  Balthasar Szczepański
   9 #
  10 # This program is free software: you can redistribute it and/or modify
  11 # it under the terms of the GNU Affero General Public License as
  12 # published by the Free Software Foundation, either version 3 of the
  13 # License, or (at your option) any later version.
  14 #
  15 # This program is distributed in the hope that it will be useful,
  16 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 # GNU Affero General Public License for more details.
  19 #
  20 # You should have received a copy of the GNU Affero General Public License
  21 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  22
  23
  24 ###PERL_GZIP:              GZIP              = gzip
  25 ###PERL_LOG_PATH:          LOG_PATH          = /botm/log/bsta/
  26 ###PERL_LOG_SIZE_LIMIT:    LOG_SIZE_LIMIT    = 65536
  27 ###PERL_LOGS_UNCOMPRESSED: LOGS_UNCOMPRESSED = 2
  28 ###PERL_LOGS_TOTAL:        LOGS_TOTAL        = 10
  29
  30
  31 if ($ARGV[0] ne '') {
  32         $log_path = $ARGV[0];
  33 }
  34 else {
  35         $log_path = LOG_PATH;
  36 }
  37 if ($ARGV[1] =~ /^([0-9]+)$/) {
  38         $log_size_limit = $1;
  39 }
  40 else {
  41         $log_size_limit = LOG_SIZE_LIMIT;
  42 }
  43 if ($ARGV[2] =~ /^([0-9]+)$/) {
  44         $logs_total = $1;
  45 }
  46 else {
  47         $logs_total = LOGS_TOTAL;
  48 }
  49 if ($ARGV[3] =~ /^([0-9]+)$/) {
  50         $logs_uncompressed = $1;
  51 }
  52 else {
  53         $logs_uncompressed = LOGS_UNCOMPRESSED;
  54 }
  55
  56 if ( opendir ($dir, $log_path)) {
  57         while ($subpath = readdir $dir) {
  58                 if ($subpath !~ /\.log$/) {
  59                         next;
  60                 }
  61                 $fullpath=$log_path.$subpath;
  62                 unless (-f $fullpath) {
  63                         next;
  64                 }
  65                 unless (@stat = stat($fullpath)) {
  66                         next;
  67                 }
  68                 if ($stat[7] > $log_size_limit) {
  69                         movelog($fullpath,0,0);
  70                 }
  71
  72         }
  73         closedir($dir);
  74 }
  75
  76 sub movelog {
  77         (my $path, my $number, my $gz) = @_;
  78         my $nextgz = 0;
  79         my $thispath;
  80         my $nextpath;
  81         my $nextnumber=$number+1;
  82         my @gzip_arg = (GZIP, '-q', '-9','-f');
  83
  84         $thispath = $path.(($number != 0)?'.'.$number.($gz?'.gz':''):'');
  85         if ($number == $logs_total) {
  86                 if (unlink $thispath) {
  87                         return 1;
  88                 }
  89                 else {
  90                         return 0;
  91                 }
  92         }
  93         if ($number == $logs_uncompressed) {
  94                 $nextgz=1;
  95                 $nextpath = $path.'.'.$nextnumber.'.gz';
  96         }
  97         else {
  98                 $nextpath = $path.'.'.$nextnumber.($gz?'.gz':'');
  99         }
 100
 101         if (-e $nextpath) {
 102                 unless (movelog($path,$nextnumber,($nextgz or $gz)?1:0)) {
 103                         return 0;
 104                 }
 105         }
 106
 107         if ($nextgz) {
 108                 push @gzip_arg, $thispath;
 109                 unless (! system (@gzip_arg)) {
 110                         return 0;
 111                 }
 112                 $thispath .= '.gz';
 113         }
 114
 115         unless (rename ($thispath, $nextpath)) {
 116                 return 0;
 117         }
 118         return 1;
 119 }