File Coverage

blib/lib/NNexus/Annotate.pm

Criterion	Covered	Total	%
statement	75	78	96.1
branch	20	24	83.3
condition	10	12	83.3
subroutine	9	9	100.0
pod	1	2	50.0
total	115	125	92.0

# /=====================================================================\ #
# |  NNexus Autolinker                                                  | #
# | Annotation Module                                                   | #
# |=====================================================================| #
# | 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::Annotate;
use strict;
use warnings;

use Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(serialize_concepts);

use List::MoreUtils;
use Data::Dumper;
$Data::Dumper::Sortkeys =1;
use NNexus::Concepts qw(links_from_concept);
use Mojo::JSON qw(decode_json encode_json);

sub serialize_concepts {
  my (%options) = @_;
  # Annotation Format:
  # HTML - fully linked html
  # HTML+RDFa - fully linked html with RDFa annotations
  # xml - the matches hash in XML format.
  # json - the matches in JSON format
  # perl - Dump the datastructrure as-is
  my ($annotation,$concepts,$domain) = map {$options{$_}} qw/annotation concepts domain/;
  $concepts = [@$concepts]; # Clone top-level array
  $annotation = lc($annotation);
  if ($domain && (lc($domain) ne 'all')) {
    # Filter by domain:
    @$concepts = grep {$_->{domain} eq $domain} @$concepts; }
  # Add the http:// prefix to all links and multilinks:
  foreach my $concept(@$concepts) {
    my $link = $concept->{link};
    my $multilinks = $concept->{multilinks};
    $concept->{link} = 'http://'.$link if ($link && $link !~ /^http/);
    @{$concept->{multilinks}} = map {$_ !~ /^http/ ? 'http://'.$_ : $_} @$multilinks if defined $multilinks;
  }
  my $total_concepts = 0;
  if ($options{embed}) {
    my $body = $options{body};
    if ((!$annotation) || ($annotation =~ /^html/)) {
      # embed HTML links
      # Enhance the text between the offset with a link pointing to the URL
      # TODO: Multi-link cases need special treatment
      while (@$concepts) {
        my $concept = pop @$concepts; # Need to traverse right-to-left to keep the offsets accurate.
        #print STDERR Dumper($concept);
        my $from = $concept->{offset_begin};
        my $to = $concept->{offset_end};
        my $domain = $concept->{domain};
        my $length = $to-$from;
        my $text = substr($body,$from,$length);
        my $rdfa_annotation = '';
        if ($annotation eq 'html+rdfa') {
          $rdfa_annotation = 'property="http://purl.org/dc/terms/relation" '; }
        my @links = map {[$_ , $domain ]} (links_from_concept($concept));
        while (@$concepts && ($$concepts[-1]->{offset_begin} == $from)) {
          $concept = pop @$concepts;
          $domain = $concept->{domain};
          my @next_links = map {[$_ , $domain ]} (links_from_concept($concept));
          while (@next_links) {
            my $next_link = shift @next_links;
            next if (grep {$_->[0] eq $next_link->[0]} @links);
            push @links, $next_link;
          }
        }
        $total_concepts += scalar(@links);
        if ($options{verbosity}) {
          print STDERR "Linking \"$text\" with: ",$_->[0],"\n" foreach @links; }
        if (@links == 1) {
          # Single link, normal anchor
          substr($body,$from,$length) = ''.$text.'';
        } else {
          # Multi-link, menu anchor
          substr($body,$from,$length) =
            # Trigger menu on click
            ''
            . $text
            . ''
            . '' # Hidden container for the link menu
            . join('',map {''.domain_tooltip($_->[1]).''} @links)
            .'';
        }
      }
      if ($options{verbosity}) {
        print STDERR "Final Annotation contains ",$total_concepts," concepts.\n"; }
      return $body;
    } else {
      return $body; # Fallback, just return what was given
    }
  } else {
    # stand-off case:
    if ($annotation eq 'json') {

     return encode_json($concepts); }
    # when ('perl') { return Dumper($concepts); } #TODO: Why is this relevant? Testing?
    # TODO: Think of Markdown annotations
    # TODO: Stand-off HTML links
    # TODO: Embedded JSON and RDFa
    else { return $concepts; }
  }
}

our $tooltip_images = {
 Planetmath=>'http://planetmath.org/sites/default/files/fab-favicon.ico',
 Wikipedia=>'http://bits.wikimedia.org/favicon/wikipedia.ico',
 Dlmf=>'http://dlmf.nist.gov/style/DLMF-16.png',
 Mathworld=>'http://mathworld.wolfram.com/favicon_mathworld.png',
 Mathhub=>'http://kwarc.info/kohlhase/varia/mathHubLogo.png',
 Encyclopediaofmath=>'http://www.euro-math-soc.eu/sites/all/themes/custom/ems/images/ems_logo.png',
 Nlab=>'http://nnexus.mathweb.org/nlab_logo.png'
};
sub domain_tooltip {
  my ($domain_name) = @_;
  '';
}

# TODO: Given a list of internally represented annotations, serialize them to
#    the desired format (html, xml, json)

1;
__END__