File Coverage

blib/lib/Search/Mousse/Writer/Related.pm

Criterion	Covered	Total	%
statement	22	24	91.6
branch			n/a
condition			n/a
subroutine	8	8	100.0
pod			n/a
total	30	32	93.7

package Search::Mousse::Writer::Related;
use strict;
use base qw(Class::Accessor::Chained::Fast);
__PACKAGE__->mk_accessors(
  qw(mousse id_to_related size)
);
use CDB_File;
use CDB_File_Thawed;
use File::Temp qw/ :POSIX /;
use List::Uniq qw(uniq);
use Path::Class;
use Search::ContextGraph;

sub new {
  my $class = shift;
  my %args  = @_;

  my $self = {};
  bless $self, $class;

  my $mousse = $args{mousse} || die "No mousse passed";
  $self->mousse($mousse);

  my $name      = $mousse->name;
  my $directory = $mousse->directory;

  my $filename = file($directory, "${name}_id_to_related.cdb");
  my $tempfile = tmpnam();
  $self->id_to_related(CDB_File_Thawed->new($filename, $tempfile)) or die $!;

  $self->size($args{size} || 20);

  return $self;
}

sub write {
  my $self          = shift;
  my $mousse        = $self->mousse;
  my $id_to_related = $self->id_to_related;
  my $size          = $self->size;

  my $cg = Search::ContextGraph->new(auto_reweight => 0);
  my %docs;
  while (my ($word, $ids) = each %{ $mousse->word_to_id }) {
    foreach my $id (@$ids) {
      push @{ $docs{$id} }, $word;
    }
  }
  $cg->bulk_add(%docs);
  $cg->reweight_graph();

  while (my ($id, $key) = each %{ $mousse->id_to_key }) {
    my @ids;
    eval {
      local $SIG{ALRM} = sub { die "alarm\n" };
      alarm 1;
      my ($docs, $words) = $cg->find_similar($id);
      @ids = (sort { $docs->{$b} <=> $docs->{$a} } keys %$docs);
      @ids = grep { $_ ne $id } @ids;
      @ids = splice(@ids, 0, $size);

      my @keys = map { $mousse->id_to_key->{$_} } @ids;

      #      print "$key -> @keys\n";
      alarm 0;
    };
    $id_to_related->insert($id, \@ids);
  }
  $id_to_related->finish;
}

1;

__END__