use strict;
use warnings;
use Data::Dumper();

my $DISK_TIMEOUT = {};
my $DEBUG = 0;
my $ARG_DEF = qr/^([a-z0-9]+)=(\d+),(\d+)$/;
my $STATUS_DEFINITION = {
	time			=> 1,
	uptime			=> 1,
	disk			=> {
		disk		=> 1,
		status		=> 1,
		since		=> 1,
		stat		=> 1,
	},
};

my $STATUS_WEIGHT = {
	active	=> 0,
	standby	=> 1,
	sleep	=> 2,
};
my $STATUS_FILE = '/var/log/disk_lullaby.status';
my $DISK_STAT = '/proc/diskstats';
my $LOG_FILE = '/var/log/disk_lullaby.log';

my $LOG = undef;
my $UPTIME = 'no time';
__PACKAGE__->_execute(@ARGV);

# VOID
sub _execute {
	my ($class, @args) = @_;
	
	$LOG = __PACKAGE__->_open_log($LOG_FILE);
	$UPTIME = $class->_get_system_uptime();
	$DISK_TIMEOUT = $class->_read_disk_settings(@args);
	
	my $status = $class->_read_status_file($STATUS_FILE, [keys(%$DISK_TIMEOUT)]);
	$class->_prepare_status($status, [keys(%$DISK_TIMEOUT)]);
	$class->_log("DEBUG: read status = " . $class->_dump($status)) if($DEBUG);

	$class->_insert_last_disk_access($DISK_STAT, $status, [keys(%$DISK_TIMEOUT)]);
	$class->_log("DEBUG: access status = " . $class->_dump($status)) if($DEBUG);
	foreach my $disk (keys(%$DISK_TIMEOUT)) {
		$class->_log("actual status:$disk=$status->{'disk'}->{$disk}->{'status'}, since=$status->{'disk'}->{$disk}->{'since'}, stat=$status->{'disk'}->{$disk}->{'stat'}");
	}
	
	my $status_changed = $class->_get_new_disk_status_changes($status->{'uptime'}, $status, $DISK_TIMEOUT, [keys(%$DISK_TIMEOUT)]);
	$class->_log("DEBUG: changed status = $status_changed:" . $class->_dump($status)) if($DEBUG);
	$class->_set_disk_status($status->{'disk'}, [keys(%$DISK_TIMEOUT)], $status) if($status_changed);
	$class->_write_status($status, $STATUS_FILE);
	return;
}
# \HASH
sub _read_disk_settings {
	my ($class, @args) = @_;
	
	my $disk_timeout = {};
	foreach my $arg (@args) {
		my ($disk, $standby, $sleep) = $arg =~ $ARG_DEF;
		if(!defined($disk)) {
			my $msg = "incorrect usage: $0 " . join(' ', @args) . "\n" .
				"Usage: $0 DISK=STANDBY_TIMEOUT,SLEEP_TIMEOUT\nNo whitespaces in one disk-config allowed. Multiple disks possible";
			$class->_log($msg);
			warn($msg . "\n");
			exit(0);
		}
		
		$disk_timeout->{$disk} = {
			standby	=> $standby,
			sleep	=> $sleep,
		};
	}
	$class->_log("DEBUG: disk-timeout parameter = " . $class->_dump($disk_timeout)) if($DEBUG);
	if(!scalar(keys(%$disk_timeout))) {
		my $msg = "no parameter given. Usage: Usage: $0 DISK=STANDBY_TIMEOUT,SLEEP_TIMEOUT";
		$class->_log($msg);
		warn($msg . "\n");
		exit(0);
	}
	return $disk_timeout;
}
# \HASH  
sub _get_new_disk_status_changes {
	my ($class, $now, $status, $disk_timeout, $disks) =  @_;
	
	my $some_changes = 0;
	foreach my $disk (@$disks) {
		my $disk_status = $status->{'disk'};
		my $last_activity = $disk_status->{$disk}->{'since'};
		my $deeper_status = {};
		foreach my $status (qw/sleep standby/) {
			next if($deeper_status->{ $disk_status->{$disk}->{'status'} });
			
			my $timeout = $DISK_TIMEOUT->{$disk}->{$status};
			if($last_activity + $timeout < $now) {
				if($status ne $disk_status->{$disk}->{'status'}) {
					$some_changes = 1;
					$class->_log("DEBUG: Change status for disk $disk from $disk_status->{$disk}->{'status'} to $status") if($DEBUG);
					$disk_status->{$disk}->{'status'} = $status;
				}
				last;
			}
			$deeper_status->{$status} = 1;
		}
	}
	if($some_changes) {
		foreach my $disk (@$disks) {
			$status->{'disk'}->{$disk}->{'since'} = $now;
		}
	}
	return $some_changes;
}
# VOID
sub _prepare_status {
	my ($class, $status_file_data, $disks) = @_;
	
	my $max_int = 999_999_999;
	$status_file_data->{'disk'} = {} if(ref($status_file_data->{'disk'}) ne 'HASH');
	foreach my $disk (@$disks) {
		$status_file_data->{'disk'}->{$disk} = {} if(ref($status_file_data->{'disk'}->{$disk}) ne 'HASH');
		
		my $disk_status = $status_file_data->{'disk'}->{$disk};
		$disk_status->{'status'} = 'active' if(!$disk_status->{'status'} || !$STATUS_WEIGHT->{$disk_status->{'status'}});
		$disk_status->{'since'} = $UPTIME if(!$disk_status->{'since'} || $disk_status->{'since'} < 1 || $disk_status->{'since'} > $max_int);
		$disk_status->{'stat'} = '' if(!defined($disk_status->{'stat'}));
		
		if($disk_status->{'since'} > $UPTIME) {
			$class->_log("Last status-change for disk $disk is in the future, reset 'status' to 'active' and 'since' to 'now'");
			$disk_status->{'status'} = 'active';
			$disk_status->{'since'} = $UPTIME;
		}
	}
	
	$status_file_data->{'uptime'} = 0 if(!$status_file_data->{'uptime'} || $status_file_data->{'uptime'} < 1 || $status_file_data->{'uptime'} > $max_int);
	$status_file_data->{'time'} = 0 if(!$status_file_data->{'time'} || $status_file_data->{'time'} < 1 || $status_file_data->{'time'} > $max_int);
	
	my $timestamp = time();
	if($status_file_data->{'uptime'} > $UPTIME || $status_file_data->{'time'} > $timestamp) {
		$class->_log("actual uptime/time is smaller than logged uptime, possible reboot?"
			. "(uptime:$UPTIME < $status_file_data->{'uptime'}, "
			. "time:$status_file_data->{'time'} < $timestamp)");
		foreach my $disk (keys(%{ $status_file_data->{'disk'} })) {
			$status_file_data->{'disk'}->{$disk}->{'since'} = $UPTIME;
			$status_file_data->{'disk'}->{$disk}->{'status'} = 'active';
		}
	}
	
	$status_file_data->{'time'} = $timestamp;
	$status_file_data->{'uptime'} = $UPTIME;
	return;
}
# VOID
sub _write_status {
	my ($class, $status, $file) = @_;
	
	my @lines = ();
	foreach my $key (keys(%$status)) {
		my $val = $status->{$key};
		my $line = '';
		if(ref($val) eq 'HASH') {
			my @new_val = ();
			foreach my $sub_key (keys(%$val)) {
				my $new_val = "$key:$sub_key";
				my $sub_val = $val->{$sub_key};
				foreach my $sub_sub_key (keys(%$sub_val)) {
					my $sub_sub_val = $sub_val->{$sub_sub_key};
					$new_val .= "\t$sub_sub_key:$sub_sub_val";
				}
				push(@new_val, $new_val);
			}
			$val = join("\n", @new_val);
			$line = "$val\n";
		} else {
			$line = "$key:$val\n";
		}
		push(@lines, $line);
	}
	
	local *FH;
	if(!open(FH, '>', $file)) {
		$class->_log("can't write to status-file: $!");
		exit(0);
	}
	foreach my $line (sort { $a cmp $b } @lines) {
		print FH $line;
	}
	$class->_log("new statusfile: " . $class->_dump(\@lines)) if($DEBUG);
	if(!close(FH)) {
		$class->_log("can't write to status-file: $!");
		exit(0);
	}
	return;
}
# VOID
sub _set_disk_status {
	my ($class, $disk_status, $disks, $status) = @_;
	
	foreach my $disk (@$disks) {
		my $new_status = $disk_status->{$disk}->{'status'};
		my $msg = "Change disk $disk status to $new_status";

		local *FH;
		if($new_status eq 'sleep') {
			open(FH, '-|', "hdparm -Y /dev/$disk") or die $!;
			close(FH);
			$class->_log($msg);
		
		} elsif($new_status eq 'standby') {
			open(FH, '-|', "hdparm -y /dev/$disk") or die $!;
			close(FH);
			$class->_log($msg);
		}
	}
	return;
}
# BOOLEAN
sub _change_disk_status {
	my ($class, $last_access, $disk_status, $timeout, $new_disk_status, $status) = @_;
	
	$last_access ||= 0;
	if($last_access > $status->{'uptime'}) {
		$class->_log("disk access is in the future (date:$last_access, uptime:$status->{'uptime'})");
		foreach my $disk (keys(%{ $status->{'disk'} })) {
			$status->{'disk'}->{$disk}->{'since'} = $status->{'uptime'};
			$status->{'disk'}->{$disk}->{'status'} = 'active';
		}
		return 0;
	}
	
	return 0 if($STATUS_WEIGHT->{$new_disk_status} <= $STATUS_WEIGHT->{$disk_status->{'status'}});
	return 0 if(($last_access + $timeout) > $status->{'uptime'});
	return 0 if(($disk_status->{'since'} + $timeout) > $status->{'uptime'});
	return 1;
}
# VOID
sub _insert_last_disk_access {
	my ($class, $file, $status, $disks) = @_;
	
	local *FH;
	if(!open(FH, '<', $file)) {
		$class->_log("can't open disk-stat: $!");
		exit(0);
	}
	my @lines = <FH>;
	if(!close(FH)) {
		$class->_log("can't close disk-stat: $!");
		exit(0);
	}
	
	foreach my $line (@lines) {
		my @stat = split(/\W+/, $line);
		my $disk = $stat[3];
		my $disk_stat = $status->{'disk'}->{$disk};
		next if(!$disk_stat);
		
		my $new_stat = join('/', @stat);
		next if($disk_stat->{'stat'} eq $new_stat);
		
		$disk_stat->{'stat'} = $new_stat;
		$disk_stat->{'since'} = $status->{'uptime'};
		$disk_stat->{'status'} = 'active';
		$class->_log("DEBUG: new $disk disk access in disk-stat found") if($DEBUG);
	}
	return;
}
# \HASH
sub _read_status_file {
	my ($class, $file, $disks) = @_;
	
	my $used_disks = {};
	foreach my $disk (@$disks) {
		$used_disks->{$disk} = 1;
	}
	
	my $data = {};
	local *FH;
	if(!open(FH, '<', $file)) {
		$class->_log("can't read status-file: $!");
		return $data;
	}
	
	while(my $line = <FH>) {
		chomp($line);
		
		my ($key, $value) = split(/:/, $line, 2);
		next if(!$key);
		
		if(!$STATUS_DEFINITION->{$key}) {
			$class->_log("key $key is not allowed in status_file: $line");
			next;
		}
		
		if(ref($STATUS_DEFINITION->{$key}) eq 'HASH') {
			my @data = split(/\t/, $line);
			(undef, $value) = split(/:/, shift(@data), 2);
			next if(!$used_disks->{$value});
			
			$data->{$key} ||= {};
			my $subdata = {};
			foreach my $pair (@data) {
				my ($subkey, $subval) = split(/:/, $pair, 2);
				if(exists($subdata->{$subkey})) {
					$class->_log("status_file key $key is defined twice: $line");
					next;
				}
				$subdata->{$subkey} = $subval;
			}
			if(exists($data->{$key}->{$value})) {
				$class->_log("status_file key $key is defined twice: $line");
				next;
			}
			$data->{$key}->{$value} = $subdata;
		} else {
			if(exists($data->{$key})) {
				$class->_log("status_file key $key is defined twice: $line");
				next;
			}
			$data->{$key} = $value;
		}
	}
	if(!close(FH)) {
		$class->_log("can't read status-file: $!");
		exit(0);
	}
	return $data;
}
# VOID
sub _get_system_uptime {
	my ($class) = @_;
	
	if(!open(FH, '<', '/proc/uptime')) {
		$class->_log("Can't get uptime: $!");
		exit(0);
	}
	my $time = <FH>;
	if(!close(FH)) {
		$class->_log("Can't get uptime: $!");
		exit(0);
	}
	
	chop($time);
	my ($uptime, $idle_time) = split(/ +/, $time);
	return $uptime;
}
# VOID
sub _log {
	my ($class, $msg, $status) = @_;
	
	my @t = localtime(time());
	my $time = sprintf("%04d.%02d.%02d %02d:%02d:%02d", $t[5] + 1900, $t[4] + 1, $t[3], $t[2], $t[1], $t[0]);
	print $LOG "\n$UPTIME ($time): $msg";
	return;
}
# \FH
sub _open_log {
	my ($class, $file) = @_;
	
	local *FH;
	open(FH, '>>', $file) or die $!;
	return *FH{'IO'};
}
# STRING
sub _dump {
	return Data::Dumper::Dumper(@_);
}