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
|
|
|
|
|
|
|
|