File Coverage

blib/lib/Web/Mention.pm
Criterion Covered Total %
statement 263 273 96.3
branch 87 108 80.5
condition 15 21 71.4
subroutine 45 46 97.8
pod 6 9 66.6
total 416 457 91.0


line stmt bran cond sub pod time code
1             package Web::Mention;
2              
3 7     7   11550 use Moo;
  7         78489  
  7         41  
4 7     7   15059 use MooX::ClassAttribute;
  7         133604  
  7         65  
5 7     7   4971 use MooX::Enumeration;
  7         18578  
  7         37  
6 7     7   5870 use Types::Standard qw(InstanceOf Maybe Str Bool Num Enum);
  7         548678  
  7         109  
7 7     7   14313 use LWP;
  7         233460  
  7         288  
8 7     7   4072 use HTTP::Link;
  7         71280  
  7         416  
9 7     7   7059 use DateTime;
  7         3663824  
  7         449  
10 7     7   4517 use String::Truncate qw(elide);
  7         91055  
  7         82  
11 7     7   2207 use Try::Tiny;
  7         16  
  7         537  
12 7     7   80 use Types::Standard qw(Enum);
  7         98  
  7         152  
13 7     7   5373 use Scalar::Util qw(blessed);
  7         18  
  7         387  
14 7     7   44 use Carp qw(carp croak);
  7         15  
  7         328  
15 7     7   5176 use Mojo::DOM58;
  7         286839  
  7         648  
16 7     7   76 use URI::Escape;
  7         16  
  7         454  
17 7     7   4745 use Encode qw(decode_utf8);
  7         74814  
  7         640  
18 7     7   4076 use Readonly;
  7         29507  
  7         428  
19 7     7   5222 use DateTime::Format::ISO8601;
  7         936572  
  7         544  
20 7     7   5355 use JSON;
  7         54684  
  7         52  
21              
22 7     7   5547 use Web::Microformats2::Parser;
  7         1190089  
  7         309  
23 7     7   4794 use Web::Mention::Author;
  7         27  
  7         24795  
24              
25             our $VERSION = '0.721';
26              
27             Readonly my @VALID_RSVP_TYPES => qw(yes no maybe interested);
28              
29             has 'source' => (
30             isa => InstanceOf['URI'],
31             is => 'ro',
32             required => 1,
33             coerce => sub { URI->new($_[0]) },
34             );
35              
36             has 'original_source' => (
37             isa => InstanceOf['URI'],
38             is => 'lazy',
39             coerce => sub { URI->new($_[0]) },
40             clearer => '_clear_original_source',
41             );
42              
43             has 'source_html' => (
44             isa => Maybe[Str],
45             is => 'rw',
46             );
47              
48             has 'source_mf2_document' => (
49             isa => Maybe[InstanceOf['Web::Microformats2::Document']],
50             is => 'rw',
51             lazy => 1,
52             builder => '_build_source_mf2_document',
53             clearer => '_clear_mf2',
54             );
55              
56             has 'target' => (
57             isa => InstanceOf['URI'],
58             is => 'ro',
59             required => 1,
60             coerce => sub { URI->new($_[0]) },
61             );
62              
63             has 'endpoint' => (
64             isa => Maybe[InstanceOf['URI']],
65             is => 'lazy',
66             );
67              
68             has 'is_tested' => (
69             isa => Bool,
70             is => 'rw',
71             default => 0,
72             );
73              
74             has 'is_verified' => (
75             isa => Bool,
76             is => 'lazy',
77             );
78              
79             has 'time_verified' => (
80             isa => InstanceOf['DateTime'],
81             is => 'rw',
82             );
83              
84             has 'time_received' => (
85             isa => InstanceOf['DateTime'],
86             is => 'ro',
87             default => sub{ DateTime->now },
88             );
89              
90             has 'time_published' => (
91             isa => InstanceOf['DateTime'],
92             is => 'rw',
93             lazy => 1,
94             builder => '_build_time_published',
95             );
96              
97             has 'rsvp_type' => (
98             isa => Maybe[Str],
99             is => 'lazy',
100             );
101              
102             has 'author' => (
103             isa => InstanceOf['Web::Mention::Author'],
104             is => 'lazy',
105             clearer => '_clear_author',
106             );
107              
108             has 'type' => (
109             isa => Maybe[Enum[qw(rsvp reply like repost quotation mention)]],
110             traits => ['Enumeration'],
111             handles => [qw(is_rsvp is_reply is_like is_repost is_quotation is_mention)],
112             is => 'lazy',
113             clearer => '_clear_type',
114             );
115              
116             has 'content' => (
117             isa => Maybe[Str],
118             is => 'lazy',
119             clearer => '_clear_content',
120             );
121              
122             has 'title' => (
123             isa => Maybe[Str],
124             is => 'lazy',
125             clearer => '_clear_title',
126             );
127              
128             has 'response' => (
129             isa => Maybe[InstanceOf['HTTP::Response']],
130             is => 'rw',
131             clearer => '_clear_response',
132             );
133              
134             class_has 'ua' => (
135             isa => InstanceOf['LWP::UserAgent'],
136             is => 'rw',
137             default => sub {
138             # Set the user-agent string to e.g. "Web::Mention/0.711"
139             LWP::UserAgent->new( agent => "$_[0]/$VERSION" );
140             },
141             );
142              
143             class_has 'max_content_length' => (
144             isa => Num,
145             is => 'rw',
146             default => 280,
147             );
148              
149             class_has 'content_truncation_marker' => (
150             isa => Str,
151             is => 'rw',
152             default => '...',
153             );
154              
155             sub _build_is_verified {
156 26     26   1390 my $self = shift;
157              
158 26         98 return $self->verify;
159             }
160              
161             sub BUILD {
162 41     41 0 16345 my $self = shift;
163              
164 41         298 my $source = $self->source->clone;
165 41         734 my $target = $self->target->clone;
166              
167 41         552 foreach ( $source, $target ) {
168 82         777 $_->fragment( undef );
169             }
170              
171 41 100       511 if ( $source->eq( $target ) ) {
172 2         251 die "Invalid webmention; source and target have the same URL "
173             . "($source)\n";
174             }
175             }
176              
177             sub new_from_request {
178 1     1 1 614 my $class = shift;
179              
180 1         4 my ( $request ) = @_;
181              
182 1 50 33     25 unless ( blessed($request) && $request->can('param') ) {
183 0         0 croak 'The argument to new_from_request must be an object that '
184             . "supports a param() method. (Got: $request)\n";
185             }
186              
187 1         5 my @complaints;
188             my %new_args;
189 1         4 foreach ( qw(source target) ) {
190 2 50       6 if ( my $value = $request->param( $_ ) ) {
191 2         22 $new_args{ $_ } = $value;
192             }
193              
194 2 50       8 unless ( defined $new_args{ $_ } ) {
195 0         0 push @complaints, "No param value set for $_.";
196             }
197             }
198              
199 1 50       7 if ( @complaints ) {
200 0         0 croak join q{ }, @complaints;
201             }
202              
203 1         31 return $class->new( %new_args );
204             }
205              
206             sub new_from_html {
207 3     3 1 3770 my $class = shift;
208              
209 3         22 my %args = @_;
210 3         9 my $source = $args{ source };
211 3         10 my $html = $args{ html };
212              
213 3 50       15 unless ($source) {
214 0         0 croak "You must define a source URL when calling new_from_html.";
215             }
216              
217 3         6 my @webmentions;
218              
219 3         72 my $dom = Mojo::DOM58->new( $html );
220 3         5726 my $nodes_ref = $dom->find( 'a[href]' );
221 3         3163 for my $node ( @$nodes_ref ) {
222             try {
223 10     10   346 push @webmentions,
224             $class->new(
225             source => $source, target => $node->attr( 'href' )
226             );
227 10         507 };
228             }
229              
230 3         499 return @webmentions;
231             }
232              
233              
234             sub verify {
235 27     27 1 1381 my $self = shift;
236              
237 27         489 $self->is_tested(1);
238 27         1405 my $response = $self->ua->get( $self->source );
239              
240             # Search for both plain and escaped ("percent-encoded") versions of the
241             # target URL in the source doc. We search for the latter to account for
242             # sites like Tumblr, who treat outgoing hyperlinks as weird internally-
243             # pointing links that pass external URLs as query-string parameters.
244 27 100 100     241706 if ( ($response->content =~ quotemeta( $self->target ) )
245             || ($response->content =~ uri_escape( $self->target ) )
246             ) {
247 25         1377 $self->time_verified( DateTime->now );
248 25         11053 $self->source_html( $response->decoded_content );
249 25         50403 $self->_clear_mf2;
250 25         571 $self->_clear_content;
251 25         664 $self->_clear_title;
252 25         547 $self->_clear_author;
253 25         589 $self->_clear_type;
254 25         716 return 1;
255             }
256             else {
257 2         245 return 0;
258             }
259             }
260              
261             sub send {
262 8     8 1 1904 my $self = shift;
263              
264 8         172 my $endpoint = $self->endpoint;
265 8         229 my $source = $self->source;
266 8         20 my $target = $self->target;
267              
268 8 100       27 unless ( $endpoint ) {
269 3         56 $self->_clear_response;
270 3         25 return 0;
271             }
272              
273             # Step three: send the webmention to the target!
274 5         56 my $request = HTTP::Request->new( POST => $endpoint );
275 5         315 $request->content_type('application/x-www-form-urlencoded');
276 5         106 $request->content("source=$source&target=$target");
277              
278 5         239 my $response = $self->ua->request($request);
279 5         4877 $self->response( $response );
280              
281 5         160 return $response->is_success;
282             }
283              
284             sub _build_source_mf2_document {
285 23     23   227 my $self = shift;
286              
287 23 100       436 return unless $self->is_verified;
288 22         683 my $doc;
289             try {
290 22     22   2150 my $parser = Web::Microformats2::Parser->new;
291 22         777 $doc = $parser->parse(
292             $self->source_html,
293             url_context => $self->source,
294             );
295             }
296             catch {
297 0     0   0 die "Error parsing source HTML: $_";
298 22         278 };
299 22         368624 return $doc;
300             }
301              
302             sub _build_author {
303 5     5   2399 my $self = shift;
304              
305 5 100       91 if ( $self->source_mf2_document ) {
306 4         179 return Web::Mention::Author->new_from_mf2_document(
307             $self->source_mf2_document
308             );
309             }
310             else {
311 1         60 return Web::Mention::Author->new;
312             }
313             }
314              
315             sub _build_type {
316 10     10   13698 my $self = shift;
317              
318 10 50       178 unless ( $self->source_mf2_document ) {
319 0         0 return 'mention';
320             }
321              
322 10         562 my $item = $self->source_mf2_document->get_first( 'h-entry' );
323 10 50       1899 return 'mention' unless $item;
324              
325             # This order comes from the W3C Post Type Detection algorithm:
326             # https://www.w3.org/TR/post-type-discovery/#response-algorithm
327             # ...except adding 'quotation' as a final allowed type, before
328             # defaulting to 'mention'.
329              
330 10 100 66     213 if ( $self->rsvp_type
    100          
    100          
    100          
    100          
331             && $self->_check_url_property( $item, 'in-reply-to' ) ) {
332 1         22 return 'rsvp';
333             }
334             elsif ( $self->_check_url_property( $item, 'repost-of' )) {
335 1         20 return 'repost';
336             }
337             elsif ( $self->_check_url_property( $item, 'like-of' ) ) {
338 2         94 return 'like';
339             }
340             elsif ( $self->_check_url_property( $item, 'in-reply-to' ) ) {
341 2         44 return 'reply';
342             }
343             elsif ( $self->_check_url_property( $item, 'quotation-of' )) {
344 1         20 return 'quotation';
345             }
346             else {
347 3         91 return 'mention';
348             }
349             }
350              
351             sub _build_content {
352 10     10   464 my $self = shift;
353              
354             # If the source page has MF2 data *and* an h-entry,
355             # then we apply the algorithm outlined at:
356             # https://indieweb.org/comments#How_to_display
357             #
358             # Otherwise, we can't extract any semantic information about it,
359             # so we'll just offer the page's title, if there is one.
360              
361 10         17 my $item;
362 10 50       167 if ( $self->source_mf2_document ) {
363 10         459 $item = $self->source_mf2_document->get_first( 'h-entry' );
364             }
365              
366 10 100       1623 unless ( $item ) {
367 1         6 return $self->_title_element_content;
368             }
369              
370 9         18 my $raw_content;
371 9 100       33 if ( $item->get_property( 'content' ) ) {
372 7         137 $raw_content = $item->get_property( 'content' )->{ value };
373             }
374 9 100       139 if ( defined $raw_content ) {
375 7 100       199 if ( length $raw_content <= $self->max_content_length ) {
376 2         49 return $raw_content;
377             }
378             }
379              
380 7 100       64 if ( my $summary = $item->get_property( 'summary' ) ) {
381 3         47 return $self->_truncate_content( $summary );
382             }
383              
384 4 100       63 if ( defined $raw_content ) {
385 2         10 return $self->_truncate_content( $raw_content );
386             }
387              
388 2 50       7 if ( my $name = $item->get_property( 'name' ) ) {
389 2         35 return $self->_truncate_content( $name );
390             }
391              
392 0         0 return $self->_truncate_content( $item->value );
393             }
394              
395             sub _build_rsvp_type {
396 10     10   155 my $self = shift;
397              
398 10         25 my $rsvp_type;
399 10 50       165 if ( my $item = $self->source_mf2_document->get_first( 'h-entry' ) ) {
400 10 100       1415 if ( my $rsvp_property = $item->get_property( 'rsvp' ) ) {
401 1 50       77 if ( grep { $_ eq lc $rsvp_property } @VALID_RSVP_TYPES ) {
  4         43  
402 1         11 $rsvp_type = $rsvp_property;
403             }
404             }
405             }
406              
407 10         357 return $rsvp_type;
408             }
409              
410             sub _check_url_property {
411 28     28   387 my $self = shift;
412 28         61 my ( $item, $property ) = @_;
413              
414 28         68 my $urls_ref = $item->get_properties( $property );
415 28         172 my $found = 0;
416              
417 28         62 for my $url_prop ( @$urls_ref ) {
418 28         70 my $url;
419 28 100 66     99 if ( blessed($url_prop) && $url_prop->isa('Web::Microformats2::Item') ) {
420 3         60 $url = $url_prop->value;
421             }
422             else {
423 25         38 $url = $url_prop;
424             }
425              
426 28 100       132 if ( $url eq $self->target ) {
427 7         45 $found = 1;
428 7         14 last;
429             }
430             }
431              
432 28         167 return $found;
433             }
434              
435             sub _truncate_content {
436 8     8   16 my $self = shift;
437 8         17 my ( $content ) = @_;
438 8 50       21 unless ( defined $content ) {
439 0         0 $content = q{};
440             }
441              
442 8         142 return elide(
443             $content,
444             $self->max_content_length,
445             {
446             at_space => 1,
447             marker => $self->content_truncation_marker,
448             },
449             );
450             }
451              
452             sub _build_original_source {
453 2     2   125 my $self = shift;
454              
455 2 50       35 if ( $self->source_mf2_document ) {
456 2 100       107 if ( my $item = $self->source_mf2_document->get_first( 'h-entry' ) ) {
457 1 50       179 if ( my $url = $item->get_property( 'url' ) ) {
458 1         29 return $url;
459             }
460             }
461             }
462              
463 1         144 return $self->source;
464             }
465              
466             sub _build_time_published {
467 2     2   1998 my $self = shift;
468              
469 2 50       35 if ( $self->source_mf2_document ) {
470 2 100       46 if ( my $item = $self->source_mf2_document->get_first( 'h-entry' ) ) {
471 1 50       183 if ( my $time = $item->get_property( 'published' ) ) {
472 1         16 my $dt;
473             try {
474 1     1   60 $dt = DateTime::Format::ISO8601->parse_datetime( $time );
475 1         8 };
476 1 50       1006 return $dt if $dt;
477             }
478             }
479             }
480              
481 1         94 return $self->time_received;
482             }
483              
484             sub _build_endpoint {
485 8     8   76 my $self = shift;
486              
487 8         12 my $endpoint;
488 8         22 my $source = $self->source;
489 8         13 my $target = $self->target;
490              
491             # Is it in the Link HTTP header?
492 8         129 my $response = $self->ua->get( $target );
493 8 100       15971 if ( $response->header( 'Link' ) ) {
494 2         96 my @header_links = HTTP::Link->parse( $response->header( 'Link' ) . '' );
495 2         575 foreach (@header_links ) {
496 2         7 my $relation = $_->{relation};
497 2 100 66     13 if ($relation && $relation eq 'webmention') {
498 1         5 $endpoint = $_->{iri};
499             }
500             }
501             }
502              
503             # Is it in the HTML?
504 8 100       350 unless ( $endpoint ) {
505 7 100       21 if ( $response->header( 'Content-type' ) =~ m{^text/html\b} ) {
506 6         265 my $dom = Mojo::DOM58->new( $response->decoded_content );
507 6         10145 my $nodes_ref = $dom->find(
508             'link[rel~="webmention"], a[rel~="webmention"]'
509             );
510 6         3593 for my $node (@$nodes_ref) {
511 5         17 $endpoint = $node->attr( 'href' );
512 5 50       128 last if defined $endpoint;
513             }
514             }
515             }
516              
517 8 100       110 return undef unless defined $endpoint;
518              
519 6         28 $endpoint = URI->new_abs( $endpoint, $response->base );
520              
521 6         3361 my $host = $endpoint->host;
522 6 100 66     196 if (
523             ( lc($host) eq 'localhost' ) || ( $host =~ /^127\.\d+\.\d+\.\d+$/ )
524             ) {
525 1         6 carp "Warning: $source declares an apparent loopback address "
526             . "($endpoint) as a webmention endpoint. Ignoring.";
527 1         749 return undef;
528             }
529             else {
530 5         125 return $endpoint;
531             }
532             }
533              
534             sub _build_title {
535 5     5   4407 my $self = shift;
536              
537             # If the source doc has an h-entry with a p-name, return that, truncated.
538 5 50       87 if ( $self->source_mf2_document ) {
539 5         111 my $entry = $self->source_mf2_document->get_first( 'h-entry' );
540 5         658 my $name;
541 5 100       22 if ( $entry ) {
542 4         12 $name = $entry->get_property( 'name' );
543             }
544 5 100 100     83 if ( $entry && $name ) {
545 1         5 return $self->_truncate_content( $name );
546             }
547             }
548              
549             # Otherwise, try to return the HTML title element's content.
550 4         15 return $self->_title_element_content;
551              
552             }
553              
554             sub _title_element_content {
555 5     5   13 my $self = shift;
556              
557 5         94 my $title = Mojo::DOM58->new( $self->source_html )->at('title');
558 5 50       7483 if ($title) {
559 5         56 return $title->text;
560             }
561             else {
562 0         0 return undef;
563             }
564             }
565              
566             sub as_json {
567 2     2 1 21 my $self = shift;
568 2         21 return JSON->new->convert_blessed->encode( $self );
569             }
570              
571             sub new_from_json {
572 2     2 1 14 my ($class, $json) = @_;
573 2         30 return $class->FROM_JSON( JSON->new->decode( $json ) );
574             }
575              
576             # Called by the JSON module during JSON encoding.
577             # Contrary to the (required) name, returns an unblessed reference, not JSON.
578             # See https://metacpan.org/pod/JSON#OBJECT-SERIALISATION
579             sub TO_JSON {
580 3     3 0 1397 my $self = shift;
581              
582 3         26 my $return_ref = {
583             source => $self->source->as_string,
584             target => $self->target->as_string,
585             time_received => $self->time_received->epoch,
586             };
587              
588 3 100       130 if ( $self->is_tested ) {
589 2         19 foreach (qw(
590             is_tested is_verified type content source_html title content
591             rsvp_type
592             )) {
593 16         677 $return_ref->{$_} = $self->$_;
594             }
595 2         53 $return_ref->{ time_verified } = $self->time_verified->epoch;
596 2         68 $return_ref->{ source_html } = $self->source_html;
597 2 50       46 if ( $self->source_mf2_document ) {
598             $return_ref->{ mf2_document_json } =
599 2         46 decode_utf8($self->source_mf2_document->as_json);
600             }
601             else {
602 0         0 $return_ref->{ mf2_document_json } = undef;
603             }
604 2         538 foreach (qw( name url photo ) ) {
605 6         3284 $return_ref->{ author }->{ $_ } = $self->author->$_;
606             }
607             }
608              
609 3         83 return $return_ref;
610             }
611              
612             # Class method to construct a Webmention object from an unblessed reference,
613             # as created from the TO_JSON method. All-caps-named for the sake of parity.
614             sub FROM_JSON {
615 3     3 0 43 my $class = shift;
616 3         7 my ( $data_ref ) = @_;
617              
618 3         7 foreach ( qw( time_received time_verified ) ) {
619 6 100       990 if ( defined $data_ref->{ $_ } ) {
620             $data_ref->{ $_ } =
621 5         24 DateTime->from_epoch( epoch => $data_ref->{ $_ } );
622             }
623             }
624              
625 3 100       512 if ( $data_ref->{ author } ) {
626             $data_ref->{ author } =
627 2         44 Web::Mention::Author->new( $data_ref->{ author } );
628             }
629              
630 3         207 my $webmention = $class->new( $data_ref );
631              
632 3 100       48 if ( my $mf2_json = $data_ref->{ mf2_document_json } ) {
633 2         9 my $doc = Web::Microformats2::Document->new_from_json( $mf2_json );
634 2         1966 $webmention->source_mf2_document( $doc );
635             }
636              
637 3         78 return $webmention;
638             }
639              
640             1;
641              
642             =pod
643              
644             =encoding UTF-8
645              
646             =head1 NAME
647              
648             Web::Mention - Implementation of the IndieWeb Webmention protocol
649              
650             =head1 SYNOPSIS
651              
652             use Web::Mention;
653             use Try::Tiny;
654             use v5.10;
655              
656             # Building a webmention from an incoming web request:
657              
658             my $wm;
659             try {
660             # $request can be any object that provides a 'param' method, such as
661             # Catalyst::Request or Mojo::Message::Request.
662             $wm = Web::Mention->new_from_request ( $request )
663             }
664             catch {
665             say "Oops, this wasn't a webmention at all: $_";
666             };
667              
668             if ( $wm && $wm->is_verified ) {
669             my $source = $wm->original_source;
670             my $target = $wm->target;
671             my $author = $wm->author;
672              
673             my $name;
674             if ( $author ) {
675             $name = $author->name;
676             }
677             else {
678             $name = $wm->source->host;
679             }
680              
681             if ( $wm->is_like ) {
682             say "Hooray, $name likes $target!";
683             }
684             elsif ( $wm->is_repost ) {
685             say "Gadzooks, over at $source, $name reposted $target!";
686             }
687             elsif ( $wm->is_reply ) {
688             say "Hmm, over at $source, $name said this about $target:";
689             say $wm->content;
690             }
691             else {
692             say "I'll be darned, $name mentioned $target at $source!";
693             }
694             }
695             else {
696             say "This webmention doesn't actually mention its target URL, "
697             . "so it is not verified.";
698             }
699              
700             # Manually buidling and sending a webmention:
701              
702             $wm = Web::Mention->new(
703             source => $url_of_the_thing_that_got_mentioned,
704             target => $url_of_the_thing_that_did_the_mentioning,
705             );
706              
707             my $success = $wm->send;
708             if ( $success ) {
709             say "Webmention sent successfully!";
710             }
711             else {
712             say "The webmention wasn't sent successfully.";
713             say "Here's the response we got back..."
714             say $wm->response->as_string;
715             }
716              
717             # Batch-sending a bunch of webmentions based on some published HTML
718              
719             my @wms = Web::Mention->new_from_html(
720             source => $url_of_a_web_page_i_just_published,
721             html => $relevant_html_content_of_that_web_page,
722             )
723              
724             for my $wm ( @wms ) {
725             my $success = $wm->send;
726             }
727              
728             =head1 DESCRIPTION
729              
730             This class implements the Webmention protocol, as defined by the W3C and
731             the IndieWeb community. (See L<this article by Chris
732             Aldrich|https://alistapart.com/article/webmentions-enabling-better-
733             communication-on-the-internet/> for an excellent high-level summary of
734             Webmention and its applications.)
735              
736             An object of this class represents a single webmention, with target and
737             source URLs. It can verify itself, determining whether or not the
738             document found at the source URL does indeed mention the target URL.
739              
740             It can also use IndieWeb algorithms to attempt identification of the
741             source document's author, and to provide a short summary of that
742             document's content, using Microformats2 metadata when available.
743              
744             =head1 METHODS
745              
746             =head2 Class Methods
747              
748             =head3 new
749              
750             $wm = Web::Mention->new(
751             source => $source_url,
752             target => $target_url,
753             );
754              
755             Basic constructor. The B<source> and B<target> URLs are both required
756             arguments. Either one can either be a L<URI> object, or a valid URL
757             string.
758              
759             Per the Webmention protocol, the B<source> URL represents the location
760             of the document that made the mention described here, and B<target>
761             describes the location of the document that got mentioned. The two
762             arguments cannot refer to the same URL (disregarding the C<#fragment>
763             part of either, if present).
764              
765             =head3 new_from_html
766              
767             @wms = Web::Mention->new_from_html(
768             source => $source_url,
769             html => $html,
770             );
771              
772             Convenience batch-construtor that returns a (possibly empty) I<list> of
773             Web::Mention objects based on the single source URL (or I<URI> object)
774             that you pass in, as well as a string containing HTML from which we can
775             extract zero or more target URLs. These extracted URLs include the
776             C<href> attribute value of every E<lt>aE<gt> tag in the provided HTML.
777              
778             Note that (as with all this class's constructors) this method won't
779             proceed to actually send the generated webmentions; that step remains
780             yours to take. (See L<"send">.)
781              
782             =head3 new_from_json
783              
784             $wm = Web::Mention->new_from_json( $json );
785              
786             Returns a new webmention based on the JSON output of L<"as_json">.
787              
788             =head3 new_from_request
789              
790             $wm = Web::Mention->new_from_request( $request_object );
791              
792             Convenience constructor that looks into the given web-request object for
793             B<source> and B<target> parameters, and attempts to build a new
794             Web::Mention object out of them.
795              
796             The object must provide a C<param( $param_name )> method that returns
797             the value of the named HTTP parameter. So it could be a
798             L<Catalyst::Request> object or a L<Mojo::Message::Request> object, for
799             example.
800              
801             Throws an exception if the given argument doesn't meet this requirement,
802             or if it does but does not define both required HTTP parameters.
803              
804             =head3 content_truncation_marker
805              
806             Web::Mention->content_truncation_marker( $new_truncation_marker )
807              
808             The text that the content method will append to text that it has
809             truncated, if it did truncate it. (See L<"content">.)
810              
811             Defaults to C<...>.
812              
813             =head3 max_content_length
814              
815             Web::Mention->max_content_length( $new_max_length )
816              
817             Gets or sets the maximum length, in characters, of the content displayed
818             by that object method prior to truncation. (See L<"content">.)
819              
820             Defaults to 280.
821              
822             =head2 Object Methods
823              
824             =head3 as_json
825              
826             $json = $wm->as_json;
827              
828             Returns a JSON representation of the webmention.
829              
830             See L<"SERIALIZATION">, below, for more information.
831              
832             =head3 author
833              
834             $author = $wm->author;
835              
836             A L<Web::Mention::Author> object representing the author of this
837             webmention's source document. You can get information about the author through
838             its C<name>, C<url>, and C<photo> methods.
839              
840             If the webmention's author is unknown or unset, then this method returns a
841             L<Web::Mention::Author> object with all its fields set to C<undef>.
842              
843             =head3 content
844              
845             $content = $wm->content;
846              
847             Returns a string containing this object's best determination of this
848             webmention's I<display-ready> content, based on a number of factors.
849              
850             If the source document uses Microformats2 metadata and contains an
851             C<h-entry> MF2 item, then returned content may come from a variety of
852             its constituent properties, according to L<the IndieWeb comment-display
853             algorithm|https://indieweb.org/comments#How_to_display>.
854              
855             If not, then it returns the content of the source document's
856             E<lt>titleE<gt> element, with any further HTML stripped away.
857              
858             In any case, the string will get truncated if it's too long. See
859             L<"max_content_length"> and L<"content_truncation_marker">.
860              
861             =head3 endpoint
862              
863             my $uri = $wm->endpoint;
864              
865             Attempts to determine the webmention endpoint URL of this webmention's
866             target. On success, returns a L<URI> object. On failure, returns undef.
867              
868             (If the endpoint is set to localhost or a loopback IP, will return undef
869             and also emit a warning, because that's terribly rude behavior on the
870             target's part.)
871              
872             =head3 is_tested
873              
874             $bool = $wm->is_tested;
875              
876             Returns 1 if this object's L<"verify"> method has been called at least
877             once, regardless of the results of that call. Returns 0 otherwise.
878              
879             =head3 is_verified
880              
881             $bool = $wm->is_verified;
882              
883             Returns 1 if the webmention's source document actually does seem to
884             mention the target URL. Otherwise returns 0.
885              
886             The first time this is called on a given webmention object, it will try
887             to fetch the source document at its designated URL by way of the
888             L<"verify"> method.
889              
890             =head3 original_source
891              
892             $original_url = $wm->original_source;
893              
894             If the document fetched from the source URL seems to point at yet
895             another URL as its original source, then this returns that URL. If not,
896             this has the same return value as L<"source">.
897              
898             (It makes this determination based on the possible presence a C<u-url>
899             property in an C<h-entry> found within the source document.)
900              
901             =head3 response
902              
903             my $response = $wm->response;
904              
905             Returns the L<HTTP::Response> object representing the response received
906             by this webmention instance during its most recent attempt to send
907             itself.
908              
909             Returns undef if this webmention instance hasn't tried to send itself.
910              
911             =head3 rsvp_type
912              
913             my $rsvp = $wm->rsvp_type;
914              
915             If this webmention is of type C<rsvp> (see L<"type">, below), then this
916             method returns the type of RSVP represented. It will be one of:
917              
918             =over
919              
920             =item *
921              
922             yes
923              
924             =item *
925              
926             no
927              
928             =item *
929              
930             maybe
931              
932             =item *
933              
934             interested
935              
936             =back
937              
938             Otherwise, returns undef.
939              
940             =head3 send
941              
942             my $bool = $wm->send;
943              
944             Attempts to send an HTTP-request representation of this webmention to
945             its target's designated webmention endpoint. This involves querying the
946             target URL to discover said endpoint's URL (via the C<endpoint> object
947             method), and then sending the actual webmention request via HTTP to that
948             endpoint.
949              
950             If that whole process goes through successfully and the endpoint returns
951             a success response (meaning that it has acknowledged the webmention, and
952             most likely queued it for later processing), then this method returns
953             true. Otherwise, it returns false.
954              
955             B<To determine why a webmention did not send itself successfully>, consult
956             the value of C<response>. If it is defined, then you can call
957             L<HTTP::Response> methods (such as C<code> or C<message>) to learn more
958             about the problem. Otherwise, if C<response> is not defined, then the
959             target URL did not advertise a Webmention endpoint.
960              
961             =head3 source
962              
963             $source_url = $wm->source;
964              
965             Returns the webmention's source URL, as a L<URI> object.
966              
967             =head3 source_html
968              
969             $html = $wm->source_html;
970              
971             The HTML of the document fetched from the source URL. If nothing got
972             fetched successfully, returns undef.
973              
974             =head3 source_mf2_document
975              
976             $mf2_doc = $wm->source_mf2_document;
977              
978             The L<Web::Microformats2::Document> object that resulted from parsing
979             the source document for Microformats2 metadata. If no such result,
980             returns undef.
981              
982             =head3 target
983              
984             $target_url = $wm->target;
985              
986             Returns the webmention's target URL, as a L<URI> object.
987              
988             =head3 time_published
989              
990             $published_dt = $wm->time_published;
991              
992             If the document fetched from the source URL explicitly declares a
993             publication time via microformats, then this will return an appropriate
994             L<DateTime> object.
995              
996             If not (or if the declared time seems to be invalid), then this will
997             instead have the same return value as L<"time_received">.
998              
999             (It makes this determination based on the possible presence a C<dt-published>
1000             property in an C<h-entry> found within the source document.)
1001              
1002             =head3 time_received
1003              
1004             $received_dt = $wm->time_received;
1005              
1006             A L<DateTime> object corresponding to this object's creation time.
1007              
1008             =head3 time_verified
1009              
1010             $verified_dt = $wm->time_verified;
1011              
1012             If this webmention has been verified, then this will return a
1013             L<DateTime> object corresponding to the time of verification.
1014             (Otherwise, returns undef.)
1015              
1016             =head3 title
1017              
1018             my $title = $wm->title;
1019              
1020             Returns a string containing this object's best determination of the
1021             I<display-ready> title of this webmention's source document,
1022             considered separately from its content. (You can get its more complete
1023             content via the L<"content"> method.
1024              
1025             If the source document uses Microformats2 metadata and contains an
1026             C<h-entry> MF2 item, I<and> that item has a C<name> property, then this
1027             method will return the text content of that name property.
1028              
1029             If not, then it will return the content of the source document's
1030             E<lt>titleE<gt> element, with any further HTML stripped away.
1031              
1032             In any case, the string will get truncated if it's too long. See
1033             L<"max_content_length"> and L<"content_truncation_marker">.
1034              
1035             Note that in some circumstances, the title and content methods might
1036             return identical values. (If, for example, the source document defines
1037             an entry with an explicit name property and no summary or content
1038             properties.)
1039              
1040             =head3 type
1041              
1042             $type = $wm->type;
1043              
1044             The type of webmention this is. One of:
1045              
1046             =over
1047              
1048             =item *
1049              
1050             mention I<(default)>
1051              
1052             =item *
1053              
1054             reply
1055              
1056             =item *
1057              
1058             like
1059              
1060             =item *
1061              
1062             repost
1063              
1064             =item *
1065              
1066             quotation
1067              
1068             =item *
1069              
1070             rsvp
1071              
1072             =back
1073              
1074             This list is based on the W3C Post Type Discovery document
1075             (L<https://www.w3.org/TR/post-type-discovery/#response-algorithm>), and
1076             adds a "quotation" type.
1077              
1078             =head3 verify
1079              
1080             my $is_verified = $wm->verify
1081              
1082             This B<verifies> the webmention, confirming that the content located at
1083             the source URL contains the target URL. Returns 1 if so, and 0
1084             otherwise. Will also return 0 if it cannot fetch the content at all,
1085             after one try.
1086              
1087             Sets C<is_tested> to 1 as a side-effect.
1088              
1089             See also L<"is_verified">.
1090              
1091             =head1 SERIALIZATION
1092              
1093             To serialize a Web::Mention object, use L<"as_json">, which returns a
1094             JSON string that you can store in any way you wish. You can later
1095             "inflate" it into a Web::Mention object through the L<"new_from_json">
1096             class method.
1097              
1098             Note that a verified webmention might serialize to a significantly
1099             larger JSON string than an unverified one: it might include a complete
1100             copy of the source document, its parsed microformats (if any), author
1101             information, and various other metadata. Unverified webmentions, on the
1102             other hand, will likely contain little data other that their source and
1103             target URLs.
1104              
1105             This is all normal; verified webmentions just have more luggage.
1106              
1107             =head1 NOTES AND BUGS
1108              
1109             This software is B<beta>; its interface continues to develop and remains
1110             subject to change, but not without some effort at supporting its current
1111             API.
1112              
1113             This library does not, at this time, support L<the proposed "Vouch"
1114             anti-spam extension for Webmention|https://indieweb.org/Vouch>.
1115              
1116             =head1 SUPPORT
1117              
1118             To file issues or submit pull requests, please see L<this module's
1119             repository on GitHub|https://github.com/jmacdotorg/webmention-perl>.
1120              
1121             The author also welcomes any direct questions about this module via
1122             email.
1123              
1124             =head1 AUTHOR
1125              
1126             Jason McIntosh (jmac@jmac.org)
1127              
1128             =head1 CONTRIBUTORS
1129              
1130             =over
1131              
1132             =item *
1133              
1134             Mohammad S Anwar (mohammad.anwar@yahoo.com)
1135              
1136             =item *
1137              
1138             Yanick Champoux
1139              
1140             =item *
1141              
1142             Tomaž Šolc (tomaz.solc@tablix.org)
1143              
1144             =back
1145              
1146             =head1 COPYRIGHT AND LICENSE
1147              
1148             This software is Copyright (c) 2018-2020 by Jason McIntosh.
1149              
1150             This is free software, licensed under:
1151              
1152             The MIT (X11) License
1153              
1154             =head1 A PERSONAL REQUEST
1155              
1156             My ability to share and maintain free, open-source software like this
1157             depends upon my living in a society that allows me the free time and
1158             personal liberty to create work benefiting people other than just myself
1159             or my immediate family. I recognize that I got a head start on this due
1160             to an accident of birth, and I strive to convert some of my unclaimed
1161             time and attention into work that, I hope, gives back to society in some
1162             small way.
1163              
1164             Worryingly, I find myself today living in a country experiencing a
1165             profound and unwelcome political upheaval, with its already flawed
1166             democracy under grave threat from powerful authoritarian elements. These
1167             powers wish to undermine this society, remolding it according to their
1168             deeply cynical and strictly zero-sum philosophies, where nobody can gain
1169             without someone else losing.
1170              
1171             Free and open-source software has no place in such a world. As such,
1172             these autocrats' further ascension would have a deleterious effect on my
1173             ability to continue working for the public good.
1174              
1175             Therefore, if you would like to financially support my work, I would ask
1176             you to consider a donation to one of the following causes. It would mean
1177             a lot to me if you did. (You can tell me about it if you'd like to, but
1178             you don't have to.)
1179              
1180             =over
1181              
1182             =item *
1183              
1184             L<The American Civil Liberties Union|https://aclu.org>
1185              
1186             =item *
1187              
1188             L<The Democratic National Committee|https://democrats.org>
1189              
1190             =item *
1191              
1192             L<Earthjustice|https://earthjustice.org>
1193              
1194             =back
1195