#------------------------------------------------------------------------------------
+=head2 compress( )
+
+Komprimiert alle alten Logdateien, die in $self->{'files_compress'} erfasst worden sind.
+
+=cut
+
+sub compress($) {
+
+ my $self = shift;
+ my $p = verbose() ? __PACKAGE__ . "::compress(): " : "";
+
+ 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;
+ }
+
+ my ( $file );
+ my $cmd = $self->{'c'}{'compress_cmd'};
+
+ 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;
+
+ for $file ( keys %{$self->{'files_compress'}} ) {
+
+ unless ( $self->$method($file) ) {
+ warn $p . "Komprimieren von '$file' ging gewaltig schief.\n";
+ return undef;
+ }
+
+ }
+
+ return 1;
+
+}
+
+#------------------------------------------------------------------------------------
+
+=head2 compress_external( $file )
+
+Komprimiert die uebergebene Datei mittels eines externen Programms.
+
+=cut
+
+sub compress_external($$) {
+
+ my $self = shift;
+ my $file = shift;
+ my $p = verbose() ? __PACKAGE__ . "::compress_external(): " : "";
+
+ 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";
+
+ # 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;
+ }
+
+ $cmd .= " " . ( $self->{'compressoptions'} || "" ) . " " . $file;
+ print " -> $cmd\n";
+
+ # Weiter, wenn Testmodus
+ return 1 if $self->{'test'};
+
+ 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;
+ }
+ }
+
+ return 1;
+
+}
+
+#------------------------------------------------------------------------------------
+
+=head2 compress_file_bzip2( $file )
+
+Komprimiert die uebergebene Datei mittels der I<Compress::Bzip2>-Bibliothek.
+
+Voraussetzung fuer den Einsatz dieser Funktion ist, dass I<Compress::Bzip2>
+bereits geladen ist.
+
+=cut
+
+sub compress_file_bzip2($$) {
+
+ my $self = shift;
+ my $file = shift;
+ my $p = verbose() ? __PACKAGE__ . "::compress_file_bzip2(): " : "";
+
+ my ( $size );
+
+ 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 !~ /^\./;
+
+ # 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 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) ;
+
+ unless ( open LOG, "<", "$file" ) {
+ warn $p . "Problem beim Oeffnen der Logdatei '$file' zum Lesen: $!\n";
+ return undef;
+ }
+
+ unless ( $bz = eval " 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();
+
+ close LOG;
+ print "\n" if verbose();
+
+ @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 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 . "Loesche Original-Datei '$file' ...\n" if verbose();
+ unless ( unlink $file ) {
+ warn $p . "Problem beim Loeschen von '$file': $!\n";
+ return undef;
+ }
+
+ return 1;
+
+}
+
+#------------------------------------------------------------------------------------
+
+=head2 compress_file_zlib( $file )
+
+Komprimiert die uebergebene Datei mittels der I<Compress::Zlib>-Bibliothek.
+
+Voraussetzung fuer den Einsatz dieser Funktion ist, dass I<Compress::Zlib>
+bereits geladen ist.
+
+=cut
+
+sub compress_file_zlib($$) {
+
+ my $self = shift;
+ my $file = shift;
+ my $p = verbose() ? __PACKAGE__ . "::compress_file_zlib(): " : "";
+
+ my ( $size );
+
+ 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 !~ /^\./;
+
+ # 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;
+ }
+
+ # 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'};
+
+ 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 "Z_DEFAULT_STRATEGY";
+ my ( $gz, $buffer );
+ my ( @Stat );
+
+ unless ( open LOG, "<", "$file" ) {
+ warn $p . "Problem beim Oeffnen der Logdatei '$file' zum Lesen: $!\n";
+ return undef;
+ }
+
+ unless ( $gz = eval " gzopen( '$target', 'wb' )" ) {
+ warn $p . "Kann komprimierte Datei '$target' nicht schreiben: $!.\n";
+ close LOG;
+ return undef;
+ }
+
+ print " ";
+ $gz->gzsetparams( $level, $strategy );
+ 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();
+
+ @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 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 . "Loesche Original-Datei '$file' ...\n" if verbose();
+ unless ( unlink $file ) {
+ warn $p . "Problem beim Loeschen von '$file': $!\n";
+ return undef;
+ }
+
+ return 1;
+
+}
+
+#------------------------------------------------------------------------------------
+
=head2 create_olddir ( $logfile )
Checkt das Vorhandensein von $self-E<gt>{'c'}{'logfiles'}{$logfile}{'olddir'}, vorher werden aber die
#------------------------------------------------------------------------------------
+=head2 delete_oldfiles( )
+
+Loescht alle alten Logdateien, die in $self->{'files_delete'} erfasst worden sind.
+
+=cut
+
+sub delete_oldfiles($) {
+
+ my $self = shift;
+ my $p = verbose() ? __PACKAGE__ . "::delete_oldfiles(): " : "";
+
+ 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;
+ }
+
+ 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;
+ }
+ }
+ }
+
+ return 1;
+
+}
+
+#------------------------------------------------------------------------------------
+
=head2 find_rotatings( $file, $target )
Findet an Hand des uebergebenen Logdatei-Namens und des Dateinamens der rotierten Datei
carp( $p . "Keine Logdatei uebergeben!\n" );
return undef;
}
+ print "\n";
+ print( ("-" x 20) . "\n\n") if verbose() > 1;
print $p . "Rotiere Logdatei '$file'.\n" if verbose();
my $f = $self->{'c'}{'logfiles'}{$file};
}
- # Ermittlung aller bisherigen Logfiles ...
- my $old_logfiles = $self->collect_old_logfiles( $file );
+ 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 . "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 ) ) {
- my $files_delete = $self->collect_files_delete($file);
+ $files_delete = $self->collect_files_delete($file);
unless ( $files_delete ) {
warn $p . "Fehler beim Ermitteln der bisher zu loeschenden alten Logdateien.\n";
return undef;
# Ermittlung der zu komprimierenden Logdateien ...
if ( $f->{'compress'} and scalar( keys %$old_logfiles ) ) {
- my $files_compress = $self->collect_compress_logfiles($file);
+ $files_compress = $self->collect_compress_logfiles($file);
unless ( $files_compress ) {
warn $p . "Fehler beim Ermitteln der zu komprimierenden Logdateien.\n";
return undef;
}
}
+ # Und Muell wegraeumen ...
+ delete $f->{'oldfiles'};
+ $old_logfiles = undef;
+ $files_delete = undef;
+ $files_compress = undef;
+
+ # 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;
}