line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#!/usr/bin/perl |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
package KiokuDB::LinkChecker; |
4
|
2
|
|
|
2
|
|
35583
|
use Moose; |
|
2
|
|
|
|
|
647254
|
|
|
2
|
|
|
|
|
15
|
|
5
|
|
|
|
|
|
|
|
6
|
2
|
|
|
2
|
|
11910
|
use KiokuDB::LinkChecker::Results; |
|
2
|
|
|
|
|
8
|
|
|
2
|
|
|
|
|
95
|
|
7
|
|
|
|
|
|
|
|
8
|
2
|
|
|
2
|
|
19
|
use namespace::clean -except => 'meta'; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
16
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
with 'KiokuDB::Role::Scan' => { result_class => "KiokuDB::LinkChecker::Results" }; |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
sub process_block { |
13
|
8
|
|
|
8
|
0
|
27
|
my ( $self, %args ) = @_; |
14
|
|
|
|
|
|
|
|
15
|
8
|
|
|
|
|
21
|
my ( $block, $res ) = @args{qw(block results)}; |
16
|
|
|
|
|
|
|
|
17
|
8
|
|
|
|
|
17
|
my ( $seen, $root, $referenced, $unreferenced, $missing, $broken ) = map { $res->$_ } qw(seen root referenced unreferenced missing broken); |
|
48
|
|
|
|
|
1598
|
|
18
|
|
|
|
|
|
|
|
19
|
8
|
|
|
|
|
186
|
my $backend = $self->backend; |
20
|
|
|
|
|
|
|
|
21
|
8
|
|
|
|
|
20
|
foreach my $entry ( @$block ) { |
22
|
70
|
|
|
|
|
1620
|
my $id = $entry->id; |
23
|
|
|
|
|
|
|
|
24
|
70
|
|
|
|
|
205
|
$seen->insert($id); |
25
|
70
|
100
|
|
|
|
1572
|
$root->insert($id) if $entry->root; |
26
|
|
|
|
|
|
|
|
27
|
70
|
100
|
|
|
|
220
|
unless ( $referenced->includes($id) ) { |
28
|
25
|
|
|
|
|
63
|
$unreferenced->insert($id); |
29
|
|
|
|
|
|
|
} |
30
|
|
|
|
|
|
|
|
31
|
70
|
|
|
|
|
159
|
my @ids = $entry->referenced_ids; |
32
|
|
|
|
|
|
|
|
33
|
70
|
|
100
|
|
|
92
|
my @new = grep { !$referenced->includes($_) && !$seen->includes($_) } @ids; |
|
191
|
|
|
|
|
704
|
|
34
|
|
|
|
|
|
|
|
35
|
70
|
|
|
|
|
63
|
my %exists; |
36
|
70
|
100
|
|
|
|
191
|
@exists{@new} = $backend->exists(@new) if @new; |
37
|
|
|
|
|
|
|
|
38
|
70
|
100
|
|
|
|
118
|
if ( my @missing = grep { not $exists{$_} } @new ) { |
|
49
|
|
|
|
|
113
|
|
39
|
4
|
|
|
|
|
95
|
$self->v("\rfound broken entry: " . $entry->id . " (references nonexisting IDs @missing)\n"); |
40
|
4
|
|
|
|
|
15
|
$missing->insert(@missing); |
41
|
4
|
|
|
|
|
79
|
$broken->insert($entry->id); |
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
|
44
|
70
|
|
|
|
|
199
|
$referenced->insert(@ids); |
45
|
70
|
|
|
|
|
469
|
$unreferenced->remove(@ids); |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
__PACKAGE__->meta->make_immutable; |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
__PACKAGE__ |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
__END__ |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
=pod |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
=head1 NAME |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
KiokuDB::LinkChecker - Reference consistency checker |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
=head1 SYNOPSIS |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
use KiokuDB::LinkChecker; |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
my $l = KiokuDB::LinkChecker->new( |
66
|
|
|
|
|
|
|
backend => $b, |
67
|
|
|
|
|
|
|
); |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
my @idw = $l->missing->members; # referenced but not in the DB |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
=head1 DESCRIPTION |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
This is the low level link checker used by L<KiokuDB::Cmd::Command::FSCK>. |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
=cut |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
|