$Revis =~ s/^.*:\s*(\S+)\s*\$.*/$1/s;
our $VERSION = $LogRotate::Common::LOGROTATE_VERSION . "." . $Revis;
-$Data::Dumper::Indent = 1;
+$Data::Dumper::Indent = 1;
$Data::Dumper::Sortkeys = 1;
use LogRotate::Conf;
use LogRotate::StateFile;
-use constant default_buffer_size => 4096;
-use constant max_rotate => 100000;
+use constant default_buffer_size => 4096;
+use constant max_rotate => 100000;
#------------------------------------------------------------------------------------
=cut
sub new {
- my $invocant = shift;
- my $class = ref($invocant) || $invocant;
- my $uid = $>;
- my ( $gid ) = $) =~ /^(\d+)/;
- my ( $res, $cmd, $t, $domain, $host );
-
- my $self = {
- test => 0,
- force => 0,
- statusfile => '/var/lib/logrotate.status',
- scripts => {},
- logfiles => {},
- rotatet_files => {},
- files_to_compress => {},
- @_
- };
-
- $res = bless $self, $class;
-
- my $p = verbose() > 2 ? __PACKAGE__ . "::new(): " : "";
-
- my $conf = new LogRotate::Conf();
-
- $self->{'c'} = $conf;
-
- # Ermittlung aller Platzhalter fuer olddir-Sachen ...
- $self->{'template'} = {};
-
- # Host- und Domainname ...
- $t = hostname();
- $domain = "";
- $host = $t;
- if ( $t =~ /^([^\.]+)\.(.*)/ ) {
- $host = $1;
- $domain = $2;
- }
- $self->{'template'}{'nodename'} = $host;
- $self->{'template'}{'domain'} = $domain;
+ my $invocant = shift;
+ my $class = ref($invocant) || $invocant;
+ my $uid = $>;
+ my ($gid) = $) =~ /^(\d+)/;
+ my ( $res, $cmd, $t, $domain, $host );
+
+ my $self = {
+ test => 0,
+ force => 0,
+ statusfile => '/var/lib/logrotate.status',
+ scripts => {},
+ logfiles => {},
+ rotatet_files => {},
+ files_to_compress => {},
+ @_
+ };
+
+ $res = bless $self, $class;
+
+ my $p = verbose() > 2 ? __PACKAGE__ . "::new(): " : "";
+
+ my $conf = new LogRotate::Conf();
+
+ $self->{'c'} = $conf;
+
+ # Ermittlung aller Platzhalter fuer olddir-Sachen ...
+ $self->{'template'} = {};
+
+ # Host- und Domainname ...
+ $t = hostname();
+ $domain = "";
+ $host = $t;
+ if ( $t =~ /^([^\.]+)\.(.*)/ ) {
+ $host = $1;
+ $domain = $2;
+ }
+ $self->{'template'}{'nodename'} = $host;
+ $self->{'template'}{'domain'} = $domain;
- # Plattform
- $t = `uname -i`;
- chomp $t;
- $self->{'template'}{'platform'} = $t;
+ # Plattform
+ $t = `uname -i`;
+ chomp $t;
+ $self->{'template'}{'platform'} = $t;
- # Prozessor
- $t = `uname -p`;
- chomp $t;
- $self->{'template'}{'isa'} = $t;
+ # Prozessor
+ $t = `uname -p`;
+ chomp $t;
+ $self->{'template'}{'isa'} = $t;
- # OS-Release
- $t = `uname -r`;
- chomp $t;
- $self->{'template'}{'release'} = $t;
+ # OS-Release
+ $t = `uname -r`;
+ chomp $t;
+ $self->{'template'}{'release'} = $t;
- # Maschinen-Version
- $t = `uname -m`;
- chomp $t;
- $self->{'template'}{'machine'} = $t;
+ # Maschinen-Version
+ $t = `uname -m`;
+ chomp $t;
+ $self->{'template'}{'machine'} = $t;
- $self->{'files_delete'} = {};
- $self->{'files_compress'} = {};
+ $self->{'files_delete'} = {};
+ $self->{'files_compress'} = {};
- return $res;
+ return $res;
-}
+} ## end sub new
#------------------------------------------------------------------------------------------
sub check_state($) {
- my $self = shift;
- my $p = verbose() ? __PACKAGE__ . "::check_state(): " : "";
+ my $self = shift;
+ my $p = verbose() ? __PACKAGE__ . "::check_state(): " : "";
- my $state_file = new LogRotate::StateFile(
- 'test' => $self->{'test'},
- );
- $state_file->file($self->{'statusfile'});
+ my $state_file = new LogRotate::StateFile( 'test' => $self->{'test'}, );
+ $state_file->file( $self->{'statusfile'} );
- my $states = $state_file->check();
+ my $states = $state_file->check();
- if ( $states ) {
- $self->{'state_file'} = $state_file;
- $self->{'states'} = $states;
- return 1;
- }
+ if ($states) {
+ $self->{'state_file'} = $state_file;
+ $self->{'states'} = $states;
+ return 1;
+ }
- warn $p . "Statusdatei '" . $self->{'statusfile'} . " ist nicht verwendungsfaehig.\n";
- return undef;
+ warn $p . "Statusdatei '" . $self->{'statusfile'} . " ist nicht verwendungsfaehig.\n";
+ return undef;
-}
+} ## end sub check_state($)
#------------------------------------------------------------------------------------------
sub collect_files_delete($$) {
- my $self = shift;
- my $file = shift;
- my $p = verbose() ? __PACKAGE__ . "::collect_files_delete(): " : "";
+ my $self = shift;
+ my $file = shift;
+ my $p = verbose() ? __PACKAGE__ . "::collect_files_delete(): " : "";
- unless ( $file ) {
- carp( $p . "Keine Logdatei uebergeben!\n" );
- return undef;
- }
- print $p . "Ermittle alte Logdateien zum Loeschen fuer '$file'.\n" if verbose() > 1;
- my $f = $self->{'c'}{'logfiles'}{$file};
+ unless ($file) {
+ carp( $p . "Keine Logdatei uebergeben!\n" );
+ return undef;
+ }
+ print $p . "Ermittle alte Logdateien zum Loeschen fuer '$file'.\n" if verbose() > 1;
+ my $f = $self->{'c'}{'logfiles'}{$file};
- my $candidates = {};
- my $of = $f->{'oldfiles'};
- my $maxage = (defined $f->{'maxage'} ? $f->{'maxage'} : 0 ) * 24 * 60 * 60;
+ my $candidates = {};
+ my $of = $f->{'oldfiles'};
+ my $maxage = ( defined $f->{'maxage'} ? $f->{'maxage'} : 0 ) * 24 * 60 * 60;
- unless ( defined $of and scalar( keys %$of ) ) {
- print $p . "Keine alten Logdateien vorhanden.\n" if verbose() > 2;
- return $candidates;
- }
+ unless ( defined $of and scalar( keys %$of ) ) {
+ print $p . "Keine alten Logdateien vorhanden.\n" if verbose() > 2;
+ return $candidates;
+ }
- my ( $oldfile, $age, $count );
+ my ( $oldfile, $age, $count );
- # Nach Alter sortiert die Liste abklappern ...
- $count = scalar( keys %$of );
- foreach $oldfile ( sort { $of->{$a} <=> $of->{$b} } keys %$of ) {
- $count--;
- $age = time() - $of->{$oldfile};
- print $p . "Untersuche, ob '$oldfile' weggeschmissen werden soll ...\n" if verbose() > 2;
+ # Nach Alter sortiert die Liste abklappern ...
+ $count = scalar( keys %$of );
+ foreach $oldfile ( sort { $of->{$a} <=> $of->{$b} } keys %$of ) {
+ $count--;
+ $age = time() - $of->{$oldfile};
+ print $p . "Untersuche, ob '$oldfile' weggeschmissen werden soll ...\n" if verbose() > 2;
- # Erst mal alles weg, was mehr als die Zahl von "rotate" aussagt ...
- if ( $f->{'rotate'} >= 0 and $count >= $f->{'rotate'} ) {
- print $p . "Loesche '$oldfile' wegen zuviel (" . $count . " >= " . $f->{'rotate'} . ").\n" if verbose() > 2;
- $candidates->{$oldfile} = 1;
- next;
- }
+ # Erst mal alles weg, was mehr als die Zahl von "rotate" aussagt ...
+ if ( $f->{'rotate'} >= 0 and $count >= $f->{'rotate'} ) {
+ print $p . "Loesche '$oldfile' wegen zuviel (" . $count . " >= " . $f->{'rotate'} . ").\n" if verbose() > 2;
+ $candidates->{$oldfile} = 1;
+ next;
+ }
- if ( $maxage and $age >= $maxage ) {
- print $p . "Loesche '$oldfile' wegen zu alt (" . $age . " >= " . $maxage . ").\n" if verbose() > 2;
- $candidates->{$oldfile} = 1;
- }
- }
+ if ( $maxage and $age >= $maxage ) {
+ print $p . "Loesche '$oldfile' wegen zu alt (" . $age . " >= " . $maxage . ").\n" if verbose() > 2;
+ $candidates->{$oldfile} = 1;
+ }
+ } ## end foreach $oldfile ( sort { $of->{$a} <=> $of->{$b...
- return $candidates;
+ return $candidates;
-}
+} ## end sub collect_files_delete($$)
#------------------------------------------------------------------------------------------
sub collect_compress_logfiles($$) {
- my $self = shift;
- my $file = shift;
- my $p = verbose() ? __PACKAGE__ . "::collect_compress_logfiles(): " : "";
+ my $self = shift;
+ my $file = shift;
+ my $p = verbose() ? __PACKAGE__ . "::collect_compress_logfiles(): " : "";
- unless ( $file ) {
- carp( $p . "Keine Logdatei uebergeben!\n" );
- return undef;
- }
- print $p . "Ermittle alte Logdateien zum Loeschen fuer '$file'.\n" if verbose() > 1;
- my $f = $self->{'c'}{'logfiles'}{$file};
-
- my $candidates = {};
- my $of = $f->{'oldfiles'};
-
- unless ( $f->{'compress'} ) {
- print $p . "Es werden keine Logdateien komprimiert.\n" if verbose() > 2;
- return $candidates;
- }
-
- my $behalten = $f->{'delaycompress'} || 0;
+ unless ($file) {
+ carp( $p . "Keine Logdatei uebergeben!\n" );
+ return undef;
+ }
+ print $p . "Ermittle alte Logdateien zum Loeschen fuer '$file'.\n" if verbose() > 1;
+ my $f = $self->{'c'}{'logfiles'}{$file};
- # Compress-Endung ermitteln ...
- my $ce = $self->{'c'}->compressext();
- if ( not defined($ce) or $ce =~ /^\s*$/ ) {
- $ce = ".gz";
- }
- $ce = "." . $ce if $ce ne "" and $ce !~ /^\./;
+ my $candidates = {};
+ my $of = $f->{'oldfiles'};
- unless ( defined $of and scalar( keys %$of ) ) {
- print $p . "Keine alten Logdateien vorhanden.\n" if verbose() > 2;
- return $candidates;
- }
+ unless ( $f->{'compress'} ) {
+ print $p . "Es werden keine Logdateien komprimiert.\n" if verbose() > 2;
+ return $candidates;
+ }
- my ( $oldfile, $count );
+ my $behalten = $f->{'delaycompress'} || 0;
- # Nach Alter sortiert die Liste abklappern ...
- $count = scalar( keys %$of );
- foreach $oldfile ( sort { $of->{$a} <=> $of->{$b} } keys %$of ) {
- $count--;
- if ( $oldfile =~ /$ce$/i ) {
- print $p . "Logdatei '$oldfile' scheint schon komprimiert zu sein.\n" if verbose() > 2;
- next;
- }
- if ( $self->{'files_delete'}{$oldfile} ) {
- print $p . "Logdatei '$oldfile' ist zum Loeschen vorgesehen.\n" if verbose() > 2;
- next;
+ # Compress-Endung ermitteln ...
+ my $ce = $self->{'c'}->compressext();
+ if ( not defined($ce) or $ce =~ /^\s*$/ ) {
+ $ce = ".gz";
}
- $candidates->{$oldfile} = $of->{$oldfile};
- }
+ $ce = "." . $ce if $ce ne "" and $ce !~ /^\./;
- if ( $behalten and scalar( keys %$candidates ) ) {
- my $files_behalten = {};
- my $i = 0;
- foreach $oldfile ( sort { $candidates->{$b} <=> $candidates->{$a} } keys %$candidates ) {
- $i++;
- last if $i > $behalten;
- $files_behalten->{$oldfile} = 1;
+ unless ( defined $of and scalar( keys %$of ) ) {
+ print $p . "Keine alten Logdateien vorhanden.\n" if verbose() > 2;
+ return $candidates;
}
- foreach $oldfile ( keys %$files_behalten ) {
- print $p . "Logdatei '$oldfile' wird NICHT komprimiert.\n" if verbose() > 2;
- delete $candidates->{$oldfile};
- }
- $files_behalten = undef;
- }
- return $candidates;
+ my ( $oldfile, $count );
-}
+ # Nach Alter sortiert die Liste abklappern ...
+ $count = scalar( keys %$of );
+ foreach $oldfile ( sort { $of->{$a} <=> $of->{$b} } keys %$of ) {
+ $count--;
+ if ( $oldfile =~ /$ce$/i ) {
+ print $p . "Logdatei '$oldfile' scheint schon komprimiert zu sein.\n" if verbose() > 2;
+ next;
+ }
+ if ( $self->{'files_delete'}{$oldfile} ) {
+ print $p . "Logdatei '$oldfile' ist zum Loeschen vorgesehen.\n" if verbose() > 2;
+ next;
+ }
+ $candidates->{$oldfile} = $of->{$oldfile};
+ } ## end foreach $oldfile ( sort { $of->{$a} <=> $of->{$b...
+
+ if ( $behalten and scalar( keys %$candidates ) ) {
+ my $files_behalten = {};
+ my $i = 0;
+ foreach $oldfile ( sort { $candidates->{$b} <=> $candidates->{$a} } keys %$candidates ) {
+ $i++;
+ last if $i > $behalten;
+ $files_behalten->{$oldfile} = 1;
+ }
+ foreach $oldfile ( keys %$files_behalten ) {
+ print $p . "Logdatei '$oldfile' wird NICHT komprimiert.\n" if verbose() > 2;
+ delete $candidates->{$oldfile};
+ }
+ $files_behalten = undef;
+ } ## end if ( $behalten and scalar( keys %$candidates...
+
+ return $candidates;
+
+} ## end sub collect_compress_logfiles($$)
#------------------------------------------------------------------------------------------
sub collect_old_logfiles($$) {
- my $self = shift;
- my $file = shift;
- my $p = verbose() ? __PACKAGE__ . "::collect_old_logfiles(): " : "";
-
- my ( $dir, $basename, $olddir, $pattern, $t );
- my ( @Pattern, @Liste, @Stats );
+ my $self = shift;
+ my $file = shift;
+ my $p = verbose() ? __PACKAGE__ . "::collect_old_logfiles(): " : "";
- my $ce = $self->{'c'}->compressext();
- if ( not defined($ce) or $ce =~ /^\s*$/ ) {
- $ce = ".gz";
- }
- $ce = "." . $ce if $ce ne "" and $ce !~ /^\./;
- print $p . "Kompressionsendung '$ce'.\n" if verbose() > 3;
+ my ( $dir, $basename, $olddir, $pattern, $t );
+ my ( @Pattern, @Liste, @Stats );
- unless ( $file ) {
- carp( $p . "Keine Logdatei uebergeben!\n" );
- return undef;
- }
- print $p . "Ermittle alte Logdateien fuer '$file'.\n" if verbose() > 1;
- my $f = $self->{'c'}{'logfiles'}{$file};
-
- my $ext = defined $f->{'extension'} ? $f->{'extension'} : "";
- $ext = "" if $ext =~ /^\s*$/;
- $ext = "." . $ext if $ext ne "" and $ext !~ /^\./;
- my $ext_ohne = $ext;
-
- # Compress-Endung hinten dran bammeln ...
- if ( $f->{'compress'} ) {
my $ce = $self->{'c'}->compressext();
if ( not defined($ce) or $ce =~ /^\s*$/ ) {
- $ce = ".gz";
+ $ce = ".gz";
}
$ce = "." . $ce if $ce ne "" and $ce !~ /^\./;
- $ext .= $ce;
- }
+ print $p . "Kompressionsendung '$ce'.\n" if verbose() > 3;
+
+ unless ($file) {
+ carp( $p . "Keine Logdatei uebergeben!\n" );
+ return undef;
+ }
+ print $p . "Ermittle alte Logdateien fuer '$file'.\n" if verbose() > 1;
+ my $f = $self->{'c'}{'logfiles'}{$file};
+
+ my $ext = defined $f->{'extension'} ? $f->{'extension'} : "";
+ $ext = "" if $ext =~ /^\s*$/;
+ $ext = "." . $ext if $ext ne "" and $ext !~ /^\./;
+ my $ext_ohne = $ext;
+
+ # Compress-Endung hinten dran bammeln ...
+ if ( $f->{'compress'} ) {
+ my $ce = $self->{'c'}->compressext();
+ if ( not defined($ce) or $ce =~ /^\s*$/ ) {
+ $ce = ".gz";
+ }
+ $ce = "." . $ce if $ce ne "" and $ce !~ /^\./;
+ $ext .= $ce;
+ }
- my $res = {};
+ my $res = {};
- unless ( ( $dir, $basename ) = $file =~ m#(.*)/([^/]*)$# ) {
- warn $p . "Ungueltiger Logdateiname: '$file'\n";
- return undef;
- }
+ unless ( ( $dir, $basename ) = $file =~ m#(.*)/([^/]*)$# ) {
+ warn $p . "Ungueltiger Logdateiname: '$file'\n";
+ return undef;
+ }
- if ( $f->{'dateext'} ) {
- $basename .= ".*";
- }
+ if ( $f->{'dateext'} ) {
+ $basename .= ".*";
+ }
- if ( $f->{'olddir'} and $f->{'olddir'}{'dirname'} ) {
+ if ( $f->{'olddir'} and $f->{'olddir'}{'dirname'} ) {
- # Ersetzung aller Platzhalter in Olddir-Angabe
+ # Ersetzung aller Platzhalter in Olddir-Angabe
- $olddir = $f->{'olddir'}{'dirname'};
+ $olddir = $f->{'olddir'}{'dirname'};
- # Verzeichnisname ...
- $olddir =~ s/(?:\${dirname}|\$dirname(?![a-zA-Z0-9_]))/$dir/g;
+ # Verzeichnisname ...
+ $olddir =~ s/(?:\${dirname}|\$dirname(?![a-zA-Z0-9_]))/$dir/g;
- # Basename ...
- $olddir =~ s/(?:\${basename}|\$basename(?![a-zA-Z0-9_]))/$basename/g;
+ # Basename ...
+ $olddir =~ s/(?:\${basename}|\$basename(?![a-zA-Z0-9_]))/$basename/g;
- # Nodename
- $t = $self->{'template'}{'nodename'};
- $olddir =~ s/(?:\${nodename}|\$nodename(?![a-zA-Z0-9_]))/$t/g;
+ # Nodename
+ $t = $self->{'template'}{'nodename'};
+ $olddir =~ s/(?:\${nodename}|\$nodename(?![a-zA-Z0-9_]))/$t/g;
- # Domain
- $t = $self->{'template'}{'domain'};
- $olddir =~ s/(?:\${domain}|\$domain(?![a-zA-Z0-9_]))/$t/g;
+ # Domain
+ $t = $self->{'template'}{'domain'};
+ $olddir =~ s/(?:\${domain}|\$domain(?![a-zA-Z0-9_]))/$t/g;
- # Platform
- $t = $self->{'template'}{'platform'};
- $olddir =~ s/(?:\${platform}|\$platform(?![a-zA-Z0-9_]))/$t/g;
+ # Platform
+ $t = $self->{'template'}{'platform'};
+ $olddir =~ s/(?:\${platform}|\$platform(?![a-zA-Z0-9_]))/$t/g;
- # Isa
- $t = $self->{'template'}{'isa'};
- $olddir =~ s/(?:\${isa}|\$isa(?![a-zA-Z0-9_]))/$t/g;
+ # Isa
+ $t = $self->{'template'}{'isa'};
+ $olddir =~ s/(?:\${isa}|\$isa(?![a-zA-Z0-9_]))/$t/g;
- # Release
- $t = $self->{'template'}{'release'};
- $olddir =~ s/(?:\${release}|\$release(?![a-zA-Z0-9_]))/$t/g;
+ # Release
+ $t = $self->{'template'}{'release'};
+ $olddir =~ s/(?:\${release}|\$release(?![a-zA-Z0-9_]))/$t/g;
- # Machine
- $t = $self->{'template'}{'machine'};
- $olddir =~ s/(?:\${machine}|\$machine(?![a-zA-Z0-9_]))/$t/g;
+ # Machine
+ $t = $self->{'template'}{'machine'};
+ $olddir =~ s/(?:\${machine}|\$machine(?![a-zA-Z0-9_]))/$t/g;
- $olddir = $dir . "/" . $olddir unless $olddir =~ m#^/#;
+ $olddir = $dir . "/" . $olddir unless $olddir =~ m#^/#;
- # Ersetzen aller POSIX::strftime-Platzhalter durch Shell-Pattern:
- # Wochentag
- $olddir =~ s/\%a/*/gi;
- # Monatsname
- $olddir =~ s/\%b/*/gi;
- $olddir =~ s/\%h/*/g;
- # Datum komplett
- $olddir =~ s/\%c/*/g;
- # Jahrhundert
- $olddir =~ s/\%C/[0-9][0-9]/g;
- # Tag im Monat
- $olddir =~ s/\%d/[0-9][0-9]/g;
- # Datum als %m/%d/%y
- $olddir =~ s#\%D#[0-9][0-9]/[0-9][0-9]/[0-9][0-9]#g;
- $olddir =~ s#\%x#[0-9][0-9]/[0-9][0-9]/[0-9][0-9]#g;
- # Stunde im 24h-Format
- $olddir =~ s/\%H/[012][0-9]/g;
- # Stunde im 12h-Format
- $olddir =~ s/\%J/[01][0-9]/g;
- # Nummer des Tags im Jahr
- $olddir =~ s/\%j/[0123][0-9][0-9]/g;
- # Stunde im 24h-Format
- $olddir =~ s/\%k/[\\ 12][0-9]/g;
- # Stunde im 12h-Format
- $olddir =~ s/\%l/[\\ 1][0-9]/g;
- # Monatsnummer
- $olddir =~ s/\%m/[0-9][0-9]/g;
- # Minute
- $olddir =~ s/\%M/[0-5][0-9]/g;
- # AM/PM
- $olddir =~ s/\%p/[AP]M/g;
- # komplette Uhrzeit im 12h-Format mit AM/PM
- $olddir =~ s/\%r/[01][0-9]:[0-5][0-9]:[0-5][0-9] [AP]M/g;
- # Uhrzeit im Format %H:%M
- $olddir =~ s/\%R/[012][0-9]:[0-5][0-9]/g;
- # Sekunden
- $olddir =~ s/\%S/[0-6][0-9]/g;
- # komplette Uhrzeit im 24h-Format
- $olddir =~ s/\%T/[012][0-9]:[0-5][0-9]:[0-5][0-9]/g;
- $olddir =~ s/\%X/[012][0-9]:[0-5][0-9]:[0-5][0-9]/g;
- # Wochentag als Zahl (1-7)
- $olddir =~ s/\%u/[0-7]/g;
- $olddir =~ s/\%w/[0-7]/g;
- # Nummer der Woche im Jahr
- $olddir =~ s/\%U/[0-5][0-9]/g;
- $olddir =~ s/\%V/[0-5][0-9]/g;
- $olddir =~ s/\%W/[0-5][0-9]/g;
- # Jahr
- $olddir =~ s/\%Y/[1-9][0-9][0-9][0-9]/g;
- # Zeitzone
- $olddir =~ s/\%Z/*/g;
-
- } else {
-
- $olddir = $dir;
+ # Ersetzen aller POSIX::strftime-Platzhalter durch Shell-Pattern:
+ # Wochentag
+ $olddir =~ s/\%a/*/gi;
- }
+ # Monatsname
+ $olddir =~ s/\%b/*/gi;
+ $olddir =~ s/\%h/*/g;
- push @Pattern, $olddir . "/" . $basename . $ext;
- push @Pattern, $olddir . "/" . $basename . ".[0-9]" . $ext;
- push @Pattern, $olddir . "/" . $basename . ".[0-9][0-9]" . $ext;
- push @Pattern, $olddir . "/" . $basename . ".[0-9][0-9][0-9]" . $ext;
- push @Pattern, $olddir . "/" . $basename . ".[0-9][0-9][0-9][0-9]" . $ext;
- push @Pattern, $olddir . "/" . $basename . ".[0-9][0-9][0-9][0-9][0-9]" . $ext;
-
- if ( $f->{'compress'} ) {
- push @Pattern, $olddir . "/" . $basename . $ext_ohne;
- push @Pattern, $olddir . "/" . $basename . ".[0-9]" . $ext_ohne;
- push @Pattern, $olddir . "/" . $basename . ".[0-9][0-9]" . $ext_ohne;
- push @Pattern, $olddir . "/" . $basename . ".[0-9][0-9][0-9]" . $ext_ohne;
- push @Pattern, $olddir . "/" . $basename . ".[0-9][0-9][0-9][0-9]" . $ext_ohne;
- push @Pattern, $olddir . "/" . $basename . ".[0-9][0-9][0-9][0-9][0-9]" . $ext_ohne;
- }
+ # Datum komplett
+ $olddir =~ s/\%c/*/g;
+
+ # Jahrhundert
+ $olddir =~ s/\%C/[0-9][0-9]/g;
+
+ # Tag im Monat
+ $olddir =~ s/\%d/[0-9][0-9]/g;
+
+ # Datum als %m/%d/%y
+ $olddir =~ s#\%D#[0-9][0-9]/[0-9][0-9]/[0-9][0-9]#g;
+ $olddir =~ s#\%x#[0-9][0-9]/[0-9][0-9]/[0-9][0-9]#g;
+
+ # Stunde im 24h-Format
+ $olddir =~ s/\%H/[012][0-9]/g;
+
+ # Stunde im 12h-Format
+ $olddir =~ s/\%J/[01][0-9]/g;
+
+ # Nummer des Tags im Jahr
+ $olddir =~ s/\%j/[0123][0-9][0-9]/g;
+
+ # Stunde im 24h-Format
+ $olddir =~ s/\%k/[\\ 12][0-9]/g;
+
+ # Stunde im 12h-Format
+ $olddir =~ s/\%l/[\\ 1][0-9]/g;
+
+ # Monatsnummer
+ $olddir =~ s/\%m/[0-9][0-9]/g;
+
+ # Minute
+ $olddir =~ s/\%M/[0-5][0-9]/g;
+
+ # AM/PM
+ $olddir =~ s/\%p/[AP]M/g;
-# $pattern = '"' . join( '" "', @Pattern ) . '"';
-# print $p . "Suchpattern nach den alten Logdateien: '$pattern'.\n" if verbose() > 2;
+ # komplette Uhrzeit im 12h-Format mit AM/PM
+ $olddir =~ s/\%r/[01][0-9]:[0-5][0-9]:[0-5][0-9] [AP]M/g;
-# @Liste = glob( $pattern );
+ # Uhrzeit im Format %H:%M
+ $olddir =~ s/\%R/[012][0-9]:[0-5][0-9]/g;
+
+ # Sekunden
+ $olddir =~ s/\%S/[0-6][0-9]/g;
+
+ # komplette Uhrzeit im 24h-Format
+ $olddir =~ s/\%T/[012][0-9]:[0-5][0-9]:[0-5][0-9]/g;
+ $olddir =~ s/\%X/[012][0-9]:[0-5][0-9]:[0-5][0-9]/g;
+
+ # Wochentag als Zahl (1-7)
+ $olddir =~ s/\%u/[0-7]/g;
+ $olddir =~ s/\%w/[0-7]/g;
+
+ # Nummer der Woche im Jahr
+ $olddir =~ s/\%U/[0-5][0-9]/g;
+ $olddir =~ s/\%V/[0-5][0-9]/g;
+ $olddir =~ s/\%W/[0-5][0-9]/g;
+
+ # Jahr
+ $olddir =~ s/\%Y/[1-9][0-9][0-9][0-9]/g;
+
+ # Zeitzone
+ $olddir =~ s/\%Z/*/g;
+
+ } ## end if ( $f->{'olddir'} and $f->{'olddir'}{'dirname'...
+ else {
+
+ $olddir = $dir;
- foreach $pattern ( @Pattern ) {
- print $p . "Suche nach Pattern '$pattern'.\n" if verbose() > 2;
- @Liste = glob( $pattern );
- for ( @Liste ) {
- if ( $_ ne $file ) {
- print " - '$_'\n" if verbose() > 3;
- @Stats = stat $_;
- $res->{$_} = $Stats[9];
- }
}
- }
- return $res;
-}
+ push @Pattern, $olddir . "/" . $basename . $ext;
+ push @Pattern, $olddir . "/" . $basename . ".[0-9]" . $ext;
+ push @Pattern, $olddir . "/" . $basename . ".[0-9][0-9]" . $ext;
+ push @Pattern, $olddir . "/" . $basename . ".[0-9][0-9][0-9]" . $ext;
+ push @Pattern, $olddir . "/" . $basename . ".[0-9][0-9][0-9][0-9]" . $ext;
+ push @Pattern, $olddir . "/" . $basename . ".[0-9][0-9][0-9][0-9][0-9]" . $ext;
+
+ if ( $f->{'compress'} ) {
+ push @Pattern, $olddir . "/" . $basename . $ext_ohne;
+ push @Pattern, $olddir . "/" . $basename . ".[0-9]" . $ext_ohne;
+ push @Pattern, $olddir . "/" . $basename . ".[0-9][0-9]" . $ext_ohne;
+ push @Pattern, $olddir . "/" . $basename . ".[0-9][0-9][0-9]" . $ext_ohne;
+ push @Pattern, $olddir . "/" . $basename . ".[0-9][0-9][0-9][0-9]" . $ext_ohne;
+ push @Pattern, $olddir . "/" . $basename . ".[0-9][0-9][0-9][0-9][0-9]" . $ext_ohne;
+ }
+
+ # $pattern = '"' . join( '" "', @Pattern ) . '"';
+ # print $p . "Suchpattern nach den alten Logdateien: '$pattern'.\n" if verbose() > 2;
+
+ # @Liste = glob( $pattern );
+
+ foreach $pattern (@Pattern) {
+ print $p . "Suche nach Pattern '$pattern'.\n" if verbose() > 2;
+ @Liste = glob($pattern);
+ for (@Liste) {
+ if ( $_ ne $file ) {
+ print " - '$_'\n" if verbose() > 3;
+ @Stats = stat $_;
+ $res->{$_} = $Stats[9];
+ }
+ }
+ } ## end foreach $pattern (@Pattern)
+
+ return $res;
+} ## end sub collect_old_logfiles($$)
#------------------------------------------------------------------------------------
sub compress($) {
- my $self = shift;
- my $p = verbose() ? __PACKAGE__ . "::compress(): " : "";
+ my $self = shift;
+ my $p = verbose() ? __PACKAGE__ . "::compress(): " : "";
- print $p . "Komprimiere alte Logdateien ...\n" if verbose();
+ print $p . "Komprimiere alte Logdateien ...\n" if verbose();
- unless ( $self->{'files_compress'} and scalar( keys %{$self->{'files_compress'}} ) ) {
- print $p . "Keine alten Logdateien zum Komprimieren gefunden.\n";
- return 1;
- }
+ unless ( $self->{'files_compress'} and scalar( keys %{ $self->{'files_compress'} } ) ) {
+ print $p . "Keine alten Logdateien zum Komprimieren gefunden.\n";
+ return 1;
+ }
- my ( $file );
- my $cmd = $self->{'c'}{'compress_cmd'};
+ my ($file);
+ my $cmd = $self->{'c'}{'compress_cmd'};
- unless ( $cmd ) {
- warn $p . "Kein gueltiges Kompressionsprogramm gegeben oder gefunden.\n";
- return 1;
- }
+ unless ($cmd) {
+ warn $p . "Kein gueltiges Kompressionsprogramm gegeben oder gefunden.\n";
+ return 1;
+ }
- my $method = ( $cmd eq 'Compress::Zlib' or $cmd eq '1' ) ? \&compress_file_zlib :
- ( $cmd eq 'Compress::Bzip2' or $cmd eq '2' ) ? \&compress_file_bzip2 :
- \&compress_external;
+ my $method
+ = ( $cmd eq 'Compress::Zlib' or $cmd eq '1' ) ? \&compress_file_zlib
+ : ( $cmd eq 'Compress::Bzip2' or $cmd eq '2' ) ? \&compress_file_bzip2
+ : \&compress_external;
- for $file ( keys %{$self->{'files_compress'}} ) {
+ for $file ( keys %{ $self->{'files_compress'} } ) {
- unless ( $self->$method($file) ) {
- warn $p . "Komprimieren von '$file' ging gewaltig schief.\n";
- return undef;
- }
+ unless ( $self->$method($file) ) {
+ warn $p . "Komprimieren von '$file' ging gewaltig schief.\n";
+ return undef;
+ }
- }
+ }
- return 1;
+ return 1;
-}
+} ## end sub compress($)
#------------------------------------------------------------------------------------
sub compress_external($$) {
- my $self = shift;
- my $file = shift;
- my $p = verbose() ? __PACKAGE__ . "::compress_external(): " : "";
+ my $self = shift;
+ my $file = shift;
+ my $p = verbose() ? __PACKAGE__ . "::compress_external(): " : "";
- my $cmd = $self->{'c'}{'compress_cmd'};
+ my $cmd = $self->{'c'}{'compress_cmd'};
- unless ( $file ) {
- carp( $p . "Keine Datei uebergeben!\n" );
- return undef;
- }
- print $p . "Komprimiere Datei '$file'" . ( verbose() ? " mittels '$cmd'" : "" ) . " ...\n";
+ unless ($file) {
+ carp( $p . "Keine Datei uebergeben!\n" );
+ return undef;
+ }
+ print $p . "Komprimiere Datei '$file'" . ( verbose() ? " mittels '$cmd'" : "" ) . " ...\n";
- # Gucken, ob Datei ueberhaupt da ist
- unless ( -f $file ) {
- warn $p . "Datei '$file' existiert nicht!\n";
- return 1;
- }
+ # Gucken, ob Datei ueberhaupt da ist
+ unless ( -f $file ) {
+ warn $p . "Datei '$file' existiert nicht!\n";
+ return 1;
+ }
- # Weiter, wenn Dateigroesse == 0
- my $size = ( -s $file );
- unless ( $size ) {
- print $p . "Datei '$file' hat Groesse 0, wird nicht komprimiert.\n";
- return 1;
- }
+ # Weiter, wenn Dateigroesse == 0
+ my $size = ( -s $file );
+ unless ($size) {
+ print $p . "Datei '$file' hat Groesse 0, wird nicht komprimiert.\n";
+ return 1;
+ }
- $cmd .= " " . ( $self->{'compressoptions'} || "" ) . " " . $file;
- print " -> $cmd\n";
+ $cmd .= " " . ( $self->{'compressoptions'} || "" ) . " " . $file;
+ print " -> $cmd\n";
- # Weiter, wenn Testmodus
- return 1 if $self->{'test'};
+ # Weiter, wenn Testmodus
+ return 1 if $self->{'test'};
- system $cmd;
+ system $cmd;
- if ( $? ) {
- if ($? == -1) {
- warn $p . "Konnte Kompressions-Kommando nicht ausfuehren: $!\n";
- return undef;
- } elsif ($? & 127) {
- warn( $p . printf "Das Kommando starb mit Signal %d, %s Coredump\n", ($? & 127), ($? & 128) ? 'mit' : 'ohne');
- return undef;
- } else {
- printf $p . "Das Kommando wurde mit dem Wert %d beendet.\n", $? >> 8;
- }
- }
+ if ($?) {
+ if ( $? == -1 ) {
+ warn $p . "Konnte Kompressions-Kommando nicht ausfuehren: $!\n";
+ return undef;
+ }
+ elsif ( $? & 127 ) {
+ warn( $p . printf "Das Kommando starb mit Signal %d, %s Coredump\n", ( $? & 127 ), ( $? & 128 ) ? 'mit' : 'ohne' );
+ return undef;
+ }
+ else {
+ printf $p . "Das Kommando wurde mit dem Wert %d beendet.\n", $? >> 8;
+ }
+ } ## end if ($?)
- return 1;
+ return 1;
-}
+} ## end sub compress_external($$)
#------------------------------------------------------------------------------------
sub compress_file_bzip2($$) {
- my $self = shift;
- my $file = shift;
- my $p = verbose() ? __PACKAGE__ . "::compress_file_bzip2(): " : "";
+ my $self = shift;
+ my $file = shift;
+ my $p = verbose() ? __PACKAGE__ . "::compress_file_bzip2(): " : "";
- my ( $size );
+ my ($size);
- unless ( $file ) {
- carp( $p . "Keine Datei uebergeben!\n" );
- return undef;
- }
- print $p . "Komprimiere Datei '$file'" . ( verbose() ? " mittels Compress::Bzip2" : "" ) . " ...\n";
+ unless ($file) {
+ carp( $p . "Keine Datei uebergeben!\n" );
+ return undef;
+ }
+ print $p . "Komprimiere Datei '$file'" . ( verbose() ? " mittels Compress::Bzip2" : "" ) . " ...\n";
- # Endung der komprimierten Datei ermitteln
- my $ce = $self->{'c'}->compressext();
- if ( not defined($ce) or $ce =~ /^\s*$/ ) {
- $ce = ".gz";
- }
- $ce = "." . $ce if $ce ne "" and $ce !~ /^\./;
+ # Endung der komprimierten Datei ermitteln
+ my $ce = $self->{'c'}->compressext();
+ if ( not defined($ce) or $ce =~ /^\s*$/ ) {
+ $ce = ".gz";
+ }
+ $ce = "." . $ce if $ce ne "" and $ce !~ /^\./;
- # Gucken, ob Datei ueberhaupt da ist
- unless ( -f $file ) {
- warn $p . "Datei '$file' existiert nicht!\n";
- return 1;
- }
+ # Gucken, ob Datei ueberhaupt da ist
+ unless ( -f $file ) {
+ warn $p . "Datei '$file' existiert nicht!\n";
+ return 1;
+ }
- # Weiter, wenn Dateigroesse == 0
- $size = ( -s $file );
- unless ( $size ) {
- print $p . "Datei '$file' hat Groesse 0, wird nicht komprimiert.\n";
- return 1;
- }
+ # Weiter, wenn Dateigroesse == 0
+ $size = ( -s $file );
+ unless ($size) {
+ print $p . "Datei '$file' hat Groesse 0, wird nicht komprimiert.\n";
+ return 1;
+ }
- # Weiter, wenn Testmodus
- return 1 if $self->{'test'};
+ # Weiter, wenn Testmodus
+ return 1 if $self->{'test'};
- my $target = $file . $ce;
- my ( $bz, $buffer );
- my ( @Stat );
- my %BzParams = ();
- $BzParams{'-verbosity'} = verbose() > 7 ? 4 : int((verbose()+1) / 2) ;
+ my $target = $file . $ce;
+ my ( $bz, $buffer );
+ my (@Stat);
+ my %BzParams = ();
+ $BzParams{'-verbosity'} = verbose() > 7 ? 4 : int( ( verbose() + 1 ) / 2 );
- unless ( open LOG, "<", "$file" ) {
- warn $p . "Problem beim Oeffnen der Logdatei '$file' zum Lesen: $!\n";
- return undef;
- }
+ unless ( open LOG, "<", "$file" ) {
+ warn $p . "Problem beim Oeffnen der Logdatei '$file' zum Lesen: $!\n";
+ return undef;
+ }
- unless ( $bz = Compress::Bzip2::bzopen( $target, 'w' ) ) {
- warn $p . "Kann komprimierte Datei '$target' nicht schreiben: $!.\n";
- close LOG;
- return undef;
- }
+ unless ( $bz = Compress::Bzip2::bzopen( $target, 'w' ) ) {
+ warn $p . "Kann komprimierte Datei '$target' nicht schreiben: $!.\n";
+ close LOG;
+ return undef;
+ }
- print " ";
- $bz->bzsetparams( %BzParams );
- while ( read LOG, $buffer, default_buffer_size ) {
- $bz->bzwrite( $buffer );
- }
- $bz->bzclose();
+ print " ";
+ $bz->bzsetparams(%BzParams);
+ while ( read LOG, $buffer, default_buffer_size ) {
+ $bz->bzwrite($buffer);
+ }
+ $bz->bzclose();
- close LOG;
- print "\n" if verbose();
+ close LOG;
+ print "\n" if verbose();
- @Stat = stat $file;
- my ( $mode, $uid, $gid, $mtime ) = @Stat[ 2, 4, 5, 9 ];
- $mode &= 0777;
+ @Stat = stat $file;
+ my ( $mode, $uid, $gid, $mtime ) = @Stat[ 2, 4, 5, 9 ];
+ $mode &= 0777;
- print $p . "Setze Permissions von '$target'.\n" if verbose();
- unless ( chmod $mode, $target ) {
- warn $p . "Problem beim Setzen der Permissions von '$target': $!\n";
- }
+ print $p . "Setze Permissions von '$target'.\n" if verbose();
+ unless ( chmod $mode, $target ) {
+ warn $p . "Problem beim Setzen der Permissions von '$target': $!\n";
+ }
- print $p . "Setze Mtime von '$target'.\n" if verbose();
- unless ( utime $mtime, $mtime, $target ) {
- warn $p . "Problem beim Setzen der Mtime von '$target': $!\n";
- }
+ print $p . "Setze Mtime von '$target'.\n" if verbose();
+ unless ( utime $mtime, $mtime, $target ) {
+ warn $p . "Problem beim Setzen der Mtime von '$target': $!\n";
+ }
- print $p . "Setze Besitzerschaft von '$target'.\n" if verbose();
- unless ( chown $uid, $gid, $target ) {
- warn $p . "Problem beim Setzen der Besitzerschaft von '$target': $!\n";
- }
+ print $p . "Setze Besitzerschaft von '$target'.\n" if verbose();
+ unless ( chown $uid, $gid, $target ) {
+ warn $p . "Problem beim Setzen der Besitzerschaft von '$target': $!\n";
+ }
- print $p . "Loesche Original-Datei '$file' ...\n" if verbose();
- unless ( unlink $file ) {
- warn $p . "Problem beim Loeschen von '$file': $!\n";
- return undef;
- }
+ print $p . "Loesche Original-Datei '$file' ...\n" if verbose();
+ unless ( unlink $file ) {
+ warn $p . "Problem beim Loeschen von '$file': $!\n";
+ return undef;
+ }
- return 1;
+ return 1;
-}
+} ## end sub compress_file_bzip2($$)
#------------------------------------------------------------------------------------
sub compress_file_zlib($$) {
- my $self = shift;
- my $file = shift;
- my $p = verbose() ? __PACKAGE__ . "::compress_file_zlib(): " : "";
+ my $self = shift;
+ my $file = shift;
+ my $p = verbose() ? __PACKAGE__ . "::compress_file_zlib(): " : "";
- my ( $size );
+ my ($size);
- unless ( $file ) {
- carp( $p . "Keine Datei uebergeben!\n" );
- return undef;
- }
- print $p . "Komprimiere Datei '$file'" . ( verbose() ? " mittels Compress::Zlib" : "" ) . " ...\n";
+ unless ($file) {
+ carp( $p . "Keine Datei uebergeben!\n" );
+ return undef;
+ }
+ print $p . "Komprimiere Datei '$file'" . ( verbose() ? " mittels Compress::Zlib" : "" ) . " ...\n";
- # Endung der komprimierten Datei ermitteln
- my $ce = $self->{'c'}->compressext();
- if ( not defined($ce) or $ce =~ /^\s*$/ ) {
- $ce = ".gz";
- }
- $ce = "." . $ce if $ce ne "" and $ce !~ /^\./;
+ # Endung der komprimierten Datei ermitteln
+ my $ce = $self->{'c'}->compressext();
+ if ( not defined($ce) or $ce =~ /^\s*$/ ) {
+ $ce = ".gz";
+ }
+ $ce = "." . $ce if $ce ne "" and $ce !~ /^\./;
- # Gucken, ob Datei ueberhaupt da ist
- unless ( -f $file ) {
- warn $p . "Datei '$file' existiert nicht!\n";
- return 1;
- }
+ # Gucken, ob Datei ueberhaupt da ist
+ unless ( -f $file ) {
+ warn $p . "Datei '$file' existiert nicht!\n";
+ return 1;
+ }
- # Weiter, wenn Dateigroesse == 0
- $size = ( -s $file );
- unless ( $size ) {
- print $p . "Datei '$file' hat Groesse 0, wird nicht komprimiert.\n";
- return 1;
- }
+ # Weiter, wenn Dateigroesse == 0
+ $size = ( -s $file );
+ unless ($size) {
+ print $p . "Datei '$file' hat Groesse 0, wird nicht komprimiert.\n";
+ return 1;
+ }
- # Ermittlung Compress-Level
- my $level = 5;
- if ( $self->{'c'}{'compressoptions'} and $self->{'c'}{'compressoptions'} =~ /^[^\d-]*-(\d)/ ) {
- $level = $1;
- }
- print $p . "Gewuenschtes Kompressions-Level: $level\n" if verbose() > 1;
- unless ( $level ) {
- warn $p . "Kompressions-Level '0' eingestellt, keine Kompression.\n";
- return 1;
- }
+ # Ermittlung Compress-Level
+ my $level = 5;
+ if ( $self->{'c'}{'compressoptions'} and $self->{'c'}{'compressoptions'} =~ /^[^\d-]*-(\d)/ ) {
+ $level = $1;
+ }
+ print $p . "Gewuenschtes Kompressions-Level: $level\n" if verbose() > 1;
+ unless ($level) {
+ warn $p . "Kompressions-Level '0' eingestellt, keine Kompression.\n";
+ return 1;
+ }
- # Weiter, wenn Testmodus
- return 1 if $self->{'test'};
+ # Weiter, wenn Testmodus
+ return 1 if $self->{'test'};
- my $blocks = int( $size / default_buffer_size );
- my $every = $blocks > 70 ? int( $blocks / 70 ) + 1 : 1;
- my $i = 0;
- my $target = $file . $ce;
- my $strategy = eval("Compress::Zlib::Z_DEFAULT_STRATEGY;");
- my ( $gz, $buffer );
- my ( @Stat );
+ my $blocks = int( $size / default_buffer_size );
+ my $every = $blocks > 70 ? int( $blocks / 70 ) + 1 : 1;
+ my $i = 0;
+ my $target = $file . $ce;
+ my $strategy = eval("Compress::Zlib::Z_DEFAULT_STRATEGY;");
+ my ( $gz, $buffer );
+ my (@Stat);
- print $p . "Oeffne '$file' zum Lesen ...\n" if verbose() > 1;
- unless ( open LOG, "<", "$file" ) {
- warn $p . "Problem beim Oeffnen der Logdatei '$file' zum Lesen: $!\n";
- return undef;
- }
+ print $p . "Oeffne '$file' zum Lesen ...\n" if verbose() > 1;
+ unless ( open LOG, "<", "$file" ) {
+ warn $p . "Problem beim Oeffnen der Logdatei '$file' zum Lesen: $!\n";
+ return undef;
+ }
- print $p . "Oeffne '$target' zum komprimierten Schreiben ...\n" if verbose() > 1;
- unless ( $gz = Compress::Zlib::gzopen( $target, 'wb' ) ) {
- warn $p . "Kann komprimierte Datei '$target' nicht schreiben: $!.\n";
- close LOG;
- return undef;
- }
+ print $p . "Oeffne '$target' zum komprimierten Schreiben ...\n" if verbose() > 1;
+ unless ( $gz = Compress::Zlib::gzopen( $target, 'wb' ) ) {
+ warn $p . "Kann komprimierte Datei '$target' nicht schreiben: $!.\n";
+ close LOG;
+ return undef;
+ }
- print $p . "Setze Kompressions-Parameter auf Level '$level' und Strategie auf '$strategy'.\n" if verbose() > 2;
- $gz->gzsetparams( $level, $strategy );
+ print $p . "Setze Kompressions-Parameter auf Level '$level' und Strategie auf '$strategy'.\n" if verbose() > 2;
+ $gz->gzsetparams( $level, $strategy );
- print " ";
- while ( read LOG, $buffer, default_buffer_size ) {
- $i++;
- $gz->gzwrite( $buffer );
- print "." if verbose() and ( $i % $every == 0 );
- }
- $gz->gzclose();
+ print " ";
+ while ( read LOG, $buffer, default_buffer_size ) {
+ $i++;
+ $gz->gzwrite($buffer);
+ print "." if verbose() and ( $i % $every == 0 );
+ }
+ $gz->gzclose();
- close LOG;
- print "\n" if verbose();
+ close LOG;
+ print "\n" if verbose();
- @Stat = stat $file;
- my ( $mode, $uid, $gid, $mtime ) = @Stat[ 2, 4, 5, 9 ];
- $mode &= 0777;
+ @Stat = stat $file;
+ my ( $mode, $uid, $gid, $mtime ) = @Stat[ 2, 4, 5, 9 ];
+ $mode &= 0777;
- print $p . "Setze Permissions von '$target'.\n" if verbose();
- unless ( chmod $mode, $target ) {
- warn $p . "Problem beim Setzen der Permissions von '$target': $!\n";
- }
+ print $p . "Setze Permissions von '$target'.\n" if verbose();
+ unless ( chmod $mode, $target ) {
+ warn $p . "Problem beim Setzen der Permissions von '$target': $!\n";
+ }
- print $p . "Setze Mtime von '$target'.\n" if verbose();
- unless ( utime $mtime, $mtime, $target ) {
- warn $p . "Problem beim Setzen der Mtime von '$target': $!\n";
- }
+ print $p . "Setze Mtime von '$target'.\n" if verbose();
+ unless ( utime $mtime, $mtime, $target ) {
+ warn $p . "Problem beim Setzen der Mtime von '$target': $!\n";
+ }
- print $p . "Setze Besitzerschaft von '$target'.\n" if verbose();
- unless ( chown $uid, $gid, $target ) {
- warn $p . "Problem beim Setzen der Besitzerschaft von '$target': $!\n";
- }
+ print $p . "Setze Besitzerschaft von '$target'.\n" if verbose();
+ unless ( chown $uid, $gid, $target ) {
+ warn $p . "Problem beim Setzen der Besitzerschaft von '$target': $!\n";
+ }
- print $p . "Loesche Original-Datei '$file' ...\n" if verbose();
- unless ( unlink $file ) {
- warn $p . "Problem beim Loeschen von '$file': $!\n";
- return undef;
- }
+ print $p . "Loesche Original-Datei '$file' ...\n" if verbose();
+ unless ( unlink $file ) {
+ warn $p . "Problem beim Loeschen von '$file': $!\n";
+ return undef;
+ }
- return 1;
+ return 1;
-}
+} ## end sub compress_file_zlib($$)
#------------------------------------------------------------------------------------
sub create_olddir($$) {
- my $self = shift;
- my $file = shift;
- my $p = verbose() ? __PACKAGE__ . "::create_olddir(): " : "";
-
- my ( $dir, $adir, $mode, $owner, $group, $olddir );
- my ( $pmode, $puid, $pgid, $basename, $t );
- my ( @Dirs, @Stats );
- my $uid = $>;
- my ( $gid ) = $) =~ /^(\d+)/;
+ my $self = shift;
+ my $file = shift;
+ my $p = verbose() ? __PACKAGE__ . "::create_olddir(): " : "";
- unless ( $file ) {
- carp( $p . "Keine Logdatei uebergeben!\n" );
- return undef;
- }
- print $p . "Ueberpruefe und erstelle 'olddir' fuer Logdatei '$file'.\n" if verbose() > 1;
- my $f = $self->{'c'}{'logfiles'}{$file};
+ my ( $dir, $adir, $mode, $owner, $group, $olddir );
+ my ( $pmode, $puid, $pgid, $basename, $t );
+ my ( @Dirs, @Stats );
+ my $uid = $>;
+ my ($gid) = $) =~ /^(\d+)/;
- print $p . Dumper( $f ) if verbose() > 2;
+ unless ($file) {
+ carp( $p . "Keine Logdatei uebergeben!\n" );
+ return undef;
+ }
+ print $p . "Ueberpruefe und erstelle 'olddir' fuer Logdatei '$file'.\n" if verbose() > 1;
+ my $f = $self->{'c'}{'logfiles'}{$file};
- unless ( $f ) {
- carp( $p . "Keine gueltige Logdatei uebergeben!\n" );
- return undef;
- }
+ print $p . Dumper($f) if verbose() > 2;
- my $o = $f->{'olddir'};
+ unless ($f) {
+ carp( $p . "Keine gueltige Logdatei uebergeben!\n" );
+ return undef;
+ }
- unless ( $o->{'dirname'} ) {
- print $p . "Keine 'olddir'-Direktive fuer '$file' gegeben.\n" if verbose() > 1;
- return 1;
- }
+ my $o = $f->{'olddir'};
- $mode = $o->{'mode'} || $self->{'logfiles'}{'default'}{'olddir'}{'mode'} || 0755;
- $owner = $o->{'owner'} || $self->{'logfiles'}{'default'}{'olddir'}{'owner'} || $uid;
- $group = $o->{'group'} || $self->{'logfiles'}{'default'}{'olddir'}{'group'} || $gid;
- unless ( $owner =~ /^\d+$/ ) {
- $owner = getpwuid( $owner );
- $owner = $uid unless defined $owner;
- }
- unless ( $group =~ /^\d+$/ ) {
- $group = getgrnam( $group );
- $group = $gid unless defined $group;
- }
+ unless ( $o->{'dirname'} ) {
+ print $p . "Keine 'olddir'-Direktive fuer '$file' gegeben.\n" if verbose() > 1;
+ return 1;
+ }
- if ( $o->{'dirname'} =~ /%/ ) {
- $o->{'dateformat'} = 1;
- $olddir = POSIX::strftime( $o->{'dirname'}, localtime() );
- } else {
- $olddir = $o->{'dirname'};
- }
+ $mode = $o->{'mode'} || $self->{'logfiles'}{'default'}{'olddir'}{'mode'} || 0755;
+ $owner = $o->{'owner'} || $self->{'logfiles'}{'default'}{'olddir'}{'owner'} || $uid;
+ $group = $o->{'group'} || $self->{'logfiles'}{'default'}{'olddir'}{'group'} || $gid;
+ unless ( $owner =~ /^\d+$/ ) {
+ $owner = getpwuid($owner);
+ $owner = $uid unless defined $owner;
+ }
+ unless ( $group =~ /^\d+$/ ) {
+ $group = getgrnam($group);
+ $group = $gid unless defined $group;
+ }
- # Ersetzung aller Platzhalter in Olddir-Angabe
+ if ( $o->{'dirname'} =~ /%/ ) {
+ $o->{'dateformat'} = 1;
+ $olddir = POSIX::strftime( $o->{'dirname'}, localtime() );
+ }
+ else {
+ $olddir = $o->{'dirname'};
+ }
- unless ( ( $dir, $basename ) = $file =~ m#(.*)/([^/]*)$# ) {
- warn $p . "Ungueltiger Logdateiname: '$file'\n";
- return undef;
- }
+ # Ersetzung aller Platzhalter in Olddir-Angabe
- # Verzeichnisname ...
- $olddir =~ s/(?:\${dirname}|\$dirname(?![a-zA-Z0-9_]))/$dir/g;
-
- # Basename ...
- $olddir =~ s/(?:\${basename}|\$basename(?![a-zA-Z0-9_]))/$basename/g;
-
- # Nodename
- $t = $self->{'template'}{'nodename'};
- $olddir =~ s/(?:\${nodename}|\$nodename(?![a-zA-Z0-9_]))/$t/g;
-
- # Domain
- $t = $self->{'template'}{'domain'};
- $olddir =~ s/(?:\${domain}|\$domain(?![a-zA-Z0-9_]))/$t/g;
-
- # Platform
- $t = $self->{'template'}{'platform'};
- $olddir =~ s/(?:\${platform}|\$platform(?![a-zA-Z0-9_]))/$t/g;
-
- # Isa
- $t = $self->{'template'}{'isa'};
- $olddir =~ s/(?:\${isa}|\$isa(?![a-zA-Z0-9_]))/$t/g;
-
- # Release
- $t = $self->{'template'}{'release'};
- $olddir =~ s/(?:\${release}|\$release(?![a-zA-Z0-9_]))/$t/g;
-
- # Machine
- $t = $self->{'template'}{'machine'};
- $olddir =~ s/(?:\${machine}|\$machine(?![a-zA-Z0-9_]))/$t/g;
-
- $olddir = $dir . "/" . $olddir unless $olddir =~ m#^/#;
-
- $o->{'expanded'} = $olddir;
- print $p . "Olddir ist jetzt: '$olddir'.\n" if verbose() > 1;
-
- unless ( -d $olddir ) {
-
- @Dirs = split m#/#, $olddir;
- $adir = "";
- @Stats = stat "/";
- ( $pmode, $puid, $pgid ) = @Stats[2, 4, 5];
- foreach $dir ( @Dirs ) {
- next unless $dir;
- next if $dir eq "/";
- $adir .= "/" . $dir;
- print " - ueberpruefe $adir\n" if verbose() > 2;
- if ( -d $adir ) {
- @Stats = stat $adir;
- ( $pmode, $puid, $pgid ) = @Stats[2, 4, 5];
- } else {
- print $p . "Erstelle Verzeichnis $adir ...\n";
- # Ermittlung effektive Permissions + Ownership
- # wenn in config-file gegeben, diese,
- # ansonsten die vom uebergeordneten Verzeichnis.
- $mode = defined $o->{'mode'} ? $o->{'mode'} : $pmode;
- $owner = defined $o->{'owner'} ? $o->{'owner'} : $puid;
- $group = defined $o->{'group'} ? $o->{'group'} : $pgid;
- print " Permissions: $mode, Owner: $owner, Group: $group\n" if verbose() > 1;
- unless ( $self->{'test'} ) {
- print " mkdir $adir $mode\n" if verbose() > 1;
- unless ( mkdir $adir, $mode ) {
- warn $p . "$!\n";
- return undef;
- }
- if ( $owner != $uid and $group != $gid ) {
- print " chown $owner, $group, $adir\n" if verbose() > 1;
- unless ( chown $owner, $group, $adir ) {
- warn $p . "$!\n";
- return undef;
- }
- }
- }
- }
+ unless ( ( $dir, $basename ) = $file =~ m#(.*)/([^/]*)$# ) {
+ warn $p . "Ungueltiger Logdateiname: '$file'\n";
+ return undef;
}
- }
+ # Verzeichnisname ...
+ $olddir =~ s/(?:\${dirname}|\$dirname(?![a-zA-Z0-9_]))/$dir/g;
- return 1;
-}
+ # Basename ...
+ $olddir =~ s/(?:\${basename}|\$basename(?![a-zA-Z0-9_]))/$basename/g;
+
+ # Nodename
+ $t = $self->{'template'}{'nodename'};
+ $olddir =~ s/(?:\${nodename}|\$nodename(?![a-zA-Z0-9_]))/$t/g;
+
+ # Domain
+ $t = $self->{'template'}{'domain'};
+ $olddir =~ s/(?:\${domain}|\$domain(?![a-zA-Z0-9_]))/$t/g;
+
+ # Platform
+ $t = $self->{'template'}{'platform'};
+ $olddir =~ s/(?:\${platform}|\$platform(?![a-zA-Z0-9_]))/$t/g;
+
+ # Isa
+ $t = $self->{'template'}{'isa'};
+ $olddir =~ s/(?:\${isa}|\$isa(?![a-zA-Z0-9_]))/$t/g;
+
+ # Release
+ $t = $self->{'template'}{'release'};
+ $olddir =~ s/(?:\${release}|\$release(?![a-zA-Z0-9_]))/$t/g;
+
+ # Machine
+ $t = $self->{'template'}{'machine'};
+ $olddir =~ s/(?:\${machine}|\$machine(?![a-zA-Z0-9_]))/$t/g;
+
+ $olddir = $dir . "/" . $olddir unless $olddir =~ m#^/#;
+
+ $o->{'expanded'} = $olddir;
+ print $p . "Olddir ist jetzt: '$olddir'.\n" if verbose() > 1;
+
+ unless ( -d $olddir ) {
+
+ @Dirs = split m#/#, $olddir;
+ $adir = "";
+ @Stats = stat "/";
+ ( $pmode, $puid, $pgid ) = @Stats[ 2, 4, 5 ];
+ foreach $dir (@Dirs) {
+ next unless $dir;
+ next if $dir eq "/";
+ $adir .= "/" . $dir;
+ print " - ueberpruefe $adir\n" if verbose() > 2;
+ if ( -d $adir ) {
+ @Stats = stat $adir;
+ ( $pmode, $puid, $pgid ) = @Stats[ 2, 4, 5 ];
+ }
+ else {
+ print $p . "Erstelle Verzeichnis $adir ...\n";
+
+ # Ermittlung effektive Permissions + Ownership
+ # wenn in config-file gegeben, diese,
+ # ansonsten die vom uebergeordneten Verzeichnis.
+ $mode = defined $o->{'mode'} ? $o->{'mode'} : $pmode;
+ $owner = defined $o->{'owner'} ? $o->{'owner'} : $puid;
+ $group = defined $o->{'group'} ? $o->{'group'} : $pgid;
+ print " Permissions: $mode, Owner: $owner, Group: $group\n" if verbose() > 1;
+ unless ( $self->{'test'} ) {
+ print " mkdir $adir $mode\n" if verbose() > 1;
+ unless ( mkdir $adir, $mode ) {
+ warn $p . "$!\n";
+ return undef;
+ }
+ if ( $owner != $uid and $group != $gid ) {
+ print " chown $owner, $group, $adir\n" if verbose() > 1;
+ unless ( chown $owner, $group, $adir ) {
+ warn $p . "$!\n";
+ return undef;
+ }
+ }
+ } ## end unless ( $self->{'test'} )
+ } ## end else [ if ( -d $adir )
+ } ## end foreach $dir (@Dirs)
+
+ } ## end unless ( -d $olddir )
+
+ return 1;
+} ## end sub create_olddir($$)
#------------------------------------------------------------------------------------
sub delete_oldfiles($) {
- my $self = shift;
- my $p = verbose() ? __PACKAGE__ . "::delete_oldfiles(): " : "";
+ my $self = shift;
+ my $p = verbose() ? __PACKAGE__ . "::delete_oldfiles(): " : "";
- print $p . "Loesche alte Logdateien ...\n" if verbose();
+ print $p . "Loesche alte Logdateien ...\n" if verbose();
- unless ( $self->{'files_delete'} and scalar( keys %{$self->{'files_delete'}} ) ) {
- print $p . "Keine alten Logdateien zum Loeschen gefunden.\n";
- return 1;
- }
+ unless ( $self->{'files_delete'} and scalar( keys %{ $self->{'files_delete'} } ) ) {
+ print $p . "Keine alten Logdateien zum Loeschen gefunden.\n";
+ return 1;
+ }
- my ( $file );
+ my ($file);
- for $file ( sort keys %{$self->{'files_delete'}} ) {
- print $p . "Loesche alte Logdatei '$file' ...\n";
- unless ( $self->{'test'} ) {
- unless ( unlink($file) ) {
- warn $p . "Konnte alte Logdatei '$file' nicht loeschen: $!\n";
- return undef;
- }
+ for $file ( sort keys %{ $self->{'files_delete'} } ) {
+ print $p . "Loesche alte Logdatei '$file' ...\n";
+ unless ( $self->{'test'} ) {
+ unless ( unlink($file) ) {
+ warn $p . "Konnte alte Logdatei '$file' nicht loeschen: $!\n";
+ return undef;
+ }
+ }
}
- }
- return 1;
+ return 1;
-}
+} ## end sub delete_oldfiles($)
#------------------------------------------------------------------------------------
=cut
-
sub find_rotatings($$$) {
- my $self = shift;
- my $file = shift;
- my $target = shift;
- my $p = verbose() ? __PACKAGE__ . "::find_rotatings(): " : "";
+ my $self = shift;
+ my $file = shift;
+ my $target = shift;
+ my $p = verbose() ? __PACKAGE__ . "::find_rotatings(): " : "";
- unless ( $file ) {
- carp( $p . "Keine Logdatei uebergeben!\n" );
- return undef;
- }
+ unless ($file) {
+ carp( $p . "Keine Logdatei uebergeben!\n" );
+ return undef;
+ }
- unless ( $target ) {
- carp( $p . "Kein Dateiname fuer rotierte Logdatei uebergeben!\n" );
- return undef;
- }
+ unless ($target) {
+ carp( $p . "Kein Dateiname fuer rotierte Logdatei uebergeben!\n" );
+ return undef;
+ }
- print $p . "Ermittle alle Umbenennungen und Rotationen fuer Logdatei '$file' -> '$target'...\n" if verbose() > 1;
- my $f = $self->{'c'}{'logfiles'}{$file};
+ print $p . "Ermittle alle Umbenennungen und Rotationen fuer Logdatei '$file' -> '$target'...\n" if verbose() > 1;
+ my $f = $self->{'c'}{'logfiles'}{$file};
- my $ext = defined $f->{'extension'} ? $f->{'extension'} : "";
- $ext = "" if $ext =~ /^\s*$/;
- $ext = "." . $ext if $ext ne "" and $ext !~ /^\./;
- my $ext_ohne = $ext;
+ my $ext = defined $f->{'extension'} ? $f->{'extension'} : "";
+ $ext = "" if $ext =~ /^\s*$/;
+ $ext = "." . $ext if $ext ne "" and $ext !~ /^\./;
+ my $ext_ohne = $ext;
- # Compress-Endung hinten dran bammeln ...
- if ( $f->{'compress'} ) {
- my $ce = $self->{'c'}->compressext();
- if ( not defined($ce) or $ce =~ /^\s*$/ ) {
- $ce = ".gz";
+ # Compress-Endung hinten dran bammeln ...
+ if ( $f->{'compress'} ) {
+ my $ce = $self->{'c'}->compressext();
+ if ( not defined($ce) or $ce =~ /^\s*$/ ) {
+ $ce = ".gz";
+ }
+ $ce = "." . $ce if $ce ne "" and $ce !~ /^\./;
+ $ext .= $ce;
}
- $ce = "." . $ce if $ce ne "" and $ce !~ /^\./;
- $ext .= $ce;
- }
- my ( $i, $pair, $t, $t_ohne, $t_new, $t_new_ohne );
- $t = $target . $ext;
- $t_ohne = $target . $ext_ohne;
- $i = 0;
-
- my $res = {
- 'rotate' => {},
- 'move' => []
- };
-
- # Ziel der eigentlichen Rotation festlegen
- if ( $file eq $t ) {
- $t = $target . ".0" . $ext;
- $t_ohne = $target . ".0" . $ext_ohne;
- $i = 1;
- }
- $res->{'rotate'}{'from'} = $file;
- $res->{'rotate'}{'to'} = $t_ohne;
-
- # Rotationsziel gibt's nicht, okay, raus hier
- return $res unless -f $t or -f $t_ohne;
-
- print $p . "Rotationsziel '$t_ohne' gibt's schon, ermittle zyklische Rotationen ...\n" if verbose() > 2;
- # restliche Rotationen festlegen ...
- while ( -f $t or -f $t_ohne ) {
- $t_new = $target . "." . $i . $ext;
- $t_new_ohne = $target . "." . $i . $ext_ohne;
- print $p . "Zyklische Rotation '$t_ohne' -> '$t_new_ohne'.\n" if verbose() > 3;
- $pair = { 'from' => $t_ohne,
- 'to' => $t_new_ohne,
- 'compressed' => 0,
- };
- $pair->{'compressed'} = 1 if -f $t and $f->{'compress'};
- unshift @{$res->{'move'}}, $pair;
- $t = $t_new;
- $t_ohne = $t_new_ohne;
- $i++;
- }
-
- return $res;
-
-}
+ my ( $i, $pair, $t, $t_ohne, $t_new, $t_new_ohne );
+ $t = $target . $ext;
+ $t_ohne = $target . $ext_ohne;
+ $i = 0;
+
+ my $res = {
+ 'rotate' => {},
+ 'move' => []
+ };
+
+ # Ziel der eigentlichen Rotation festlegen
+ if ( $file eq $t ) {
+ $t = $target . ".0" . $ext;
+ $t_ohne = $target . ".0" . $ext_ohne;
+ $i = 1;
+ }
+ $res->{'rotate'}{'from'} = $file;
+ $res->{'rotate'}{'to'} = $t_ohne;
+
+ # Rotationsziel gibt's nicht, okay, raus hier
+ return $res unless -f $t or -f $t_ohne;
+
+ print $p . "Rotationsziel '$t_ohne' gibt's schon, ermittle zyklische Rotationen ...\n" if verbose() > 2;
+
+ # restliche Rotationen festlegen ...
+ while ( -f $t or -f $t_ohne ) {
+ $t_new = $target . "." . $i . $ext;
+ $t_new_ohne = $target . "." . $i . $ext_ohne;
+ print $p . "Zyklische Rotation '$t_ohne' -> '$t_new_ohne'.\n" if verbose() > 3;
+ $pair = {
+ 'from' => $t_ohne,
+ 'to' => $t_new_ohne,
+ 'compressed' => 0,
+ };
+ $pair->{'compressed'} = 1 if -f $t and $f->{'compress'};
+ unshift @{ $res->{'move'} }, $pair;
+ $t = $t_new;
+ $t_ohne = $t_new_ohne;
+ $i++;
+ } ## end while ( -f $t or -f $t_ohne )
+
+ return $res;
+
+} ## end sub find_rotatings($$$)
#------------------------------------------------------------------------------------
sub get_logfile_target($$) {
- my $self = shift;
- my $file = shift;
- my $p = verbose() ? __PACKAGE__ . "::get_logfile_target(): " : "";
+ my $self = shift;
+ my $file = shift;
+ my $p = verbose() ? __PACKAGE__ . "::get_logfile_target(): " : "";
- unless ( $file ) {
- carp( $p . "Keine Logdatei uebergeben!\n" );
- return undef;
- }
+ unless ($file) {
+ carp( $p . "Keine Logdatei uebergeben!\n" );
+ return undef;
+ }
- print $p . "Ermittle Dateinamen der rotierten Logdatei '$file'...\n" if verbose() > 1;
- my $f = $self->{'c'}{'logfiles'}{$file};
+ print $p . "Ermittle Dateinamen der rotierten Logdatei '$file'...\n" if verbose() > 1;
+ my $f = $self->{'c'}{'logfiles'}{$file};
- print $p . "Struktur von '$file': " . " " . Dumper( $f ) if verbose() > 2;
+ print $p . "Struktur von '$file': " . " " . Dumper($f) if verbose() > 2;
- my ( $nr, $dir, $basename, $target, $pattern, $t );
+ my ( $nr, $dir, $basename, $target, $pattern, $t );
- unless ( $f ) {
- carp( $p . "Keine gueltige Logdatei uebergeben!\n" );
- return undef;
- }
+ unless ($f) {
+ carp( $p . "Keine gueltige Logdatei uebergeben!\n" );
+ return undef;
+ }
- unless ( ( $dir, $basename ) = $file =~ m#(.*)/([^/]*)$# ) {
- warn $p . "Ungueltiger Logdateiname: '$file'\n";
- return undef;
- }
+ unless ( ( $dir, $basename ) = $file =~ m#(.*)/([^/]*)$# ) {
+ warn $p . "Ungueltiger Logdateiname: '$file'\n";
+ return undef;
+ }
- $dir = $f->{'olddir'}{'expanded'} if $f->{'olddir'}{'expanded'};
- $target = $dir . "/" . $basename;
- if ( $f->{'dateext'} ) {
- $pattern = $f->{'datepattern'};
- print $p . "Verwende Datumsersetzung '$pattern' fuer '$file'.\n" if verbose() > 1;
- $pattern = POSIX::strftime( $pattern, localtime() );
- print $p . " -> '$pattern'\n" if verbose() > 3;
- $target .= "." . $pattern;
- }
+ $dir = $f->{'olddir'}{'expanded'} if $f->{'olddir'}{'expanded'};
+ $target = $dir . "/" . $basename;
+ if ( $f->{'dateext'} ) {
+ $pattern = $f->{'datepattern'};
+ print $p . "Verwende Datumsersetzung '$pattern' fuer '$file'.\n" if verbose() > 1;
+ $pattern = POSIX::strftime( $pattern, localtime() );
+ print $p . " -> '$pattern'\n" if verbose() > 3;
+ $target .= "." . $pattern;
+ }
- print $p . "Dateiname '$target' fuer rotierte Logdatei '$file' gefunden.\n" if verbose() > 1;
- return $target;
+ print $p . "Dateiname '$target' fuer rotierte Logdatei '$file' gefunden.\n" if verbose() > 1;
+ return $target;
-}
+} ## end sub get_logfile_target($$)
#------------------------------------------------------------------------------------
sub read_config($$) {
- my $self = shift;
- my $file = shift;
- my $p = verbose() ? __PACKAGE__ . "::read_config(): " : "";
+ my $self = shift;
+ my $file = shift;
+ my $p = verbose() ? __PACKAGE__ . "::read_config(): " : "";
- return $self->{'c'}->read($file);
+ return $self->{'c'}->read($file);
}
sub rotate($) {
- my $self = shift;
- my $p = verbose() ? __PACKAGE__ . "::rotate(): " : "";
-
- die $p . "Noch keine Konfiguration eingelesen.\n\n" unless $self->{'c'};
+ my $self = shift;
+ my $p = verbose() ? __PACKAGE__ . "::rotate(): " : "";
- unless ( $self->{'c'}{'logfiles'} and scalar( keys %{$self->{'c'}{'logfiles'}} ) ) {
- warn $p . "Keine Logdateien zum Rotieren gefunden.\n";
- return undef;
- }
+ die $p . "Noch keine Konfiguration eingelesen.\n\n" unless $self->{'c'};
- my ( $file, $should_rotate, $firstscript, $prescript, $postscript, $lastscript, $sharedscripts );
- my ( $cmd, $do_script, $name );
-
- foreach $file ( sort { lc($a) cmp lc($b) } keys %{$self->{'c'}{'logfiles'}} ) {
-
- print( "\n" . ("-" x 20) . "\n\n") if verbose() > 1;
- print $p . "Bearbeite Logdatei '$file' ...\n" if verbose() > 1;
-
- $should_rotate = $self->test_for_rotate( $file );
-
- unless( defined $should_rotate ) {
- die $p . "Schwerer Fehler, breche hier ab.\n";
- }
-
- unless ( $should_rotate ) {
- print $p . "Logdatei '$file' wird NICHT rotiert.\n" if verbose();
- next;
- }
- print $p . "Logdatei '$file' wird rotiert.\n" if verbose();
-
- $sharedscripts = $self->{'c'}{'logfiles'}{$file}{'sharedscripts'} || 0;
- $firstscript = $self->{'c'}{'logfiles'}{$file}{'firstaction'};
- $prescript = $self->{'c'}{'logfiles'}{$file}{'prerotate'};
- $postscript = $self->{'c'}{'logfiles'}{$file}{'postrotate'};
- $lastscript = $self->{'c'}{'logfiles'}{$file}{'lastaction'};
-
- # Ausfuehren des Firtsaction-Scripts, falls es noch nicht ausgefuehrt wurde
- if ( $firstscript ) {
- print $p . "Schau nach, ob das Firstaction-Script ausgefuehrt werden soll ...\n" if verbose() > 2;
- unless ( $self->{'c'}{'scripts'}{$firstscript}{'first'} ) {
- $cmd = join( "\n", @{$self->{'c'}{'scripts'}{$firstscript}{'cmd'}} ) . "\n";
- print $p . "Fuehre Firstaction-Script '$firstscript' aus:\n$cmd";
- system $cmd unless $self->{'test'};
- }
- $self->{'c'}{'scripts'}{$firstscript}{'first'} = 1;
- }
-
- # Ausfuehren des Prerotate-Scripts, falls es noch nicht ausgefuehrt wurde
- # oder sharedscripts nicht gesetzt ist
- if ( $prescript ) {
- print $p . "Schau nach, ob das Prerotate-Script ausgefuehrt werden soll ...\n" if verbose() > 2;
- unless ( $self->{'c'}{'scripts'}{$prescript}{'prerun'} and $sharedscripts ) {
- $cmd = join( "\n", @{$self->{'c'}{'scripts'}{$prescript}{'cmd'}} ) . "\n";
- print $p . "Fuehre Firstaction-Script '$prescript' aus:\n$cmd";
- system $cmd unless $self->{'test'};
- }
- $self->{'c'}{'scripts'}{$prescript}{'prerun'} = 1;
- }
-
- #####
- # Hier jetzt das eigentliche Rotieren ....
- #####
-
- unless ( $self->create_olddir( $file ) ) {
- next;
- }
-
- unless ( $self->rotate_file( $file ) ) {
- next;
- }
-
- # Ausfuehren des Postrotate-Scripts, falls es die letzte Rotation ist, fuer die
- # dieses Script gilt, oder sharedscripts nicht gesetzt ist
- if ( $postscript ) {
- print $p . "Schau nach, ob das Postrotate-Script ausgefuehrt werden soll ...\n" if verbose() > 2;
- $do_script = 0;
- $self->{'c'}{'scripts'}{$postscript}{'post'}--;
- $self->{'c'}{'scripts'}{$postscript}{'dopost'} = 1;
- if ( $sharedscripts ) {
- $do_script = 0;
- } else {
- $do_script = 1 if $self->{'c'}{'scripts'}{$postscript}{'post'} == 0;
- }
- if ( $do_script ) {
- $self->{'c'}{'scripts'}{$postscript}{'donepost'} = 1;
- $cmd = join( "\n", @{$self->{'c'}{'scripts'}{$postscript}{'cmd'}} ) . "\n";
- print $p . "Fuehre Postrotate-Script '$postscript' aus:\n$cmd";
- system $cmd unless $self->{'test'};
- }
- }
-
- # Ausfuehren des Lastaction-Scripts, falls es die letzte Rotation ist, fuer die
- # dieses Script gilt, oder sharedscripts nicht gesetzt ist
- if ( $lastscript ) {
- print $p . "Schau nach, ob das Lastaction-Script ausgefuehrt werden soll ...\n" if verbose() > 2;
- $do_script = 0;
- $self->{'c'}{'scripts'}{$lastscript}{'last'}--;
- $self->{'c'}{'scripts'}{$lastscript}{'dolast'} = 1;
- $do_script = 1 if $self->{'c'}{'scripts'}{$lastscript}{'last'} == 0;
- if ( $do_script ) {
- $self->{'c'}{'scripts'}{$lastscript}{'donelast'} = 1;
- $cmd = join( "\n", @{$self->{'c'}{'scripts'}{$lastscript}{'cmd'}} ) . "\n";
- print $p . "Fuehre Lastaction-Script '$lastscript' aus:\n$cmd";
- system $cmd unless $self->{'test'};
- }
+ unless ( $self->{'c'}{'logfiles'} and scalar( keys %{ $self->{'c'}{'logfiles'} } ) ) {
+ warn $p . "Keine Logdateien zum Rotieren gefunden.\n";
+ return undef;
}
- }
+ my ( $file, $should_rotate, $firstscript, $prescript, $postscript, $lastscript, $sharedscripts );
+ my ( $cmd, $do_script, $name );
+
+ foreach $file ( sort { lc($a) cmp lc($b) } keys %{ $self->{'c'}{'logfiles'} } ) {
+
+ print( "\n" . ( "-" x 20 ) . "\n\n" ) if verbose() > 1;
+ print $p . "Bearbeite Logdatei '$file' ...\n" if verbose() > 1;
+
+ $should_rotate = $self->test_for_rotate($file);
+
+ unless ( defined $should_rotate ) {
+ die $p . "Schwerer Fehler, breche hier ab.\n";
+ }
+
+ unless ($should_rotate) {
+ print $p . "Logdatei '$file' wird NICHT rotiert.\n" if verbose();
+ next;
+ }
+ print $p . "Logdatei '$file' wird rotiert.\n" if verbose();
+
+ $sharedscripts = $self->{'c'}{'logfiles'}{$file}{'sharedscripts'} || 0;
+ $firstscript = $self->{'c'}{'logfiles'}{$file}{'firstaction'};
+ $prescript = $self->{'c'}{'logfiles'}{$file}{'prerotate'};
+ $postscript = $self->{'c'}{'logfiles'}{$file}{'postrotate'};
+ $lastscript = $self->{'c'}{'logfiles'}{$file}{'lastaction'};
+
+ # Ausfuehren des Firtsaction-Scripts, falls es noch nicht ausgefuehrt wurde
+ if ($firstscript) {
+ print $p . "Schau nach, ob das Firstaction-Script ausgefuehrt werden soll ...\n" if verbose() > 2;
+ unless ( $self->{'c'}{'scripts'}{$firstscript}{'first'} ) {
+ $cmd = join( "\n", @{ $self->{'c'}{'scripts'}{$firstscript}{'cmd'} } ) . "\n";
+ print $p . "Fuehre Firstaction-Script '$firstscript' aus:\n$cmd";
+ system $cmd unless $self->{'test'};
+ }
+ $self->{'c'}{'scripts'}{$firstscript}{'first'} = 1;
+ }
- # Checke nach uebriggebliebenen Postrotate-Scripts ...
- print "\n$p" . "Checke nach uebriggebliebenen Postrotate-Scripts ...\n" if verbose();
- foreach $name ( keys %{$self->{'c'}{'scripts'}} ) {
- if ( $self->{'c'}{'scripts'}{$name}{'dopost'} and not $self->{'c'}{'scripts'}{$name}{'donepost'} ) {
- $cmd = join( "\n", @{$self->{'c'}{'scripts'}{$name}{'cmd'}} ) . "\n";
- print $p . "Fuehre Postrotate-Script '$name' aus:\n$cmd";
- system $cmd unless $self->{'test'};
+ # Ausfuehren des Prerotate-Scripts, falls es noch nicht ausgefuehrt wurde
+ # oder sharedscripts nicht gesetzt ist
+ if ($prescript) {
+ print $p . "Schau nach, ob das Prerotate-Script ausgefuehrt werden soll ...\n" if verbose() > 2;
+ unless ( $self->{'c'}{'scripts'}{$prescript}{'prerun'} and $sharedscripts ) {
+ $cmd = join( "\n", @{ $self->{'c'}{'scripts'}{$prescript}{'cmd'} } ) . "\n";
+ print $p . "Fuehre Firstaction-Script '$prescript' aus:\n$cmd";
+ system $cmd unless $self->{'test'};
+ }
+ $self->{'c'}{'scripts'}{$prescript}{'prerun'} = 1;
+ }
+
+ #####
+ # Hier jetzt das eigentliche Rotieren ....
+ #####
+
+ unless ( $self->create_olddir($file) ) {
+ next;
+ }
+
+ unless ( $self->rotate_file($file) ) {
+ next;
+ }
+
+ # Ausfuehren des Postrotate-Scripts, falls es die letzte Rotation ist, fuer die
+ # dieses Script gilt, oder sharedscripts nicht gesetzt ist
+ if ($postscript) {
+ print $p . "Schau nach, ob das Postrotate-Script ausgefuehrt werden soll ...\n" if verbose() > 2;
+ $do_script = 0;
+ $self->{'c'}{'scripts'}{$postscript}{'post'}--;
+ $self->{'c'}{'scripts'}{$postscript}{'dopost'} = 1;
+ if ($sharedscripts) {
+ $do_script = 0;
+ }
+ else {
+ $do_script = 1 if $self->{'c'}{'scripts'}{$postscript}{'post'} == 0;
+ }
+ if ($do_script) {
+ $self->{'c'}{'scripts'}{$postscript}{'donepost'} = 1;
+ $cmd = join( "\n", @{ $self->{'c'}{'scripts'}{$postscript}{'cmd'} } ) . "\n";
+ print $p . "Fuehre Postrotate-Script '$postscript' aus:\n$cmd";
+ system $cmd unless $self->{'test'};
+ }
+ } ## end if ($postscript)
+
+ # Ausfuehren des Lastaction-Scripts, falls es die letzte Rotation ist, fuer die
+ # dieses Script gilt, oder sharedscripts nicht gesetzt ist
+ if ($lastscript) {
+ print $p . "Schau nach, ob das Lastaction-Script ausgefuehrt werden soll ...\n" if verbose() > 2;
+ $do_script = 0;
+ $self->{'c'}{'scripts'}{$lastscript}{'last'}--;
+ $self->{'c'}{'scripts'}{$lastscript}{'dolast'} = 1;
+ $do_script = 1 if $self->{'c'}{'scripts'}{$lastscript}{'last'} == 0;
+ if ($do_script) {
+ $self->{'c'}{'scripts'}{$lastscript}{'donelast'} = 1;
+ $cmd = join( "\n", @{ $self->{'c'}{'scripts'}{$lastscript}{'cmd'} } ) . "\n";
+ print $p . "Fuehre Lastaction-Script '$lastscript' aus:\n$cmd";
+ system $cmd unless $self->{'test'};
+ }
+ } ## end if ($lastscript)
+
+ } ## end foreach $file ( sort { lc($a) cmp lc($b) } keys...
+
+ # Checke nach uebriggebliebenen Postrotate-Scripts ...
+ print "\n$p" . "Checke nach uebriggebliebenen Postrotate-Scripts ...\n" if verbose();
+ foreach $name ( keys %{ $self->{'c'}{'scripts'} } ) {
+ if ( $self->{'c'}{'scripts'}{$name}{'dopost'} and not $self->{'c'}{'scripts'}{$name}{'donepost'} ) {
+ $cmd = join( "\n", @{ $self->{'c'}{'scripts'}{$name}{'cmd'} } ) . "\n";
+ print $p . "Fuehre Postrotate-Script '$name' aus:\n$cmd";
+ system $cmd unless $self->{'test'};
+ }
}
- }
- # Checke nach uebriggebliebenen Lastaction-Scripts ...
- print "\n$p" . "Checke nach uebriggebliebenen Lastaction-Scripts ...\n" if verbose();
- foreach $name ( keys %{$self->{'c'}{'scripts'}} ) {
- if ( $self->{'c'}{'scripts'}{$name}{'dolast'} and not $self->{'c'}{'scripts'}{$name}{'donelast'} ) {
- $cmd = join( "\n", @{$self->{'c'}{'scripts'}{$name}{'cmd'}} ) . "\n";
- print $p . "Fuehre Lastaction-Script '$name' aus:\n$cmd";
- system $cmd unless $self->{'test'};
+ # Checke nach uebriggebliebenen Lastaction-Scripts ...
+ print "\n$p" . "Checke nach uebriggebliebenen Lastaction-Scripts ...\n" if verbose();
+ foreach $name ( keys %{ $self->{'c'}{'scripts'} } ) {
+ if ( $self->{'c'}{'scripts'}{$name}{'dolast'} and not $self->{'c'}{'scripts'}{$name}{'donelast'} ) {
+ $cmd = join( "\n", @{ $self->{'c'}{'scripts'}{$name}{'cmd'} } ) . "\n";
+ print $p . "Fuehre Lastaction-Script '$name' aus:\n$cmd";
+ system $cmd unless $self->{'test'};
+ }
}
- }
- return 1;
+ return 1;
-}
+} ## end sub rotate($)
#------------------------------------------------------------------------------------
sub rotate_file($$) {
- my $self = shift;
- my $file = shift;
- my $p = verbose() ? __PACKAGE__ . "::rotate_file(): " : "";
-
- my ( $target, $rotates, $pair, $from, $to );
- my ( $omode, $ouid, $ogid, $nmode, $nuid, $ngid, $atime, $mtime );
- my ( @Stats );
+ my $self = shift;
+ my $file = shift;
+ my $p = verbose() ? __PACKAGE__ . "::rotate_file(): " : "";
- print "\n";
-
- my $ce = $self->{'c'}->compressext();
- if ( not defined($ce) or $ce =~ /^\s*$/ ) {
- $ce = ".gz";
- }
- $ce = "." . $ce if $ce ne "" and $ce !~ /^\./;
- print $p . "Kompressionsendung '$ce'.\n" if verbose() > 2;
-
- unless ( $file ) {
- carp( $p . "Keine Logdatei uebergeben!\n" );
- return undef;
- }
- print $p . "Rotiere Logdatei '$file'.\n" if verbose();
- my $f = $self->{'c'}{'logfiles'}{$file};
-
- print $p . Dumper( $f ) if verbose() > 2;
-
- unless ( $f ) {
- carp( $p . "Keine gueltige Logdatei uebergeben!\n" );
- return undef;
- }
+ my ( $target, $rotates, $pair, $from, $to );
+ my ( $omode, $ouid, $ogid, $nmode, $nuid, $ngid, $atime, $mtime );
+ my (@Stats);
- unless ( $target = $self->get_logfile_target($file) ) {
- carp( $p . "Kein gueltigen Dateinamen fuer Rotation gefunden!\n" );
- return undef;
- }
+ print "\n";
- unless ( $rotates = $self->find_rotatings($file, $target) ) {
- carp( $p . "Keine gueltigen Moves fuer Rotation gefunden!\n" );
- return undef;
- }
+ my $ce = $self->{'c'}->compressext();
+ if ( not defined($ce) or $ce =~ /^\s*$/ ) {
+ $ce = ".gz";
+ }
+ $ce = "." . $ce if $ce ne "" and $ce !~ /^\./;
+ print $p . "Kompressionsendung '$ce'.\n" if verbose() > 2;
- print $p . "Ermittelte Moves: " . Dumper($rotates) if verbose() > 2;
-
- # Zuerst mal alles Alte zyklisch rotieren ...
-
- for $pair ( @{$rotates->{'move'}} ) {
- $from = $pair->{'from'};
- $to = $pair->{'to'};
- if ( $pair->{'compressed'} ) {
- $from .= $ce;
- $to .= $ce;
- }
- print $p . "Umbenennung '$from' => '$to'.\n";
- unless ( $self->{'test'} ) {
- unless ( move $from, $to ) {
- warn $p . "Konnte '$from' nicht in '$to' umbenennen: $!\n";
+ unless ($file) {
+ carp( $p . "Keine Logdatei uebergeben!\n" );
return undef;
- }
}
- }
-
- # Jetzt die eigentliche Rotation ...
-
- $from = $rotates->{'rotate'}{'from'};
- $to = $rotates->{'rotate'}{'to'};
-
- $f->{'rotated'} = $to;
+ print $p . "Rotiere Logdatei '$file'.\n" if verbose();
+ my $f = $self->{'c'}{'logfiles'}{$file};
- if ( $f->{'copytruncate'} ) {
+ print $p . Dumper($f) if verbose() > 2;
- # alte Permissions und Besitzer der rotierten Datei ermitteln
- @Stats = stat $from;
- ( $omode, $ouid, $ogid, $atime, $mtime ) = @Stats[ 2, 4, 5, 8, 9 ];
-
- print $p . "Kopiere '$from' nach '$to' ...\n";
- unless ( $self->{'test'} ) {
- unless ( copy $from, $to ) {
- warn $p . "Konnte '$from' nicht nach '$to' kopieren: $!\n";
+ unless ($f) {
+ carp( $p . "Keine gueltige Logdatei uebergeben!\n" );
return undef;
- }
}
- print $p . "Trunce Datei '$from' ...\n";
- unless ( $self->{'test'} ) {
- if ( open FILE, ">$from" ) {
- close FILE;
- } else {
- warn $p . "Konnte Logdatei '$from' nicht truncen: $!\n";
+ unless ( $target = $self->get_logfile_target($file) ) {
+ carp( $p . "Kein gueltigen Dateinamen fuer Rotation gefunden!\n" );
return undef;
- }
}
- # gewuenschte Permissions setzen
- print $p . "Setze Permissions von '$to'.\n" if verbose();
- unless ( $self->{'test'} ) {
- unless ( chmod $omode, $to ) {
- warn $p . "Setzen der Permissions von '$to' war nnicht erfolgreich: $!\n";
- }
- }
-
- # gewuenschte Besitzer stzen
- print $p . "Setze Besitzer von '$to'.\n" if verbose();
- unless ( $self->{'test'} ) {
- unless ( chown $ouid, $ogid, $to ) {
- warn $p . "Setzen des Besitzers von '$to' war nicht erfolgreich: $!\n";
- }
+ unless ( $rotates = $self->find_rotatings( $file, $target ) ) {
+ carp( $p . "Keine gueltigen Moves fuer Rotation gefunden!\n" );
+ return undef;
}
- # Access- und Modification-Time setzen ...
- print $p . "Setze Access- und Modification-Time von '$to'.\n" if verbose();
- unless ( $self->{'test'} ) {
- unless ( utime $atime, $mtime, $to ) {
- warn $p . "Setzen der Access- und Modification-Time von '$to' war nicht erfolgreich: $!\n";
- }
- }
+ print $p . "Ermittelte Moves: " . Dumper($rotates) if verbose() > 2;
- } else {
+ # Zuerst mal alles Alte zyklisch rotieren ...
- # alte Permissions und Besitzer ermitteln
- @Stats = stat $from;
+ for $pair ( @{ $rotates->{'move'} } ) {
+ $from = $pair->{'from'};
+ $to = $pair->{'to'};
+ if ( $pair->{'compressed'} ) {
+ $from .= $ce;
+ $to .= $ce;
+ }
+ print $p . "Umbenennung '$from' => '$to'.\n";
+ unless ( $self->{'test'} ) {
+ unless ( move $from, $to ) {
+ warn $p . "Konnte '$from' nicht in '$to' umbenennen: $!\n";
+ return undef;
+ }
+ }
+ } ## end for $pair ( @{ $rotates->{'move'} } )
- print $p . "Benenne um bzw. verschiebe '$from' nach '$to' ...\n";
- unless ( $self->{'test'} ) {
- unless ( move $from, $to ) {
- warn $p . "Konnte '$from' nicht nach '$to' umbenennen/verschieben: $!\n";
- return undef;
- }
- }
+ # Jetzt die eigentliche Rotation ...
- if ( $f->{'create'} ) {
+ $from = $rotates->{'rotate'}{'from'};
+ $to = $rotates->{'rotate'}{'to'};
- print $p . "Lege '$from' neu an ...\n";
- unless ( $self->{'test'} ) {
- if ( open FILE, ">$from" ) {
- close FILE;
- } else {
- warn $p . "Konnte Logdatei '$from' nicht neu anlegen: $!\n";
- return undef;
- }
- }
+ $f->{'rotated'} = $to;
- # gewuenschte Permissions und Besitzer ermitteln
- $nmode = defined $f->{'create'}{'mode'} ? $f->{'create'}{'mode'} : $Stats[2];
- $nuid = defined $f->{'create'}{'owner'} ? $f->{'create'}{'owner'} : $Stats[4];
- $ngid = defined $f->{'create'}{'group'} ? $f->{'create'}{'group'} : $Stats[5];
+ if ( $f->{'copytruncate'} ) {
- # alte Permissions und Besitzer der neu angelegten Datei ermitteln
- @Stats = stat $from;
- ( $omode, $ouid, $ogid ) = @Stats[ 2, 4, 5 ];
+ # alte Permissions und Besitzer der rotierten Datei ermitteln
+ @Stats = stat $from;
+ ( $omode, $ouid, $ogid, $atime, $mtime ) = @Stats[ 2, 4, 5, 8, 9 ];
+
+ print $p . "Kopiere '$from' nach '$to' ...\n";
+ unless ( $self->{'test'} ) {
+ unless ( copy $from, $to ) {
+ warn $p . "Konnte '$from' nicht nach '$to' kopieren: $!\n";
+ return undef;
+ }
+ }
+
+ print $p . "Trunce Datei '$from' ...\n";
+ unless ( $self->{'test'} ) {
+ if ( open FILE, ">$from" ) {
+ close FILE;
+ }
+ else {
+ warn $p . "Konnte Logdatei '$from' nicht truncen: $!\n";
+ return undef;
+ }
+ }
- if ( $nmode != $omode ) {
# gewuenschte Permissions setzen
- print $p . "Setze Permissions von '$from'.\n" if verbose();
+ print $p . "Setze Permissions von '$to'.\n" if verbose();
unless ( $self->{'test'} ) {
- unless ( chmod $nmode, $from ) {
- warn $p . "Setzen der Permissions von '$from' war nnicht erfolgreich: $!\n";
- }
+ unless ( chmod $omode, $to ) {
+ warn $p . "Setzen der Permissions von '$to' war nnicht erfolgreich: $!\n";
+ }
}
- }
- if ( $ouid != $nuid or $ogid != $ngid ) {
# gewuenschte Besitzer stzen
- print $p . "Setze Besitzer von '$from'.\n" if verbose();
+ print $p . "Setze Besitzer von '$to'.\n" if verbose();
unless ( $self->{'test'} ) {
- unless ( chown $nuid, $ngid, $from ) {
- warn $p . "Setzen des Besitzers von '$from' war nicht erfolgreich: $!\n";
- }
+ unless ( chown $ouid, $ogid, $to ) {
+ warn $p . "Setzen des Besitzers von '$to' war nicht erfolgreich: $!\n";
+ }
}
- }
- }
+ # Access- und Modification-Time setzen ...
+ print $p . "Setze Access- und Modification-Time von '$to'.\n" if verbose();
+ unless ( $self->{'test'} ) {
+ unless ( utime $atime, $mtime, $to ) {
+ warn $p . "Setzen der Access- und Modification-Time von '$to' war nicht erfolgreich: $!\n";
+ }
+ }
- }
+ } ## end if ( $f->{'copytruncate'} )
+ else {
- my ( $old_logfiles, $files_delete, $files_compress );
+ # alte Permissions und Besitzer ermitteln
+ @Stats = stat $from;
- # Ermittlung aller bisherigen Logdateien ...
- $old_logfiles = $self->collect_old_logfiles( $file );
- unless ( $old_logfiles ) {
- warn $p . "Fehler beim Ermitteln der bisher rotierten Logdateien.\n";
- return undef;
- }
- print $p . "Insgesamt " . scalar( keys %$old_logfiles ) . " bisher rotierte Logdateie" . (scalar( keys %$old_logfiles ) == 1 ? "" : "n") . ".\n" if verbose();
- print $p . "Liste aller bisher rotierten Logdateien: " . Dumper($old_logfiles) if verbose() > 2;
- $f->{'oldfiles'} = $old_logfiles;
-
- # Ermittlung der alten Logdateien, die zu loeschen sind ...
- if ( scalar( keys %$old_logfiles ) ) {
- $files_delete = $self->collect_files_delete($file);
- unless ( $files_delete ) {
- warn $p . "Fehler beim Ermitteln der bisher zu loeschenden alten Logdateien.\n";
- return undef;
- }
- print $p . "Insgesamt " . scalar( keys %$files_delete ) . " alte Logdateie" . (scalar( keys %$files_delete ) == 1 ? "" : "n") .
- " zum Loeschen ermittelt.\n" if verbose() > 1;
- for ( keys %$files_delete ) {
- $self->{'files_delete'}{$_} = 1;
- }
- }
+ print $p . "Benenne um bzw. verschiebe '$from' nach '$to' ...\n";
+ unless ( $self->{'test'} ) {
+ unless ( move $from, $to ) {
+ warn $p . "Konnte '$from' nicht nach '$to' umbenennen/verschieben: $!\n";
+ return undef;
+ }
+ }
- # Ermittlung der zu komprimierenden Logdateien ...
- if ( $f->{'compress'} and scalar( keys %$old_logfiles ) ) {
- $files_compress = $self->collect_compress_logfiles($file);
- unless ( $files_compress ) {
- warn $p . "Fehler beim Ermitteln der zu komprimierenden Logdateien.\n";
- return undef;
- }
- print $p . "Insgesamt " . scalar( keys %$files_compress ) . " Logdateie" . (scalar( keys %$files_compress ) == 1 ? "" : "n") . " zu komprimieren.\n" if verbose();
- print $p . "Liste aller zu komprimierenden Logdateien: " . Dumper($files_compress) if verbose() > 2;
+ if ( $f->{'create'} ) {
+
+ print $p . "Lege '$from' neu an ...\n";
+ unless ( $self->{'test'} ) {
+ if ( open FILE, ">$from" ) {
+ close FILE;
+ }
+ else {
+ warn $p . "Konnte Logdatei '$from' nicht neu anlegen: $!\n";
+ return undef;
+ }
+ }
+
+ # gewuenschte Permissions und Besitzer ermitteln
+ $nmode = defined $f->{'create'}{'mode'} ? $f->{'create'}{'mode'} : $Stats[2];
+ $nuid = defined $f->{'create'}{'owner'} ? $f->{'create'}{'owner'} : $Stats[4];
+ $ngid = defined $f->{'create'}{'group'} ? $f->{'create'}{'group'} : $Stats[5];
+
+ # alte Permissions und Besitzer der neu angelegten Datei ermitteln
+ @Stats = stat $from;
+ ( $omode, $ouid, $ogid ) = @Stats[ 2, 4, 5 ];
+
+ if ( $nmode != $omode ) {
+
+ # gewuenschte Permissions setzen
+ print $p . "Setze Permissions von '$from'.\n" if verbose();
+ unless ( $self->{'test'} ) {
+ unless ( chmod $nmode, $from ) {
+ warn $p . "Setzen der Permissions von '$from' war nnicht erfolgreich: $!\n";
+ }
+ }
+ } ## end if ( $nmode != $omode )
+
+ if ( $ouid != $nuid or $ogid != $ngid ) {
- for ( keys %$files_compress ) {
- $self->{'files_compress'}{$_} = 1;
+ # gewuenschte Besitzer stzen
+ print $p . "Setze Besitzer von '$from'.\n" if verbose();
+ unless ( $self->{'test'} ) {
+ unless ( chown $nuid, $ngid, $from ) {
+ warn $p . "Setzen des Besitzers von '$from' war nicht erfolgreich: $!\n";
+ }
+ }
+ } ## end if ( $ouid != $nuid or $ogid != $ngid )
+
+ } ## end if ( $f->{'create'} )
+
+ } ## end else [ if ( $f->{'copytruncate'} )
+
+ my ( $old_logfiles, $files_delete, $files_compress );
+
+ # Ermittlung aller bisherigen Logdateien ...
+ $old_logfiles = $self->collect_old_logfiles($file);
+ unless ($old_logfiles) {
+ warn $p . "Fehler beim Ermitteln der bisher rotierten Logdateien.\n";
+ return undef;
}
- }
+ print $p
+ . "Insgesamt "
+ . scalar( keys %$old_logfiles )
+ . " bisher rotierte Logdateie"
+ . ( scalar( keys %$old_logfiles ) == 1 ? "" : "n" ) . ".\n"
+ if verbose();
+ print $p . "Liste aller bisher rotierten Logdateien: " . Dumper($old_logfiles) if verbose() > 2;
+ $f->{'oldfiles'} = $old_logfiles;
+
+ # Ermittlung der alten Logdateien, die zu loeschen sind ...
+ if ( scalar( keys %$old_logfiles ) ) {
+ $files_delete = $self->collect_files_delete($file);
+ unless ($files_delete) {
+ warn $p . "Fehler beim Ermitteln der bisher zu loeschenden alten Logdateien.\n";
+ return undef;
+ }
+ print $p
+ . "Insgesamt "
+ . scalar( keys %$files_delete )
+ . " alte Logdateie"
+ . ( scalar( keys %$files_delete ) == 1 ? "" : "n" )
+ . " zum Loeschen ermittelt.\n"
+ if verbose() > 1;
+ for ( keys %$files_delete ) {
+ $self->{'files_delete'}{$_} = 1;
+ }
+ } ## end if ( scalar( keys %$old_logfiles ) )
- # Und Muell wegraeumen ...
- delete $f->{'oldfiles'};
- $old_logfiles = undef;
- $files_delete = undef;
- $files_compress = undef;
+ # Ermittlung der zu komprimierenden Logdateien ...
+ if ( $f->{'compress'} and scalar( keys %$old_logfiles ) ) {
+ $files_compress = $self->collect_compress_logfiles($file);
+ unless ($files_compress) {
+ warn $p . "Fehler beim Ermitteln der zu komprimierenden Logdateien.\n";
+ return undef;
+ }
+ print $p
+ . "Insgesamt "
+ . scalar( keys %$files_compress )
+ . " Logdateie"
+ . ( scalar( keys %$files_compress ) == 1 ? "" : "n" )
+ . " zu komprimieren.\n"
+ if verbose();
+ print $p . "Liste aller zu komprimierenden Logdateien: " . Dumper($files_compress) if verbose() > 2;
+
+ for ( keys %$files_compress ) {
+ $self->{'files_compress'}{$_} = 1;
+ }
+ } ## end if ( $f->{'compress'} and scalar( keys %$old_logfiles...
- # und schliesslich noch das Rueckschreiben des Rotierens in die Statusdatei ...
- unless ( $self->{'state_file'}->write_logfile($file) ) {
- die $p . "Fehler beim Schreiben der Statusdatei.\n";
- return undef;
- }
+ # Und Muell wegraeumen ...
+ delete $f->{'oldfiles'};
+ $old_logfiles = undef;
+ $files_delete = undef;
+ $files_compress = undef;
- return 1;
+ # und schliesslich noch das Rueckschreiben des Rotierens in die Statusdatei ...
+ unless ( $self->{'state_file'}->write_logfile($file) ) {
+ die $p . "Fehler beim Schreiben der Statusdatei.\n";
+ return undef;
+ }
-}
+ return 1;
+
+} ## end sub rotate_file($$)
#------------------------------------------------------------------------------------
sub test_for_rotate($$) {
- my $self = shift;
- my $file = shift;
- my $p = verbose() ? __PACKAGE__ . "::test_for_rotate(): " : "";
+ my $self = shift;
+ my $file = shift;
+ my $p = verbose() ? __PACKAGE__ . "::test_for_rotate(): " : "";
- my ( $text, $f_size, $maxsize, $last_updated, $time_next_rotate );
+ my ( $text, $f_size, $maxsize, $last_updated, $time_next_rotate );
- unless ( $file ) {
- warn $p . "Keine Datei uebergeben beim Aufruf.\n";
- return undef;
- }
+ unless ($file) {
+ warn $p . "Keine Datei uebergeben beim Aufruf.\n";
+ return undef;
+ }
- print $p . "Ueberpruefe Logdatei '$file', ob sie rotiert werden soll...\n" if verbose() > 2;
+ print $p . "Ueberpruefe Logdatei '$file', ob sie rotiert werden soll...\n" if verbose() > 2;
- unless ( -f $file ) {
- $text = $p . "Logdatei '$file' existiert NICHT, keine Rotation.\n";
- unless ( $self->{'c'}{'logfiles'}{$file}{'missingok'} ) {
- warn $text;
- return 0;
+ unless ( -f $file ) {
+ $text = $p . "Logdatei '$file' existiert NICHT, keine Rotation.\n";
+ unless ( $self->{'c'}{'logfiles'}{$file}{'missingok'} ) {
+ warn $text;
+ return 0;
+ }
+ print $text if verbose() > 1;
+ return 0;
}
- print $text if verbose() > 1;
- return 0;
- }
- unless ( -s $file ) {
- $text = $p . "Logdatei '$file' hat eine Dateigroesse von 0, keine Rotation.\n";
- unless ( $self->{'c'}{'logfiles'}{$file}{'ifempty'} ) {
- print $text if verbose() > 1;
- return 0;
+ unless ( -s $file ) {
+ $text = $p . "Logdatei '$file' hat eine Dateigroesse von 0, keine Rotation.\n";
+ unless ( $self->{'c'}{'logfiles'}{$file}{'ifempty'} ) {
+ print $text if verbose() > 1;
+ return 0;
+ }
}
- }
- if ( $self->{'force'} ) {
- print $p . "Logdatei '$file' wird rotiert, da FORCE-Mode eingeschaltet wird.\n" if verbose() > 1;
- return 1;
- }
+ if ( $self->{'force'} ) {
+ print $p . "Logdatei '$file' wird rotiert, da FORCE-Mode eingeschaltet wird.\n" if verbose() > 1;
+ return 1;
+ }
- $f_size = ( -s $file );
- $maxsize = $self->{'c'}{'logfiles'}{$file}{'size'} || 0;
- $last_updated = $self->{'states'}{$file} || 0;
- $time_next_rotate = $last_updated ? ( $last_updated + ($self->{'c'}{'logfiles'}{$file}{'period'} * 24 * 60 * 60) ) : 0;
+ $f_size = ( -s $file );
+ $maxsize = $self->{'c'}{'logfiles'}{$file}{'size'} || 0;
+ $last_updated = $self->{'states'}{$file} || 0;
+ $time_next_rotate = $last_updated ? ( $last_updated + ( $self->{'c'}{'logfiles'}{$file}{'period'} * 24 * 60 * 60 ) ) : 0;
- if ( $maxsize ) {
- print $p . "Vergleiche Dateigroesse $f_size mit Maximalgroesse $maxsize ...\n" if verbose > 2;
- return 0 if $maxsize > $f_size;
- }
+ if ($maxsize) {
+ print $p . "Vergleiche Dateigroesse $f_size mit Maximalgroesse $maxsize ...\n" if verbose > 2;
+ return 0 if $maxsize > $f_size;
+ }
- printf( $p . "Vergleiche Timestamp naechste Rotation %s mit aktuellem Timestamp %s ...\n", $time_next_rotate, time() ) if verbose > 2;
- if ( verbose() > 3 ) {
- printf( " Periode %.2f Tage.\n", $self->{'c'}{'logfiles'}{$file}{'period'} );
- printf( " Letzte Rotation %s\n", $last_updated ? (scalar(localtime($last_updated)) . " GMT") : "<nie>" );
- printf( " Naechste Rotation %s\n", $time_next_rotate ? (scalar(localtime($time_next_rotate)) . " GMT") : "<sofort>" );
- printf( " Aktuelle Zeit %s\n", scalar(localtime()) . " GMT" );
- }
- return 0 if $time_next_rotate > time();
+ printf( $p . "Vergleiche Timestamp naechste Rotation %s mit aktuellem Timestamp %s ...\n", $time_next_rotate, time() ) if verbose > 2;
+ if ( verbose() > 3 ) {
+ printf( " Periode %.2f Tage.\n", $self->{'c'}{'logfiles'}{$file}{'period'} );
+ printf( " Letzte Rotation %s\n", $last_updated ? ( scalar( localtime($last_updated) ) . " GMT" ) : "<nie>" );
+ printf( " Naechste Rotation %s\n", $time_next_rotate ? ( scalar( localtime($time_next_rotate) ) . " GMT" ) : "<sofort>" );
+ printf( " Aktuelle Zeit %s\n", scalar( localtime() ) . " GMT" );
+ }
+ return 0 if $time_next_rotate > time();
- return 1;
+ return 1;
-}
+} ## end sub test_for_rotate($$)
#------------------------------------------------------------------------------------------
use Carp qw(:DEFAULT cluck);
-our @ISA = qw(Exporter);
+our @ISA = qw(Exporter);
our @EXPORT = qw(
- &human2byte
- &parts
- &period2days
- &verbose
- &to_bool
- &to_float
- &to_int
+ &human2byte
+ &parts
+ &period2days
+ &verbose
+ &to_bool
+ &to_float
+ &to_int
);
sub human2byte($);
$Revis =~ s/^.*:\s*(\S+)\s*\$.*/$1/s;
our $VERSION = $LOGROTATE_VERSION . "." . $Revis;
-if( $ENV{"LANG"} and $ENV{"LANG"} =~ /utf-8/i and $] <= 5.008 and $] > 5.006 ) {
- print warn "WARNING: your system is set to UTF-8 and your perl version might not support this - this might result in malfunction\n";
+if ( $ENV{"LANG"} and $ENV{"LANG"} =~ /utf-8/i and $] <= 5.008 and $] > 5.006 ) {
+ print warn "WARNING: your system is set to UTF-8 and your perl version might not support this - this might result in malfunction\n";
}
my $verbose = 0;
#----------------------------------------------------------------------------------------
END {
- my $p = __PACKAGE__ . "::END(): ";
- print $p . " endet.\n" if $verbose;
+ my $p = __PACKAGE__ . "::END(): ";
+ print $p . " endet.\n" if $verbose;
}
##########################################################################################
sub human2byte($) {
- my $val = shift;
- my $p = $verbose ? __PACKAGE__ . "::human2byte(): " : "";
-
- return undef unless defined $val;
- print $p . "aufgerufen mit '" . $val . "'.\n" if $verbose > 5;
- return 0 if $val =~ /^\s*$/;
-
- my ( $unit, $factor );
-
- if ( $val =~ /^\s*(\d+(?:\.\d*)?)\s*(?:([kmg])(?:b|byte)?)?\s*$/i ) {
- $factor = 1;
- $val = $1 + 0;
- $unit = lc( $2 || 'b' );
- if ( $unit eq 'k' ) {
- $factor = 1024;
- } elsif ( $unit eq 'm' ) {
- $factor = 1024 * 1024;
- } elsif ( $unit eq 'g' ) {
- $factor = 1024 * 1024 * 1024;
+ my $val = shift;
+ my $p = $verbose ? __PACKAGE__ . "::human2byte(): " : "";
+
+ return undef unless defined $val;
+ print $p . "aufgerufen mit '" . $val . "'.\n" if $verbose > 5;
+ return 0 if $val =~ /^\s*$/;
+
+ my ( $unit, $factor );
+
+ if ( $val =~ /^\s*(\d+(?:\.\d*)?)\s*(?:([kmg])(?:b|byte)?)?\s*$/i ) {
+ $factor = 1;
+ $val = $1 + 0;
+ $unit = lc( $2 || 'b' );
+ if ( $unit eq 'k' ) {
+ $factor = 1024;
+ }
+ elsif ( $unit eq 'm' ) {
+ $factor = 1024 * 1024;
+ }
+ elsif ( $unit eq 'g' ) {
+ $factor = 1024 * 1024 * 1024;
+ }
+ print $p . "Faktor fuer '$unit': " . $factor . "'.\n" if $verbose > 5;
+ $val = int( $val * $factor );
+ } ## end if ( $val =~ /^\s*(\d+(?:\.\d*)?)\s*(?:([kmg])(?:b|byte)?)?\s*$/i)
+ else {
+ warn $p . "Ungueltige Byte-Angabe: '$val'.\n";
+ $val = undef;
}
- print $p . "Faktor fuer '$unit': " . $factor . "'.\n" if $verbose > 5;
- $val = int( $val * $factor );
- } else {
- warn $p . "Ungueltige Byte-Angabe: '$val'.\n";
- $val = undef;
- }
- return $val;
+ return $val;
-}
+} ## end sub human2byte($)
#------------------------------------------------------------------------------------
sub parts($) {
- my $p = verbose() ? __PACKAGE__ . "::parts(): " : "";
+ my $p = verbose() ? __PACKAGE__ . "::parts(): " : "";
- my $term = shift;
- my @Parts = ();
- my $part;
+ my $term = shift;
+ my @Parts = ();
+ my $part;
- while ( $term =~ /"([^"\\]*(?:\\.[^"\\]*)*)"|(\S+)/g ) {
- $part = $1 || $2;
- $part =~ s/\\"/"/g;
- push @Parts, $part;
- }
+ while ( $term =~ /"([^"\\]*(?:\\.[^"\\]*)*)"|(\S+)/g ) {
+ $part = $1 || $2;
+ $part =~ s/\\"/"/g;
+ push @Parts, $part;
+ }
- return @Parts;
+ return @Parts;
-}
+} ## end sub parts($)
#------------------------------------------------------------------------------------
sub period2days($) {
- my $period = shift;
- my $p = verbose() ? __PACKAGE__ . "::period2days(): " : "";
-
- $period = "" unless defined $period;
- my $orig = $period;
- print $p . "Aufgerufen mit '" . $period . "'.\n" if verbose() > 5;
- $period =~ s/^\s+//;
- $period =~ s/\s+$//;
-
- if ( $period eq "" ) {
- warn $p . "Ungueltige Periodenangabe.\n";
- return undef;
- }
-
- if ( $period =~ /^now$/i ) {
- # Rotation immer sofort
- return 0;
- }
-
- if ( $period =~ /^never$/i ) {
- # Rotation in 400 Jahren (also hoffentlich nie)
- return 36525 * 4;
- }
-
- my $days = undef;
- my $t = 0;
-
- if ( $period =~ /(\d+)\s*h(?:ours?)?/i ) {
- $t = $1;
- print $p . "$t Stunden.\n" if verbose() > 5;
- $t /= 24;
- $days += $t;
- $period =~ s/\d+\s*h(?:ours?)?//i;
- }
- print $p . "Noch uebrig nach Stunden: '$period'.\n" if verbose() > 5;
-
- if ( $period =~ /(\d+(?:\.\d*)?)\s*w(?:eeks?)?/i ) {
- $t = $1;
- print $p . "$t Wochen.\n" if verbose() > 5;
- $t *= 7;
- $days += $t;
- $period =~ s/\d+(?:\.\d*)?\s*w(?:eeks?)?//i;
- }
- print $p . "Noch uebrig nach Wochen: '$period'.\n" if verbose() > 5;
-
- if ( $period =~ /(\d+(?:\.\d*)?)\s*m(?:onths?)?/i ) {
- $t = $1;
- print $p . "$t Monate.\n" if verbose() > 5;
- $t *= 30.4;
- $days += $t;
- $period =~ s/\d+(?:\.\d*)?\s*m(?:onths?)?//i;
- }
- print $p . "Noch uebrig nach Monaten: '$period'.\n" if verbose() > 5;
-
- if ( $period =~ /(\d+(?:\.\d*)?)\s*y(?:ears?)?/i ) {
- $t = $1;
- print $p . "$t Jahre.\n" if verbose() > 5;
- $t *= 365;
- $days += $t;
- $period =~ s/\d+(?:\.\d*)?\s*y(?:ears?)?//i;
- }
- print $p . "Noch uebrig nach Jahren: '$period'.\n" if verbose() > 5;
-
- if ( $period =~ /(\d+(?:\.\d*)?)\s*(?:d(?:ays?)?\s*)?$/i ) {
- $t = $1;
- print $p . "$t Tage.\n" if verbose() > 5;
- $days += $t;
- $period =~ s/\d+(?:\.\d*)?\s*(?:d(?:ays?)?\s*)?$//i;
- }
- print $p . "Noch uebrig nach Tagen: '$period'.\n" if verbose() > 5;
-
- warn $p . "Ungueltige Angabe einer Periode: '" . $orig . "'.\n" unless $period =~ /^\s*$/;
-
- return $days;
+ my $period = shift;
+ my $p = verbose() ? __PACKAGE__ . "::period2days(): " : "";
-}
+ $period = "" unless defined $period;
+ my $orig = $period;
+ print $p . "Aufgerufen mit '" . $period . "'.\n" if verbose() > 5;
+ $period =~ s/^\s+//;
+ $period =~ s/\s+$//;
+
+ if ( $period eq "" ) {
+ warn $p . "Ungueltige Periodenangabe.\n";
+ return undef;
+ }
+
+ if ( $period =~ /^now$/i ) {
+
+ # Rotation immer sofort
+ return 0;
+ }
+
+ if ( $period =~ /^never$/i ) {
+
+ # Rotation in 400 Jahren (also hoffentlich nie)
+ return 36525 * 4;
+ }
+
+ my $days = undef;
+ my $t = 0;
+
+ if ( $period =~ /(\d+)\s*h(?:ours?)?/i ) {
+ $t = $1;
+ print $p . "$t Stunden.\n" if verbose() > 5;
+ $t /= 24;
+ $days += $t;
+ $period =~ s/\d+\s*h(?:ours?)?//i;
+ }
+ print $p . "Noch uebrig nach Stunden: '$period'.\n" if verbose() > 5;
+
+ if ( $period =~ /(\d+(?:\.\d*)?)\s*w(?:eeks?)?/i ) {
+ $t = $1;
+ print $p . "$t Wochen.\n" if verbose() > 5;
+ $t *= 7;
+ $days += $t;
+ $period =~ s/\d+(?:\.\d*)?\s*w(?:eeks?)?//i;
+ }
+ print $p . "Noch uebrig nach Wochen: '$period'.\n" if verbose() > 5;
+
+ if ( $period =~ /(\d+(?:\.\d*)?)\s*m(?:onths?)?/i ) {
+ $t = $1;
+ print $p . "$t Monate.\n" if verbose() > 5;
+ $t *= 30.4;
+ $days += $t;
+ $period =~ s/\d+(?:\.\d*)?\s*m(?:onths?)?//i;
+ }
+ print $p . "Noch uebrig nach Monaten: '$period'.\n" if verbose() > 5;
+
+ if ( $period =~ /(\d+(?:\.\d*)?)\s*y(?:ears?)?/i ) {
+ $t = $1;
+ print $p . "$t Jahre.\n" if verbose() > 5;
+ $t *= 365;
+ $days += $t;
+ $period =~ s/\d+(?:\.\d*)?\s*y(?:ears?)?//i;
+ }
+ print $p . "Noch uebrig nach Jahren: '$period'.\n" if verbose() > 5;
+
+ if ( $period =~ /(\d+(?:\.\d*)?)\s*(?:d(?:ays?)?\s*)?$/i ) {
+ $t = $1;
+ print $p . "$t Tage.\n" if verbose() > 5;
+ $days += $t;
+ $period =~ s/\d+(?:\.\d*)?\s*(?:d(?:ays?)?\s*)?$//i;
+ }
+ print $p . "Noch uebrig nach Tagen: '$period'.\n" if verbose() > 5;
+
+ warn $p . "Ungueltige Angabe einer Periode: '" . $orig . "'.\n" unless $period =~ /^\s*$/;
+
+ return $days;
+
+} ## end sub period2days($)
#------------------------------------------------------------------------------------------
sub to_bool($) {
- my $val = shift;
- my $p = verbose() ? __PACKAGE__ . "::to_bool(): " : "";
+ my $val = shift;
+ my $p = verbose() ? __PACKAGE__ . "::to_bool(): " : "";
- return 0 unless defined $val;
- print $p . "aufgerufen mit '" . $val . "'.\n" if verbose() > 5;
- return 0 if $val =~ /^\s*$/;
+ return 0 unless defined $val;
+ print $p . "aufgerufen mit '" . $val . "'.\n" if verbose() > 5;
+ return 0 if $val =~ /^\s*$/;
- if ( $val =~ /^\s*y(?:es?)?/i or
- $val =~ /^\s*ja?/i or
- $val =~ /^\s*[wt]\s*$/i or
- $val =~ /^\s*on\s*$/i or
- $val =~ /^\s*wahr|true/i ) {
- return 1;
- }
+ if ( $val =~ /^\s*y(?:es?)?/i
+ or $val =~ /^\s*ja?/i
+ or $val =~ /^\s*[wt]\s*$/i
+ or $val =~ /^\s*on\s*$/i
+ or $val =~ /^\s*wahr|true/i )
+ {
+ return 1;
+ }
- if ( $val =~ /^\s*no?/i or
- $val =~ /^\s*ne(?:in?)?/i or
- $val =~ /^\s*f\s*$/i or
- $val =~ /^\s*off\s*$/i or
- $val =~ /^\s*falsch|false/i ) {
- return 0;
- }
+ if ( $val =~ /^\s*no?/i
+ or $val =~ /^\s*ne(?:in?)?/i
+ or $val =~ /^\s*f\s*$/i
+ or $val =~ /^\s*off\s*$/i
+ or $val =~ /^\s*falsch|false/i )
+ {
+ return 0;
+ }
- my $intval = to_int $val;
- if ( defined $intval ) {
- return $intval ? 1 : 0;
- }
+ my $intval = to_int $val;
+ if ( defined $intval ) {
+ return $intval ? 1 : 0;
+ }
- return $val ? 1 : 0;
+ return $val ? 1 : 0;
-}
+} ## end sub to_bool($)
#------------------------------------------------------------------------------------------
sub to_float($) {
- my $val = shift;
- my $p = verbose() ? __PACKAGE__ . "::to_float(): " : "";
+ my $val = shift;
+ my $p = verbose() ? __PACKAGE__ . "::to_float(): " : "";
- return undef unless defined( $val ) and $val =~ /\d/;
- print $p . "aufgerufen mit '" . $val . "'.\n" if verbose() > 5;
+ return undef unless defined($val) and $val =~ /\d/;
+ print $p . "aufgerufen mit '" . $val . "'.\n" if verbose() > 5;
- my $ts = ",";
- my $ds = ".";
+ my $ts = ",";
+ my $ds = ".";
- if ( ( $val =~ /\d,/ and $val !~ /\d\./ ) or
- ( $val =~ /\d\.\d\d\d\./ ) or
- ( $val =~ /\d\.\d\d\d,/ ) ) {
- $ds = ",";
- $ts = ".";
- }
+ if ( ( $val =~ /\d,/ and $val !~ /\d\./ )
+ or ( $val =~ /\d\.\d\d\d\./ )
+ or ( $val =~ /\d\.\d\d\d,/ ) )
+ {
+ $ds = ",";
+ $ts = ".";
+ }
- $val =~ s/\Q$ts\E//g;
- $val =~ s/\Q$ds\E/\./g;
+ $val =~ s/\Q$ts\E//g;
+ $val =~ s/\Q$ds\E/\./g;
- return ( $val + 0 );
+ return ( $val + 0 );
-}
+} ## end sub to_float($)
#------------------------------------------------------------------------------------------
sub to_int($;$) {
- my $val = shift;
- my $signed = shift;
- my $p = verbose() ? __PACKAGE__ . "::to_int(): " : "";
+ my $val = shift;
+ my $signed = shift;
+ my $p = verbose() ? __PACKAGE__ . "::to_int(): " : "";
- return undef unless defined $val;
- print $p . "aufgerufen mit '" . $val . "' (" . ($signed ? 'mit' : 'ohne'). " Vorzeichen) .\n" if verbose() > 5;
- unless ( $val =~ /\d/ ) {
- return undef;
- }
+ return undef unless defined $val;
+ print $p . "aufgerufen mit '" . $val . "' (" . ( $signed ? 'mit' : 'ohne' ) . " Vorzeichen) .\n" if verbose() > 5;
+ unless ( $val =~ /\d/ ) {
+ return undef;
+ }
- if ( $signed ) {
- $val =~ s/^[^\d-]*(?:(-)\s*)?(\d+)\D?.*?/$1$2/;
- } else {
- $val =~ s/^\D*(\d+)\D?.*$/$1/;
- }
- print $p . "Neuer Wert: '" . ( defined($val) ? $val : "<undef>" ) . "'.\n" if verbose() > 5;
+ if ($signed) {
+ $val =~ s/^[^\d-]*(?:(-)\s*)?(\d+)\D?.*?/$1$2/;
+ }
+ else {
+ $val =~ s/^\D*(\d+)\D?.*$/$1/;
+ }
+ print $p . "Neuer Wert: '" . ( defined($val) ? $val : "<undef>" ) . "'.\n" if verbose() > 5;
- return $val + 0;
+ return $val + 0;
-}
+} ## end sub to_int($;$)
#------------------------------------------------------------------------------------------
sub verbose(;$) {
- my $new_verbose_level = shift;
+ my $new_verbose_level = shift;
- if ( defined $new_verbose_level and $new_verbose_level =~ /^\d+$/ ) {
- $verbose = $new_verbose_level;
- }
+ if ( defined $new_verbose_level and $new_verbose_level =~ /^\d+$/ ) {
+ $verbose = $new_verbose_level;
+ }
- return $verbose;
+ return $verbose;
-}
+} ## end sub verbose(;$)
#------------------------------------------------------------------------------------------
use Cwd qw(cwd getcwd abs_path);
use File::Basename;
use Data::Dumper;
+
#use POSIX;
use LogRotate::Common;
$Revis =~ s/^.*:\s*(\S+)\s*\$.*/$1/s;
our $VERSION = $LogRotate::Common::LOGROTATE_VERSION . "." . $Revis;
-$Data::Dumper::Indent = 1;
+$Data::Dumper::Indent = 1;
$Data::Dumper::Sortkeys = 1;
my @ValidFields = qw( parent compressext compressoptions );
-for my $attr ( @ValidFields ) {
- $ok_field{$attr}++;
+for my $attr (@ValidFields) {
+ $ok_field{$attr}++;
}
my %ValidPeriods = (
- 'hourly' => (1/24),
- '2hourly' => (2/24),
- '4hourly' => (4/24),
- '6hourly' => (6/24),
- '12hourly' => (12/24),
- 'daily' => 1,
- '2daily' => 2,
- 'weekly' => 7,
- 'monthly' => 30.4,
- '2monthly' => 60.8,
- '4monthly' => 121.7,
- '6monthly' => 182.5,
- 'yearly' => 365,
+ 'hourly' => ( 1 / 24 ),
+ '2hourly' => ( 2 / 24 ),
+ '4hourly' => ( 4 / 24 ),
+ '6hourly' => ( 6 / 24 ),
+ '12hourly' => ( 12 / 24 ),
+ 'daily' => 1,
+ '2daily' => 2,
+ 'weekly' => 7,
+ 'monthly' => 30.4,
+ '2monthly' => 60.8,
+ '4monthly' => 121.7,
+ '6monthly' => 182.5,
+ 'yearly' => 365,
);
-my @StandardCompressPrograms = (
- 'gzip',
- 'bzip2',
- 'compress',
-);
+my @StandardCompressPrograms = ( 'gzip', 'bzip2', 'compress', );
my %StandardCompressPrograms = (
- 'gzip' => '.gz',
- 'bzip2' => '.bz2',
- 'compress' => '.Z',
+ 'gzip' => '.gz',
+ 'bzip2' => '.bz2',
+ 'compress' => '.Z',
);
my %ScriptDirectives = (
- 'postrotate' => 1,
- 'prerotate' => 1,
- 'firstaction' => 1,
- 'lastaction' => 1,
+ 'postrotate' => 1,
+ 'prerotate' => 1,
+ 'firstaction' => 1,
+ 'lastaction' => 1,
);
#use constant default_firstline_statusfile => "Logrotate State -- Version 2";
=cut
sub new {
- my $invocant = shift;
- my $class = ref($invocant) || $invocant;
- my ( $res, $cmd );
-
- my $self = {
- 'configfiles' => {},
- 'included_files' => {},
- 'compress_cmd' => 'Compress::Zlib',
- 'pidfile' => '/var/run/logrotate.pid',
- 'statusfile' => '/var/lib/logrotate.status',
- 'COMPRESSEXT' => ".gz",
- 'COMPRESSOPTIONS' => "",
- 'scripts' => {},
- @_
- };
-
- $res = bless $self, $class;
-
- my $p = verbose() ? __PACKAGE__ . "::new(): " : "";
- $self->reset_defaults();
- $self->add_taboo( '\.rpmnew', 'ext' );
- $self->add_taboo( '\.rpmorig', 'ext' );
- $self->add_taboo( '\.rpmsave', 'ext' );
- $self->add_taboo( ',v', 'ext' );
- $self->add_taboo( '\.swp', 'ext' );
- $self->add_taboo( '~', 'ext' );
- $self->add_taboo( '\.', 'prefix' );
- $self->add_taboo( '\.bak', 'ext' );
- $self->add_taboo( '\.old', 'ext' );
- $self->add_taboo( '\.rej', 'ext' );
- $self->add_taboo( 'CVS', 'file' );
-
- if ( $self->{'compress_cmd'} ) {
- unless ( $cmd = $self->check_compress_program( $self->{'compress_cmd'}, 1 ) ) {
- carp $p . "Kein gueltiges Kompressionsprogramm gefunden, Kompression wird deaktiviert.\n" if verbose();
- $self->{'compress_cmd'} = undef;
+ my $invocant = shift;
+ my $class = ref($invocant) || $invocant;
+ my ( $res, $cmd );
+
+ my $self = {
+ 'configfiles' => {},
+ 'included_files' => {},
+ 'compress_cmd' => 'Compress::Zlib',
+ 'pidfile' => '/var/run/logrotate.pid',
+ 'statusfile' => '/var/lib/logrotate.status',
+ 'COMPRESSEXT' => ".gz",
+ 'COMPRESSOPTIONS' => "",
+ 'scripts' => {},
+ @_
+ };
+
+ $res = bless $self, $class;
+
+ my $p = verbose() ? __PACKAGE__ . "::new(): " : "";
+ $self->reset_defaults();
+ $self->add_taboo( '\.rpmnew', 'ext' );
+ $self->add_taboo( '\.rpmorig', 'ext' );
+ $self->add_taboo( '\.rpmsave', 'ext' );
+ $self->add_taboo( ',v', 'ext' );
+ $self->add_taboo( '\.swp', 'ext' );
+ $self->add_taboo( '~', 'ext' );
+ $self->add_taboo( '\.', 'prefix' );
+ $self->add_taboo( '\.bak', 'ext' );
+ $self->add_taboo( '\.old', 'ext' );
+ $self->add_taboo( '\.rej', 'ext' );
+ $self->add_taboo( 'CVS', 'file' );
+
+ if ( $self->{'compress_cmd'} ) {
+ unless ( $cmd = $self->check_compress_program( $self->{'compress_cmd'}, 1 ) ) {
+ carp $p . "Kein gueltiges Kompressionsprogramm gefunden, Kompression wird deaktiviert.\n" if verbose();
+ $self->{'compress_cmd'} = undef;
+ }
+ $self->{'compress_cmd'} = $cmd;
}
- $self->{'compress_cmd'} = $cmd;
- }
- return $res;
+ return $res;
-}
+} ## end sub new
#------------------------------------------------------------------------------------------
sub AUTOLOAD {
- my $self = shift;
- my $attr = $AUTOLOAD;
- my ( $val );
-
- $attr =~ s/.*:://;
- $attr = lc($attr);
-
- croak "Ungueltige Attributmethode ->$attr()" unless $ok_field{$attr};
-
- return $self->compress_cmd(@_) if $attr eq "compress_cmd";
- return $self->default_compress(@_) if $attr eq "default_compress";
- return $self->default_copytruncate(@_) if $attr eq "default_copytruncate";
- return $self->default_create_mode(@_) if $attr eq "default_create_mode";
- return $self->default_create_group(@_) if $attr eq "default_create_group";
- return $self->default_create_owner(@_) if $attr eq "default_create_owner";
- return $self->default_period(@_) if $attr eq "default_period";
- return $self->default_dateext(@_) if $attr eq "default_dateext";
- return $self->default_delaycompress(@_) if $attr eq "default_delaycompress";
- return $self->default_extension(@_) if $attr eq "default_extension";
- return $self->default_if_empty(@_) if $attr eq "default_if_empty" or $attr eq "default_ifempty";
- return $self->default_maxage(@_) if $attr eq "default_maxage";
- return $self->default_missingok(@_) if $attr eq "default_missingok";
- return $self->default_olddir_dirname(@_) if $attr eq "default_olddir_dirname";
- return $self->default_olddir_dateformat(@_) if $attr eq "default_olddir_dateformat";
- return $self->default_olddir_group(@_) if $attr eq "default_olddir_group";
- return $self->default_olddir_mode(@_) if $attr eq "default_olddir_mode";
- return $self->default_olddir_owner(@_) if $attr eq "default_olddir_owner";
- return $self->default_rotate(@_) if $attr eq "default_rotate";
- return $self->default_size(@_) if $attr eq "default_size";
-
- if ( @_ ) {
- $val = shift;
- $self->{uc($attr)} = $val;
- }
- return $self->{uc($attr)};
+ my $self = shift;
+ my $attr = $AUTOLOAD;
+ my ($val);
+
+ $attr =~ s/.*:://;
+ $attr = lc($attr);
+
+ croak "Ungueltige Attributmethode ->$attr()" unless $ok_field{$attr};
+
+ return $self->compress_cmd(@_) if $attr eq "compress_cmd";
+ return $self->default_compress(@_) if $attr eq "default_compress";
+ return $self->default_copytruncate(@_) if $attr eq "default_copytruncate";
+ return $self->default_create_mode(@_) if $attr eq "default_create_mode";
+ return $self->default_create_group(@_) if $attr eq "default_create_group";
+ return $self->default_create_owner(@_) if $attr eq "default_create_owner";
+ return $self->default_period(@_) if $attr eq "default_period";
+ return $self->default_dateext(@_) if $attr eq "default_dateext";
+ return $self->default_delaycompress(@_) if $attr eq "default_delaycompress";
+ return $self->default_extension(@_) if $attr eq "default_extension";
+ return $self->default_if_empty(@_) if $attr eq "default_if_empty" or $attr eq "default_ifempty";
+ return $self->default_maxage(@_) if $attr eq "default_maxage";
+ return $self->default_missingok(@_) if $attr eq "default_missingok";
+ return $self->default_olddir_dirname(@_) if $attr eq "default_olddir_dirname";
+ return $self->default_olddir_dateformat(@_) if $attr eq "default_olddir_dateformat";
+ return $self->default_olddir_group(@_) if $attr eq "default_olddir_group";
+ return $self->default_olddir_mode(@_) if $attr eq "default_olddir_mode";
+ return $self->default_olddir_owner(@_) if $attr eq "default_olddir_owner";
+ return $self->default_rotate(@_) if $attr eq "default_rotate";
+ return $self->default_size(@_) if $attr eq "default_size";
+
+ if (@_) {
+ $val = shift;
+ $self->{ uc($attr) } = $val;
+ }
+ return $self->{ uc($attr) };
-}
+} ## end sub AUTOLOAD
#------------------------------------------------------------------------------------------
sub add_taboo($$;$) {
- my $self = shift;
- my $pattern = shift || '';
- my $p = verbose() ? __PACKAGE__ . "::add_taboo(): " : "";
- my $type = lc(shift || 'file');
+ my $self = shift;
+ my $pattern = shift || '';
+ my $p = verbose() ? __PACKAGE__ . "::add_taboo(): " : "";
+ my $type = lc( shift || 'file' );
- $self->{'taboo'} = [] unless $self->{'taboo'};
+ $self->{'taboo'} = [] unless $self->{'taboo'};
- my %Pat = ( 'ext' => '%s$',
- 'file' => '^%s$',
- 'prefix' => '^%s' );
+ my %Pat = (
+ 'ext' => '%s$',
+ 'file' => '^%s$',
+ 'prefix' => '^%s'
+ );
- unless ( $Pat{$type} ) {
- carp $p . "Ungueltiger Parameter fuer \$type uebergeben: '$type'.\n";
- return;
- }
+ unless ( $Pat{$type} ) {
+ carp $p . "Ungueltiger Parameter fuer \$type uebergeben: '$type'.\n";
+ return;
+ }
- $pattern = sprintf( $Pat{$type}, $pattern );
- print $p . "Neues Tabu-Pattern: '$pattern'.\n" if verbose() > 3;
- push( @{$self->{'taboo'}}, $pattern );
+ $pattern = sprintf( $Pat{$type}, $pattern );
+ print $p . "Neues Tabu-Pattern: '$pattern'.\n" if verbose() > 3;
+ push( @{ $self->{'taboo'} }, $pattern );
-}
+} ## end sub add_taboo($$;$)
#------------------------------------------------------------------------------------------
sub check_compress_program($$;$) {
- my $self = shift;
- my $cmd = shift || 0;
- my $p = verbose() ? __PACKAGE__ . "::check_compress_program(): " : "";
- my $check_if_empty = shift || 0;
- my @Dirs;
- my ( $dir, $found, $prog );
-
- @Dirs = split ":", $ENV{'PATH'};
-
- if ( $cmd ) {
- if ( $cmd =~ m#^/# ) {
- if ( -f $cmd and -x $cmd ) {
- print $p . "Kopressionsprogramm in '$cmd' gefunden.\n" if verbose() > 1;
- return $cmd;
- } else {
- warn $p . "Ungueltiges Kopressionsprogramm '$cmd'.\n";
- $cmd = undef;
- }
- } else {
- if ( $cmd eq "1" or $cmd =~ /^Compress::Zlib$/ ) {
+ my $self = shift;
+ my $cmd = shift || 0;
+ my $p = verbose() ? __PACKAGE__ . "::check_compress_program(): " : "";
+ my $check_if_empty = shift || 0;
+ my @Dirs;
+ my ( $dir, $found, $prog );
+
+ @Dirs = split ":", $ENV{'PATH'};
+
+ if ($cmd) {
+ if ( $cmd =~ m#^/# ) {
+ if ( -f $cmd and -x $cmd ) {
+ print $p . "Kopressionsprogramm in '$cmd' gefunden.\n" if verbose() > 1;
+ return $cmd;
+ }
+ else {
+ warn $p . "Ungueltiges Kopressionsprogramm '$cmd'.\n";
+ $cmd = undef;
+ }
+ } ## end if ( $cmd =~ m#^/# )
+ else {
+ if ( $cmd eq "1" or $cmd =~ /^Compress::Zlib$/ ) {
+ eval "use Compress::Zlib;";
+ if ($@) {
+ warn "$@\n" if verbose();
+ $cmd = undef;
+ }
+ else {
+ print $p . "Verwende Perl-Modul 'Compress::Zlib' fuer Kompression.\n" if verbose() > 1;
+ return 'Compress::Zlib';
+ }
+ } ## end if ( $cmd eq "1" or $cmd =~ /^Compress::Zlib$/)
+ elsif ( $cmd eq "2" or $cmd =~ /^Compress::Bzip2$/ ) {
+ eval "use Compress::Bzip2;";
+ if ($@) {
+ warn "$@\n" if verbose();
+ $cmd = undef;
+ }
+ else {
+ print $p . "Verwende Perl-Modul 'Compress::Bzip2' fuer Kompression.\n" if verbose() > 1;
+ return 'Compress::Bzip2';
+ }
+ } ## end elsif ( $cmd eq "2" or $cmd =~ /^Compress::Bzip2$/)
+ else {
+ foreach $dir (@Dirs) {
+ $prog = $dir . "/" . $cmd;
+ if ( -f $prog and -x $prog ) {
+ print $p . "Kompressionsprogramm in '$prog' gefunden.\n" if verbose() > 1;
+ return $prog;
+ }
+ }
+ warn $p . "'$cmd' nicht gefunden im Suchpfad '$ENV{'PATH'}'.\n";
+ $cmd = undef;
+ } ## end else [ if ( $cmd eq "1" or $cmd =~ /^Compress::Zlib$/)
+ } ## end else [ if ( $cmd =~ m#^/# )
+ } ## end if ($cmd)
+
+ if ($check_if_empty) {
+
eval "use Compress::Zlib;";
- if ( $@ ) {
- warn "$@\n" if verbose();
- $cmd = undef;
- } else {
- print $p . "Verwende Perl-Modul 'Compress::Zlib' fuer Kompression.\n" if verbose() > 1;
- return 'Compress::Zlib';
- }
- } elsif ( $cmd eq "2" or $cmd =~ /^Compress::Bzip2$/ ) {
- eval "use Compress::Bzip2;";
- if ( $@ ) {
- warn "$@\n" if verbose();
- $cmd = undef;
- } else {
- print $p . "Verwende Perl-Modul 'Compress::Bzip2' fuer Kompression.\n" if verbose() > 1;
- return 'Compress::Bzip2';
+ if ($@) {
+ $cmd = undef;
}
- } else {
- foreach $dir ( @Dirs ) {
- $prog = $dir . "/" . $cmd;
- if ( -f $prog and -x $prog ) {
- print $p . "Kompressionsprogramm in '$prog' gefunden.\n" if verbose() > 1;
- return $prog;
- }
+ else {
+ print $p . "Verwende Perl-Modul 'Compress::Zlib' fuer Kompression.\n" if verbose() > 1;
+ $self->{'compressext'} = ".gz";
+ return 'Compress::Zlib';
}
- warn $p . "'$cmd' nicht gefunden im Suchpfad '$ENV{'PATH'}'.\n";
- $cmd = undef;
- }
- }
- }
-
- if ( $check_if_empty ) {
-
- eval "use Compress::Zlib;";
- if ( $@ ) {
- $cmd = undef;
- } else {
- print $p . "Verwende Perl-Modul 'Compress::Zlib' fuer Kompression.\n" if verbose() > 1;
- $self->{'compressext'} = ".gz";
- return 'Compress::Zlib';
- }
-
- eval "use Compress::Bzip2;";
- if ( $@ ) {
- $cmd = undef;
- } else {
- print $p . "Verwende Perl-Modul 'Compress::Bzip2' fuer Kompression.\n" if verbose() > 1;
- $self->{'compressext'} = ".bz2";
- return 'Compress::Bzip2';
- }
- foreach $cmd ( @StandardCompressPrograms ) {
- foreach $dir ( @Dirs ) {
- $prog = $dir . "/" . $cmd;
- if ( -f $prog and -x $prog ) {
- $self->{'compressext'} = $StandardCompressPrograms{$cmd};
- print $p . "Kompressionsprogramm in '$prog' gefunden.\n" if verbose() > 1;
- return $prog;
+ eval "use Compress::Bzip2;";
+ if ($@) {
+ $cmd = undef;
+ }
+ else {
+ print $p . "Verwende Perl-Modul 'Compress::Bzip2' fuer Kompression.\n" if verbose() > 1;
+ $self->{'compressext'} = ".bz2";
+ return 'Compress::Bzip2';
}
- }
- }
- warn $p . "Kein gueltiges Kompressionsprogramm in '$ENV{'PATH'}' gefunden.\n";
- }
+ foreach $cmd (@StandardCompressPrograms) {
+ foreach $dir (@Dirs) {
+ $prog = $dir . "/" . $cmd;
+ if ( -f $prog and -x $prog ) {
+ $self->{'compressext'} = $StandardCompressPrograms{$cmd};
+ print $p . "Kompressionsprogramm in '$prog' gefunden.\n" if verbose() > 1;
+ return $prog;
+ }
+ }
+ } ## end foreach $cmd (@StandardCompressPrograms)
+ warn $p . "Kein gueltiges Kompressionsprogramm in '$ENV{'PATH'}' gefunden.\n";
- return undef;
+ } ## end if ($check_if_empty)
+ return undef;
-
-}
+} ## end sub check_compress_program($$;$)
#------------------------------------------------------------------------------------------
sub compress_cmd($;$) {
- my $self = shift;
+ my $self = shift;
- if ( @_ ) {
- my $cmd = shift;
- if ( $cmd ) {
- if ( $cmd = $self->check_compress_program( $cmd ) ) {
- $self->{'compress_cmd'} = $cmd;
- }
+ if (@_) {
+ my $cmd = shift;
+ if ($cmd) {
+ if ( $cmd = $self->check_compress_program($cmd) ) {
+ $self->{'compress_cmd'} = $cmd;
+ }
+ }
}
- }
- return $self->{'compress_cmd'};
+ return $self->{'compress_cmd'};
-}
+} ## end sub compress_cmd($;$)
#------------------------------------------------------------------------------------------
sub compresscmd_statement($$$$$) {
- my $self = shift;
- my $line = shift || "";
- my $f = shift || "'unknown'";
- my $in_fd = shift || 0;
- my $linenr = shift || "'unknown'";
- my $p = verbose() ? __PACKAGE__ . "::compresscmd_statement(): " : "";
-
- my ( $cmd, $name );
- my ( @Values );
-
- if ( $in_fd ) {
- warn $p . "Die Direktive 'compresscmd' ist nicht innerhalb von Logdatei-Definitionen erlaubt" .
- " (Datei '$f', Zeile '$f').\n" if verbose();
- return;
- }
-
- $cmd = $line;
- $cmd =~ s/^\S+\s*//;
- @Values = $cmd ? parts( $cmd ) : ();
- unless ( $Values[0] ) {
- warn $p . "Direktive 'compresscmd' ohne dazugehoeriges Kommando gegeben (Datei '$f', Zeile '$f').\n" if verbose();
- return;
- }
- $cmd = $Values[0];
-
- if ( $name = $self->check_compress_program( $cmd ) ) {
- $self->{'compress_cmd'} = $name;
- return;
- }
-
- warn $p . "Das gegebene Kompressions-Kommando ist ungueltig, verwende das alte " .
- "Kommando '" . $self->{'compress_cmd'} . "' (Datei '$f', Zeile '$f').\n" if verbose();
+ my $self = shift;
+ my $line = shift || "";
+ my $f = shift || "'unknown'";
+ my $in_fd = shift || 0;
+ my $linenr = shift || "'unknown'";
+ my $p = verbose() ? __PACKAGE__ . "::compresscmd_statement(): " : "";
-}
+ my ( $cmd, $name );
+ my (@Values);
+
+ if ($in_fd) {
+ warn $p . "Die Direktive 'compresscmd' ist nicht innerhalb von Logdatei-Definitionen erlaubt" . " (Datei '$f', Zeile '$f').\n"
+ if verbose();
+ return;
+ }
+
+ $cmd = $line;
+ $cmd =~ s/^\S+\s*//;
+ @Values = $cmd ? parts($cmd) : ();
+ unless ( $Values[0] ) {
+ warn $p . "Direktive 'compresscmd' ohne dazugehoeriges Kommando gegeben (Datei '$f', Zeile '$f').\n" if verbose();
+ return;
+ }
+ $cmd = $Values[0];
+
+ if ( $name = $self->check_compress_program($cmd) ) {
+ $self->{'compress_cmd'} = $name;
+ return;
+ }
+
+ warn $p
+ . "Das gegebene Kompressions-Kommando ist ungueltig, verwende das alte "
+ . "Kommando '"
+ . $self->{'compress_cmd'}
+ . "' (Datei '$f', Zeile '$f').\n"
+ if verbose();
+
+} ## end sub compresscmd_statement($$$$$)
#------------------------------------------------------------------------------------------
sub default_compress($;$) {
- my $self = shift;
- my $nv;
- if ( @_ ) {
- $nv = shift;
- $self->{'default'}{'compress'} = to_bool($nv);
- }
- return $self->{'default'}{'compress'};
+ my $self = shift;
+ my $nv;
+ if (@_) {
+ $nv = shift;
+ $self->{'default'}{'compress'} = to_bool($nv);
+ }
+ return $self->{'default'}{'compress'};
-}
+} ## end sub default_compress($;$)
#------------------------------------------------------------------------------------------
sub default_copytruncate($;$) {
- my $self = shift;
- my $nv;
- if ( @_ ) {
- $nv = shift;
- $self->{'default'}{'copytruncate'} = $nv;
- }
- return $self->{'default'}{'copytruncate'};
+ my $self = shift;
+ my $nv;
+ if (@_) {
+ $nv = shift;
+ $self->{'default'}{'copytruncate'} = $nv;
+ }
+ return $self->{'default'}{'copytruncate'};
-}
+} ## end sub default_copytruncate($;$)
#------------------------------------------------------------------------------------------
sub default_create_group($;$) {
- my $self = shift;
- my $nv;
- if ( @_ ) {
- $nv = shift;
- if ( defined $nv ) {
- $nv = $nv =~ /^[1-9]\d*$/ ? $nv : scalar( getgrnam( $nv ) );
- $self->{'default'}{'create'}{'group'} = $nv;
+ my $self = shift;
+ my $nv;
+ if (@_) {
+ $nv = shift;
+ if ( defined $nv ) {
+ $nv = $nv =~ /^[1-9]\d*$/ ? $nv : scalar( getgrnam($nv) );
+ $self->{'default'}{'create'}{'group'} = $nv;
+ }
}
- }
- return $self->{'default'}{'create'}{'group'};
+ return $self->{'default'}{'create'}{'group'};
-}
+} ## end sub default_create_group($;$)
#------------------------------------------------------------------------------------------
sub default_create_mode($;$) {
- my $self = shift;
- my $nv;
- if ( @_ ) {
- $nv = shift;
- $nv = defined $nv ? ( $nv =~ /^\d+$/ ? $nv : 0644 ) : 0644;
- $self->{'default'}{'create'}{'mode'} = $nv;
- }
- return $self->{'default'}{'create'}{'mode'};
+ my $self = shift;
+ my $nv;
+ if (@_) {
+ $nv = shift;
+ $nv = defined $nv ? ( $nv =~ /^\d+$/ ? $nv : 0644 ) : 0644;
+ $self->{'default'}{'create'}{'mode'} = $nv;
+ }
+ return $self->{'default'}{'create'}{'mode'};
-}
+} ## end sub default_create_mode($;$)
#------------------------------------------------------------------------------------------
sub default_create_owner($;$) {
- my $self = shift;
- my $nv;
- if ( @_ ) {
- $nv = shift;
- if ( defined $nv ) {
- $nv = $nv =~ /^[1-9]\d*$/ ? $nv : scalar( getpwnam( $nv ) );
- $self->{'default'}{'create'}{'owner'} = $nv;
+ my $self = shift;
+ my $nv;
+ if (@_) {
+ $nv = shift;
+ if ( defined $nv ) {
+ $nv = $nv =~ /^[1-9]\d*$/ ? $nv : scalar( getpwnam($nv) );
+ $self->{'default'}{'create'}{'owner'} = $nv;
+ }
}
- }
- return $self->{'default'}{'create'}{'owner'};
+ return $self->{'default'}{'create'}{'owner'};
-}
+} ## end sub default_create_owner($;$)
#------------------------------------------------------------------------------------------
sub default_dateext($;$) {
- my $self = shift;
- my $nv;
- if ( @_ ) {
- $nv = shift;
- $self->{'default'}{'dateext'} = to_bool($nv);
- }
- return $self->{'default'}{'dateext'};
+ my $self = shift;
+ my $nv;
+ if (@_) {
+ $nv = shift;
+ $self->{'default'}{'dateext'} = to_bool($nv);
+ }
+ return $self->{'default'}{'dateext'};
-}
+} ## end sub default_dateext($;$)
#------------------------------------------------------------------------------------------
sub default_datepattern($;$) {
- my $self = shift;
- my $nv;
- if ( @_ ) {
- $nv = shift;
- $self->{'default'}{'datepattern'} = $nv;
- }
- return $self->{'default'}{'datepattern'};
+ my $self = shift;
+ my $nv;
+ if (@_) {
+ $nv = shift;
+ $self->{'default'}{'datepattern'} = $nv;
+ }
+ return $self->{'default'}{'datepattern'};
-}
+} ## end sub default_datepattern($;$)
#------------------------------------------------------------------------------------------
sub default_delaycompress($;$) {
- my $self = shift;
- my $nv;
- if ( @_ ) {
- $nv = shift;
- $self->{'default'}{'delaycompress'} = to_bool($nv);
- }
- return $self->{'default'}{'delaycompress'};
+ my $self = shift;
+ my $nv;
+ if (@_) {
+ $nv = shift;
+ $self->{'default'}{'delaycompress'} = to_bool($nv);
+ }
+ return $self->{'default'}{'delaycompress'};
-}
+} ## end sub default_delaycompress($;$)
#------------------------------------------------------------------------------------------
sub default_extension($;$) {
- my $self = shift;
- my $nv;
- if ( @_ ) {
- $nv = shift;
- $self->{'default'}{'extension'} = $nv if defined $nv;
- }
- return $self->{'default'}{'extension'};
+ my $self = shift;
+ my $nv;
+ if (@_) {
+ $nv = shift;
+ $self->{'default'}{'extension'} = $nv if defined $nv;
+ }
+ return $self->{'default'}{'extension'};
-}
+} ## end sub default_extension($;$)
#------------------------------------------------------------------------------------------
sub default_if_empty($;$) {
- my $self = shift;
- my $nv;
- if ( @_ ) {
- $nv = shift;
- $self->{'default'}{'if_empty'} = to_bool($nv);
- }
- return $self->{'default'}{'if_empty'};
+ my $self = shift;
+ my $nv;
+ if (@_) {
+ $nv = shift;
+ $self->{'default'}{'if_empty'} = to_bool($nv);
+ }
+ return $self->{'default'}{'if_empty'};
-}
+} ## end sub default_if_empty($;$)
#------------------------------------------------------------------------------------------
sub default_max_age($;$) {
- my $self = shift;
- my $nv;
- if ( @_ ) {
- $nv = shift;
- $self->{'default'}{'max_age'} = to_int($nv);
- }
- return $self->{'default'}{'max_age'};
+ my $self = shift;
+ my $nv;
+ if (@_) {
+ $nv = shift;
+ $self->{'default'}{'max_age'} = to_int($nv);
+ }
+ return $self->{'default'}{'max_age'};
-}
+} ## end sub default_max_age($;$)
#------------------------------------------------------------------------------------------
sub default_missingok($;$) {
- my $self = shift;
- my $nv;
- if ( @_ ) {
- $nv = shift;
- $self->{'default'}{'missingok'} = to_bool($nv);
- }
- return $self->{'default'}{'missingok'};
+ my $self = shift;
+ my $nv;
+ if (@_) {
+ $nv = shift;
+ $self->{'default'}{'missingok'} = to_bool($nv);
+ }
+ return $self->{'default'}{'missingok'};
-}
+} ## end sub default_missingok($;$)
#------------------------------------------------------------------------------------------
sub default_olddir_dirname($;$) {
- my $self = shift;
- my $nv;
- if ( @_ ) {
- $nv = shift;
- $self->{'default'}{'olddir'}{'dirname'} = $nv if defined $nv;
- }
- return $self->{'olddir'}{'dirname'}{'extension'};
+ my $self = shift;
+ my $nv;
+ if (@_) {
+ $nv = shift;
+ $self->{'default'}{'olddir'}{'dirname'} = $nv if defined $nv;
+ }
+ return $self->{'olddir'}{'dirname'}{'extension'};
-}
+} ## end sub default_olddir_dirname($;$)
#------------------------------------------------------------------------------------------
sub default_olddir_dateformat($;$) {
- my $self = shift;
- my $nv;
- if ( @_ ) {
- $nv = shift;
- $self->{'default'}{'olddir'}{'dateformat'} = $nv;
- }
- return $self->{'default'}{'olddir'}{'dateformat'};
+ my $self = shift;
+ my $nv;
+ if (@_) {
+ $nv = shift;
+ $self->{'default'}{'olddir'}{'dateformat'} = $nv;
+ }
+ return $self->{'default'}{'olddir'}{'dateformat'};
-}
+} ## end sub default_olddir_dateformat($;$)
#------------------------------------------------------------------------------------------
sub default_olddir_group($;$) {
- my $self = shift;
- my $nv;
- if ( @_ ) {
- $nv = shift;
- if ( defined $nv ) {
- $nv = $nv =~ /^[1-9]\d*$/ ? $nv : scalar( getgrnam( $nv ) );
- $self->{'default'}{'olddir'}{'group'} = $nv;
- } else {
- $self->{'default'}{'olddir'}{'group'} = undef;
- }
- }
- return $self->{'default'}{'olddir'}{'group'};
+ my $self = shift;
+ my $nv;
+ if (@_) {
+ $nv = shift;
+ if ( defined $nv ) {
+ $nv = $nv =~ /^[1-9]\d*$/ ? $nv : scalar( getgrnam($nv) );
+ $self->{'default'}{'olddir'}{'group'} = $nv;
+ }
+ else {
+ $self->{'default'}{'olddir'}{'group'} = undef;
+ }
+ } ## end if (@_)
+ return $self->{'default'}{'olddir'}{'group'};
-}
+} ## end sub default_olddir_group($;$)
#------------------------------------------------------------------------------------------
sub default_olddir_mode($;$) {
- my $self = shift;
- my $nv;
- if ( @_ ) {
- $nv = shift;
- $nv = defined $nv ? ( $nv =~ /^\d+$/ ? $nv : 0644 ) : undef;
- $self->{'default'}{'olddir'}{'mode'} = $nv;
- }
- return $self->{'default'}{'olddir'}{'mode'};
+ my $self = shift;
+ my $nv;
+ if (@_) {
+ $nv = shift;
+ $nv = defined $nv ? ( $nv =~ /^\d+$/ ? $nv : 0644 ) : undef;
+ $self->{'default'}{'olddir'}{'mode'} = $nv;
+ }
+ return $self->{'default'}{'olddir'}{'mode'};
-}
+} ## end sub default_olddir_mode($;$)
#------------------------------------------------------------------------------------------
sub default_olddir_owner($;$) {
- my $self = shift;
- my $nv;
- if ( @_ ) {
- $nv = shift;
- if ( defined $nv ) {
- $nv = $nv =~ /^[1-9]\d*$/ ? $nv : scalar( getpwnam( $nv ) );
- $self->{'default'}{'olddir'}{'owner'} = $nv;
- } else {
- $self->{'default'}{'olddir'}{'owner'} = undef;
- }
- }
- return $self->{'default'}{'olddir'}{'owner'};
+ my $self = shift;
+ my $nv;
+ if (@_) {
+ $nv = shift;
+ if ( defined $nv ) {
+ $nv = $nv =~ /^[1-9]\d*$/ ? $nv : scalar( getpwnam($nv) );
+ $self->{'default'}{'olddir'}{'owner'} = $nv;
+ }
+ else {
+ $self->{'default'}{'olddir'}{'owner'} = undef;
+ }
+ } ## end if (@_)
+ return $self->{'default'}{'olddir'}{'owner'};
-}
+} ## end sub default_olddir_owner($;$)
#------------------------------------------------------------------------------------------
sub default_period($;$) {
- my $self = shift;
- my $nv;
- if ( @_ ) {
- $nv = shift;
- if ( defined $nv ) {
- $nv = lc($nv);
- if ( $ValidPeriods{$nv} ) {
- $self->{'default'}{'period'} = $ValidPeriods{$nv};
- } else {
- $nv = period2days($nv);
- $self->{'default'}{'period'} = $nv if defined $nv;
- }
- }
- }
- return $self->{'default'}{'period'};
-
-}
+ my $self = shift;
+ my $nv;
+ if (@_) {
+ $nv = shift;
+ if ( defined $nv ) {
+ $nv = lc($nv);
+ if ( $ValidPeriods{$nv} ) {
+ $self->{'default'}{'period'} = $ValidPeriods{$nv};
+ }
+ else {
+ $nv = period2days($nv);
+ $self->{'default'}{'period'} = $nv if defined $nv;
+ }
+ } ## end if ( defined $nv )
+ } ## end if (@_)
+ return $self->{'default'}{'period'};
+
+} ## end sub default_period($;$)
#------------------------------------------------------------------------------------------
sub default_rotate($;$) {
- my $self = shift;
- my $nv;
- if ( @_ ) {
- $nv = shift;
- $self->{'default'}{'rotate'} = to_int($nv);
- }
- return $self->{'default'}{'rotate'};
+ my $self = shift;
+ my $nv;
+ if (@_) {
+ $nv = shift;
+ $self->{'default'}{'rotate'} = to_int($nv);
+ }
+ return $self->{'default'}{'rotate'};
-}
+} ## end sub default_rotate($;$)
#------------------------------------------------------------------------------------------
sub default_size($;$) {
- my $self = shift;
- my ( $nv, $val );
- if ( @_ ) {
- $nv = shift;
- if ( defined $nv ) {
- $val = human2byte($nv);
- $self->{'default'}{'size'} = $val if defined $val;
+ my $self = shift;
+ my ( $nv, $val );
+ if (@_) {
+ $nv = shift;
+ if ( defined $nv ) {
+ $val = human2byte($nv);
+ $self->{'default'}{'size'} = $val if defined $val;
+ }
}
- }
- return $self->{'default'}{'size'};
+ return $self->{'default'}{'size'};
-}
+} ## end sub default_size($;$)
#------------------------------------------------------------------------------------------
sub directive($$$$$) {
- my $self = shift;
- my $line = shift || "";
- my $f = shift || "'unknown'";
- my $in_fd = shift || 0;
- my $linenr = shift || "'unknown'";
- my $p = verbose() ? __PACKAGE__ . "::directive(): " : "";
-
- print $p . "Untersuche '$line' (Datei '$f', Zeilennr $linenr) ...\n" if verbose() > 5;
- my ( $directive, $val ) = $line =~ /^(\S+)\s*(.*)/;
- my ( $key, $negated, $name, $pattern, $wert );
- my ( @Values );
- my $wo = $in_fd ? 'newfile' : 'default';
- $directive = lc($directive);
-
- my %GlobalDirectives = (
- 'compresscmd' => 1,
- 'statusfile' => 1,
- 'pidfile' => 1,
- 'compressext' => 1,
- 'compressoptions' => 1,
- );
-
- my %BoolDirectives = (
- 'compress' => 1,
- 'copytruncate' => 1,
- 'ifempty' => 1,
- 'missingok' => 1,
- 'sharedscripts' => 1,
- );
-
- my %DirectivesWithValues = (
- 'compresscmd' => 1,
- 'statusfile' => 1,
- 'pidfile' => 1,
- 'compressext' => 1,
- 'rotate' => 1,
- 'maxage' => 1,
- );
-
- my %PathDirectives = (
- 'statusfile' => 1,
- 'pidfile' => 1,
- );
-
- my %UnsupportedDirectives = (
- '(?:no)?mail' => 1,
- 'mail(?:first|last)' => 1,
- 'uncompresscmd' => 1,
- 'error' => 1,
- );
-
- my %IntegerDirectives = (
- 'delaycompress' => 1,
- 'rotate' => 1,
- 'start' => 1,
- );
-
- my %StringDirectives = (
- 'extension' => 1,
- );
-
- my %YesValues = (
- '1' => 1,
- 'on' => 1,
- 'yes' => 1,
- 'ja' => 1,
- 'y' => 1,
- 'j' => 1,
- );
-
- my %NoValues = (
- '0' => 1,
- 'off' => 1,
- 'no' => 1,
- 'nein' => 1,
- 'n' => 1,
- );
-
-
- # Jetzt nicht unterstuetzte Direktiven ...
- $pattern = join( "|", keys %UnsupportedDirectives );
- if ( $directive =~ /^($pattern)$/i ) {
- $key = lc($1);
- warn $p . "Direktive '$key' wird nicht unterstuetzt (Datei '$f', Zeile $linenr).\n";
- return 1;
- }
-
- # jetzt die Logischen Werte untersuchen ...
- $pattern = join( "|", keys %BoolDirectives );
- if ( $directive =~ /^(not?)?($pattern)$/i ) {
- $negated = $1;
- $key = lc($2);
- print $p . "Untersuche boolsche Direktive '$key' (" . __LINE__ . ") ...\n" if verbose() > 5;
- if ( defined $val and $val ne "" ) {
- warn $p . "Wert '$val' hinter logischer Direktive $directive gefunden (Datei '$f', Zeile $linenr)\n";
- }
- $val = $negated ? 0 : 1;
- if ( $key eq 'compress' and not $self->{'compress_cmd'} and $val ) {
- warn $p . "Kompression unmoeglich, kein Kompressions-Kommando gegeben (Datei '$f', Zeile $linenr)\n";
- $val = 0;
- }
- print $p . "Setze '$key' in '$wo' auf $val.\n" if verbose() > 5;
- $self->{$wo}{$key} = $val;
- return 1;
- }
-
- # und nun die Integer-Direktiven ...
- $pattern = join( "|", keys %IntegerDirectives );
- if ( $directive =~ /^(not?)?($pattern)$/i ) {
- $negated = $1;
- $key = lc($2);
- print $p . "Untersuche Integer-Direktive '$key' (" . __LINE__ . ") ...\n" if verbose() > 5;
- if ( $DirectivesWithValues{$key} ) {
- print $p . "Direktive '$key' muss einen Wert haben.\n" if verbose() > 5;
- unless ( defined $val and $val !~ /^\s*$/ ) {
- warn $p . "Direktive '$key' ohne erforderlichen Wert angegeben (Datei '$f', Zeile $linenr).\n";
+ my $self = shift;
+ my $line = shift || "";
+ my $f = shift || "'unknown'";
+ my $in_fd = shift || 0;
+ my $linenr = shift || "'unknown'";
+ my $p = verbose() ? __PACKAGE__ . "::directive(): " : "";
+
+ print $p . "Untersuche '$line' (Datei '$f', Zeilennr $linenr) ...\n" if verbose() > 5;
+ my ( $directive, $val ) = $line =~ /^(\S+)\s*(.*)/;
+ my ( $key, $negated, $name, $pattern, $wert );
+ my (@Values);
+ my $wo = $in_fd ? 'newfile' : 'default';
+ $directive = lc($directive);
+
+ my %GlobalDirectives = (
+ 'compresscmd' => 1,
+ 'statusfile' => 1,
+ 'pidfile' => 1,
+ 'compressext' => 1,
+ 'compressoptions' => 1,
+ );
+
+ my %BoolDirectives = (
+ 'compress' => 1,
+ 'copytruncate' => 1,
+ 'ifempty' => 1,
+ 'missingok' => 1,
+ 'sharedscripts' => 1,
+ );
+
+ my %DirectivesWithValues = (
+ 'compresscmd' => 1,
+ 'statusfile' => 1,
+ 'pidfile' => 1,
+ 'compressext' => 1,
+ 'rotate' => 1,
+ 'maxage' => 1,
+ );
+
+ my %PathDirectives = (
+ 'statusfile' => 1,
+ 'pidfile' => 1,
+ );
+
+ my %UnsupportedDirectives = (
+ '(?:no)?mail' => 1,
+ 'mail(?:first|last)' => 1,
+ 'uncompresscmd' => 1,
+ 'error' => 1,
+ );
+
+ my %IntegerDirectives = (
+ 'delaycompress' => 1,
+ 'rotate' => 1,
+ 'start' => 1,
+ );
+
+ my %StringDirectives = ( 'extension' => 1, );
+
+ my %YesValues = (
+ '1' => 1,
+ 'on' => 1,
+ 'yes' => 1,
+ 'ja' => 1,
+ 'y' => 1,
+ 'j' => 1,
+ );
+
+ my %NoValues = (
+ '0' => 1,
+ 'off' => 1,
+ 'no' => 1,
+ 'nein' => 1,
+ 'n' => 1,
+ );
+
+ # Jetzt nicht unterstuetzte Direktiven ...
+ $pattern = join( "|", keys %UnsupportedDirectives );
+ if ( $directive =~ /^($pattern)$/i ) {
+ $key = lc($1);
+ warn $p . "Direktive '$key' wird nicht unterstuetzt (Datei '$f', Zeile $linenr).\n";
return 1;
- }
}
- if ( $negated ) {
- $wert = 0;
- } else {
- if ( not defined($val) or $val =~ /^\s*$/ ) {
- $wert = 1;
- } else {
- $wert = to_int($val);
- }
- }
- unless ( defined $wert ) {
- warn $p . "Ungueltiger Wert '$val' fuer Direktive '$key' (Datei '$f', Zeile $linenr).\n";
- return 1;
- }
- $self->{$wo}{$key} = $wert + 0;
- return 1;
- }
-
- # und hier allgemeine String-Direktiven
- $pattern = join( "|", keys %StringDirectives );
- if ( $directive =~ /^($pattern)$/i ) {
- $negated = $1;
- $key = lc($2);
- print $p . "Untersuche String-Direktive '$key' (" . __LINE__ . ") ...\n" if verbose() > 5;
- if ( $DirectivesWithValues{$key} ) {
- print $p . "Direktive '$key' muss einen Wert haben.\n" if verbose() > 5;
- unless ( defined $val and $val !~ /^\s*$/ ) {
- warn $p . "Direktive '$key' ohne erforderlichen Wert angegeben (Datei '$f', Zeile $linenr).\n";
+
+ # jetzt die Logischen Werte untersuchen ...
+ $pattern = join( "|", keys %BoolDirectives );
+ if ( $directive =~ /^(not?)?($pattern)$/i ) {
+ $negated = $1;
+ $key = lc($2);
+ print $p . "Untersuche boolsche Direktive '$key' (" . __LINE__ . ") ...\n" if verbose() > 5;
+ if ( defined $val and $val ne "" ) {
+ warn $p . "Wert '$val' hinter logischer Direktive $directive gefunden (Datei '$f', Zeile $linenr)\n";
+ }
+ $val = $negated ? 0 : 1;
+ if ( $key eq 'compress' and not $self->{'compress_cmd'} and $val ) {
+ warn $p . "Kompression unmoeglich, kein Kompressions-Kommando gegeben (Datei '$f', Zeile $linenr)\n";
+ $val = 0;
+ }
+ print $p . "Setze '$key' in '$wo' auf $val.\n" if verbose() > 5;
+ $self->{$wo}{$key} = $val;
return 1;
- }
- }
- if ( $negated ) {
- $val = "";
- }
- $wert = defined $val ? $val : "";
- $self->{$wo}{$key} = $wert;
- return 1;
- }
-
- # Jetzt die Werte, die nur ausserhalb von Logfile-Definitionen gueltig sind
- $pattern = join( "|", keys %GlobalDirectives );
- if ( $directive =~ /^($pattern)$/i ) {
- $key = lc($1);
- print $p . "Untersuche globale Direktive '$key' (" . __LINE__ . ") ...\n" if verbose() > 5;
- if ( $in_fd ) {
- warn $p . "Direktive '$key' ist nicht innerhalb von Logdatei-Definitionen erlaubt (Datei '$f', Zeile $linenr).\n";
- return 1;
- }
- if ( $DirectivesWithValues{$key} ) {
- print $p . "Direktive '$key' muss einen Wert haben.\n" if verbose() > 5;
- unless ( defined $val and $val ne "" ) {
- warn $p . "Direktive '$key' ohne erforderlichen Wert angegeben (Datei '$f', Zeile $linenr).\n";
+ } ## end if ( $directive =~ /^(not?)?($pattern)$/i )
+
+ # und nun die Integer-Direktiven ...
+ $pattern = join( "|", keys %IntegerDirectives );
+ if ( $directive =~ /^(not?)?($pattern)$/i ) {
+ $negated = $1;
+ $key = lc($2);
+ print $p . "Untersuche Integer-Direktive '$key' (" . __LINE__ . ") ...\n" if verbose() > 5;
+ if ( $DirectivesWithValues{$key} ) {
+ print $p . "Direktive '$key' muss einen Wert haben.\n" if verbose() > 5;
+ unless ( defined $val and $val !~ /^\s*$/ ) {
+ warn $p . "Direktive '$key' ohne erforderlichen Wert angegeben (Datei '$f', Zeile $linenr).\n";
+ return 1;
+ }
+ }
+ if ($negated) {
+ $wert = 0;
+ }
+ else {
+ if ( not defined($val) or $val =~ /^\s*$/ ) {
+ $wert = 1;
+ }
+ else {
+ $wert = to_int($val);
+ }
+ }
+ unless ( defined $wert ) {
+ warn $p . "Ungueltiger Wert '$val' fuer Direktive '$key' (Datei '$f', Zeile $linenr).\n";
+ return 1;
+ }
+ $self->{$wo}{$key} = $wert + 0;
return 1;
- }
- }
- $val = "" if $key eq "compressoptions" and not defined $val;
- if ( $key eq 'compresscmd' ) {
- if ( $name = $self->check_compress_program( $val ) ) {
- print $p . "Setze 'compress_cmd' auf '$name'.\n" if verbose() > 4;
- $self->{'compress_cmd'} = $name;
+ } ## end if ( $directive =~ /^(not?)?($pattern)$/i )
+
+ # und hier allgemeine String-Direktiven
+ $pattern = join( "|", keys %StringDirectives );
+ if ( $directive =~ /^($pattern)$/i ) {
+ $negated = $1;
+ $key = lc($2);
+ print $p . "Untersuche String-Direktive '$key' (" . __LINE__ . ") ...\n" if verbose() > 5;
+ if ( $DirectivesWithValues{$key} ) {
+ print $p . "Direktive '$key' muss einen Wert haben.\n" if verbose() > 5;
+ unless ( defined $val and $val !~ /^\s*$/ ) {
+ warn $p . "Direktive '$key' ohne erforderlichen Wert angegeben (Datei '$f', Zeile $linenr).\n";
+ return 1;
+ }
+ }
+ if ($negated) {
+ $val = "";
+ }
+ $wert = defined $val ? $val : "";
+ $self->{$wo}{$key} = $wert;
return 1;
- }
- warn $p . "Das gegebene Kompressions-Kommando ist ungueltig, verwende das alte " .
- "Kommando '" . $self->{'compress_cmd'} . "' (Datei '$f', Zeile '$f').\n";
- }
- if ( $PathDirectives{$key} ) {
- unless ( $val =~ m#^/# ) {
- warn $p . "Direktive '$key' erfordert absolute Pfadangaben ( '$val' in Datei '$f', Zeile $linenr).\n";
+ } ## end if ( $directive =~ /^($pattern)$/i )
+
+ # Jetzt die Werte, die nur ausserhalb von Logfile-Definitionen gueltig sind
+ $pattern = join( "|", keys %GlobalDirectives );
+ if ( $directive =~ /^($pattern)$/i ) {
+ $key = lc($1);
+ print $p . "Untersuche globale Direktive '$key' (" . __LINE__ . ") ...\n" if verbose() > 5;
+ if ($in_fd) {
+ warn $p . "Direktive '$key' ist nicht innerhalb von Logdatei-Definitionen erlaubt (Datei '$f', Zeile $linenr).\n";
+ return 1;
+ }
+ if ( $DirectivesWithValues{$key} ) {
+ print $p . "Direktive '$key' muss einen Wert haben.\n" if verbose() > 5;
+ unless ( defined $val and $val ne "" ) {
+ warn $p . "Direktive '$key' ohne erforderlichen Wert angegeben (Datei '$f', Zeile $linenr).\n";
+ return 1;
+ }
+ }
+ $val = "" if $key eq "compressoptions" and not defined $val;
+ if ( $key eq 'compresscmd' ) {
+ if ( $name = $self->check_compress_program($val) ) {
+ print $p . "Setze 'compress_cmd' auf '$name'.\n" if verbose() > 4;
+ $self->{'compress_cmd'} = $name;
+ return 1;
+ }
+ warn $p
+ . "Das gegebene Kompressions-Kommando ist ungueltig, verwende das alte "
+ . "Kommando '"
+ . $self->{'compress_cmd'}
+ . "' (Datei '$f', Zeile '$f').\n";
+ } ## end if ( $key eq 'compresscmd' )
+ if ( $PathDirectives{$key} ) {
+ unless ( $val =~ m#^/# ) {
+ warn $p . "Direktive '$key' erfordert absolute Pfadangaben ( '$val' in Datei '$f', Zeile $linenr).\n";
+ return 1;
+ }
+ }
+ print $p . "Setze '$key' auf '$val'.\n" if verbose() > 4;
+ $self->{$key} = $val;
return 1;
- }
- }
- print $p . "Setze '$key' auf '$val'.\n" if verbose() > 4;
- $self->{$key} = $val;
- return 1;
- }
-
- # Rotations-Periode ermitteln
- $pattern = join( "|", 'period', keys %ValidPeriods );
- if ( $directive =~ /^($pattern)$/i ) {
-
- $key = lc($1);
- print $p . "Untersuche Rotations-Perioden-Direktive '$key' (" . __LINE__ . ") ...\n" if verbose() > 5;
-
- if ( $ValidPeriods{$key} ) {
- warn $p . "Direktive '$key' darf keine Argumente haben ( '$val' in Datei '$f', Zeile $linenr).\n"
- if defined $val and $val !~ /^\s*$/;
- $val = $ValidPeriods{$key};
- } else {
- if ( defined $val and $val =~ /^\s*-\s*\d+\s*$/ ) {
- $val = -1;
- } else {
- $val = period2days($val);
- unless ( defined $val ) {
- warn $p . "Ungueltige Perioden-Definition (Datei '$f', Zeile $linenr).\n";
- return 1;
+ } ## end if ( $directive =~ /^($pattern)$/i )
+
+ # Rotations-Periode ermitteln
+ $pattern = join( "|", 'period', keys %ValidPeriods );
+ if ( $directive =~ /^($pattern)$/i ) {
+
+ $key = lc($1);
+ print $p . "Untersuche Rotations-Perioden-Direktive '$key' (" . __LINE__ . ") ...\n" if verbose() > 5;
+
+ if ( $ValidPeriods{$key} ) {
+ warn $p . "Direktive '$key' darf keine Argumente haben ( '$val' in Datei '$f', Zeile $linenr).\n"
+ if defined $val and $val !~ /^\s*$/;
+ $val = $ValidPeriods{$key};
}
- }
- }
+ else {
+ if ( defined $val and $val =~ /^\s*-\s*\d+\s*$/ ) {
+ $val = -1;
+ }
+ else {
+ $val = period2days($val);
+ unless ( defined $val ) {
+ warn $p . "Ungueltige Perioden-Definition (Datei '$f', Zeile $linenr).\n";
+ return 1;
+ }
+ }
+ } ## end else [ if ( $ValidPeriods{$key} )
+
+ print $p . "Setze Periode in '$wo' auf '$val'.\n" if verbose() > 5;
+ $self->{$wo}{'period'} = $val;
+ return 1;
+ } ## end if ( $directive =~ /^($pattern)$/i )
- print $p . "Setze Periode in '$wo' auf '$val'.\n" if verbose() > 5;
- $self->{$wo}{'period'} = $val;
- return 1;
- }
+ # Maximalalter fuer alte Logdateien ermitteln
+ if ( $directive =~ /^(not?)?maxage$/ ) {
- # Maximalalter fuer alte Logdateien ermitteln
- if ( $directive =~ /^(not?)?maxage$/ ) {
+ $negated = $1;
+ print $p . "Untersuche Direktive 'maxage' (" . __LINE__ . ") ...\n" if verbose() > 5;
- $negated = $1;
- print $p . "Untersuche Direktive 'maxage' (" . __LINE__ . ") ...\n" if verbose() > 5;
+ $negated = 1 if not defined($val) or $val =~ /^\s*$/;
+ if ($negated) {
+ $val = 0;
+ }
+ else {
+ $val = period2days($val);
+ unless ( defined $val ) {
+ warn $p . "Ungueltige Maxage-Definition (Datei '$f', Zeile $linenr).\n";
+ return 1;
+ }
+ }
- $negated = 1 if not defined($val) or $val =~ /^\s*$/;
- if ( $negated ) {
- $val = 0;
- } else {
- $val = period2days($val);
- unless ( defined $val ) {
- warn $p . "Ungueltige Maxage-Definition (Datei '$f', Zeile $linenr).\n";
+ print $p . "Setze Maxage in '$wo' auf '$val'.\n" if verbose() > 5;
+ $self->{$wo}{'maxage'} = $val;
return 1;
- }
- }
+ } ## end if ( $directive =~ /^(not?)?maxage$/ )
- print $p . "Setze Maxage in '$wo' auf '$val'.\n" if verbose() > 5;
- $self->{$wo}{'maxage'} = $val;
- return 1;
- }
-
- # Datumserweiterung der rotierten Logdateien festlegen ...
- if ( $directive =~ /^(no)?dateext$/ ) {
-
- $negated = $1;
- print $p . "Untersuche Direktive 'dateext' (" . __LINE__ . ") ...\n" if verbose() > 5;
- @Values = $val ? parts( $val ) : ();
-
- if ( $negated ) {
- $val = 0;
- $name = undef;
- } else {
- $val = lc( defined $Values[0] ? $Values[0] : '' );
- $val = 1 if $val =~ /^\s*$/;
- if ( $YesValues{$val} ) {
- $val = 1;
- $name = undef;
- } elsif ( $NoValues{$val} ) {
- $val = 0;
- $name = undef;
- } else {
- $name = $val;
- $val = 1;
- }
- }
+ # Datumserweiterung der rotierten Logdateien festlegen ...
+ if ( $directive =~ /^(no)?dateext$/ ) {
- print $p . "Setze dateext in '$wo' auf $val.\n" if verbose() > 5;
- $self->{$wo}{'dateext'} = $val;
+ $negated = $1;
+ print $p . "Untersuche Direktive 'dateext' (" . __LINE__ . ") ...\n" if verbose() > 5;
+ @Values = $val ? parts($val) : ();
- if ( defined $name ) {
- print $p . "Setze datepattern in '$wo' auf '$name'.\n" if verbose() > 5;
- $self->{$wo}{'datepattern'} = $name;
- }
- return 1;
+ if ($negated) {
+ $val = 0;
+ $name = undef;
+ }
+ else {
+ $val = lc( defined $Values[0] ? $Values[0] : '' );
+ $val = 1 if $val =~ /^\s*$/;
+ if ( $YesValues{$val} ) {
+ $val = 1;
+ $name = undef;
+ }
+ elsif ( $NoValues{$val} ) {
+ $val = 0;
+ $name = undef;
+ }
+ else {
+ $name = $val;
+ $val = 1;
+ }
+ } ## end else [ if ($negated)
+
+ print $p . "Setze dateext in '$wo' auf $val.\n" if verbose() > 5;
+ $self->{$wo}{'dateext'} = $val;
+
+ if ( defined $name ) {
+ print $p . "Setze datepattern in '$wo' auf '$name'.\n" if verbose() > 5;
+ $self->{$wo}{'datepattern'} = $name;
+ }
+ return 1;
- }
+ } ## end if ( $directive =~ /^(no)?dateext$/ )
- # Erstellungs-Modi festlegen
- if ( $directive eq 'create' ) {
+ # Erstellungs-Modi festlegen
+ if ( $directive =~ /^(not?)?create$/i ) {
- print $p . "Untersuche Direktive 'create' (" . __LINE__ . ") ...\n" if verbose() > 5;
- @Values = $val ? parts( $val ) : ();
- $self->{$wo}{'copytruncate'} = 0;
- print $p . "Ermittelte Werte fuer 'create': " . Dumper(\@Values) if verbose() > 5;
+ $negated = $1;
- # Mode (Permission) definition
- if ( defined $Values[0] ) {
- if ( $Values[0] =~ /^\d+$/ ) {
- $self->{$wo}{'create'}{'mode'} = oct( $Values[0] );
- } else {
- warn $p . "Directive 'create' mit ungueltigem Modus '" . $Values[0] . "' (Datei '$f', Zeile '$f').\n";
- }
- }
+ print $p . "Untersuche Direktive 'create' (" . __LINE__ . ") ...\n" if verbose() > 5;
- # User (owner, uid) definition
- if ( defined $Values[1] and $Values[1] ne "" ) {
- if ( $Values[1] =~ /^[1-9]\d*$/ ) {
- $self->{$wo}{'create'}{'owner'} = $Values[1];
- } else {
- $self->{$wo}{'create'}{'owner'} = scalar getpwnam( $Values[1] );
- }
- }
+ if ($negated) {
+ print $p . "Direktive 'create' wird in '$wo' enfernt.\n" if verbose() > 5;
+ delete $self->{$wo}{'create'} = if exists $self->{$wo}{'create'};
+ return 1;
+ }
- # Group (gid) definition
- if ( defined $Values[2] and $Values[2] ne "" ) {
- if ( $Values[2] =~ /^[1-9]\d*$/ ) {
- $self->{$wo}{'create'}{'group'} = $Values[2];
- } else {
- $self->{$wo}{'create'}{'group'} = scalar getgrnam( $Values[2] );
- }
- }
+ @Values = $val ? parts($val) : ();
+ $self->{$wo}{'copytruncate'} = 0;
+ print $p . "Ermittelte Werte fuer 'create': " . Dumper( \@Values ) if verbose() > 5;
+
+ # Mode (Permission) definition
+ if ( defined $Values[0] ) {
+ if ( $Values[0] =~ /^\d+$/ ) {
+ $self->{$wo}{'create'}{'mode'} = oct( $Values[0] );
+ }
+ else {
+ warn $p . "Directive 'create' mit ungueltigem Modus '" . $Values[0] . "' (Datei '$f', Zeile '$f').\n";
+ }
+ }
- return 1;
+ # User (owner, uid) definition
+ if ( defined $Values[1] and $Values[1] ne "" ) {
+ if ( $Values[1] =~ /^[1-9]\d*$/ ) {
+ $self->{$wo}{'create'}{'owner'} = $Values[1];
+ }
+ else {
+ $self->{$wo}{'create'}{'owner'} = scalar getpwnam( $Values[1] );
+ }
+ }
- }
+ # Group (gid) definition
+ if ( defined $Values[2] and $Values[2] ne "" ) {
+ if ( $Values[2] =~ /^[1-9]\d*$/ ) {
+ $self->{$wo}{'create'}{'group'} = $Values[2];
+ }
+ else {
+ $self->{$wo}{'create'}{'group'} = scalar getgrnam( $Values[2] );
+ }
+ }
- # Olddir-Verhalten festlegen ...
- if ( $directive =~ /^(not?)?olddir$/i ) {
+ return 1;
- $negated = $1;
- $directive = 'olddir';
+ } ## end if ( $directive =~ /^(not?)?create$/i )
- print $p . "Untersuche Direktive 'olddir' (" . __LINE__ . ") ...\n" if verbose() > 5;
+ # Olddir-Verhalten festlegen ...
+ if ( $directive =~ /^(not?)?olddir$/i ) {
- if ( $negated ) {
- print $p . "Direktive 'olddir' wird in '$wo' enfernt.\n" if verbose() > 5;
- $self->{$wo}{'olddir'} = undef;
- return 1;
- }
+ $negated = $1;
+ $directive = 'olddir';
- @Values = $val ? parts( $val ) : ();
+ print $p . "Untersuche Direktive 'olddir' (" . __LINE__ . ") ...\n" if verbose() > 5;
- if ( $Values[0] ) {
- $self->{$wo}{'olddir'} = {} unless $self->{$wo}{'olddir'};
- $self->{$wo}{'olddir'}{'dirname'} = $Values[0];
- } else {
- warn $p . "Direktive '$directive' ohne erforderlichen Wert angegeben (Datei '$f', Zeile $linenr).\n";
- return 1;
- }
+ if ($negated) {
+ print $p . "Direktive 'olddir' wird in '$wo' enfernt.\n" if verbose() > 5;
+ delete $self->{$wo}{'olddir'} = if exists $self->{$wo}{'olddir'};
+ return 1;
+ }
- $self->{$wo}{'olddir'}{'mode'} = undef;
- $self->{$wo}{'olddir'}{'owner'} = undef;
- $self->{$wo}{'olddir'}{'group'} = undef;
-
- # Mode (Permission) definition
- if ( defined $Values[1] ) {
- if ( $Values[0] =~ /^\d+$/ ) {
- $self->{$wo}{'olddir'}{'mode'} = oct( $Values[1] );
- } else {
- warn $p . "Directive 'olddir' mit ungueltigem Modus '" . $Values[1] . "' (Datei '$f', Zeile '$f').\n";
- }
- }
+ @Values = $val ? parts($val) : ();
- # User (owner, uid) definition
- if ( defined $Values[2] and $Values[2] ne "" ) {
- if ( $Values[1] =~ /^[1-9]\d*$/ ) {
- $self->{$wo}{'olddir'}{'owner'} = $Values[2];
- } else {
- $self->{$wo}{'olddir'}{'owner'} = scalar getpwnam( $Values[2] );
- }
- }
+ if ( $Values[0] ) {
+ $self->{$wo}{'olddir'} = {} unless $self->{$wo}{'olddir'};
+ $self->{$wo}{'olddir'}{'dirname'} = $Values[0];
+ }
+ else {
+ warn $p . "Direktive '$directive' ohne erforderlichen Wert angegeben (Datei '$f', Zeile $linenr).\n";
+ return 1;
+ }
- # Group (gid) definition
- if ( defined $Values[3] and $Values[3] ne "" ) {
- if ( $Values[2] =~ /^[1-9]\d*$/ ) {
- $self->{$wo}{'olddir'}{'group'} = $Values[3];
- } else {
- $self->{$wo}{'olddir'}{'group'} = scalar getgrnam( $Values[3] );
- }
- }
+ $self->{$wo}{'olddir'}{'mode'} = undef;
+ $self->{$wo}{'olddir'}{'owner'} = undef;
+ $self->{$wo}{'olddir'}{'group'} = undef;
+
+ # Mode (Permission) definition
+ if ( defined $Values[1] ) {
+ if ( $Values[0] =~ /^\d+$/ ) {
+ $self->{$wo}{'olddir'}{'mode'} = oct( $Values[1] );
+ }
+ else {
+ warn $p . "Directive 'olddir' mit ungueltigem Modus '" . $Values[1] . "' (Datei '$f', Zeile '$f').\n";
+ }
+ }
- return 1;
+ # User (owner, uid) definition
+ if ( defined $Values[2] and $Values[2] ne "" ) {
+ if ( $Values[1] =~ /^[1-9]\d*$/ ) {
+ $self->{$wo}{'olddir'}{'owner'} = $Values[2];
+ }
+ else {
+ $self->{$wo}{'olddir'}{'owner'} = scalar getpwnam( $Values[2] );
+ }
+ }
- }
+ # Group (gid) definition
+ if ( defined $Values[3] and $Values[3] ne "" ) {
+ if ( $Values[2] =~ /^[1-9]\d*$/ ) {
+ $self->{$wo}{'olddir'}{'group'} = $Values[3];
+ }
+ else {
+ $self->{$wo}{'olddir'}{'group'} = scalar getgrnam( $Values[3] );
+ }
+ }
- # Rotations-Mindestgroesse ermitteln
- if ( $line =~ /^size(?:\s*(?:=|\s)\s*(.*)?)?$/i ) {
- $directive = 'size';
- $val = $1;
- print $p . "Untersuche Direktive 'size' (" . __LINE__ . ") mit Groesse '" . (defined $val ? $val : "<undef>") . "' ...\n" if verbose() > 5;
- unless ( defined $val ) {
- warn $p . "Ungueltige Groessen-Definition (Datei '$f', Zeile $linenr).\n";
- return 1;
- }
- $wert = human2byte($val);
- unless ( defined $wert ) {
- warn $p . "Ungueltige Groessen-Definition ('$val' in Datei '$f', Zeile $linenr).\n";
- return 1;
- }
- print $p . "Setze Groesse in '$wo' auf '$wert'.\n" if verbose() > 5;
- $self->{$wo}{'size'} = $wert;
- return 1;
- }
+ return 1;
- # Tabu-Pattern aendern bzw. hinzufuegen
- if ( $directive =~ /^taboo(ext|file|prefix)$/ ) {
+ } ## end if ( $directive =~ /^(not?)?olddir$/i )
- $key = lc($1);
- print $p . "Untersuche globale Direktive '$key' (" . __LINE__ . ") ...\n" if verbose() > 5;
+ # Rotations-Mindestgroesse ermitteln
+ if ( $line =~ /^size(?:\s*(?:=|\s)\s*(.*)?)?$/i ) {
+ $directive = 'size';
+ $val = $1;
+ print $p . "Untersuche Direktive 'size' (" . __LINE__ . ") mit Groesse '" . ( defined $val ? $val : "<undef>" ) . "' ...\n"
+ if verbose() > 5;
+ unless ( defined $val ) {
+ warn $p . "Ungueltige Groessen-Definition (Datei '$f', Zeile $linenr).\n";
+ return 1;
+ }
+ $wert = human2byte($val);
+ unless ( defined $wert ) {
+ warn $p . "Ungueltige Groessen-Definition ('$val' in Datei '$f', Zeile $linenr).\n";
+ return 1;
+ }
+ print $p . "Setze Groesse in '$wo' auf '$wert'.\n" if verbose() > 5;
+ $self->{$wo}{'size'} = $wert;
+ return 1;
+ } ## end if ( $line =~ /^size(?:\s*(?:=|\s)\s*(.*)?)?$/i)
- if ( $in_fd ) {
- warn $p . "Direktive '$directive' ist nicht innerhalb von Logdatei-Definitionen erlaubt (Datei '$f', Zeile $linenr).\n";
- return 1;
- }
+ # Tabu-Pattern aendern bzw. hinzufuegen
+ if ( $directive =~ /^taboo(ext|file|prefix)$/ ) {
- @Values = $val ? parts( $val ) : ();
- my $extend = 0;
- if ( $Values[0] and $Values[0] eq "+" ) {
- $extend = 1;
- shift @Values;
- }
+ $key = lc($1);
+ print $p . "Untersuche globale Direktive '$key' (" . __LINE__ . ") ...\n" if verbose() > 5;
- $self->{'taboo'} = [] unless $extend;
- for $name ( @Values ) {
- $self->add_taboo( $name, $key );
- }
+ if ($in_fd) {
+ warn $p . "Direktive '$directive' ist nicht innerhalb von Logdatei-Definitionen erlaubt (Datei '$f', Zeile $linenr).\n";
+ return 1;
+ }
- return 1;
- }
+ @Values = $val ? parts($val) : ();
+ my $extend = 0;
+ if ( $Values[0] and $Values[0] eq "+" ) {
+ $extend = 1;
+ shift @Values;
+ }
- warn $p . "Unbekannte Direktive '$directive' (Datei '$f', Zeile $linenr).\n";
- return 1;
+ $self->{'taboo'} = [] unless $extend;
+ for $name (@Values) {
+ $self->add_taboo( $name, $key );
+ }
-}
+ return 1;
+ } ## end if ( $directive =~ /^taboo(ext|file|prefix)$/)
+
+ warn $p . "Unbekannte Direktive '$directive' (Datei '$f', Zeile $linenr).\n";
+ return 1;
+
+} ## end sub directive($$$$$)
#------------------------------------------------------------------------------------------
sub do_include($$$$$) {
- my $self = shift;
- my $line = shift || "";
- my $f = shift || "'unknown'";
- my $in_fd = shift || 0;
- my $linenr = shift || "'unknown'";
- my $p = verbose() ? __PACKAGE__ . "::do_include(): " : "";
+ my $self = shift;
+ my $line = shift || "";
+ my $f = shift || "'unknown'";
+ my $in_fd = shift || 0;
+ my $linenr = shift || "'unknown'";
+ my $p = verbose() ? __PACKAGE__ . "::do_include(): " : "";
- my ( $if, $dir, $basename, $name, $bname, $found, $pattern );
+ my ( $if, $dir, $basename, $name, $bname, $found, $pattern );
- if ( $in_fd ) {
- warn $p . "include-Directiven innerhalb von Logfile-Definitionen sind nicht erlaubt" .
- "(Zeile $linenr in datei '$f')\n";
- return undef;
- }
+ if ($in_fd) {
+ warn $p . "include-Directiven innerhalb von Logfile-Definitionen sind nicht erlaubt" . "(Zeile $linenr in datei '$f')\n";
+ return undef;
+ }
- # Das Wort 'include selbst wegschmeissen
- $line =~ s/^\S+\s*//;
+ # Das Wort 'include selbst wegschmeissen
+ $line =~ s/^\S+\s*//;
- my @Values = parts($line);
+ my @Values = parts($line);
- # Fehlermeldung, wenn der Dateiname fehlt
- unless ( @Values ) {
- warn $p . "Include-Directive ohne Datei- oder Verzzeichnisangabe in Datei '$f', Zeile $linenr gefunden.\n";
- return undef;
- }
-
- $if = $Values[0];
- warn $p . "Nur ein Include pro Direktive ist erlaubt. Der erste Eintrag '$if' wird verwendet." .
- " (Datei ''$f', Zeile $linenr).\n" if scalar @Values > 1;
-
- if ( $if !~ m#^/# ) {
- if ( $f =~ m#/# ) {
- ( $dir, $basename ) = $f =~ m#(.*)/([^/]+)$#;
- } else {
- $dir = ".";
- $basename = $f;
+ # Fehlermeldung, wenn der Dateiname fehlt
+ unless (@Values) {
+ warn $p . "Include-Directive ohne Datei- oder Verzzeichnisangabe in Datei '$f', Zeile $linenr gefunden.\n";
+ return undef;
}
- $if = $dir . "/" . $if;
- }
- if ( -f $if ) {
- if ( $self->{'included_files'}{$if} ) {
- warn $p . "Rekursives Includen von '$if' in Datei '$f', Zeile $linenr.\n";
- return undef;
- }
- print $p . "Include Datei '$if' ...\n" if verbose() > 1;
- $self->{'included_files'}{$if} = 1;
- return $self->read( $f );
- }
-
- if ( -d $if ) {
-
- print $p . "Include Verzeichnis '$if' ...\n" if verbose() > 1;
-
- foreach $name ( glob( "$if/.* $if/*") ) {
-
- $bname = basename( $name );
- next if $bname eq "." or $bname eq "..";
-
- print $p . "Checke Include-Datei '$if/$bname' ...\n" if verbose() > 1;
- if ( -d "$if/$bname" ) {
- # Keine Verzeichnis-Rekursion !!!
- print $p . "Verzeichnis '$if/$bname' wird uebergangen.\n" if verbose() > 1;
- next;
- }
-
- # Check auf Tabu-Dateinamen
- $found = 0;
- foreach $pattern ( @{$self->{'taboo'}} ) {
- if ( $bname =~ /$pattern/ ) {
- $found = 1;
- print $p . "Datei '$if/$bname' matcht Tabu-Pattern '$pattern', wird uebergangen.\n" if verbose() > 1;
- last;
+ $if = $Values[0];
+ warn $p . "Nur ein Include pro Direktive ist erlaubt. Der erste Eintrag '$if' wird verwendet." . " (Datei ''$f', Zeile $linenr).\n"
+ if scalar @Values > 1;
+
+ if ( $if !~ m#^/# ) {
+ if ( $f =~ m#/# ) {
+ ( $dir, $basename ) = $f =~ m#(.*)/([^/]+)$#;
+ }
+ else {
+ $dir = ".";
+ $basename = $f;
}
- }
- next if $found;
+ $if = $dir . "/" . $if;
+ } ## end if ( $if !~ m#^/# )
- if ( $self->{'included_files'}{$name} ) {
- warn $p . "Rekursives Includen von '$name' in Datei '$f', Zeile $linenr.\n";
- return undef;
- }
- print $p . "Include Datei '$name' ...\n" if verbose() > 1;
- $self->{'included_files'}{$name} = 1;
+ if ( -f $if ) {
+ if ( $self->{'included_files'}{$if} ) {
+ warn $p . "Rekursives Includen von '$if' in Datei '$f', Zeile $linenr.\n";
+ return undef;
+ }
+ print $p . "Include Datei '$if' ...\n" if verbose() > 1;
+ $self->{'included_files'}{$if} = 1;
+ return $self->read($f);
+ }
- return undef unless $self->read( $name );
+ if ( -d $if ) {
- }
+ print $p . "Include Verzeichnis '$if' ...\n" if verbose() > 1;
- return 1;
+ foreach $name ( glob("$if/.* $if/*") ) {
- }
+ $bname = basename($name);
+ next if $bname eq "." or $bname eq "..";
- warn $p . "Ungueltige Include-Direktive '$line' in Datei '$f', Zeile $linenr gefunden.\n";
- return undef;
+ print $p . "Checke Include-Datei '$if/$bname' ...\n" if verbose() > 1;
+ if ( -d "$if/$bname" ) {
-}
+ # Keine Verzeichnis-Rekursion !!!
+ print $p . "Verzeichnis '$if/$bname' wird uebergangen.\n" if verbose() > 1;
+ next;
+ }
+
+ # Check auf Tabu-Dateinamen
+ $found = 0;
+ foreach $pattern ( @{ $self->{'taboo'} } ) {
+ if ( $bname =~ /$pattern/ ) {
+ $found = 1;
+ print $p . "Datei '$if/$bname' matcht Tabu-Pattern '$pattern', wird uebergangen.\n" if verbose() > 1;
+ last;
+ }
+ }
+ next if $found;
+
+ if ( $self->{'included_files'}{$name} ) {
+ warn $p . "Rekursives Includen von '$name' in Datei '$f', Zeile $linenr.\n";
+ return undef;
+ }
+ print $p . "Include Datei '$name' ...\n" if verbose() > 1;
+ $self->{'included_files'}{$name} = 1;
+
+ return undef unless $self->read($name);
+
+ } ## end foreach $name ( glob("$if/.* $if/*") )
+
+ return 1;
+
+ } ## end if ( -d $if )
+
+ warn $p . "Ungueltige Include-Direktive '$line' in Datei '$f', Zeile $linenr gefunden.\n";
+ return undef;
+
+} ## end sub do_include($$$$$)
#------------------------------------------------------------------------------------------
sub do_logfilescript($$$$$) {
- my $self = shift;
- my $line = shift || "";
- my $f = shift || "'unknown'";
- my $in_fd = shift || 0;
- my $linenr = shift || "'unknown'";
- my $p = verbose() ? __PACKAGE__ . "::do_logfilescript(): " : "";
+ my $self = shift;
+ my $line = shift || "";
+ my $f = shift || "'unknown'";
+ my $in_fd = shift || 0;
+ my $linenr = shift || "'unknown'";
+ my $p = verbose() ? __PACKAGE__ . "::do_logfilescript(): " : "";
- print $p . "Scriptdefinition '$line' (Datei '$f', Zeilennr $linenr) ...\n" if verbose() > 5;
- my ( $directive, $val ) = $line =~ /^(\S+)\s*(.*)/;
- $directive = lc($directive);
+ print $p . "Scriptdefinition '$line' (Datei '$f', Zeilennr $linenr) ...\n" if verbose() > 5;
+ my ( $directive, $val ) = $line =~ /^(\S+)\s*(.*)/;
+ $directive = lc($directive);
- unless ( $in_fd ) {
- warn $p . "Direktive '$directive' ist nicht erlaubt ausserhalb einer Logfile-Definition (Datei '$f', Zeile $linenr).\n";
- return undef;
- }
+ unless ($in_fd) {
+ warn $p . "Direktive '$directive' ist nicht erlaubt ausserhalb einer Logfile-Definition (Datei '$f', Zeile $linenr).\n";
+ return undef;
+ }
- my @Values = $val ? parts( $val ) : ();
+ my @Values = $val ? parts($val) : ();
- my $name;
- if ( $Values[0] ) {
- $self->{'newfile'}{$directive} = lc($Values[0]);
- return undef;
- } else {
- $name = $self->new_script_name($directive);
- $self->{'scripts'}{$name}{'cmd'} = [];
- $self->{'scripts'}{$name}{'post'} = 0;
- $self->{'scripts'}{$name}{'last'} = 0;
- $self->{'scripts'}{$name}{'first'} = 0;
- $self->{'scripts'}{$name}{'prerun'} = 0;
- $self->{'scripts'}{$name}{'donepost'} = 0;
- $self->{'scripts'}{$name}{'donelast'} = 0;
- $self->{'newfile'}{$directive} = $name;
- return $name;
- }
+ my $name;
+ if ( $Values[0] ) {
+ $self->{'newfile'}{$directive} = lc( $Values[0] );
+ return undef;
+ }
+ else {
+ $name = $self->new_script_name($directive);
+ $self->{'scripts'}{$name}{'cmd'} = [];
+ $self->{'scripts'}{$name}{'post'} = 0;
+ $self->{'scripts'}{$name}{'last'} = 0;
+ $self->{'scripts'}{$name}{'first'} = 0;
+ $self->{'scripts'}{$name}{'prerun'} = 0;
+ $self->{'scripts'}{$name}{'donepost'} = 0;
+ $self->{'scripts'}{$name}{'donelast'} = 0;
+ $self->{'newfile'}{$directive} = $name;
+ return $name;
+ } ## end else [ if ( $Values[0] )
- return undef;
-}
+ return undef;
+} ## end sub do_logfilescript($$$$$)
#------------------------------------------------------------------------------------------
sub do_script($$$$$) {
- my $self = shift;
- my $line = shift || "";
- my $f = shift || "'unknown'";
- my $in_fd = shift || 0;
- my $linenr = shift || "'unknown'";
- my $p = verbose() ? __PACKAGE__ . "::do_script(): " : "";
+ my $self = shift;
+ my $line = shift || "";
+ my $f = shift || "'unknown'";
+ my $in_fd = shift || 0;
+ my $linenr = shift || "'unknown'";
+ my $p = verbose() ? __PACKAGE__ . "::do_script(): " : "";
- print $p . "Scriptdefinition '$line' (Datei '$f', Zeilennr $linenr) ...\n" if verbose() > 5;
- my ( $directive, $val ) = $line =~ /^(\S+)\s*(.*)/;
- $directive = lc($directive);
+ print $p . "Scriptdefinition '$line' (Datei '$f', Zeilennr $linenr) ...\n" if verbose() > 5;
+ my ( $directive, $val ) = $line =~ /^(\S+)\s*(.*)/;
+ $directive = lc($directive);
- if ( $in_fd ) {
- warn $p . "Direktive '$directive' ist nicht erlaubt innerhalb einer Logfile-Definition (Datei '$f', Zeile $linenr).\n";
- return undef;
- }
+ if ($in_fd) {
+ warn $p . "Direktive '$directive' ist nicht erlaubt innerhalb einer Logfile-Definition (Datei '$f', Zeile $linenr).\n";
+ return undef;
+ }
- my @Values = $val ? parts( $val ) : ();
+ my @Values = $val ? parts($val) : ();
- unless ( $Values[0] ) {
- warn $p . "Direktive '$directive' ohne gueltigen Scriptnamen (Datei '$f', Zeile $linenr).\n";
- return undef;
- }
-
- my $name = lc($Values[0]);
- if ( $self->{'scripts'}{$name} ) {
- warn $p . "Das Script '$name' ist bereits deklariert, wird ueberschrieben (Datei '$f', Zeile $linenr).\n";
- }
-
- $self->{'scripts'}{$name}{'cmd'} = [];
- $self->{'scripts'}{$name}{'post'} = 0;
- $self->{'scripts'}{$name}{'prerun'} = 0;
- $self->{'scripts'}{$name}{'first'} = 0;
- $self->{'scripts'}{$name}{'last'} = 0;
- $self->{'scripts'}{$name}{'donepost'} = 0;
- $self->{'scripts'}{$name}{'donelast'} = 0;
- return $name;
+ unless ( $Values[0] ) {
+ warn $p . "Direktive '$directive' ohne gueltigen Scriptnamen (Datei '$f', Zeile $linenr).\n";
+ return undef;
+ }
-}
+ my $name = lc( $Values[0] );
+ if ( $self->{'scripts'}{$name} ) {
+ warn $p . "Das Script '$name' ist bereits deklariert, wird ueberschrieben (Datei '$f', Zeile $linenr).\n";
+ }
+
+ $self->{'scripts'}{$name}{'cmd'} = [];
+ $self->{'scripts'}{$name}{'post'} = 0;
+ $self->{'scripts'}{$name}{'prerun'} = 0;
+ $self->{'scripts'}{$name}{'first'} = 0;
+ $self->{'scripts'}{$name}{'last'} = 0;
+ $self->{'scripts'}{$name}{'donepost'} = 0;
+ $self->{'scripts'}{$name}{'donelast'} = 0;
+ return $name;
+
+} ## end sub do_script($$$$$)
#------------------------------------------------------------------------------------------
sub log_begin($$$$$) {
- my $self = shift;
- my $line = shift || "";
- my $f = shift || "'unknown'";
- my $in_fd = shift || 0;
- my $linenr = shift || "'unknown'";
- my $p = verbose() ? __PACKAGE__ . "::log_begin(): " : "";
-
- my ( @Values, @Files, @FileGlob );
- my ( $name, $file );
-
- if ( $in_fd ) {
- warn $p . "Verschachtelte Logfile-Definition in Konfigdatei '$f', Zeile $linenr.\n";
- return 1;
- }
-
- $line =~ s/\s*{$//;
- @Values = parts( $line );
-
- unless ( @Values ) {
- warn $p . "Kein Dateiname fuer eine Logdatei am Beginn der Logdatei-Definition in Konfigdatei '" .
- $f . "', Zeile $linenr gefunden.\n";
- return undef;
- }
+ my $self = shift;
+ my $line = shift || "";
+ my $f = shift || "'unknown'";
+ my $in_fd = shift || 0;
+ my $linenr = shift || "'unknown'";
+ my $p = verbose() ? __PACKAGE__ . "::log_begin(): " : "";
- print "\nStart Logfile-Definition:\n - " . join( "\n - ", @Values ) . "\n" if verbose() > 2;
+ my ( @Values, @Files, @FileGlob );
+ my ( $name, $file );
- @Files = ();
- foreach $name ( @Values ) {
+ if ($in_fd) {
+ warn $p . "Verschachtelte Logfile-Definition in Konfigdatei '$f', Zeile $linenr.\n";
+ return 1;
+ }
- if ( $name =~ m#^/# ) {
+ $line =~ s/\s*{$//;
+ @Values = parts($line);
- # Datei-Globbing aufloesen
- if ( $name =~ /[\*\?\[]/ ) {
- @FileGlob = glob( $name );
- $FileGlob[0] = $name unless scalar @FileGlob;
- } else {
- @FileGlob = ();
- $FileGlob[0] = $name;
- }
+ unless (@Values) {
+ warn $p
+ . "Kein Dateiname fuer eine Logdatei am Beginn der Logdatei-Definition in Konfigdatei '"
+ . $f
+ . "', Zeile $linenr gefunden.\n";
+ return undef;
+ }
- foreach $file ( @FileGlob ) {
- next if -d $file;
- if ( $self->{'logfiles'}{$file} ) {
- warn $p . "Die Logdatei '$file' wurde bereits definiert. Die neue Definition " .
- "wird die alte ueberschreiben (Datei '$f', Zeile $linenr).\n";
+ print "\nStart Logfile-Definition:\n - " . join( "\n - ", @Values ) . "\n" if verbose() > 2;
+
+ @Files = ();
+ foreach $name (@Values) {
+
+ if ( $name =~ m#^/# ) {
+
+ # Datei-Globbing aufloesen
+ if ( $name =~ /[\*\?\[]/ ) {
+ @FileGlob = glob($name);
+ $FileGlob[0] = $name unless scalar @FileGlob;
+ }
+ else {
+ @FileGlob = ();
+ $FileGlob[0] = $name;
+ }
+
+ foreach $file (@FileGlob) {
+ next if -d $file;
+ if ( $self->{'logfiles'}{$file} ) {
+ warn $p
+ . "Die Logdatei '$file' wurde bereits definiert. Die neue Definition "
+ . "wird die alte ueberschreiben (Datei '$f', Zeile $linenr).\n";
+ }
+ push @Files, $file;
+ }
+
+ } ## end if ( $name =~ m#^/# )
+ else {
+ warn $p . "Die Logdatei '$file' hat keine absolute Pfaddefinition (Datei '$f', Zeile $linenr).\n";
}
- push @Files, $file;
- }
- } else {
- warn $p . "Die Logdatei '$file' hat keine absolute Pfaddefinition (Datei '$f', Zeile $linenr).\n";
- }
-
- }
-
- if ( scalar @Files ) {
- $self->{'newfile'} = {};
- %{$self->{'newfile'}} = %{$self->{'default'}};
- $self->{'newfile'}{'files'} = [ @Files ];
- $self->{'newfile'}{'create'} = {};
- %{$self->{'newfile'}{'create'}} = %{$self->{'default'}{'create'}};
- if ( $self->{'default'}{'olddir'} ) {
- $self->{'newfile'}{'olddir'} = {};
- %{$self->{'newfile'}{'olddir'}} = %{$self->{'default'}{'olddir'}};
- } else {
- $self->{'newfile'}{'olddir'} = undef;
- }
- }
+ } ## end foreach $name (@Values)
+
+ if ( scalar @Files ) {
+ $self->{'newfile'} = {};
+ %{ $self->{'newfile'} } = %{ $self->{'default'} };
+ $self->{'newfile'}{'files'} = [@Files];
+ $self->{'newfile'}{'create'} = {};
+ %{ $self->{'newfile'}{'create'} } = %{ $self->{'default'}{'create'} };
+ if ( $self->{'default'}{'olddir'} ) {
+ $self->{'newfile'}{'olddir'} = {};
+ %{ $self->{'newfile'}{'olddir'} } = %{ $self->{'default'}{'olddir'} };
+ }
+ else {
+ $self->{'newfile'}{'olddir'} = undef;
+ }
+ } ## end if ( scalar @Files )
- return 1;
+ return 1;
-}
+} ## end sub log_begin($$$$$)
#------------------------------------------------------------------------------------------
sub log_end($$$$$) {
- my $self = shift;
- my $line = shift || "";
- my $f = shift || "'unknown'";
- my $in_fd = shift || 0;
- my $linenr = shift || "'unknown'";
- my $p = verbose() ? __PACKAGE__ . "::log_end(): " : "";
+ my $self = shift;
+ my $line = shift || "";
+ my $f = shift || "'unknown'";
+ my $in_fd = shift || 0;
+ my $linenr = shift || "'unknown'";
+ my $p = verbose() ? __PACKAGE__ . "::log_end(): " : "";
- my ( $name );
+ my ($name);
- unless ( $in_fd ) {
- warn $p . "Alleinstehende schliessende geschweifte Klammer in Konfigdatei '$f', Zeile $linenr gefunden.\n";
- return undef;
- }
-
- print "Ende Logfile-Definition\n" if verbose() > 2;
- print $p . "\$self->{'newfile'}: " . Dumper $self->{'newfile'} if verbose() > 3;
-
- foreach $name ( @{$self->{'newfile'}{'files'}} ) {
- %{$self->{'logfiles'}{$name}} = %{$self->{'newfile'}};
- $self->{'logfiles'}{$name}{'create'} = {};
- %{$self->{'logfiles'}{$name}{'create'}} = %{$self->{'newfile'}{'create'}};
- $self->{'logfiles'}{$name}{'olddir'} = {};
- if ( defined $self->{'newfile'}{'olddir'} ) {
- %{$self->{'logfiles'}{$name}{'olddir'}} = %{$self->{'newfile'}{'olddir'}};
- } else {
- $self->{'logfiles'}{$name}{'olddir'} = undef;
+ unless ($in_fd) {
+ warn $p . "Alleinstehende schliessende geschweifte Klammer in Konfigdatei '$f', Zeile $linenr gefunden.\n";
+ return undef;
}
- delete $self->{'logfiles'}{$name}{'files'} if $self->{'logfiles'}{$name}{'files'};
- $self->{'scripts'}{ $self->{'newfile'}{'postrotate'} }{'post'}++ if $self->{'newfile'}{'postrotate'};
- $self->{'scripts'}{ $self->{'newfile'}{'lastaction'} }{'last'}++ if $self->{'newfile'}{'lastaction'};
- }
- return 1;
+ print "Ende Logfile-Definition\n" if verbose() > 2;
+ print $p . "\$self->{'newfile'}: " . Dumper $self->{'newfile'} if verbose() > 3;
+ foreach $name ( @{ $self->{'newfile'}{'files'} } ) {
+ %{ $self->{'logfiles'}{$name} } = %{ $self->{'newfile'} };
+ $self->{'logfiles'}{$name}{'create'} = {};
+ %{ $self->{'logfiles'}{$name}{'create'} } = %{ $self->{'newfile'}{'create'} };
+ $self->{'logfiles'}{$name}{'olddir'} = {};
+ if ( defined $self->{'newfile'}{'olddir'} ) {
+ %{ $self->{'logfiles'}{$name}{'olddir'} } = %{ $self->{'newfile'}{'olddir'} };
+ }
+ else {
+ $self->{'logfiles'}{$name}{'olddir'} = undef;
+ }
+ delete $self->{'logfiles'}{$name}{'files'} if $self->{'logfiles'}{$name}{'files'};
+ $self->{'scripts'}{ $self->{'newfile'}{'postrotate'} }{'post'}++ if $self->{'newfile'}{'postrotate'};
+ $self->{'scripts'}{ $self->{'newfile'}{'lastaction'} }{'last'}++ if $self->{'newfile'}{'lastaction'};
+ } ## end foreach $name ( @{ $self->{'newfile'}{'files'} ...
-}
+ return 1;
+
+} ## end sub log_end($$$$$)
#------------------------------------------------------------------------------------------
sub new_script_name($;$) {
- my $self = shift;
- my $pre = shift || "script";
- my $p = verbose() ? __PACKAGE__ . "::new_script_name(): " : "";
-
- my $i = 0;
- my $name = "$pre$i";
-
- while ( 1 ) {
- if ( defined $self->{'scripts'}{$name}{'cmd'} ) {
- if ( scalar @{$self->{'scripts'}{$name}{'cmd'}} ) {
- $i++;
- $name = "$pre$i";
- } else {
- last;
- }
- } else {
- last;
- }
- }
+ my $self = shift;
+ my $pre = shift || "script";
+ my $p = verbose() ? __PACKAGE__ . "::new_script_name(): " : "";
+
+ my $i = 0;
+ my $name = "$pre$i";
+
+ while (1) {
+ if ( defined $self->{'scripts'}{$name}{'cmd'} ) {
+ if ( scalar @{ $self->{'scripts'}{$name}{'cmd'} } ) {
+ $i++;
+ $name = "$pre$i";
+ }
+ else {
+ last;
+ }
+ }
+ else {
+ last;
+ }
+ } ## end while (1)
- return $name;
-}
+ return $name;
+} ## end sub new_script_name($;$)
#------------------------------------------------------------------------------------------
sub read($$) {
- my $self = shift;
- my $file = shift;
- my $p = verbose() ? __PACKAGE__ . "::read(): " : "";
+ my $self = shift;
+ my $file = shift;
+ my $p = verbose() ? __PACKAGE__ . "::read(): " : "";
- my ( $dir, $f, $real_dir, $linenr, $in_fd, $in_script, $newscript, $lastrow, $pattern );
- my ( @Lines );
+ my ( $dir, $f, $real_dir, $linenr, $in_fd, $in_script, $newscript, $lastrow, $pattern );
+ my (@Lines);
- print $p . "Aufgerufen mit '" . $file . "'.\n" if verbose() > 2;
+ print $p . "Aufgerufen mit '" . $file . "'.\n" if verbose() > 2;
- unless ( $file ) {
- carp $p . "Keine Datei uebergeben.\n";
- return undef;
- }
+ unless ($file) {
+ carp $p . "Keine Datei uebergeben.\n";
+ return undef;
+ }
- unless ( -f $file ) {
- warn $p . "Datei '$file' existiert nicht oder ist keine normale Datei.\n";
- return undef;
- }
-
- if ( $file =~ m#/# ) {
- ( $dir, $f ) = $file =~ m#(.*)/([^/]+)$#;
- } else {
- $dir = ".";
- $f = $file;
- }
- $real_dir = abs_path( $dir );
- print $p . "Real-Path: '$real_dir', Basename: '$f'\n" if verbose() > 2;
- $f = $real_dir . "/" . $f;
-
- if ( $self->{'configfiles'}{$f} ) {
- warn $p . "recursive call for file '$f', exiting.\n";
- return undef;
- }
+ unless ( -f $file ) {
+ warn $p . "Datei '$file' existiert nicht oder ist keine normale Datei.\n";
+ return undef;
+ }
- $self->{'configfiles'}{$f} = 1;
+ if ( $file =~ m#/# ) {
+ ( $dir, $f ) = $file =~ m#(.*)/([^/]+)$#;
+ }
+ else {
+ $dir = ".";
+ $f = $file;
+ }
+ $real_dir = abs_path($dir);
+ print $p . "Real-Path: '$real_dir', Basename: '$f'\n" if verbose() > 2;
+ $f = $real_dir . "/" . $f;
- print $p . "Lese Datei '$f' ...\n";
- unless ( open FILE, "<$f" ) {
- warn $p . "Konnte Datei '$f' nicht oeffnen: $!\n";
- return undef;
- }
+ if ( $self->{'configfiles'}{$f} ) {
+ warn $p . "recursive call for file '$f', exiting.\n";
+ return undef;
+ }
- @Lines = <FILE>;
- close FILE;
+ $self->{'configfiles'}{$f} = 1;
- $linenr = 0;
- $in_fd = 0;
- $in_script = 0;
- $lastrow = "";
+ print $p . "Lese Datei '$f' ...\n";
+ unless ( open FILE, "<$f" ) {
+ warn $p . "Konnte Datei '$f' nicht oeffnen: $!\n";
+ return undef;
+ }
- # Alle Zeilen abklappern
- foreach ( @Lines ) {
+ @Lines = <FILE>;
+ close FILE;
- $linenr++;
+ $linenr = 0;
+ $in_fd = 0;
+ $in_script = 0;
+ $lastrow = "";
- # Zeilen vorn und hinten abschneiden
- s#^\s+##;
- s#\s+$##;
+ # Alle Zeilen abklappern
+ foreach (@Lines) {
- # Behandlung von \ am Ende der Zeile
- $_ = $lastrow . $_;
- if ( /\\$/ ) {
- s/\\$//;
- $lastrow = $_;
- next;
- }
- $lastrow = "";
-
- # Kommentare raus
- s/^#.*//;
-
- next unless $_;
-
- # Scriptinhalt zusammensuchen
- if ( $in_script ) {
- if ( /^endscript$/ ) {
- # Script ist zuende
- $in_script = 0;
- next;
- }
- push @{$self->{'scripts'}{$newscript}{'cmd'}}, $_;
- next;
- }
+ $linenr++;
- # Beginn Logfile-Definition
- if ( /{$/ ) {
- return undef unless $in_fd = $self->log_begin( $_, $f, $in_fd, $linenr );
- next;
- }
+ # Zeilen vorn und hinten abschneiden
+ s#^\s+##;
+ s#\s+$##;
- # Ende Logfile-Definition
- if ( /^}/ ) {
- return undef unless $self->log_end( $_, $f, $in_fd, $linenr );
- $in_fd = 0;
- next;
- }
+ # Behandlung von \ am Ende der Zeile
+ $_ = $lastrow . $_;
+ if (/\\$/) {
+ s/\\$//;
+ $lastrow = $_;
+ next;
+ }
+ $lastrow = "";
- # Includes ...
- if ( /^include\s/i ) {
- return undef unless $self->do_include( $_, $f, $in_fd, $linenr );
- next;
- }
+ # Kommentare raus
+ s/^#.*//;
- # Beginn Script-Definition fuer Logfile
- $pattern = join( "|", keys %ScriptDirectives );
- if ( /^$pattern(?:\s+.*)?$/i ) {
- $in_script = 1 if $newscript = $self->do_logfilescript( $_, $f, $in_fd, $linenr );
- next;
- }
+ next unless $_;
- # Beginn allgemeine Script-Definition
- if ( /^script\s/i ) {
- $in_script = 1 if $newscript = $self->do_script( $_, $f, $in_fd, $linenr );
- next;
- }
+ # Scriptinhalt zusammensuchen
+ if ($in_script) {
+ if (/^endscript$/) {
- # alle sonstigen Direktiven
- if ( $self->directive($_, $f, $in_fd, $linenr ) ) {
- next;
- } else {
- warn $p . "Schwerer Fehler beim Lesen der Konfigdatei '$f', Zeile Nr. $linenr: '$_'.\n";
- return undef;
- }
+ # Script ist zuende
+ $in_script = 0;
+ next;
+ }
+ push @{ $self->{'scripts'}{$newscript}{'cmd'} }, $_;
+ next;
+ } ## end if ($in_script)
- }
+ # Beginn Logfile-Definition
+ if (/{$/) {
+ return undef unless $in_fd = $self->log_begin( $_, $f, $in_fd, $linenr );
+ next;
+ }
+ # Ende Logfile-Definition
+ if (/^}/) {
+ return undef unless $self->log_end( $_, $f, $in_fd, $linenr );
+ $in_fd = 0;
+ next;
+ }
- return 1;
+ # Includes ...
+ if (/^include\s/i) {
+ return undef unless $self->do_include( $_, $f, $in_fd, $linenr );
+ next;
+ }
-}
+ # Beginn Script-Definition fuer Logfile
+ $pattern = join( "|", keys %ScriptDirectives );
+ if (/^$pattern(?:\s+.*)?$/i) {
+ $in_script = 1 if $newscript = $self->do_logfilescript( $_, $f, $in_fd, $linenr );
+ next;
+ }
+
+ # Beginn allgemeine Script-Definition
+ if (/^script\s/i) {
+ $in_script = 1 if $newscript = $self->do_script( $_, $f, $in_fd, $linenr );
+ next;
+ }
+
+ # alle sonstigen Direktiven
+ if ( $self->directive( $_, $f, $in_fd, $linenr ) ) {
+ next;
+ }
+ else {
+ warn $p . "Schwerer Fehler beim Lesen der Konfigdatei '$f', Zeile Nr. $linenr: '$_'.\n";
+ return undef;
+ }
+
+ } ## end foreach (@Lines)
+
+ return 1;
+
+} ## end sub read($$)
#------------------------------------------------------------------------------------------
sub reset_defaults($) {
- my $self = shift;
- my $p = verbose() ? __PACKAGE__ . "::reset_defaults(): " : "";
-
- print $p . "Setze \$self->{'defaults'} auf Vorgabewerte zurueck.\n" if verbose() > 3;
-
- $self->{'default'} = {
- 'compress' => undef,
- 'copytruncate' => undef,
- 'create' => {
- 'mode' => undef,
- 'owner' => undef,
- 'group' => undef,
- },
- 'period' => 7,
- 'dateext' => undef,
- 'datepattern' => '%Y-%m-%d',
- 'delaycompress' => undef,
- 'extension' => "",
- 'ifempty' => 1,
- 'maxage' => undef,
- 'missingok' => undef,
- 'olddir' => {
- 'dirname' => '',
- 'dateformat' => undef,
- 'mode' => undef,
- 'owner' => undef,
- 'group' => undef,
- },
- 'rotate' => 4,
- 'size' => undef,
- };
-
-}
+ my $self = shift;
+ my $p = verbose() ? __PACKAGE__ . "::reset_defaults(): " : "";
+
+ print $p . "Setze \$self->{'defaults'} auf Vorgabewerte zurueck.\n" if verbose() > 3;
+
+ $self->{'default'} = {
+ 'compress' => undef,
+ 'copytruncate' => undef,
+ 'create' => {
+ 'mode' => undef,
+ 'owner' => undef,
+ 'group' => undef,
+ },
+ 'period' => 7,
+ 'dateext' => undef,
+ 'datepattern' => '%Y-%m-%d',
+ 'delaycompress' => undef,
+ 'extension' => "",
+ 'ifempty' => 1,
+ 'maxage' => undef,
+ 'missingok' => undef,
+ 'olddir' => {
+ 'dirname' => '',
+ 'dateformat' => undef,
+ 'mode' => undef,
+ 'owner' => undef,
+ 'group' => undef,
+ },
+ 'rotate' => 4,
+ 'size' => undef,
+ };
+
+} ## end sub reset_defaults($)
#------------------------------------------------------------------------------------------
$Revis =~ s/^.*:\s*(\S+)\s*\$.*/$1/s;
our $VERSION = $LogRotate::Common::LOGROTATE_VERSION . "." . $Revis;
-$Data::Dumper::Indent = 1;
+$Data::Dumper::Indent = 1;
$Data::Dumper::Sortkeys = 1;
use constant default_firstline_statusfile_v2 => "Logrotate State -- Version 2";
my @ValidFields = qw( parent file test file_version fileversion file-version );
-for my $attr ( @ValidFields ) {
- $ok_field{$attr}++;
+for my $attr (@ValidFields) {
+ $ok_field{$attr}++;
}
#------------------------------------------------------------------------------------
sub new {
- my $invocant = shift;
- my $class = ref($invocant) || $invocant;
- my ( $res, $cmd );
+ my $invocant = shift;
+ my $class = ref($invocant) || $invocant;
+ my ( $res, $cmd );
- my $self = {
- 'file' => '/val/lib/logrotate.status',
- 'file_version' => 3,
- 'test' => 0,
- @_
- };
+ my $self = {
+ 'file' => '/val/lib/logrotate.status',
+ 'file_version' => 3,
+ 'test' => 0,
+ @_
+ };
- $res = bless $self, $class;
+ $res = bless $self, $class;
- my $p = verbose() ? __PACKAGE__ . "::new(): " : "";
+ my $p = verbose() ? __PACKAGE__ . "::new(): " : "";
- return $res;
+ return $res;
-}
+} ## end sub new
#------------------------------------------------------------------------------------------
sub AUTOLOAD {
- my $self = shift;
- my $attr = $AUTOLOAD;
- my ( $val );
+ my $self = shift;
+ my $attr = $AUTOLOAD;
+ my ($val);
- $attr =~ s/.*:://;
- $attr = lc($attr);
+ $attr =~ s/.*:://;
+ $attr = lc($attr);
- croak "Ungueltige Attributmethode ->$attr()" unless $ok_field{$attr};
+ croak "Ungueltige Attributmethode ->$attr()" unless $ok_field{$attr};
- return $self->file(@_) if $attr eq "file";
- return $self->test(@_) if $attr eq "test";
- return $self->file_version(@_) if $attr =~ /^file[\-_]*version$/i;
+ return $self->file(@_) if $attr eq "file";
+ return $self->test(@_) if $attr eq "test";
+ return $self->file_version(@_) if $attr =~ /^file[\-_]*version$/i;
- if ( @_ ) {
- $val = shift;
- $self->{uc($attr)} = $val;
- }
- return $self->{uc($attr)};
+ if (@_) {
+ $val = shift;
+ $self->{ uc($attr) } = $val;
+ }
+ return $self->{ uc($attr) };
-}
+} ## end sub AUTOLOAD
#------------------------------------------------------------------------------------------
sub check($;$) {
- my $self = shift;
- my $file = shift;
- my $p = verbose() ? __PACKAGE__ . "::check(): " : "";
+ my $self = shift;
+ my $file = shift;
+ my $p = verbose() ? __PACKAGE__ . "::check(): " : "";
- print $p . "Aufgerufen mit '" . ( defined $file ? $file : "<undef>" ) . "'.\n" if verbose() > 2;
+ print $p . "Aufgerufen mit '" . ( defined $file ? $file : "<undef>" ) . "'.\n" if verbose() > 2;
- my $res = $self->read($file);
+ my $res = $self->read($file);
- return undef unless $res;
- $file = $self->{'file'};
+ return undef unless $res;
+ $file = $self->{'file'};
- unless ( $self->test() ) {
- if ( open FILE, ">>$file" ) {
- close FILE;
- } else {
- warn $p . "Fehler beim Oeffnen der Status-Datei '$file' zum Schreiben: $!\n";
- return undef;
+ unless ( $self->test() ) {
+ if ( open FILE, ">>$file" ) {
+ close FILE;
+ }
+ else {
+ warn $p . "Fehler beim Oeffnen der Status-Datei '$file' zum Schreiben: $!\n";
+ return undef;
+ }
}
- }
- return $res;
+ return $res;
-}
+} ## end sub check($;$)
#------------------------------------------------------------------------------------------
sub read($;$) {
- my $self = shift;
- my $file = shift;
- my $p = verbose() ? __PACKAGE__ . "::read(): " : "";
-
- my $res = {};
-
- print $p . "Aufgerufen mit '" . ( defined $file ? $file : "<undef>" ) . "'.\n" if verbose() > 2;
+ my $self = shift;
+ my $file = shift;
+ my $p = verbose() ? __PACKAGE__ . "::read(): " : "";
- my ( $f, $dir, $real_dir, $logfile, $date, $time_t, $i );
+ my $res = {};
- $file = $self->{'file'} unless $file;
- unless ( $file ) {
- carp $p . "Keine Datei uebergeben.\n";
- return undef;
- }
+ print $p . "Aufgerufen mit '" . ( defined $file ? $file : "<undef>" ) . "'.\n" if verbose() > 2;
- if ( $file =~ m#/# ) {
- ( $dir, $f ) = $file =~ m#(.*)/([^/]+)$#;
- } else {
- $dir = ".";
- $f = $file;
- }
- $real_dir = abs_path( $dir );
- print $p . "Real-Path: '$real_dir', Basename: '$f'\n" if verbose() > 2;
- $f = $real_dir . "/" . $f;
+ my ( $f, $dir, $real_dir, $logfile, $date, $time_t, $i );
-
- unless ( -f $file ) {
- warn $p . "Datei '$file' existiert nicht oder ist keine normale Datei.\n";
- $self->{'file'} = $f;
- return $res;
- }
-
- print $p . "Lese Datei '$f' ...\n" if verbose();
- unless ( open FILE, "<$f" ) {
- warn $p . "Konnte Datei '$f' nicht oeffnen: $!\n";
- return undef;
- }
-
- $i = 0;
- while ( <FILE> ) {
-
- $i++;
- s/^\s+//;
- s/\s+$//;
-
- if ( $i == 1 ) {
- if ( /^logrotate\s+state\s+-+\s+version\s+[123]$/i ) {
- next;
- } else {
- warn $p . "Inkompatible Version der Statusdatei '$f'.\n";
- close FILE;
+ $file = $self->{'file'} unless $file;
+ unless ($file) {
+ carp $p . "Keine Datei uebergeben.\n";
return undef;
- }
}
- next unless $_;
+ if ( $file =~ m#/# ) {
+ ( $dir, $f ) = $file =~ m#(.*)/([^/]+)$#;
+ }
+ else {
+ $dir = ".";
+ $f = $file;
+ }
+ $real_dir = abs_path($dir);
+ print $p . "Real-Path: '$real_dir', Basename: '$f'\n" if verbose() > 2;
+ $f = $real_dir . "/" . $f;
+
+ unless ( -f $file ) {
+ warn $p . "Datei '$file' existiert nicht oder ist keine normale Datei.\n";
+ $self->{'file'} = $f;
+ return $res;
+ }
- ( $logfile, $date ) = parts( $_ );
- if ( $logfile and $date ) {
- my @Date = $date =~ /^\s*(\d+)[_\-](\d+)[_\-](\d+)(?:[\s\-_]+(\d+)[_\-:](\d+)[_\-:](\d+))?/;
- unless ( @Date ) {
- warn $p . "Konnte Datum nicht erkennen: '$date' (Datei '$f', Zeile $.).\n";
- close FILE;
+ print $p . "Lese Datei '$f' ...\n" if verbose();
+ unless ( open FILE, "<$f" ) {
+ warn $p . "Konnte Datei '$f' nicht oeffnen: $!\n";
return undef;
- }
- for $i ( 0 .. 5 ) {
- $Date[$i] += 0;
- }
- printf( $p . "Gelesenes Datum '%-20s': %04d-%02d-%02d %02d:%02d:%02d (%s)\n", $date, @Date, $logfile ) if verbose() > 4;
- $time_t = mktime( $Date[5], $Date[4], $Date[3], $Date[2], $Date[1] - 1, $Date[0] - 1900 );
- unless ( $time_t ) {
- warn $p . "Unbekanntes Datumsformat: '$date' (Datei '$f', Zeile $.).\n";
- close FILE;
- return undef;
- }
}
- $res->{$logfile} = $time_t;
+ $i = 0;
+ while (<FILE>) {
+
+ $i++;
+ s/^\s+//;
+ s/\s+$//;
+
+ if ( $i == 1 ) {
+ if (/^logrotate\s+state\s+-+\s+version\s+[123]$/i) {
+ next;
+ }
+ else {
+ warn $p . "Inkompatible Version der Statusdatei '$f'.\n";
+ close FILE;
+ return undef;
+ }
+ } ## end if ( $i == 1 )
+
+ next unless $_;
+
+ ( $logfile, $date ) = parts($_);
+ if ( $logfile and $date ) {
+ my @Date = $date =~ /^\s*(\d+)[_\-](\d+)[_\-](\d+)(?:[\s\-_]+(\d+)[_\-:](\d+)[_\-:](\d+))?/;
+ unless (@Date) {
+ warn $p . "Konnte Datum nicht erkennen: '$date' (Datei '$f', Zeile $.).\n";
+ close FILE;
+ return undef;
+ }
+ for $i ( 0 .. 5 ) {
+ $Date[$i] += 0;
+ }
+ printf( $p . "Gelesenes Datum '%-20s': %04d-%02d-%02d %02d:%02d:%02d (%s)\n", $date, @Date, $logfile ) if verbose() > 4;
+ $time_t = mktime( $Date[5], $Date[4], $Date[3], $Date[2], $Date[1] - 1, $Date[0] - 1900 );
+ unless ($time_t) {
+ warn $p . "Unbekanntes Datumsformat: '$date' (Datei '$f', Zeile $.).\n";
+ close FILE;
+ return undef;
+ }
+ } ## end if ( $logfile and $date )
+
+ $res->{$logfile} = $time_t;
+
+ } ## end while (<FILE>)
- }
-
- close FILE;
- $self->{'file'} = $f;
- return $res;
+ close FILE;
+ $self->{'file'} = $f;
+ return $res;
-}
+} ## end sub read($;$)
#------------------------------------------------------------------------------------------
sub file($;$) {
- my $self = shift;
- my $nv;
- if ( @_ ) {
- $nv = shift;
- $self->{'file'} = $nv if defined $nv;
- }
- return $self->{'file'};
+ my $self = shift;
+ my $nv;
+ if (@_) {
+ $nv = shift;
+ $self->{'file'} = $nv if defined $nv;
+ }
+ return $self->{'file'};
-}
+} ## end sub file($;$)
#------------------------------------------------------------------------------------------
sub file_version($;$) {
- my $self = shift;
- my $p = verbose() ? __PACKAGE__ . "::file_version(): " : "";
- my ( $nv, $old_version );
- if ( @_ ) {
- $nv = shift;
- $old_version = defined $nv ? $nv : "<undef>";
- $nv = to_int( $nv );
- if ( defined $nv ) {
- unless ( $nv == 2 or $nv == 3 ) {
- $nv = undef;
- }
- }
- if ( defined $nv ) {
- $self->{'file_version'} = $nv;
- } else {
- warn $p . "Ungueltige Versionsnummer: '$old_version', gueltig sind nur '2' oder '3'.\n";
- }
- }
- return $self->{'file_version'};
-
-}
+ my $self = shift;
+ my $p = verbose() ? __PACKAGE__ . "::file_version(): " : "";
+ my ( $nv, $old_version );
+ if (@_) {
+ $nv = shift;
+ $old_version = defined $nv ? $nv : "<undef>";
+ $nv = to_int($nv);
+ if ( defined $nv ) {
+ unless ( $nv == 2 or $nv == 3 ) {
+ $nv = undef;
+ }
+ }
+ if ( defined $nv ) {
+ $self->{'file_version'} = $nv;
+ }
+ else {
+ warn $p . "Ungueltige Versionsnummer: '$old_version', gueltig sind nur '2' oder '3'.\n";
+ }
+ } ## end if (@_)
+ return $self->{'file_version'};
+
+} ## end sub file_version($;$)
#------------------------------------------------------------------------------------------
sub test($;$) {
- my $self = shift;
- my $nv;
- if ( @_ ) {
- $nv = shift;
- $self->{'test'} = $nv;
- }
- return $self->{'test'};
+ my $self = shift;
+ my $nv;
+ if (@_) {
+ $nv = shift;
+ $self->{'test'} = $nv;
+ }
+ return $self->{'test'};
-}
+} ## end sub test($;$)
#------------------------------------------------------------------------------------------
sub write_logfile($$;$) {
- my $self = shift;
- my $logfile = shift;
- my $timestamp = shift || time();
- my $p = verbose() ? __PACKAGE__ . "::write_logfile(): " : "";
- my $ver = $self->file_version();
-
- unless ( defined($logfile) and $logfile !~ /^\s*$/ ) {
- warn $p . "Ungueltiger Dateiname uebergeben zum Schreiben in Statusdatei.\n";
- return undef;
- }
-
- my ( @Date );
- my ( $f, $d, $max );
- my $file = $self->{'file'};
+ my $self = shift;
+ my $logfile = shift;
+ my $timestamp = shift || time();
+ my $p = verbose() ? __PACKAGE__ . "::write_logfile(): " : "";
+ my $ver = $self->file_version();
- my $files = $self->read();
- return undef unless $files;
+ unless ( defined($logfile) and $logfile !~ /^\s*$/ ) {
+ warn $p . "Ungueltiger Dateiname uebergeben zum Schreiben in Statusdatei.\n";
+ return undef;
+ }
- $files->{$logfile} = $timestamp;
+ my (@Date);
+ my ( $f, $d, $max );
+ my $file = $self->{'file'};
- $max = 1;
- foreach $f ( keys %$files ) {
- $max = length($f) if length($f) > $max;
- }
- $max += 2;
+ my $files = $self->read();
+ return undef unless $files;
- print $p . "Schreibe Statusdatei '$file' ...\n" if verbose();
+ $files->{$logfile} = $timestamp;
- unless ( $self->test() ) {
- unless ( open FILE, ">$file" ) {
- warn $p . "Konnte Statusdatei nicht zum Schreiben oeffnen: " . $! . "\n";
- return undef;
+ $max = 1;
+ foreach $f ( keys %$files ) {
+ $max = length($f) if length($f) > $max;
}
- print FILE ( $ver == 2 ? default_firstline_statusfile_v2 : default_firstline_statusfile_v3 ) . "\n";
- foreach $f ( sort { lc($a) cmp lc($b) } keys %$files ) {
- @Date = localtime($files->{$f});
- if ( $ver == 2 ) {
- $d = sprintf "%d-%d-%d", $Date[5] + 1900, $Date[4] + 1, $Date[3];
- } else {
- $d = strftime( '%Y-%m-%d_%H:%M:%S', @Date );
- }
- printf FILE "%-*s %s\n", $max, ('"' . $f . '"' ), $d;
- }
- close FILE;
- }
- return 1;
+ $max += 2;
+
+ print $p . "Schreibe Statusdatei '$file' ...\n" if verbose();
+
+ unless ( $self->test() ) {
+ unless ( open FILE, ">$file" ) {
+ warn $p . "Konnte Statusdatei nicht zum Schreiben oeffnen: " . $! . "\n";
+ return undef;
+ }
+ print FILE ( $ver == 2 ? default_firstline_statusfile_v2 : default_firstline_statusfile_v3 ) . "\n";
+ foreach $f ( sort { lc($a) cmp lc($b) } keys %$files ) {
+ @Date = localtime( $files->{$f} );
+ if ( $ver == 2 ) {
+ $d = sprintf "%d-%d-%d", $Date[5] + 1900, $Date[4] + 1, $Date[3];
+ }
+ else {
+ $d = strftime( '%Y-%m-%d_%H:%M:%S', @Date );
+ }
+ printf FILE "%-*s %s\n", $max, ( '"' . $f . '"' ), $d;
+ } ## end foreach $f ( sort { lc($a) cmp lc($b) } keys %$files)
+ close FILE;
+ } ## end unless ( $self->test() )
+ return 1;
-}
+} ## end sub write_logfile($$;$)
#------------------------------------------------------------------------------------------
BEGIN {
- my ( $dir ) = $0 =~ m#^(.*)/#;
- if ( $dir ) {
- unshift @INC, $dir;
- }
+ my ($dir) = $0 =~ m#^(.*)/#;
+ if ($dir) {
+ unshift @INC, $dir;
+ }
}
use LogRotate::Common;
# Ruecksetzen aller locale-Einstellungen auf Standard
-setlocale( LC_ALL, "C" );
-setlocale( LC_CTYPE, "C" );
-setlocale( LC_NUMERIC, "C" );
-setlocale( LC_TIME, "C" );
+setlocale( LC_ALL, "C" );
+setlocale( LC_CTYPE, "C" );
+setlocale( LC_NUMERIC, "C" );
+setlocale( LC_TIME, "C" );
setlocale( LC_MESSAGES, "C" );
$ENV{'TZ'} = 'GMT';
$Revis =~ s/^.*:\s*(\S+)\s*\$.*/$1/s;
our $VERSION = $LogRotate::Common::LOGROTATE_VERSION . "." . $Revis;
-$Data::Dumper::Indent = 1;
+$Data::Dumper::Indent = 1;
$Data::Dumper::Sortkeys = 1;
sub write_pidfile($$);
my $DefConfigFile = "/etc/logrotate.conf";
my $ConfigFile = $DefConfigFile;
my $StateFile;
-my $force = 0;
-my $Debug = 0;
-my $help = 0;
-my $verbose = 0;
-my $version = 0;
-my $test = 0;
-my $config_check = 0;
-my $config = {};
+my $force = 0;
+my $Debug = 0;
+my $help = 0;
+my $verbose = 0;
+my $version = 0;
+my $test = 0;
+my $config_check = 0;
+my $config = {};
my @ActDate = localtime();
$| = 1;
-my ( @ConfigFiles, @InvalidConfigFiles );
+my ( @ConfigFiles, @InvalidConfigFiles );
my ( $res, $delete_pidfile, $pidfile );
Getopt::Long::Configure("bundling");
Getopt::Long::Configure("no_ignore_case");
-unless ( GetOptions( 'verbose|v+' => \$verbose,
- 'usage|help|h' => \$help,
- 'debug|d' => \$Debug,
- 'force|f' => \$force,
- 'configcheck|c' => \$config_check,
- 'Version|V' => \$version,
- 'state|s:s' => \$StateFile,
- 'test|t' => \$test,
- ) ) {
- warn "Invalid option called in $0.\n";
- warn usage();
- exit 1;
-}
-
-if ( $help ) {
- print "Version of $0: $VERSION\n\n";
- print usage();
- exit 0;
+unless (
+ GetOptions(
+ 'verbose|v+' => \$verbose,
+ 'usage|help|h' => \$help,
+ 'debug|d' => \$Debug,
+ 'force|f' => \$force,
+ 'configcheck|c' => \$config_check,
+ 'Version|V' => \$version,
+ 'state|s:s' => \$StateFile,
+ 'test|t' => \$test,
+ )
+ )
+{
+ warn "Invalid option called in $0.\n";
+ warn usage();
+ exit 1;
+} ## end unless ( GetOptions( 'verbose|v+' => \$verbose...
+
+if ($help) {
+ print "Version of $0: $VERSION\n\n";
+ print usage();
+ exit 0;
}
-if ( $version ) {
- print "Version of $0: $VERSION\n";
- exit 0;
+if ($version) {
+ print "Version of $0: $VERSION\n";
+ exit 0;
}
$test = 1 if $Debug;
+
#$test = 1;
-if ( $Debug ) {
- $verbose = $Debug unless $verbose;
+if ($Debug) {
+ $verbose = $Debug unless $verbose;
}
verbose($verbose);
$test = 1 if $config_check;
-unless ( $test ) {
- print "\n" . ( "#" x 80 ) . "\n";
- print "$0 beginnt mit Logrotation um: " . localtime() . "\n\n";
+unless ($test) {
+ print "\n" . ( "#" x 80 ) . "\n";
+ print "$0 beginnt mit Logrotation um: " . localtime() . "\n\n";
}
-print "Test mode is ON.\n" if $test;
+print "Test mode is ON.\n" if $test;
print "Verbose mode is ON on level: $verbose.\n" if $verbose;
-print "Force mode is ON.\n" if $force;
-print "Configuration check only.\n" if $config_check;
+print "Force mode is ON.\n" if $force;
+print "Configuration check only.\n" if $config_check;
my $p = $verbose > 1 ? "$0 - " : "";
-unless ( $config_check ) {
- print "\n";
- print( ("-" x 80) . "\n\n") if $verbose > 1;
- print "Phase 1: Konfiguration einlesen ...\n\n";
+unless ($config_check) {
+ print "\n";
+ print( ( "-" x 80 ) . "\n\n" ) if $verbose > 1;
+ print "Phase 1: Konfiguration einlesen ...\n\n";
}
-if ( @ARGV ) {
- @ConfigFiles = @ARGV;
-} else {
- @ConfigFiles = ( $DefConfigFile );
+if (@ARGV) {
+ @ConfigFiles = @ARGV;
+}
+else {
+ @ConfigFiles = ($DefConfigFile);
}
@InvalidConfigFiles = ();
-foreach $ConfigFile ( @ConfigFiles ) {
- push(@InvalidConfigFiles, $ConfigFile) unless -f $ConfigFile;
+foreach $ConfigFile (@ConfigFiles) {
+ push( @InvalidConfigFiles, $ConfigFile ) unless -f $ConfigFile;
}
if ( scalar @InvalidConfigFiles ) {
- warn "No existing configuration files (" . join( ", ", @InvalidConfigFiles) . ") in calling $0\n";
- exit 3;
+ warn "No existing configuration files (" . join( ", ", @InvalidConfigFiles ) . ") in calling $0\n";
+ exit 3;
}
-print "Used configuration files: " . join( ",\n ", @ConfigFiles) .
- ".\n\n" if $verbose > 1;
+print "Used configuration files: " . join( ",\n ", @ConfigFiles ) . ".\n\n" if $verbose > 1;
print "\n" . $p . "initialisation:\n\n" if $verbose;
-my $lr = new LogRotate( verbose => $verbose,
- test => $test,
- force => $force,
- );
+my $lr = new LogRotate(
+ verbose => $verbose,
+ test => $test,
+ force => $force,
+);
print "\n" . $p . "Lese Konfig-Dateien:\n\n" if $verbose > 1;
-foreach $ConfigFile ( @ConfigFiles ) {
+foreach $ConfigFile (@ConfigFiles) {
- $res = $lr->read_config( $ConfigFile );
- exit 10 unless $res;
+ $res = $lr->read_config($ConfigFile);
+ exit 10 unless $res;
}
-if ( $StateFile ) {
- $lr->{'statusfile'} = $StateFile;
-} else {
- $lr->{'statusfile'} = $lr->{'c'}{'statusfile'} if $lr->{'c'}{'statusfile'};
+if ($StateFile) {
+ $lr->{'statusfile'} = $StateFile;
+}
+else {
+ $lr->{'statusfile'} = $lr->{'c'}{'statusfile'} if $lr->{'c'}{'statusfile'};
}
$pidfile = $lr->{'c'}{'pidfile'} || "/var/run/logrotate.pid";
$delete_pidfile = $test ? 0 : 1;
unless ( $lr->{'statusfile'} ) {
- warn "Keine Statusdatei gegeben.\n";
- exit 2;
+ warn "Keine Statusdatei gegeben.\n";
+ exit 2;
}
print "Statusdatei ist: '" . $lr->{'statusfile'} . "'.\n" if $verbose;
-unless ( $test ) {
+unless ($test) {
- if ( check_pidfile $pidfile ) {
- print $p . "Pidfile okay.\n" if $verbose > 1;
- } else {
- $delete_pidfile = undef;
- exit 9;
- }
+ if ( check_pidfile $pidfile ) {
+ print $p . "Pidfile okay.\n" if $verbose > 1;
+ }
+ else {
+ $delete_pidfile = undef;
+ exit 9;
+ }
- unless ( write_pidfile $pidfile, $$ ) {
- $delete_pidfile = undef;
- exit 10;
- }
+ unless ( write_pidfile $pidfile, $$ ) {
+ $delete_pidfile = undef;
+ exit 10;
+ }
-}
+} ## end unless ($test)
exit 11 unless $lr->check_state();
-print "\n" . $p . "Gelesene Konfiguration: " . Dumper( $lr ) if $verbose > 3;
+print "\n" . $p . "Gelesene Konfiguration: " . Dumper($lr) if $verbose > 3;
-unless ( scalar keys %{$lr->{'c'}{'logfiles'}} ) {
- warn $p . "Keine Logdateien zum Rotieren gefunden, exit.\n";
- exit 4;
+unless ( scalar keys %{ $lr->{'c'}{'logfiles'} } ) {
+ warn $p . "Keine Logdateien zum Rotieren gefunden, exit.\n";
+ exit 4;
}
-exit ( $res ? 0 : 2 ) if $config_check;
+exit( $res ? 0 : 2 ) if $config_check;
print "\n";
-print( ("-" x 80) . "\n\n") if $verbose > 1;
+print( ( "-" x 80 ) . "\n\n" ) if $verbose > 1;
print "Phase 2: Eigentliches Rotieren ...\n\n";
$lr->rotate();
print "\n";
-print( ("-" x 80) . "\n\n") if $verbose > 1;
+print( ( "-" x 80 ) . "\n\n" ) if $verbose > 1;
print "Phase 3: Loeschen der alten Logdateien ...\n\n";
$lr->delete_oldfiles();
print "\n";
-print( ("-" x 80) . "\n\n") if $verbose > 1;
+print( ( "-" x 80 ) . "\n\n" ) if $verbose > 1;
print "Phase 4: Komprimieren der alten Logdateien ...\n\n";
$lr->compress();
END {
- my $p = $verbose ? __PACKAGE__ . "::END(): " : "";
- if ( $delete_pidfile and -f $pidfile ) {
- print $p . "Loesche PID-File '" . $pidfile . "' ...\n" if $verbose > 1;
- unless ( unlink $pidfile ) {
- warn $p . "Konnte PID-File '" . $pidfile . "' nicht loeschen: $!\n";
+ my $p = $verbose ? __PACKAGE__ . "::END(): " : "";
+ if ( $delete_pidfile and -f $pidfile ) {
+ print $p . "Loesche PID-File '" . $pidfile . "' ...\n" if $verbose > 1;
+ unless ( unlink $pidfile ) {
+ warn $p . "Konnte PID-File '" . $pidfile . "' nicht loeschen: $!\n";
+ }
}
- }
-}
+} ## end END
#----------------------------------------------------------------------
=cut
-
#------------------------------------------------------------------------------------------
sub usage {
-return <<ENDE;
+ return <<ENDE;
Usage: $0 [[-d]|[-v]] [-V] [-f|--force] [-s|--state file] [-h|--help|--usage] config_file+
Options: -c Checks only the given configuration files and does nothing,
ENDE
-}
+} ## end sub usage
#------------------------------------------------------------------------------------------
sub check_pidfile($) {
- my $file = shift;
- my ( $pid );
- my $p = $verbose ? __PACKAGE__ . "::check_pidfile(): " : "";
-
- if ( -f $file ) {
- unless ( open PID, "<", $file ) {
- warn $p . "Konnte PID file '" . $file. "' nicht lesend oeffnen: $!\n";
- return undef;
- }
- $pid = <PID>;
- close PID;
- if ( $pid =~ /^\d+$/ ) {
- if ( kill( 0, $pid ) ) {
- warn $p . "Es laeuft schon ein '$0'-Script mit pid $pid!\n";
- return undef;
- }
- warn $p . "Altes Pidfile gefunden, Prozess aber unbekannt verstorben...\n";
- } else {
- warn $p . "Nichts Verwendungsfaehiges im Pidfile gefunden, exit ...\n";
- return undef;
- }
-
- }
-
- return 1;
-
-}
+ my $file = shift;
+ my ($pid);
+ my $p = $verbose ? __PACKAGE__ . "::check_pidfile(): " : "";
+
+ if ( -f $file ) {
+ unless ( open PID, "<", $file ) {
+ warn $p . "Konnte PID file '" . $file . "' nicht lesend oeffnen: $!\n";
+ return undef;
+ }
+ $pid = <PID>;
+ close PID;
+ if ( $pid =~ /^\d+$/ ) {
+ if ( kill( 0, $pid ) ) {
+ warn $p . "Es laeuft schon ein '$0'-Script mit pid $pid!\n";
+ return undef;
+ }
+ warn $p . "Altes Pidfile gefunden, Prozess aber unbekannt verstorben...\n";
+ }
+ else {
+ warn $p . "Nichts Verwendungsfaehiges im Pidfile gefunden, exit ...\n";
+ return undef;
+ }
+
+ } ## end if ( -f $file )
+
+ return 1;
+
+} ## end sub check_pidfile($)
#------------------------------------------------------------------------------------------
sub write_pidfile($$) {
- my ( $pidfile, $pid ) = @_;
- my $p = $verbose ? __PACKAGE__ . "::write_pidfile(): " : "";
-
- print $p . "Schreibe PID-File '$pidfile' ...\n";
- unless ( open PID, ">", $pidfile ) {
- warn $p . "Konnte PID-file '" . $pidfile . "' nicht schreiben: $!\n";
- return undef;
- }
- print PID "$pid\n";
- close PID;
+ my ( $pidfile, $pid ) = @_;
+ my $p = $verbose ? __PACKAGE__ . "::write_pidfile(): " : "";
- return 1;
+ print $p . "Schreibe PID-File '$pidfile' ...\n";
+ unless ( open PID, ">", $pidfile ) {
+ warn $p . "Konnte PID-file '" . $pidfile . "' nicht schreiben: $!\n";
+ return undef;
+ }
+ print PID "$pid\n";
+ close PID;
-}
+ return 1;
+} ## end sub write_pidfile($$)
#------------------------------------------------------------------------------------
projects / scripts / solaris.git / commitdiff