File Coverage

blib/lib/HTML/SocialMedia.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

line	stmt	sub	time	code
1				package HTML::SocialMedia;
2
3	1	1	86184	use warnings;
	1		2
	1		26
4	1	1	3	use strict;
	1		1
	1		16
5	1	1	511	use CGI::Lingua;
	0
	0
6
7				=head1 NAME
8
9				HTML::SocialMedia - Put social media links onto your website
10
11				=head1 VERSION
12
13				Version 0.27
14
15				=cut
16
17				our $VERSION = '0.27';
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 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 object.
40
41				Takes optional parameter lingua, which is a L 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.
59				info: Object which understands host_name messages, such as L.
60
61				=cut
62
63				sub new {
64				my $proto = shift;
65
66				my $class = ref($proto) \|\| $proto;
67				return unless(defined($class));
68
69				my %params = (ref($_[0]) eq 'HASH') ? %{$_[0]} : @_;
70
71				my $lingua = $params{lingua};
72				unless(defined($lingua)) {
73				my %args;
74				if($params{twitter}) {
75				# Languages supported by Twitter according to
76				# https://twitter.com/about/resources/tweetbutton
77				$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				require I18N::LangTags::Detect;
82
83				# Facebook supports just about everything
84				my @l = I18N::LangTags::implicate_supers_strictly(I18N::LangTags::Detect::detect());
85
86				if(@l) {
87				$args{supported} = [$l[0]];
88				} else {
89				$args{supported} = [];
90				}
91				}
92				if($params{cache}) {
93				$args{cache} = $params{cache};
94				}
95				if($params{logger}) {
96				$args{logger} = $params{logger};
97				}
98				$lingua = $params{lingua} \|\| CGI::Lingua->new(%args);
99				if((!defined($lingua)) && scalar($args{supported})) {
100				$args{supported} = [];
101				$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				}, $class;
114				}
115
116				=head2 as_string
117
118				Returns the HTML to be added to your website.
119				HTML::SocialMedia uses L 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 '';
131				print '';
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 '';
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 HTML tag
164
165				=cut
166
167				sub as_string {
168				my $self = shift;
169
170				my %params = (ref($_[0]) eq 'HASH') ? %{$_[0]} : @_;
171
172				if($self->{_logger}) {
173				$self->{_logger}->trace('Entering as_string');
174				}
175				my $lingua = $self->{_lingua};
176
177				unless($self->{_alpha2}) {
178				my $alpha2 = $lingua->language_code_alpha2();
179				my $locale = $lingua->locale(); # Locale::Object::Country
180
181				if($self->{_logger}) {
182				if(defined($alpha2)) {
183				$self->{_logger}->debug("language_code_alpha2: $alpha2");
184				} else {
185				$self->{_logger}->debug('language_code_alpha2 returned undef');
186				}
187				}
188				if($alpha2) {
189				my $salpha2 = $lingua->sublanguage_code_alpha2();
190				if((!defined($salpha2)) && defined($locale)) {
191				$salpha2 = $locale->code_alpha2();
192				}
193				if($salpha2) {
194				$salpha2 = uc($salpha2);
195				$alpha2 .= "_$salpha2";
196				} elsif($locale) {
197				my @l = $locale->languages_official();
198				$alpha2 = lc($l[0]->code_alpha2()) . '_' . uc($locale->code_alpha2());
199				} else {
200				# Can't determine the area, i.e. is it en_GB or en_US?
201				if($self->{_logger}) {
202				$self->{_logger}->debug('Clearing the value of alpha2');
203				}
204				$alpha2 = undef;
205				}
206				}
207
208				unless($alpha2) {
209				if($locale) {
210				my @l = $locale->languages_official();
211				if(scalar(@l) && defined($l[0]->code_alpha2())) {
212				$alpha2 = lc($l[0]->code_alpha2()) . '_' . uc($locale->code_alpha2());
213				} else {
214				@l = $locale->languages();
215				if(scalar(@l) && defined($l[0]->code_alpha2())) {
216				$alpha2 = lc($l[0]->code_alpha2()) . '_' . uc($locale->code_alpha2());
217				}
218				}
219				}
220				unless($alpha2) {
221				$alpha2 = 'en_GB';
222				if($self->{_logger}) {
223				$self->{_logger}->info("Can't determine country, falling back to en_GB");
224				}
225				}
226				}
227				if($self->{_logger}) {
228				$self->{_logger}->debug("alpha2: $alpha2");
229				}
230				$self->{_alpha2} = $alpha2;
231				}
232
233				my $rc;
234
235				if($params{facebook_like_button} \|\| $params{facebook_share_button}) {
236				if(!defined($self->{_country})) {
237				# Grab the Facebook preamble and put it as early as we can
238
239				# See if Facebook supports our wanted language. If not then
240				# I suppose we could enuerate through other requested languages,
241				# but that is probably not worth the effort.
242
243				my $country = $self->{_alpha2} \|\| 'en_US';
244				my $res;
245				if($self->{_cache}) {
246				$res = $self->{_cache}->get($country);
247				}
248
249				if(defined($res)) {
250				unless($res) {
251				$country = 'en_US';
252				}
253				} else {
254				# Resposnse is of type HTTP::Response
255				require LWP::UserAgent;
256
257				my $response;
258
259				eval {
260				$response = LWP::UserAgent->new(timeout => 10)->request(
261				HTTP::Request->new(GET => "http://connect.facebook.com/$country/sdk.js")
262				);
263				};
264				if($@) {
265				if($self->{_logger}) {
266				$self->{_logger}->info($@);
267				}
268				$response = undef;
269				}
270				if(defined($response) && $response->is_success()) {
271				# If it's not supported, Facebook doesn't return an HTTP
272				# error such as 404, it returns a string, which no doubt
273				# will get changed at sometime in the future. Sigh.
274				if($response->decoded_content() =~ /is not a valid locale/) {
275				# TODO: Guess more appropriate fallbacks
276				$country = 'en_US';
277				if($self->{_cache}) {
278				$self->{_cache}->set($country, 0, '10 minutes');
279				}
280				} elsif($self->{_cache}) {
281				$self->{_cache}->set($country, 1, '10 minutes');
282				}
283				} else {
284				$country = 'en_US';
285				if($self->{_cache}) {
286				$self->{_cache}->set($country, 0, '10 minutes');
287				}
288				}
289				}
290				$self->{_country} = $country;
291				}
292
293				$rc = << "END";
294
295
303				END
304				}
305
306				my $paragraph;
307				if($params{'align'}) {
308				$paragraph = " ";
309				} else {
310				$paragraph = ' ';
311				}
312
313				my $protocol;
314				if($self->{_info}) {
315				$protocol = $self->{_info}->protocol() \|\| 'http';
316				} else {
317				require CGI::Info;
318				$protocol = CGI::Info->protocol() \|\| 'http';
319				}
320
321				if($self->{_twitter}) {
322				if($params{twitter_follow_button}) {
323				my $language = $lingua->language();
324				if(($language eq 'English') \|\| ($language eq 'Unknown')) {
325				$rc .= 'Follow @' . $self->{_twitter} . '';
326				} else {
327				my $langcode = substr($self->{_alpha2}, 0, 2);
328				$rc .= 'Follow \@" . $self->{_twitter} . '';
329				}
330				if($params{twitter_tweet_button}) {
331				$rc .= $paragraph;
332				}
333				}
334				if($params{twitter_tweet_button}) {
335				$rc .= << 'END';
336
354				355	END
356				$rc =~ s/\n$//;
357				$rc .= $self->{_twitter} . '"';
358				if($self->{_twitter_related}) {
359				my @related = @{$self->{_twitter_related}};
360				$rc .= ' data-related="' . $related[0] . ':' . $related[1] . '"';
361				}
362				$rc .= '>Tweet';
363				}
364				}
365
366				if($params{facebook_like_button}) {
367				if($params{twitter_tweet_button} \|\| $params{twitter_follow_button}) {
368				$rc .= $paragraph;
369				}
370
371				my $host_name;
372				unless($self->{info}) {
373				require CGI::Info;
374
375				$self->{info} = CGI::Info->new();
376				}
377				$host_name = $self->{info}->host_name();
378
379				$rc .= " ";
380
381				if($params{google_plusone} \|\| $params{linkedin_share_button} \|\| $params{reddit_button} \|\| $params{'facebook_share_button'}) {
382				$rc .= $paragraph;
383				}
384				}
385				if($params{'facebook_share_button'}) {
386				if($params{twitter_tweet_button} \|\| $params{twitter_follow_button}) {
387				$rc .= $paragraph;
388				}
389
390				my $host_name;
391				unless($self->{info}) {
392				require CGI::Info;
393
394				$self->{info} = CGI::Info->new();
395				}
396				$host_name = $self->{info}->host_name();
397
398				$rc .= " Share ";
399
400				if($params{google_plusone} \|\| $params{linkedin_share_button} \|\| $params{reddit_button}) {
401				$rc .= $paragraph;
402				}
403				}
404
405				if($params{linkedin_share_button}) {
406				$rc .= << 'END';
407
408
409				END
410				if($params{google_plusone} \|\| $params{reddit_button}) {
411				$rc .= $paragraph;
412				}
413				}
414				if($params{google_plusone}) {
415				# $rc .= << 'END';
416				#
417				#
420				#
421				#
422				#
425				#
426				# END
427				$rc .= '';
428				$rc .= '
442				END
443				if($params{reddit_button}) {
444				$rc .= $paragraph;
445				}
446				}
447				if($params{reddit_button}) {
448				$rc .= '';
449				}
450
451				return $rc;
452				}
453
454				=head2 render
455
456				Synonym for as_string.
457
458				=cut
459
460				sub render {
461				my ($self, %params) = @_;
462
463				return $self->as_string(%params);
464				}
465
466				=head1 AUTHOR
467
468				Nigel Horne, C<< >>
469
470				=head1 BUGS
471
472				When adding a FaceBook like button, you may find performance improves a lot if
473				you use L.
474
475				Please report any bugs or feature requests to C, or through
476				the web interface at L. I will be notified, and then you'll
477				automatically be notified of progress on your bug as I make changes.
478
479				Would be good to have
480				my ($head, $body) = $sm->onload_render();
481
482				=head1 SEE ALSO
483
484
485				=head1 SUPPORT
486
487				You can find documentation for this module with the perldoc command.
488
489				perldoc HTML::SocialMedia
490
491				You can also look for information at:
492
493				=over 4
494
495				=item * RT: CPAN's request tracker
496
497				L
498
499				=item * AnnoCPAN: Annotated CPAN documentation
500
501				L
502
503				=item * CPAN Ratings
504
505				L
506
507				=item * Search CPAN
508
509				L
510
511				=back
512
513
514				=head1 ACKNOWLEDGEMENTS
515
516
517				=head1 LICENSE AND COPYRIGHT
518
519				Copyright 2011-2016 Nigel Horne.
520
521				This program is released under the following licence: GPL
522
523				=cut
524
525				1; # End of HTML::SocialMedia