Logfile, maximal 10 Zeilen (Allgemeines zu Perl)

[thread]15699[/thread]

Logfile, maximal 10 Zeilen

Leser: 23

Articles: hide open all | hide show old branches

+4 replies

roooot

2010-12-02 18:31

User since
2008-03-03
276 Artikel
BenutzerIn
[default_avatar]

Hallo, ich schreibe Logfiles der letzten N Aktionen, die ein User durchgeführt hat. Dazu soll bei einem Eintrag die 1. Zeile rausfliegen und die neue ans Ende angehängt werden, sodass das File maximal 10 Zeilen hat.
Gibts da was?
Benutze sonst immer CPAN:

Log::Log4Perl aber sehe da keine solche Funktion nicht.
Wär natürlich Klasse, wenn ich da nur eine neue Config für bräuchte und dass dann auch darüber handhaben kann.

mfg

Viele Grüße :)

GwenDragon

2010-12-02 19:16
User since
2005-01-17
14761 Artikel
Admin1
Wie wäre es mit File::Tail?
Code (perl): (dl )

1 2 3 4 5

use File::Tail; my $logfile=File::Tail->new(name=>$filename, tail=>10); while (defined(my $line=$logfile->read)) { print "$line"; }
ungetestet.
Last edited: 2010-12-02 19:32:32 +0100 (CET)
die Drachin Gwen

Meine Perl-Artikel · perldev – verschiedene Perl-Versionen unter Windows starten

Linuxer

2010-12-02 22:04

User since
2006-01-27
3890 Artikel
HausmeisterIn

user image

Hi,

ich weiß nicht, ob es das als Modul schon gibt, aber hier eine rudimentäre Variante "zu Fuß":

Code (perl): (dl )

#! /usr/bin/perl
use warnings;
use strict;
use Tie::File;

use constant {
  MAX_LINES => 10,
};

my $logfile = '/tmp/logfile';

# binde datei an array; legt datei an, wenn nicht existent
tie my @file, 'Tie::File', $logfile
  or die "$logfile: $!\n";

# generiere log eintraege
for my $i ( 1 .. 20 ) {
    # entferne ersten eintrag, wenn maximum erreicht
    shift @file if MAX_LINES == @file;

    # fuege eintrag hinten an
    push @file, sprintf "meine nachricht: %02d\n", $i;
}

meine Beiträge: I.d.R. alle Angaben ohne Gewähr und auf Linux abgestimmt!
Die Sprache heisst Perl, nicht PERL. - Bitte Crossposts als solche kenntlich machen!

topeg

2010-12-03 02:02

User since
2006-07-10
2611 Artikel
BenutzerIn

user image

Weil es mich interessierte habe ich kurz ein Modul Log::Log4perl::Appender::File::fixed_size geschrieben.

Das sollte machen was du dir wünschst. Speicher es unter "Log/Log4perl/Appender/File/fixed_size.pm" in deinem Script Verzeichnis.
am Anfang des Scriptes sollte stehen

Code (perl): (dl )

1
2

use FindBin '$Bin';
use lib $Bin;

Das macht das Script Verzeichnis zu einem Ort wo Module gesucht werden. Dann kann Log4Perl das Modul finden. Benutze es wie "Log::Log4perl::Appender::File".
nur die "mode" und "syswrite" Optionen aus "Log::Log4perl::Appender::File" werden ignoriert.
"max_lines" ist die neue Option. Wenn man die Option auf "0" setzt gibt es keine Größenbeschränkung (Default Wert). ansonsten wird das log nur bis zur Anzahl von Zeilen gefüllt.

Beispiel:

Code (perl): (dl )

#!/usr/bin/perl
use strict;
use warnings;
use FindBin '$Bin';
use lib $Bin;
use Log::Log4perl::Appender::File::fixed_size;

my $app = Log::Log4perl::Appender::File::fixed_size->new(
  filename  => 'file.log',
  max_lines => 10,
  header_text=>'Nur ein Test!',
);

for(0..100)
{
  $app->log(message => "Log me (I'm message $_ from ".localtime()." )\n");
}

Also hier 'Log/Log4perl/Appender/File/fixed_size.pm':

Code (perl): (dl )

package Log::Log4perl::Appender::File::fixed_size;
##################################################

use base qw(Log::Log4perl::Appender::File);
use constant _INTERNAL_DEBUG => 0;
use warnings;
use strict;
use Fcntl;
use Tie::File;

##################################################
sub new {
##################################################
    my($class, @options) = @_;

    pop(@options) if(@options%2!=0);

    my $self={
      max_lines => 0,
      name      => "unknown name",
      umask     => undef,
      owner     => undef,
      group     => undef,
      binmode   => undef,
      utf8      => undef,
      recreate  => 0,
      recreate_check_interval => 30,
      recreate_check_signal   => undef,
      recreate_pid_write      => undef,
      create_at_logtime       => 0,
      header_text             => undef,
      @options
    };

    if($self->{create_at_logtime}) {
        $self->{recreate}  = 1;
    }

    if(defined $self->{umask} and $self->{umask} =~ /^0/) {
            # umask value is a string, meant to be an oct value
        $self->{umask} = oct($self->{umask});
    }

    if(defined $self->{header_text} && $self->{header_text} !~ /\n\Z/){
        $self->{header_text} .= "\n";
    }

    die "Mandatory parameter 'filename' missing" unless
        exists $self->{filename};

    bless $self, $class;

    # This will die() if it fails
    $self->file_open() unless $self->{create_at_logtime};

    return $self;
}

##################################################
sub file_open {
##################################################
    my($self) = @_;

    my $arrows  = ">";
    my $mode = (O_CREAT|O_RDWR);

    my $old_umask = umask();
    umask($self->{umask}) if defined $self->{umask};

    $self->{tied}=tie(@{$self->{log}}, 'Tie::File', $self->{filename}, mode => $mode);

    if( -f $self->{filename} and
        ( defined $self->{owner} or defined $self->{group} )
      ) {

        eval { $self->perms_fix() };

        if($@) {
            # Cleanup and re-throw
            $self->file_close();
            die $@;
        }
    }

    if($self->{recreate}) {
        $self->{watcher} = Log::Log4perl::Config::Watch->new(
            file           => $self->{filename},
            (defined $self->{recreate_check_interval} ?
              (check_interval => $self->{recreate_check_interval}) : ()),
            (defined $self->{recreate_check_signal} ?
              (signal => $self->{recreate_check_signal}) : ()),
        );
    }

    umask($old_umask) if defined $self->{umask};

    if (defined $self->{binmode}) {
        binmode $self->{tied}->{fh}, $self->{binmode};
    }

    if (defined $self->{utf8}) {
        binmode $self->{tied}->{fh}, ":utf8";
    }
}

##################################################
sub file_close {
##################################################
    my($self) = @_;

    if(defined $self->{tied})
    {
        delete($self->{tied});
        untie(@{$self->{log}});
        delete($self->{log});
    }
}

##################################################
sub file_switch {
##################################################
    my($self, $new_filename) = @_;

    print "Switching file from $self->{filename} to $new_filename\n" if
        _INTERNAL_DEBUG;

    $self->file_close();
    $self->{filename} = $new_filename;
    $self->file_open();
}

##################################################
sub log {
##################################################
    my($self, %params) = @_;

    if($self->{recreate}) {
        if($self->{recreate_check_signal}) {
            if($self->{watcher}->{signal_caught}) {
                $self->{watcher}->{signal_caught} = 0;
                $self->file_switch($self->{filename});
            }
        } else {
            if(!$self->{watcher} or
                $self->{watcher}->file_has_moved()) {
                $self->file_switch($self->{filename});
            }
        }
    }

    shift(@{$self->{log}}) if($self->{max_lines} && defined $self->{header_text});

    push(@{$self->{log}},$params{message});
    shift(@{$self->{log}}) while($self->{max_lines} && @{$self->{log}}>$self->{max_lines});

    unshift(@{$self->{log}}, $self->{header_text}) if($self->{max_lines} && defined $self->{header_text});
}

##################################################
sub DESTROY {
##################################################
   $_[0]->file_close();
}

1;

View all threads created 2010-12-02 18:31.