libkiokudb-perl 0.56-1 / usr / share / perl5 / KiokuDB / GC / Naive / Mark.pm

This file is indexed.

/usr/share/perl5/KiokuDB/GC/Naive/Mark.pm is in libkiokudb-perl 0.56-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
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
package KiokuDB::GC::Naive::Mark;
BEGIN {
  $KiokuDB::GC::Naive::Mark::AUTHORITY = 'cpan:NUFFIN';
}
{
  $KiokuDB::GC::Naive::Mark::VERSION = '0.56';
}
use Moose;

use namespace::clean -except => 'meta';

with 'KiokuDB::Role::Scan' => { result_class => "KiokuDB::GC::Naive::Mark::Results" };

{
    package KiokuDB::GC::Naive::Mark::Results;
BEGIN {
  $KiokuDB::GC::Naive::Mark::Results::AUTHORITY = 'cpan:NUFFIN';
}
{
  $KiokuDB::GC::Naive::Mark::Results::VERSION = '0.56';
}
    use Moose;

    use Set::Object;

    has [qw(seen root)] => (
        isa => "Set::Object",
        is  => "ro",
        default => sub { Set::Object->new },
    );

    __PACKAGE__->meta->make_immutable;
}

has '+scan_all' => ( default => 0 );

has chunk_size => (
    isa => "Int",
    is  => "ro",
    default => 100,
);

sub process_block {
    my ( $self, %args ) = @_;

    my ( $block, $res ) = @args{qw(block results)};

    my ( $seen, $root ) = map { $res->$_ } qw(seen root);

    my ( $backend, $chunk_size ) = ( $self->backend, $self->chunk_size );

    $root->insert(map { $_->id } @$block);
    @$block = grep { not $seen->includes($_->id) } @$block;

    $seen->insert(map { $_->id } @$block);

    my @queue;

    # recursively walk the entries making note of all seen entries
    loop: {
        foreach my $entry ( @$block ) {
            croak("ERROR: Missing entry. Run FSCK") unless $entry;

            my $id = $entry->id;

            my @candidates = grep { not $seen->includes($_) } $entry->referenced_ids;

            # even though we technically haven't seen them yet, insert into the
            # set so that we scan less data
            $seen->insert(@candidates);

            push @queue, @candidates;
        }

        if ( @queue ) {
            my @ids = ( @queue > $chunk_size ) ? ( splice @queue, -$chunk_size ) : splice @queue;

            # reuse the block array so that we throw away unnecessary data
            @$block = $backend->get(@ids);

            redo loop;
        }
    }
}

__PACKAGE__->meta->make_immutable;

__PACKAGE__

__END__

=pod

=head1 NAME

KiokuDB::GC::Naive::Mark

=head1 VERSION

version 0.56

=head1 AUTHOR

Yuval Kogman <nothingmuch@woobling.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2013 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

APT Browse - Built by Thomas Orozco.