1 ###RUN_PERL: #!/usr/bin/perl
3 # oldlogs is generated from oldlogs.1.pl.
5 # This script renames log files if they are big enough.
6 # Compresses or removes older log files.
8 # Copyright (C) 2015, 2016, 2023, 2024 Balthasar SzczepaĆski
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.
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.
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/>.
23 # TODO: use a real log rotate instead of this tool?
27 use Encode::Locale ('decode_argv');
28 use Encode ('encode', 'decode');
30 ###PERL_LIB: use lib /botm/lib/bsta
34 'opendir_encoded', 'readdir_decoded',
35 '_x_encoded', 'stat_encoded',
36 'unlink_encoded', 'rename_encoded'
39 ###PERL_PATH_SEPARATOR: PATH_SEPARATOR = /
41 ###PERL_GZIP: GZIP = gzip
42 ###PERL_LOG_PATH: LOG_PATH = /botm/log/bsta/
43 ###PERL_LOG_SIZE_LIMIT: LOG_SIZE_LIMIT = 65536
44 ###PERL_LOGS_UNCOMPRESSED: LOGS_UNCOMPRESSED = 2
45 ###PERL_LOGS_TOTAL: LOGS_TOTAL = 10
47 binmode STDIN, ':encoding(UTF-8)';
48 binmode STDOUT, ':encoding(UTF-8)';
49 binmode STDERR, ':encoding(UTF-8)';
52 my $log_path = ($ARGV[0] ne '' ) ? $ARGV[0]: LOG_PATH();
53 my $log_size_limit = ($ARGV[1] =~ /^[0-9]+$/) ? int($&) : LOG_SIZE_LIMIT();
54 my $logs_total = ($ARGV[2] =~ /^[0-9]+$/) ? int($&) : LOGS_TOTAL();
55 my $logs_uncompressed = ($ARGV[3] =~ /^[0-9]+$/) ? int($&) : LOGS_UNCOMPRESSED();
57 if (opendir_encoded(my $dir, $log_path)) {
58 while (my $file_name = readdir_decoded($dir)) {
59 if ($file_name !~ /\.log$/) {
62 my $full_path = join_path(PATH_SEPARATOR(), $log_path, $file_name);
63 unless (_x_encoded('-f', $full_path)) {
67 unless (@stat = stat_encoded($full_path)) {
70 if ($stat[7] > $log_size_limit) {
71 move_log($full_path, 0, 0);
83 (my $path, my $number, my $gz) = @_;
87 my $next_number = $number + 1;
88 my @gzip_arg = (GZIP(), '-q', '-9','-f');
92 '.'.$number.($gz ? '.gz' : '') :
95 if ($number == $logs_total) {
96 if (unlink_encoded($this_path)) {
103 if ($number == $logs_uncompressed) {
105 $next_path = $path.'.'.$next_number.'.gz';
108 $next_path = $path.'.'.$next_number.($gz ? '.gz' : '');
111 # TODO: consider loop instead of recursion?
112 if (_x_encoded('-e', $next_path)) {
113 unless (move_log($path, $next_number, ($next_gz or $gz) ? 1 : 0)) {
119 push @gzip_arg, $this_path;
120 unless (! system_encoded(GZIP(), @gzip_arg)) {
126 unless (rename_encoded($this_path, $next_path)) {