File Coverage

blib/lib/HTML/SocialMedia.pm
Criterion Covered Total %
statement 90 178 50.5
branch 43 124 34.6
condition 12 56 21.4
subroutine 6 7 85.7
pod 3 3 100.0
total 154 368 41.8


line stmt bran cond sub pod time code
1             package HTML::SocialMedia;
2              
3 5     5   494337 use warnings;
  5         34  
  5         131  
4 5     5   21 use strict;
  5         8  
  5         75  
5 5     5   2155 use CGI::Lingua;
  5         70620  
  5         45  
6 5     5   126 use Carp;
  5         8  
  5         7059  
7              
8             =head1 NAME
9              
10             HTML::SocialMedia - Put social media links onto your website
11              
12             =head1 VERSION
13              
14             Version 0.28
15              
16             =cut
17              
18             our $VERSION = '0.28';
19              
20             =head1 SYNOPSIS
21              
22             Many websites these days have links and buttons into social media sites.
23             This module eases links into Twitter, Facebook and Google's PlusOne.
24              
25             use HTML::SocialMedia;
26             my $sm = HTML::SocialMedia->new();
27             # ...
28              
29             The language of the text displayed will depend on the client's choice, making
30             HTML::SocialMedia ideal for running on multilingual sites.
31              
32             Takes optional parameter logger, an object which is used for warnings and
33             traces.
34             This logger object is an object that understands warn() and trace() messages,
35             such as a L<Log::Log4perl> object.
36              
37             Takes optional parameter cache, an object which is used to cache country
38             lookups.
39             This cache object is an object that understands get() and set() messages,
40             such as an L<CHI> object.
41              
42             Takes optional parameter lingua, which is a L<CGI::Lingua> object.
43              
44             =head1 SUBROUTINES/METHODS
45              
46             =head2 new
47              
48             Creates a HTML::SocialMedia object.
49              
50             use HTML::SocialMedia;
51             my $sm = HTML::SocialMedia->new(twitter => 'example');
52             # ...
53              
54             =head3 Optional parameters
55              
56             twitter: twitter account name
57             twitter_related: array of 2 elements - the name and description of a related account
58             cache: This object will be an instantiation of a class that understands get and
59             set, such as L<CHI>.
60             info: Object which understands host_name messages, such as L<CGI::Info>.
61              
62             =cut
63              
64             sub new {
65 4     4 1 493 my $proto = shift;
66              
67 4   66     23 my $class = ref($proto) || $proto;
68 4 100       16 return unless(defined($class));
69              
70 3 50       15 my %params = (ref($_[0]) eq 'HASH') ? %{$_[0]} : @_;
  0         0  
71              
72 3         7 my $lingua = $params{lingua};
73 3 50       8 unless(defined($lingua)) {
74 3         5 my %args;
75 3 50       9 if($params{twitter}) {
76             # Languages supported by Twitter according to
77             # https://twitter.com/about/resources/tweetbutton
78 0         0 $args{supported} = ['en', 'nl', 'fr', 'fr-fr', 'de', 'id', 'il', 'ja', 'ko', 'pt', 'ru', 'es', 'tr'];
79             } else {
80             # TODO: Google plus only supports the languages listed at
81             # http://www.google.com/webmasters/+1/button/index.html
82 3         17 require I18N::LangTags::Detect;
83              
84             # Facebook supports just about everything
85 3         27 my @l = I18N::LangTags::implicate_supers_strictly(I18N::LangTags::Detect::detect());
86              
87 3 50       14116 if(@l) {
88 0         0 $args{supported} = [$l[0]];
89             } else {
90 3         9 $args{supported} = [];
91             }
92             }
93 3 50       13 if($params{cache}) {
94 0         0 $args{cache} = $params{cache};
95             }
96 3 100       18 if($params{logger}) {
97 2         4 $args{logger} = $params{logger};
98             }
99 3   33     31 $lingua = $params{lingua} || CGI::Lingua->new(%args);
100 3 0 50     100 if((!defined($lingua)) && scalar($args{supported})) {
101 0         0 $args{supported} = [];
102 0         0 $lingua = CGI::Lingua->new(%args);
103             }
104             }
105              
106             return bless {
107             _lingua => $lingua,
108             _twitter => $params{twitter},
109             _twitter_related => $params{twitter_related},
110             _cache => $params{cache},
111             _logger => $params{logger},
112             _info => $params{info},
113             # _alpha2 => undef,
114 3         31 }, $class;
115             }
116              
117             =head2 as_string
118              
119             Returns the HTML to be added to your website.
120             HTML::SocialMedia uses L<CGI::Lingua> to try to ensure that the text printed is
121             in the language of the user.
122              
123             use HTML::SocialMedia;
124             my $sm = HTML::SocialMedia->new(
125             twitter => 'mytwittername',
126             twitter_related => [ 'someonelikeme', 'another twitter feed' ]
127             );
128              
129             print "Content-type: text/html\n\n";
130              
131             print '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">';
132             print '<HTML><HEAD></HEAD><BODY>';
133              
134             print $sm->as_string(
135             twitter_follow_button => 1,
136             twitter_tweet_button => 1, # button to tweet this page
137             facebook_like_button => 1,
138             facebook_share_button => 1,
139             linkedin_share_button => 1,
140             google_plusone => 1,
141             reddit_button => 1,
142             align => 'right',
143             );
144              
145             print '</BODY></HTML>';
146             print "\n";
147              
148             =head3 Optional parameters
149              
150             twitter_follow_button: add a button to follow the account
151              
152             twitter_tweet_button: add a button to tweet this page
153              
154             facebook_like_button: add a Facebook like button
155              
156             facebook_share_button: add a Facebook share button
157              
158             linkedin_share_button: add a LinkedIn share button
159              
160             google_plusone: add a Google +1 button
161              
162             reddit_button: add a Reddit button
163              
164             align: argument to <p> HTML tag
165              
166             =cut
167              
168             sub as_string {
169 2     2 1 1803 my $self = shift;
170              
171 2 100       12 my %params = (ref($_[0]) eq 'HASH') ? %{$_[0]} : @_;
  1         5  
172              
173 2 100       11 if(ref($_[0]) eq 'HASH') {
    50          
    50          
174 1         2 %params = %{$_[0]};
  1         12  
175             } elsif(ref($_[0])) {
176 0         0 Carp::croak('Usage: as_string($options)');
177             } elsif(@_ % 2 == 0) {
178 1         3 %params = @_;
179             }
180              
181 2 50       11 if($self->{_logger}) {
182 2         22 $self->{_logger}->trace('Entering as_string');
183             }
184 2         14 my $lingua = $self->{_lingua};
185              
186 2 50       5 unless($self->{_alpha2}) {
187 2         12 my $alpha2 = $lingua->language_code_alpha2();
188 2         1712661 my $locale = $lingua->locale(); # Locale::Object::Country
189              
190 2 50       1331 if($self->{_logger}) {
191 2 50       9 if(defined($alpha2)) {
192 0         0 $self->{_logger}->debug("language_code_alpha2: $alpha2");
193             } else {
194 2         8 $self->{_logger}->debug('language_code_alpha2 returned undef');
195             }
196             }
197 2 50       13 if($alpha2) {
198 0         0 my $salpha2 = $lingua->sublanguage_code_alpha2();
199 0 0 0     0 if((!defined($salpha2)) && defined($locale)) {
200 0         0 $salpha2 = $locale->code_alpha2();
201             }
202 0 0       0 if($salpha2) {
    0          
203 0         0 $salpha2 = uc($salpha2);
204 0         0 $alpha2 .= "_$salpha2";
205             } elsif($locale) {
206 0         0 my @l = $locale->languages_official();
207 0         0 $alpha2 = lc($l[0]->code_alpha2()) . '_' . uc($locale->code_alpha2());
208             } else {
209             # Can't determine the area, i.e. is it en_GB or en_US?
210 0 0       0 if($self->{_logger}) {
211 0         0 $self->{_logger}->debug('Clearing the value of alpha2');
212             }
213 0         0 $alpha2 = undef;
214             }
215             }
216              
217 2 50       6 unless($alpha2) {
218 2 50       7 if($locale) {
219 2         9 my @l = $locale->languages_official();
220 2 50 33     2195 if(scalar(@l) && defined($l[0]->code_alpha2())) {
221 2         22 $alpha2 = lc($l[0]->code_alpha2()) . '_' . uc($locale->code_alpha2());
222             } else {
223 0         0 @l = $locale->languages();
224 0 0 0     0 if(scalar(@l) && defined($l[0]->code_alpha2())) {
225 0         0 $alpha2 = lc($l[0]->code_alpha2()) . '_' . uc($locale->code_alpha2());
226             }
227             }
228             }
229 2 50       32 unless($alpha2) {
230 0         0 $alpha2 = 'en_GB';
231 0 0       0 if($self->{_logger}) {
232 0         0 $self->{_logger}->info("Can't determine country, falling back to en_GB");
233             }
234             }
235             }
236 2 50       7 if($self->{_logger}) {
237 2         9 $self->{_logger}->debug("alpha2: $alpha2");
238             }
239 2         12 $self->{_alpha2} = $alpha2;
240             }
241              
242 2         4 my $rc;
243              
244 2 50 33     12 if($params{facebook_like_button} || $params{facebook_share_button}) {
245 2 50       7 if(!defined($self->{_country})) {
246             # Grab the Facebook preamble and put it as early as we can
247              
248             # See if Facebook supports our wanted language. If not then
249             # I suppose we could enuerate through other requested languages,
250             # but that is probably not worth the effort.
251              
252 2   50     8 my $country = $self->{_alpha2} || 'en_US';
253 2         3 my $res;
254 2 50       7 if($self->{_cache}) {
255 0         0 $res = $self->{_cache}->get($country);
256             }
257              
258 2 50       8 if(defined($res)) {
259 0 0       0 unless($res) {
260 0         0 $country = 'en_US';
261             }
262             } else {
263             # Resposnse is of type HTTP::Response
264 2         17 require LWP::UserAgent;
265              
266 2         3 my $response;
267              
268 2         5 eval {
269 2         22 $response = LWP::UserAgent->new(timeout => 10)->request(
270             HTTP::Request->new(GET => "http://connect.facebook.com/$country/sdk.js")
271             );
272             };
273 2 50       837546 if($@) {
274 0 0       0 if($self->{_logger}) {
275 0         0 $self->{_logger}->info($@);
276             }
277 0         0 $response = undef;
278             }
279 2 50 33     20 if(defined($response) && $response->is_success()) {
280             # If it's not supported, Facebook doesn't return an HTTP
281             # error such as 404, it returns a string, which no doubt
282             # will get changed at sometime in the future. Sigh.
283 2 50       40 if($response->decoded_content() =~ /is not a valid locale/) {
    50          
284             # TODO: Guess more appropriate fallbacks
285 0         0 $country = 'en_US';
286 0 0       0 if($self->{_cache}) {
287 0         0 $self->{_cache}->set($country, 0, '10 minutes');
288             }
289             } elsif($self->{_cache}) {
290 0         0 $self->{_cache}->set($country, 1, '10 minutes');
291             }
292             } else {
293 0         0 $country = 'en_US';
294 0 0       0 if($self->{_cache}) {
295 0         0 $self->{_cache}->set($country, 0, '10 minutes');
296             }
297             }
298             }
299 2         526 $self->{_country} = $country;
300             }
301              
302 2         54 $rc = << "END";
303             <div id="fb-root"></div>
304             <script>(function(d, s, id) {
305             var js, fjs = d.getElementsByTagName(s)[0];
306             if (d.getElementById(id)) return;
307             js = d.createElement(s); js.id = id;
308             js.src = "//connect.facebook.com/$self->{_country}/sdk.js#xfbml=1&version=v2.8&appId=953901534714390";
309             fjs.parentNode.insertBefore(js, fjs);
310             }(document, 'script', 'facebook-jssdk'));
311             </script>
312             END
313             }
314              
315 2         6 my $paragraph;
316 2 50       8 if($params{'align'}) {
317 0         0 $paragraph = "<p align=\"$params{'align'}\">";
318             } else {
319 2         5 $paragraph = '<p>';
320             }
321              
322 2 50       7 if($self->{_twitter}) {
323 0 0       0 if($params{twitter_follow_button}) {
324 0         0 my $language = $lingua->language();
325 0 0 0     0 if(($language eq 'English') || ($language eq 'Unknown')) {
326 0         0 $rc .= '<a href="//twitter.com/' . $self->{_twitter} . '" class="twitter-follow-button">Follow @' . $self->{_twitter} . '</a>';
327             } else {
328 0         0 my $langcode = substr($self->{_alpha2}, 0, 2);
329 0         0 $rc .= '<a href="//twitter.com/' . $self->{_twitter} . "\" class=\"twitter-follow-button\" data-lang=\"$langcode\">Follow \@" . $self->{_twitter} . '</a>';
330             }
331 0 0       0 if($params{twitter_tweet_button}) {
332 0         0 $rc .= $paragraph;
333             }
334             }
335 0 0       0 if($params{twitter_tweet_button}) {
336 0         0 $rc .= << 'END';
337             <script type="text/javascript">
338             window.twttr = (function(d, s, id) {
339             var js, fjs = d.getElementsByTagName(s)[0],
340             t = window.twttr || {};
341             if (d.getElementById(id)) return t;
342             js = d.createElement(s);
343             js.id = id;
344             js.src = "https://platform.twitter.com/widgets.js";
345             fjs.parentNode.insertBefore(js, fjs);
346              
347             t._e = [];
348             t.ready = function(f) {
349             t._e.push(f);
350             };
351              
352             return t;
353             }(document, "script", "twitter-wjs"));
354             </script>
355             <a href="//twitter.com/intent/tweet" class="twitter-share-button" data-count="horizontal" data-via="
356             END
357 0         0 $rc =~ s/\n$//;
358 0         0 $rc .= $self->{_twitter} . '"';
359 0 0       0 if($self->{_twitter_related}) {
360 0         0 my @related = @{$self->{_twitter_related}};
  0         0  
361 0         0 $rc .= ' data-related="' . $related[0] . ':' . $related[1] . '"';
362             }
363 0         0 $rc .= '>Tweet</a><script type="text/javascript" src="//platform.twitter.com/widgets.js"></script>';
364             }
365             }
366              
367 2 50       7 if($params{facebook_like_button}) {
368 2 50 33     14 if($params{twitter_tweet_button} || $params{twitter_follow_button}) {
369 0         0 $rc .= $paragraph;
370             }
371              
372 2         5 my $host_name;
373 2 50       7 unless($self->{info}) {
374 2         1913 require CGI::Info;
375              
376 2         67947 $self->{info} = CGI::Info->new();
377             }
378 2         46 $host_name = $self->{info}->host_name();
379              
380 2         7453 $rc .= "<div class=\"fb-like\" data-href=\"//$host_name\" data-layout=\"standard\" data-action=\"like\" data-size=\"small\" data-show-faces=\"false\" data-share=\"false\"></div>";
381              
382 2 50 33     31 if($params{google_plusone} || $params{linkedin_share_button} || $params{reddit_button} || $params{'facebook_share_button'}) {
      33        
      33        
383 0         0 $rc .= $paragraph;
384             }
385             }
386 2 50       8 if($params{'facebook_share_button'}) {
387 0 0 0     0 if($params{twitter_tweet_button} || $params{twitter_follow_button}) {
388 0         0 $rc .= $paragraph;
389             }
390              
391 0         0 my $host_name;
392 0 0       0 unless($self->{info}) {
393 0         0 require CGI::Info;
394              
395 0         0 $self->{info} = CGI::Info->new();
396             }
397 0         0 $host_name = $self->{info}->host_name();
398              
399 0         0 $rc .= "<div class=\"fb-share-button\" data-href=\"//$host_name\" data-layout=\"button_count\" data-size=\"small\" data-mobile-iframe=\"false\"><a class=\"fb-xfbml-parse-ignore\" target=\"_blank\" href=\"//www.facebook.com/sharer/sharer.php?u=%2F%2F$host_name&amp;src=sdkpreparse\">Share</a></div>";
400              
401 0 0 0     0 if($params{google_plusone} || $params{linkedin_share_button} || $params{reddit_button}) {
      0        
402 0         0 $rc .= $paragraph;
403             }
404             }
405              
406 2 50       8 if($params{linkedin_share_button}) {
407 0         0 $rc .= << 'END';
408             <script src="//platform.linkedin.com/in.js" type="text/javascript"></script>
409             <script type="IN/Share" data-counter="right"></script>
410             END
411 0 0 0     0 if($params{google_plusone} || $params{reddit_button}) {
412 0         0 $rc .= $paragraph;
413             }
414             }
415 2 50       8 if($params{google_plusone}) {
416             # $rc .= << 'END';
417             # <div id="gplus">
418             # <script type="text/javascript" src="https://apis.google.com/js/plusone.js">
419             # {"parsetags": "explicit"}
420             # </script>
421             # <div id="plusone-div"></div>
422             #
423             # <script type="text/javascript">
424             # gapi.plusone.render("plusone-div",{"size": "medium", "count": "true"});
425             # </script>
426             # </div>
427             # END
428 0         0 $rc .= '<g:plusone></g:plusone>';
429 0         0 $rc .= '<script type="text/javascript">';
430 0         0 my $alpha2 = $self->{_alpha2};
431 0 0       0 if(defined($alpha2)) {
432 0         0 $alpha2 =~ s/_/-/;
433 0         0 $rc .= "window.___gcfg = {lang: '$alpha2'};\n";
434             }
435              
436 0         0 my $protocol;
437 0 0       0 if($self->{_info}) {
438 0   0     0 $protocol = $self->{_info}->protocol() || 'http';
439             } else {
440 0         0 require CGI::Info;
441 0   0     0 $protocol = CGI::Info->protocol() || 'http';
442             }
443              
444 0         0 $rc .= << "END";
445             (function() {
446             var po = document.createElement('script'); po.type = 'text/javascript'; po.async = true;
447             po.src = '$protocol://apis.google.com/js/plusone.js';
448             var s = document.getElementsByTagName('script')[0]; s.parentNode.insertBefore(po, s);
449             })();
450             </script>
451             END
452 0 0       0 if($params{reddit_button}) {
453 0         0 $rc .= $paragraph;
454             }
455             }
456 2 50       7 if($params{reddit_button}) {
457 0         0 $rc .= '<script type="text/javascript" src="//www.reddit.com/static/button/button1.js"></script>';
458             }
459              
460 2         18 return $rc;
461             }
462              
463             =head2 render
464              
465             Synonym for as_string.
466              
467             =cut
468              
469             sub render {
470 0     0 1   my ($self, %params) = @_;
471              
472 0           return $self->as_string(%params);
473             }
474              
475             =head1 AUTHOR
476              
477             Nigel Horne, C<< <njh at bandsman.co.uk> >>
478              
479             =head1 BUGS
480              
481             When adding a FaceBook like button, you may find performance improves a lot if
482             you use L<HTTP::Cache::Transparent>.
483              
484             Please report any bugs or feature requests to C<bug-html-socialmedia at rt.cpan.org>, or through
485             the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=HTML-SocialMedia>.
486             I will be notified, and then you'll
487             automatically be notified of progress on your bug as I make changes.
488              
489             Would be good to have
490             my ($head, $body) = $sm->onload_render();
491              
492             =head1 SEE ALSO
493              
494              
495             =head1 SUPPORT
496              
497             You can find documentation for this module with the perldoc command.
498              
499             perldoc HTML::SocialMedia
500              
501             You can also look for information at:
502              
503             =over 4
504              
505             =item * RT: CPAN's request tracker
506              
507             L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=HTML-SocialMedia>
508              
509             =item * CPAN Ratings
510              
511             L<http://cpanratings.perl.org/d/HTML-SocialMedia>
512              
513             =item * Search CPAN
514              
515             L<http://search.cpan.org/dist/HTML-SocialMedia/>
516              
517             =back
518              
519              
520             =head1 ACKNOWLEDGEMENTS
521              
522              
523             =head1 LICENSE AND COPYRIGHT
524              
525             Copyright 2011-2020 Nigel Horne.
526              
527             This program is released under the following licence: GPL2
528              
529             =cut
530              
531             1; # End of HTML::SocialMedia