#!/usr/bin/perl
use strict;
use warnings;
my %fds = ();
my $sleep_time = 1;

sub read_positions {
	my $fds_ref = shift;
	my $pid = shift;
	my $pos = '';
	opendir my $pid_fds, '/proc/'.$pid.'/fdinfo';
	while ( my $fdinfo = readdir($pid_fds) ) {
		next if ($fdinfo eq '.' || $fdinfo eq '..' || $fdinfo < 3 || $fdinfo == 255);	# skip standard FDs
		$pos = '';
		open my $fd, '<', '/proc/'.$pid.'/fdinfo/'.$fdinfo;
		while (<$fd>) {
			if ($_ =~ /^pos/) {
				$pos = $_;
				last;
			}
		}
		close $fd;
		if ( $pos ne '') {
			$pos =~ s/^pos:\s*([0-9]+)\s*$/$1/;
			push(@{$fds_ref->{$pid}{$fdinfo}}, $pos);
		}	
	}
	closedir $pid_fds;
}

sub read_fdinfo {
	my $fds_ref = shift;
	opendir my $proc, '/proc';
	while ( my $ent = readdir($proc) ) {
		next if ( $ent !~ /^[0-9]+$/ || ! -d '/proc/'.$ent );	# skip everything that is not a process dir
		read_positions($fds_ref, $ent);
	}
	closedir $proc;
}

sub display_fdsusage {
	my $fds_ref = shift;
	while ( my $pid = each(%{$fds_ref}) ) {
		while ( my $fd = each(%{$fds_ref->{$pid}}) ) { 
			my $fdname = readlink('/proc/'.$pid.'/fd/'.$fd);
			next if (!defined($fdname) || $fdname =~ /pipe:/ || $fdname =~ /socket:/ || $fdname =~ /^\/dev/);
			my $pos = 0;
			my $prev = 0;
			if (defined(${$fds_ref->{$pid}{$fd}}[1])) {
				$pos = ${$fds_ref->{$pid}{$fd}}[1] - ${$fds_ref->{$pid}{$fd}}[0];
			}
			if ($pos > 0) {
				printf "Pid: %5d Position change: %10d blocks FD: %3d(%s)\n", $pid, $pos, $fd, $fdname;
			}
		}
	}
}

if (defined($ARGV[0]) && $ARGV[0] =~ /^[0-9]+$/) {
	$sleep_time = $ARGV[0];
}

read_fdinfo(\%fds);
sleep $sleep_time;
read_fdinfo(\%fds);
display_fdsusage(\%fds);