fragstat.pl

use strict;
use warnings;

use PIR;
use POSIX qw( O_RDONLY );
# The following values should be extracted from a .ph file, but my personal
# experience has shown me that gives the wrong results and yeilds lots of INVALID IOCTL garbage

# This can't be gotten from a .ph file, for some reason I can't work out yet
use constant _ULONG_MAX => 2147483647;

# FS_IOC_FIEMAP from linux/fs.ph for some reason has the wrong value for me.
# Supplement by running:
#    strace -e trace=ioctl filefrags ./somefile 
# and then running it again with 
#     strace -e trace=ioctl -e raw=ioctl filefrags ./somefile
# and extracting the raw ID from the entry that should correspond to FS_IOC_FIEMAP
use constant _FS_IOC_FIEMAP => 0xc020660b;
use constant _FS_IOC_FIEMAP_QUERY =>  pack 'QQLLLL', 0, _ULONG_MAX, 0, 0, 0, 0;

my $rule = PIR->new();

my $root = $ARGV[0];

# This rule is like `find -xdev`
my $dev_rule = PIR->new->not( PIR->new->dev( [ stat $root ]->[0] ) );

$rule->skip($dev_rule);
$rule->file;

my $it = $rule->iter(
    $root,
    {
        loop_safe       => 1,
        relative        => 0,
        depthfirst      => -1,
        follow_symlinks => 0,
        sorted          => 0,
    }
);
my $files = 0;
my $fragments = 0;
my $fragmented_files = 0;
my $fragmap = {};

*STDOUT->autoflush(1);

while ( my $file = $it->() ) {
  $files++;
  if ( $files % 100 == 0 ) {
    printf "%80s\r", substr( $file, -80 );
  }
  my $fh;
  local $!;
  unless ( sysopen $fh, $file,  O_RDONLY ) {
    warn "$file: Can't open for reading, $!";
    next;
  }
  my $buf = _FS_IOC_FIEMAP_QUERY;
  if ( defined ( my $code = ioctl $fh, _FS_IOC_FIEMAP, $buf ) ) {
    my ( undef,undef,undef, $extents, undef, undef ) = unpack 'QQLLLL', $buf;
    $fragments += $extents;
    if ( $extents > 1 ) {
      $fragmented_files++;
      $fragmap->{ $file } = $extents;
    }
  } else {
    warn "$file: FS_IOC_FIEMAP failed, $!";
  }
  close $fh;
}
printf "\nFiles: %s, Fragments: %s, Fragmented Files: %s, Percent Fragmented: %3.2f%%\n", 
  $files, $fragments, $fragmented_files, ( $fragmented_files / $files * 100.0 );


print "Most Fragmented Files:\n";
my $i = 0; 
for my $key ( sort { $fragmap->{$b} <=> $fragmap->{$a} } keys %{$fragmap} ) {
  last if $i++ > 10;
  printf "%60s: %10d\n", $key, $fragmap->{$key};
}