+++ /dev/null
-###RUN_PERL: #!/usr/bin/perl
-
-# oldlogs is generated from oldlogs.1.pl.
-#
-# This script renames log files if they are big enough.
-# Compresses or removes older log files.
-#
-# Copyright (C) 2015, 2016, 2023, 2024 Balthasar SzczepaĆski
-#
-# This program is free software: you can redistribute it and/or modify
-# it under the terms of the GNU Affero General Public License as
-# published by the Free Software Foundation, either version 3 of the
-# License, or (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU Affero General Public License for more details.
-#
-# You should have received a copy of the GNU Affero General Public License
-# along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-# TODO: use a real log rotate instead of this tool?
-
-use strict;
-use utf8;
-use Encode::Locale ('decode_argv');
-use Encode ('encode', 'decode');
-
-###PERL_LIB: use lib /botm/lib/bsta
-use botm_common (
- 'join_path',
- 'system_encoded',
- 'opendir_encoded', 'readdir_decoded',
- '_x_encoded', 'stat_encoded',
- 'unlink_encoded', 'rename_encoded'
-);
-
-###PERL_PATH_SEPARATOR: PATH_SEPARATOR = /
-
-###PERL_GZIP: GZIP = gzip
-###PERL_LOG_PATH: LOG_PATH = /botm/log/bsta/
-###PERL_LOG_SIZE_LIMIT: LOG_SIZE_LIMIT = 65536
-###PERL_LOGS_UNCOMPRESSED: LOGS_UNCOMPRESSED = 2
-###PERL_LOGS_TOTAL: LOGS_TOTAL = 10
-
-binmode STDIN, ':encoding(UTF-8)';
-binmode STDOUT, ':encoding(UTF-8)';
-binmode STDERR, ':encoding(UTF-8)';
-decode_argv();
-
-my $log_path = ($ARGV[0] ne '' ) ? $ARGV[0]: LOG_PATH();
-my $log_size_limit = ($ARGV[1] =~ /^[0-9]+$/) ? int($&) : LOG_SIZE_LIMIT();
-my $logs_total = ($ARGV[2] =~ /^[0-9]+$/) ? int($&) : LOGS_TOTAL();
-my $logs_uncompressed = ($ARGV[3] =~ /^[0-9]+$/) ? int($&) : LOGS_UNCOMPRESSED();
-
-if (opendir_encoded(my $dir, $log_path)) {
- while (defined (my $file_name = readdir_decoded($dir))) {
- if ($file_name !~ /\.log$/) {
- next;
- }
- my $full_path = join_path(PATH_SEPARATOR(), $log_path, $file_name);
- unless (_x_encoded('-f', $full_path)) {
- next;
- }
- my @stat;
- unless (@stat = stat_encoded($full_path)) {
- next;
- }
- if ($stat[7] > $log_size_limit) {
- move_log($full_path, 0, 0);
- }
- }
- closedir($dir);
-}
-else {
- print "fail ";
- print $log_path;
- print "\n";
-}
-
-sub move_log {
- (my $path, my $number, my $gz) = @_;
- my $next_gz = 0;
- my $this_path;
- my $next_path;
- my $next_number = $number + 1;
- my @gzip_arg = (GZIP(), '-q', '-9','-f');
-
- $this_path = $path.(
- ($number != 0) ?
- '.'.$number.($gz ? '.gz' : '') :
- ''
- );
- if ($number == $logs_total) {
- if (unlink_encoded($this_path)) {
- return 1;
- }
- else {
- return 0;
- }
- }
- if ($number == $logs_uncompressed) {
- $next_gz = 1;
- $next_path = $path.'.'.$next_number.'.gz';
- }
- else {
- $next_path = $path.'.'.$next_number.($gz ? '.gz' : '');
- }
-
- # TODO: consider loop instead of recursion?
- if (_x_encoded('-e', $next_path)) {
- unless (move_log($path, $next_number, ($next_gz or $gz) ? 1 : 0)) {
- return 0;
- }
- }
-
- if ($next_gz) {
- push @gzip_arg, $this_path;
- unless (! system_encoded(GZIP(), @gzip_arg)) {
- return 0;
- }
- $this_path .= '.gz';
- }
-
- unless (rename_encoded($this_path, $next_path)) {
- return 0;
- }
- return 1;
-}