File Coverage

blib/lib/NNexus/Annotate.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             # /=====================================================================\ #
2             # | NNexus Autolinker | #
3             # | Annotation Module | #
4             # |=====================================================================| #
5             # | Part of the Planetary project: http://trac.mathweb.org/planetary | #
6             # | Research software, produced as part of work done by: | #
7             # | the KWARC group at Jacobs University | #
8             # | Copyright (c) 2012 | #
9             # | Released under the MIT License (MIT) | #
10             # |---------------------------------------------------------------------| #
11             # | Adapted from the original NNexus code by | #
12             # | James Gardner and Aaron Krowne | #
13             # |---------------------------------------------------------------------| #
14             # | Deyan Ginev #_# | #
15             # | http://kwarc.info/people/dginev (o o) | #
16             # \=========================================================ooo==U==ooo=/ #
17             package NNexus::Annotate;
18 1     1   19364 use strict;
  1         1  
  1         38  
19 1     1   4 use warnings;
  1         1  
  1         28  
20              
21 1     1   6 use Exporter;
  1         1  
  1         81  
22             our @ISA = qw(Exporter);
23             our @EXPORT_OK = qw(serialize_concepts);
24              
25 1     1   910 use List::MoreUtils;
  0            
  0            
26             use Data::Dumper;
27             $Data::Dumper::Sortkeys =1;
28             use NNexus::Concepts qw(links_from_concept);
29             use Mojo::JSON;
30              
31             sub serialize_concepts {
32             my (%options) = @_;
33             # Annotation Format:
34             # HTML - fully linked html
35             # HTML+RDFa - fully linked html with RDFa annotations
36             # xml - the matches hash in XML format.
37             # json - the matches in JSON format
38             # perl - Dump the datastructrure as-is
39             my ($annotation,$concepts,$domain) = map {$options{$_}} qw/annotation concepts domain/;
40             $concepts = [@$concepts]; # Clone top-level array
41             $annotation = lc($annotation);
42             if ($domain && (lc($domain) ne 'all')) {
43             # Filter by domain:
44             @$concepts = grep {$_->{domain} eq $domain} @$concepts; }
45             # Add the http:// prefix to all links and multilinks:
46             foreach my $concept(@$concepts) {
47             my $link = $concept->{link};
48             my $multilinks = $concept->{multilinks};
49             $concept->{link} = 'http://'.$link if ($link && $link !~ /^http/);
50             @{$concept->{multilinks}} = map {$_ !~ /^http/ ? 'http://'.$_ : $_} @$multilinks if defined $multilinks;
51             }
52             my $total_concepts = 0;
53             if ($options{embed}) {
54             my $body = $options{body};
55             if ((!$annotation) || ($annotation =~ /^html/)) {
56             # embed HTML links
57             # Enhance the text between the offset with a link pointing to the URL
58             # TODO: Multi-link cases need special treatment
59             while (@$concepts) {
60             my $concept = pop @$concepts; # Need to traverse right-to-left to keep the offsets accurate.
61             #print STDERR Dumper($concept);
62             my $from = $concept->{offset_begin};
63             my $to = $concept->{offset_end};
64             my $domain = $concept->{domain};
65             my $length = $to-$from;
66             my $text = substr($body,$from,$length);
67             my $rdfa_annotation = '';
68             if ($annotation eq 'html+rdfa') {
69             $rdfa_annotation = 'property="http://purl.org/dc/terms/relation" '; }
70             my @links = map {[$_ , $domain ]} (links_from_concept($concept));
71             while (@$concepts && ($$concepts[-1]->{offset_begin} == $from)) {
72             $concept = pop @$concepts;
73             $domain = $concept->{domain};
74             my @next_links = map {[$_ , $domain ]} (links_from_concept($concept));
75             while (@next_links) {
76             my $next_link = shift @next_links;
77             next if (grep {$_->[0] eq $next_link->[0]} @links);
78             push @links, $next_link;
79             }
80             }
81             $total_concepts += scalar(@links);
82             if ($options{verbosity}) {
83             print STDERR "Linking \"$text\" with: ",$_->[0],"\n" foreach @links; }
84             if (@links == 1) {
85             # Single link, normal anchor
86             substr($body,$from,$length) = ''.$text.'';
87             } else {
88             # Multi-link, menu anchor
89             substr($body,$from,$length) =
90             # Trigger menu on click
91             ''
92             . $text
93             . ''
94             . '' # Hidden container for the link menu
95             . join('',map {''.domain_tooltip($_->[1]).''} @links)
96             .'';
97             }
98             }
99             if ($options{verbosity}) {
100             print STDERR "Final Annotation contains ",$total_concepts," concepts.\n"; }
101             return $body;
102             } else {
103             return $body; # Fallback, just return what was given
104             }
105             } else {
106             # stand-off case:
107             if ($annotation eq 'json') {
108             my $json = Mojo::JSON->new;
109             return $json->encode($concepts); }
110             # when ('perl') { return Dumper($concepts); } #TODO: Why is this relevant? Testing?
111             # TODO: Think of Markdown annotations
112             # TODO: Stand-off HTML links
113             # TODO: Embedded JSON and RDFa
114             else { return $concepts; }
115             }
116             }
117              
118             our $tooltip_images = {
119             Planetmath=>'http://planetmath.org/sites/default/files/fab-favicon.ico',
120             Wikipedia=>'http://bits.wikimedia.org/favicon/wikipedia.ico',
121             Dlmf=>'http://dlmf.nist.gov/style/DLMF-16.png',
122             Mathworld=>'http://mathworld.wolfram.com/favicon_mathworld.png',
123             Mathhub=>'http://kwarc.info/kohlhase/varia/mathHubLogo.png',
124             Encyclopediaofmath=>'http://www.euro-math-soc.eu/sites/all/themes/custom/ems/images/ems_logo.png',
125             Nlab=>'http://nnexus.mathweb.org/nlab_logo.png'
126             };
127             sub domain_tooltip {
128             my ($domain_name) = @_;
129             ''.$domain_name.'';
130             }
131              
132             # TODO: Given a list of internally represented annotations, serialize them to
133             # the desired format (html, xml, json)
134              
135             1;
136             __END__