/usr/share/perl5/KiokuDB/LinkChecker.pm is in libkiokudb-perl 0.57-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 | package KiokuDB::LinkChecker;
BEGIN {
$KiokuDB::LinkChecker::AUTHORITY = 'cpan:NUFFIN';
}
$KiokuDB::LinkChecker::VERSION = '0.57';
use Moose;
# ABSTRACT: Reference consistency checker
use KiokuDB::LinkChecker::Results;
use namespace::clean -except => 'meta';
with 'KiokuDB::Role::Scan' => { result_class => "KiokuDB::LinkChecker::Results" };
sub process_block {
my ( $self, %args ) = @_;
my ( $block, $res ) = @args{qw(block results)};
my ( $seen, $root, $referenced, $unreferenced, $missing, $broken ) = map { $res->$_ } qw(seen root referenced unreferenced missing broken);
my $backend = $self->backend;
foreach my $entry ( @$block ) {
my $id = $entry->id;
$seen->insert($id);
$root->insert($id) if $entry->root;
unless ( $referenced->includes($id) ) {
$unreferenced->insert($id);
}
my @ids = $entry->referenced_ids;
my @new = grep { !$referenced->includes($_) && !$seen->includes($_) } @ids;
my %exists;
@exists{@new} = $backend->exists(@new) if @new;
if ( my @missing = grep { not $exists{$_} } @new ) {
$self->v("\rfound broken entry: " . $entry->id . " (references nonexisting IDs @missing)\n");
$missing->insert(@missing);
$broken->insert($entry->id);
}
$referenced->insert(@ids);
$unreferenced->remove(@ids);
}
}
__PACKAGE__->meta->make_immutable;
__PACKAGE__
__END__
=pod
=encoding UTF-8
=head1 NAME
KiokuDB::LinkChecker - Reference consistency checker
=head1 VERSION
version 0.57
=head1 SYNOPSIS
use KiokuDB::LinkChecker;
my $l = KiokuDB::LinkChecker->new(
backend => $b,
);
my @idw = $l->missing->members; # referenced but not in the DB
=head1 DESCRIPTION
This is the low level link checker used by L<KiokuDB::Cmd::Command::FSCK>.
=head1 AUTHOR
Yuval Kogman <nothingmuch@woobling.org>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2014 by Yuval Kogman, Infinity Interactive.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
|