view release on metacpan or  search on metacpan

t/new.t  view on Meta::CPAN

#!/usr/bin/perl

use strict;
use warnings;

package LogWriter;

use t::Utils;
use IO::Handle;

sub new ($;$) {
    my ($class, $props) = @_;
    $props ||= {};
    my $self = {
        log => "tfiles/test.log",
        %$props,
    };

    unless ($self->{pos}) {
        $self->{pos} = $self->{log};
        $self->{pos} =~ s/\.log$/.pos/ or $self->{pos} =~ s/$/.pos/;
    }

    bless $self => $class;
}

sub logfile ($;$) {
    my ($self, $n) = @_;
    my $log = $self->{log};
    $log .= ".$n" if $n;
    return $log;
}

sub posfile ($) {
    my ($self) = @_;
    return $self->{pos};
}

sub write_raw ($$;$) {
    my ($self, $line, $n) = @_;
    my $fh = xopen(">>", $self->logfile($n));
    xprint($fh, $line);
    $fh->flush();
    xclose($fh);
}

sub write ($$;$) {
    my ($self, $line, $n) = @_;
    $line .= "\n" unless $line =~ /\n$/;
    $self->write_raw($line, $n);
}

sub touch ($;$) {
    my ($self, $n) = @_;
    $self->write_raw("", $n);
}

sub rotate ($) {
    my ($self) = @_;
    for (reverse 0..10) {
        if (-e $self->logfile($_)) {
            rename $self->logfile($_), $self->logfile($_ + 1) or die "rename failed: $!";
        }
    }
}

sub remove ($;$) {
    my ($self, $n) = @_;
    my $log = $self->logfile($n);
    if (-e $log) {
        unlink $log or die "Can't unlink $log: $!";
    }
}

sub clear ($) {
    my ($self) = @_;
    for my $file ($self->{pos}, glob("$self->{log}*")) {
        if (-e $file) {
            unlink $file or die "Can't unlink $file: $!";
        }
    }
}

sub DESTROY ($) {