view release on metacpan or  search on metacpan

lib/Log/Log4perl/Appender/File.pm  view on Meta::CPAN

            binmode $self->{fh}, ":utf8";
        }
    }

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

          # quick and dirty print/syswrite without the usual
          # log() recreate magic.
        local $self->{recreate} = 0;
        $self->log( message => $self->{header_text} );
    }
}

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

    if(defined $self->{fh}) {
        $self->close_with_care( $self->{ fh } );
    }

    undef $self->{fh};
}

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

    my ($uid_org, $gid_org) = (stat $self->{filename})[4,5];

    my ($uid, $gid) = ($uid_org, $gid_org);

    if(!defined $uid) {
        die "stat of $self->{filename} failed ($!)";
    }

    my $needs_fixing = 0;

    if(defined $self->{owner}) {
        $uid = $self->{owner};
        if($self->{owner} !~ /^\d+$/) {
            $uid = (getpwnam($self->{owner}))[2];
            die "Unknown user: $self->{owner}" unless defined $uid;
        }
    }

    if(defined $self->{group}) {
        $gid = $self->{group};
        if($self->{group} !~ /^\d+$/) {
            $gid = getgrnam($self->{group});

            die "Unknown group: $self->{group}" unless defined $gid;
        }
    }
    if($uid != $uid_org or $gid != $gid_org) {
        chown($uid, $gid, $self->{filename}) or
            die "chown('$uid', '$gid') on '$self->{filename}' failed: $!";
    }
}

##################################################
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) = @_;

    # Warning: this function gets called by file_open() which assumes 
    # it can use it as a simple print/syswrite wrapper by temporary 
    # disabling the 'recreate' entry. Add anything fancy here and 
    # fix up file_open() accordingly.

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

    my $fh = $self->{fh};

    if($self->{syswrite}) {
         my $rc = 
           syswrite( $fh, 
               $self->{ syswrite_encoder } ?
                 $self->{ syswrite_encoder }->($params{message}) :
                 $params{message} );

         if(!defined $rc) {
             die "Cannot syswrite to '$self->{filename}': $!";
         }
    } else {
        print $fh $params{message} or
            die "Cannot write to '$self->{filename}': $!";
    }
}

##################################################