File Coverage

blib/lib/HTML/SocialMedia.pm
Criterion Covered Total %
statement 131 159 82.3
branch 76 106 71.7
condition 30 54 55.5
subroutine 6 6 100.0
pod 3 3 100.0
total 246 328 75.0


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