#!/usr/bin/env perl
use strict;
use warnings;
use 5.020;
use experimental 'smartmatch';
use autodie;
use Try::Tiny;
use File::Find;
use File::stat;
use Digest::MD5;

sub load_portage_data {
    my %data;
    find(
        {
            wanted => sub {
                $_ eq 'CONTENTS' or return;
                open my $fh,'<',$File::Find::name;
                while (defined(my $line=<$fh>)) {
                    chomp $line;
                    if ($line =~ /^dir /) {
                        my ($path) = $line =~ m{\A dir [ ] (.+)\z}x;
                        $data{$path}={kind=>'dir'};
                    }
                    elsif ($line =~ /^obj /) {
                        my ($path,$md5,$mtime) = $line =~
                            m{\A obj [ ] (.+) [ ] ([0-9a-f]+) [ ] ([0-9]+)\z}x;
                        $data{$path} = {
                            kind => 'obj',
                            md5 => $md5,
                            mtime => $mtime,
                        };
                    }
                    elsif ($line =~ /^sym /) {
                        my ($path,$dest,$mtime) = $line =~
                            m{\A sym [ ] (.+) [ ]->[ ] (.+) [ ] ([0-9]+)\z}x;
                        $data{$path} = {
                            kind => 'sym',
                            dest => $dest,
                            mtime => $mtime,
                        };
                    }
                    else {
                        warn "WTF? <$line> in $File::Find::name\n";
                    }
                }
            },
        },
        '/var/db/pkg',
    );
    return \%data;
}

sub match_file {
    my ($fn,$data) = @_;

    my $file_info = $data->{$fn} || $data->{ $fn =~ s{^/lib64/}{/lib/}r };
    my $fs = lstat($fn);
    my $kind = -l $fs ? 'sym' : -d $fs ? 'dir' : 'obj';

    my %ret = (
        kind => $kind,
        dev => $fs->dev,
        errs => [],
    );
    my $errs = $ret{errs};

    if (!$file_info) {
        push @$errs, 'O';
        return \%ret;
    }

    if ($kind ne $file_info->{kind}) {
        push @$errs, 'K';
        return \%ret;
    }
    return \%ret if $kind eq 'dir'; # nothing else to check

    my $mtime = $fs->mtime;
    if ($mtime != $file_info->{mtime}) {
        push @$errs, 'T';
    }
    if ($kind eq 'sym') {
        my $dest = readlink($fn);
        if ($dest ne $file_info->{dest}) {
            push @$errs, 'L';
        }
    }
    else {
        my $d = Digest::MD5->new;
        try {
            open my $fh,'<:raw',$fn;
            $d->addfile($fh);
            my $md5 = $d->hexdigest;
            if ($md5 ne $file_info->{md5}) {
                push @$errs, '5';
            }
        }
        catch { push @$errs, '*' };
    }
    return \%ret;
}

my $prune_rx = qr{\A / (?:home/|ssd/|vm-disk/|net/|dev/|sys/|proc/|run/|tmp/|var/(?:db/pkg/|cache/|spool/|run/|log/)|usr/(?:src/linux/|portage/)) }x;

my $data = load_portage_data;
warn "loaded\n";

my $root_stat = stat('/');
my $root_dev = $root_stat->dev;
my %symbol_for_kind=(
    dir => '/',
    sym => '@',
    obj => '',
);
find(
    {
        no_chdir => 1,
        wanted => sub {
            if (/$prune_rx/) {
                $File::Find::prune=1;
                return;
            }
            my $match = match_file($_,$data);
            if (@{$match->{errs}}) {
                say $_, $symbol_for_kind{$match->{kind}},
                    ' ',@{$match->{errs}};
            }
            if (
                ($_ ne '/'
                     and $match->{kind} eq 'dir'
                     and 'O' ~~ $match->{errs})
                    or
                    ($match->{dev} != $root_dev)
                ) {
                $File::Find::prune=1;
            }
        },
    },
    '/',
);