File Coverage

blib/lib/NNexus/Index/Dispatcher.pm

Criterion	Covered	Total	%
statement	65	74	87.8
branch	10	20	50.0
condition	7	15	46.6
subroutine	7	7	100.0
pod	2	2	100.0
total	91	118	77.1

# /=====================================================================\ #
# | NNexus Autolinker                                                   | #
# | Indexing Driver,                                                    | #
# |   Dispatcher for Crawl, Store, Invalidation tasks                   | #
# |=====================================================================| #
# | Part of the Planetary project: http://trac.mathweb.org/planetary    | #
# |  Research software, produced as part of work done by:               | #
# |  the KWARC group at Jacobs University                               | #
# | Copyright (c) 2012                                                  | #
# | Released under the MIT License (MIT)                                | #
# |---------------------------------------------------------------------| #
# | Adapted from the original NNexus code by                            | #
# |                                  James Gardner and Aaron Krowne     | #
# |---------------------------------------------------------------------| #
# | Deyan Ginev                   #_#     | #
# | http://kwarc.info/people/dginev                            (o o)    | #
# \=========================================================ooo==U==ooo=/ #
package NNexus::Index::Dispatcher;
use warnings;
use strict;
use Data::Dumper;
use NNexus::Concepts qw(flatten_concept_harvest diff_concept_harvests);
use NNexus::Morphology qw(admissible_name);

# Dispatch to the right NNexus::Index::Domain class
sub new {
  my ($class,%options) = @_;
  my $domain = $options{domain};
  my $db = $options{db};
  $domain = $domain ? ucfirst(lc($domain)) : '';
  die ("Bad domain name: $domain; Must contain only alphanumeric characters!") if $domain =~ /\W/;
  my $index_template;
  my $should_update = $options{should_update} // 1;
  my $eval_return = eval {require "NNexus/Index/$domain.pm"; 1; };
  if ($eval_return && (!$@)) {
    $index_template = eval {
      "NNexus::Index::$domain"->new(start=>$options{start},dom=>$options{dom},should_update=>$should_update);
    };
  } else {
    print STDERR "NNexus::Index::$domain not available, fallback to generic indexer.\n";
    print STDERR "Reason: $@\n" if $@;
    require NNexus::Index::Template;
    # The generic template will always fail...
    # TODO: Should we fallback to Planetmath instead?
    $index_template = NNexus::Index::Template->new(start=>$options{start},dom=>$options{dom},should_update=>$should_update);
  }

  bless {index_template=>$index_template,domain=>$domain,db=>$db,
	verbosity=>$options{verbosity}||0,should_update=>$should_update}, $class;
}

sub index_step {
  my ($self,%options) = @_;
  my $template = $self->{index_template};
  my $db = $self->{db};
  my $domain = $self->{domain};
  my $verbosity = $options{verbosity} ? $options{verbosity} : $self->{verbosity};
  # 1. Check if object has already been indexed:
  my $next_step = $template->next_step;
  return unless ref $next_step; # Done if nothing left.
  unshift @{$template->{queue}}, $next_step; # Just peaking, keep it in the queue
  my $url = $next_step->{url}; # Grab the next canonical URL
  my $object = $db->select_object_by(url=>$url);
  my $objectid = $object->{objectid};
  my $old_concepts = [];
  if (! $objectid) {
    # 1.1. If not present, add it:
    $objectid = $db->add_object_by(url=>$url,domain=>$domain);
  } else {
    # 1.2. If already indexed, grab all concepts defined by the object.
    $old_concepts = $db->select_concepts_by(objectid=>$objectid);
    # 1.3. Skip if we don't want to update and the URL is a leaf with some already known concepts
    if ((!$self->{should_update}) && $template->leaf_test($url) && scalar(@$old_concepts)) {
        # Skip leaves, when we don't want to update!
        print STDERR "Skipping over $url\n";
        my $indexed_concepts = $template->index_step(skip=>1);
        return []; } }
  # 2. Relay the indexing request to the template, gather concepts
  my $indexed_concepts = $template->index_step(%options);
  return unless defined $indexed_concepts; # Last step.

  # Idea: If a page can no longer be accessed, we will never delete it from the object table,
  #       we will only empty its payload (= no concepts defined by it) from the concept table.

  # 3.0.1 Flatten out incoming synonyms and categories to individual concepts:
  my $new_concepts = flatten_concept_harvest($indexed_concepts);
  # 3.0.2 Make sure they're admissible names;
  @$new_concepts = grep {admissible_name($_->{concept})} @$new_concepts;
  if ($verbosity > 0) {
    print STDERR "FlatConcepts: ".scalar(@$new_concepts)."|URL: $url\n";
    print STDERR Dumper($new_concepts);
  }
  # 3.1 Compute diff between previous and new concepts
  my ($delete_concepts,$add_concepts) = diff_concept_harvests($old_concepts,$new_concepts);
  # 4. Delete no longer present concepts
  my $invalidated_URLs = [];
  foreach my $delc(@$delete_concepts) {
    my $concepts = $db->select_concepts_by(concept=>$delc->{concept},category=>$delc->{category},scheme=>$delc->{scheme},objectid=>$objectid);
    my $delc_id = $concepts->[0]->{conceptid};
    $db->delete_concept_by(concept=>$delc->{concept},category=>$delc->{category},scheme=>$delc->{scheme},objectid=>$objectid);
    push @$invalidated_URLs,
      $db->invalidate_by(conceptid=>$delc_id);
  }
  # 5. Add newly introduced concepts
  foreach my $addc(@$add_concepts) {
    my $addc_id =
      $db->add_concept_by(concept=>$addc->{concept},category=>$addc->{category},objectid=>$objectid,
                       domain=>$domain,link=>($addc->{url}||$url),scheme=>$addc->{scheme});
    push @$invalidated_URLs,
      $db->invalidate_by(conceptid=>$addc_id);
  }
  # Add the http:// prefix before returning:
  @$invalidated_URLs = map {'http://'.$_} @$invalidated_URLs;
  # 6. Return URLs to be invalidated as effect:
  return $invalidated_URLs;
}

1;
__END__