##################################################
package  Log::Log4perl::Appender::FileRotate;
##################################################

our @ISA = qw(Log::Log4perl::Appender);

use warnings;
use strict;
use Log::Log4perl::Config::Watch;
use Fcntl;
use constant _INTERNAL_DEBUG => 1;
use threads;
use Thread::Semaphore;

my $singleton;
##################################################
sub new {
##################################################
    my($class, @options) = @_;
	
	unless(defined($singleton)){
		$singleton = {
			name      => "unknown name",
			umask     => undef,
			owner     => undef,
			group     => undef,
			autoflush => 1,
			syswrite  => 0,
			mode      => "append",
			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,
			max_size  => 1024*1024*1024,
			max_logs  => 20,
			old_logs_name  => "log.old",
			@options,
		};

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

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

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

		#initialize semaphore for synchronization
		my $sema = Thread::Semaphore->new();
		$singleton->{sema} = $sema;
		
		
		bless $singleton, $class;
		
		if($singleton->{recreate_pid_write}) {
			print "Creating pid file",
				  " $singleton->{recreate_pid_write}\n" if _INTERNAL_DEBUG;
			open FILE, ">$singleton->{recreate_pid_write}" or 
				die "Cannot open $singleton->{recreate_pid_write}";
			print FILE "$$\n";
			close FILE;
		}

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

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

    return $self->{filename};
}

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

    my $arrows  = ">";
    my $sysmode = (O_CREAT|O_WRONLY);

    my $old_umask = umask();

    if($self->{mode} eq "append") {
        $arrows   = ">>";
        $sysmode |= O_APPEND;
    } elsif ($self->{mode} eq "pipe") {
        $arrows = "|";
    } else {
        $sysmode |= O_TRUNC;
    }

    my $fh = do { local *FH; *FH; };

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

    my $didnt_exist = ! -f $self->{filename};

    if($self->{syswrite}) {
        sysopen $fh, "$self->{filename}", $sysmode or
            die "Can't sysopen $self->{filename} ($!)";
    } else {
		
        open $fh, "$arrows$self->{filename}" or
            die "Can't open $self->{filename} ($!)";
	    print "Opened the filehandle using  $arrows$self->{filename}\n" if _INTERNAL_DEBUG;
		print "FH = " . \$fh . "\n" if _INTERNAL_DEBUG;
	
    }

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

        eval { $self->perms_fix() };

        if($@) {
              # Cleanup and re-throw
            unlink $self->{filename};
            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};
    $self->{fh} = $fh;
    print "Set the logger filehandle to be $self->{fh}\n" if _INTERNAL_DEBUG;
	
    if ($self->{autoflush} and ! $self->{syswrite}) {
        my $oldfh = select $self->{fh}; 
        $| = 1; 
        select $oldfh;
    }

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

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

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

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

    if(defined $self->{fh}) {
        close $self->{fh} or
            die "Can't close $self->{filename} ($!)";
		
		print "Closed the logger filehandle $self->{filename}\n" if
        _INTERNAL_DEBUG;
			
    }

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

    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});
            }
        }
    }

    my $fh = $self->{fh};
	
$self->{sema}->down();
	$self->_rotateLog();
$self->{sema}->up();
	
	$self->{sema}->down();
    if($self->{syswrite}) {
       defined (syswrite $fh, $params{message}) or
           warn "Cannot syswrite to '$self->{filename}': $!";
           # die "Cannot syswrite to '$self->{filename}': $!";
    } else {
        print $fh $params{message} or
            warn "Cannot write to '$self->{filename}': $!";
            # die "Cannot write to '$self->{filename}': $!";
    }
	
	$self->{sema}->up();
}

##################################################
sub _rotateLog{
##################################################
	my $self = shift;
	if(int(-s $self->{filename}) > $self->{max_size}){
		my $logDir = '';
		my $logName = '';
		my $logNameNoExt = '';
		my $logExt = '';
		if($self->{filename} =~ /(.+[\\\/])((.+?)(\.\w+)*)$/){
			$logDir = $1;
			$logName = $2;
			$logNameNoExt = $3;
			$logExt = $4 || ''; #just accounting for things like .log, .txt or w/e. Handles filenames with multiple '.'s oddly, but should still work
		}else{
			warn "Cannot rotate the file!!!";
			return;
		}
		print "Log file size limit reached. Rotating logs.\n" if _INTERNAL_DEBUG;
		
		# rename older logs incremented by 1 log.1 -> log.2 etc
		my $count = $self->{max_logs};
		print "Incrementing the old logs starting at $self->{old_logs_name}$self->{max_logs}.\n" if _INTERNAL_DEBUG;
		while($count > 0){
			if(-e $logDir . $self->{old_logs_name} . '.' . $count){
				my $oldFile = $logDir. $self->{old_logs_name}.  '.' . $count;
				my $newFile = $logDir. $self->{old_logs_name}. '.' . ($count+1);
				rename($oldFile, $newFile) or warn "Unable to rename file because: $!";
				print "Incrementing '$oldFile' to '$newFile'.\n" if _INTERNAL_DEBUG;
			}else{
				# print "'$logDir$self->{old_logs_name}.$count' did not exist\n" if _INTERNAL_DEBUG;
			}
			$count--;
		}
		
		my $currFile = $self->{filename};
		my $switchFile = '';
		if($self->{filename} =~ /(.+SWAP)(0|1)(.+)/){ #this should be the case after one rotation
			my $newLogNum = 0 if $2 == 1;
			$newLogNum = 1 if $2 == 0;
						
			$switchFile = $1 . $newLogNum . $3;
		}else{
			$switchFile = $logDir . $logNameNoExt . "SWAP0" . $logExt;
		}

		$self->file_switch($switchFile);
		rename($currFile, $logDir . $self->{old_logs_name} . '.' . 1) or warn "Could not rename the log file because: $!";

	}
}



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

    if ($self->{fh}) {
        my $fh = $self->{fh};
        close $fh;
    }
}

1;