flickrgallery.pl 6.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219
  1. # Copyright (C) 2005 Fletcher T. Penney <fletcher@freeshell.org>
  2. #
  3. # This program is free software; you can redistribute it and/or modify
  4. # it under the terms of the GNU General Public License as published by
  5. # the Free Software Foundation; either version 3 of the License, or
  6. # (at your option) any later version.
  7. #
  8. # This program is distributed in the hope that it will be useful,
  9. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. # GNU General Public License for more details.
  12. #
  13. # You should have received a copy of the GNU General Public License
  14. # along with this program. If not, see <http://www.gnu.org/licenses/>.
  15. use strict;
  16. use v5.10;
  17. AddModuleDescription('flickrgallery.pl', 'FlickrGallery Module');
  18. # NOTE: This API key for Flickr is NOT to be used in any other products
  19. # INCLUDING derivative works. The rest of the code can be used as licensed
  20. my $FlickrAPIKey = "a8d5ba0d878e08847ccc8b150e52a859";
  21. our (%RuleOrder, @MyRules, @MyMarkdownRules);
  22. our ($FlickrBaseUrl, $FlickrHeaderTemplate, $FlickrFooterTemplate, $FlickrImageTemplate, $FlickrExtension, $FlickrLabel);
  23. use LWP;
  24. $FlickrBaseUrl = "http://www.flickr.com/services/rest/" unless defined $FlickrBaseUrl;
  25. $FlickrHeaderTemplate = '<h3>$title</h3>
  26. <p>$description</p>
  27. <div class="gallery">' unless defined $FlickrHeaderTemplate;
  28. $FlickrFooterTemplate = '<div class="gallery close"></div></div>' unless defined $FlickrFooterTemplate;
  29. $FlickrImageTemplate = '<div class="image"><a href="$imageurl" title="$title"><img src="http://static.flickr.com/$server/$id_$secret$FlickrExtension.jpg" width="$width" height="$height" alt="$title"/></a><div class="text"><p>$cleanTitle<br/><br/>$description</p></div></div>' unless defined $FlickrImageTemplate;
  30. $FlickrLabel = "Square" unless defined $FlickrLabel;
  31. $FlickrLabel = ucfirst($FlickrLabel);
  32. my %FlickrExtensions = (
  33. 'Square' => '_s',
  34. 'Thumbnail' => '_t',
  35. 'Small' => '_m',
  36. 'Medium' => '',
  37. 'Original' => '_o',
  38. );
  39. $FlickrExtension = $FlickrExtensions{$FlickrLabel};
  40. # Square|Thumbnail|Small|Medium|Original
  41. my $size = "Square|Thumbnail|Small|medium|Original";
  42. push (@MyRules, \&FlickrGalleryRule);
  43. # Allow compatibility with Markdown Module
  44. push (@MyMarkdownRules, \&MarkdownFlickrGalleryRule);
  45. $RuleOrder{\&FlickrGalleryRule} = -10;
  46. sub FlickrGalleryRule {
  47. # This code is used when Markdown is not available
  48. if (/\G^([\n\r]*\&lt;\s*FlickrSet:\s*(\d+)\s*\&gt;\s*)$/cgim) {
  49. my $oldpos = pos;
  50. my $oldstr = $_;
  51. print FlickrGallery($2);
  52. pos = $oldpos;
  53. $oldstr =~ s/\&lt;\s*FlickrSet:\s*(\d+)\s*\&gt;//is;
  54. $_ = $oldstr;
  55. return '';
  56. }
  57. if (/\G^([\n\r]*\&lt;\s*FlickrPhoto:\s*(\d+)\s*([a-z0-9]*?)\s*($size)?\s*\&gt;\s*)$/cgim) {
  58. my $oldpos = pos;
  59. my $oldstr = $_;
  60. print GetFlickrPhoto($2,$3,$4);
  61. pos = $oldpos;
  62. $oldstr =~ s/\&lt;\s*FlickrPhoto:\s*(\d+)\s*([a-z0-9]*?)\s*($size)?\s*\&gt;//is;
  63. $_ = $oldstr;
  64. return '';
  65. }
  66. return;
  67. }
  68. sub MarkdownFlickrGalleryRule {
  69. # for Markdown only
  70. my $text = shift;
  71. $text =~ s{
  72. ^&lt;FlickrSet:\s*(\d+)\s*\>
  73. }{
  74. FlickrGallery($1);
  75. }egimx;
  76. $text =~ s{
  77. ^&lt;FlickrPhoto:\s*(\d+)\s*([a-z0-9]*?)\s*($size)?\s*\>
  78. }{
  79. GetFlickrPhoto($1,$2,$3);
  80. }egimx;
  81. return $text
  82. }
  83. sub FlickrGallery {
  84. my $id = shift();
  85. return "&lt;FlickrSet:$id&gt; (error LWP::UserAgent not available)" unless eval {require LWP::UserAgent};
  86. my $ua = LWP::UserAgent->new;
  87. # $ua->timeout(10);
  88. my $result = "";
  89. # Get Title and description
  90. my $url = $FlickrBaseUrl . "?method=flickr.photosets.getInfo&api_key=" .
  91. $FlickrAPIKey . "&photoset_id=" . $id;
  92. # my $response = $ua->get($url);
  93. my $response = $ua->request(HTTP::Request->new(GET=>$url));
  94. $response->content =~ /\<title\>(.*?)\<\/title\>/;
  95. my $title = $1;
  96. $response->content =~ /\<description\>(.*?)\<\/description\>/;
  97. my $description = $1;
  98. $result = $FlickrHeaderTemplate;
  99. $result =~ s/(\$[a-zA-Z\d]+)/"defined $1 ? $1 : ''"/eeg;
  100. # Get list of photos and process them
  101. $url = $FlickrBaseUrl . "?method=flickr.photosets.getPhotos&api_key=" .
  102. $FlickrAPIKey . "&photoset_id=" . $id;
  103. # $response = $ua->get($url);
  104. $response = $ua->request(HTTP::Request->new(GET=>$url));
  105. my $xml = $response->content;
  106. while (
  107. $xml =~ m/\<photo\s+id=\"(\d+)\"\s+secret=\"(.+?)\"\s+server=\"(\d+)\"/g
  108. ) {
  109. $result .= FlickrPhoto($1,$2,$3);
  110. }
  111. my $footer = $FlickrFooterTemplate;
  112. $footer =~ s/(\$[a-zA-Z\d]+)/"defined $1 ? $1 : ''"/eeg;
  113. $result .= $footer;
  114. return $result;
  115. }
  116. sub FlickrPhoto {
  117. my ($id, $secret, $server) = @_;
  118. my $ua = LWP::UserAgent->new;
  119. # $ua->timeout(10);
  120. my $url = $FlickrBaseUrl . "?method=flickr.photos.getInfo&api_key=" .
  121. $FlickrAPIKey . "&photo_id=" . $id . "&secret=" . $secret;
  122. # my $response = $ua->get($url);
  123. my $response = $ua->request(HTTP::Request->new(GET=>$url));
  124. $response->content =~ /\<title\>(.*?)\<\/title\>/;
  125. my $title = $1;
  126. my $cleanTitle = $title;
  127. $response->content =~ /\<description\>(.*?)\<\/description\>/;
  128. my $description = $1;
  129. $response->content =~ /\<url type="photopage"\>(.*?)\<\/url\>/;
  130. my $imageurl = $1;
  131. $url = $FlickrBaseUrl . "?method=flickr.photos.getSizes&api_key=" .
  132. $FlickrAPIKey . "&photo_id=" . $id;
  133. # $response = $ua->get($url);
  134. $response = $ua->request(HTTP::Request->new(GET=>$url));
  135. $response->content =~ /\<size label=\"$FlickrLabel\" width=\"(\d+)\" height=\"(\d+)\"/;
  136. my $width = $1;
  137. my $height = $2;
  138. my $output = $FlickrImageTemplate;
  139. $output =~ s/(\$[a-zA-Z\d]+)/"defined $1 ? $1 : ''"/eeg;
  140. return $output
  141. }
  142. sub GetFlickrPhoto{
  143. my ($id, $secret, $size) = @_;
  144. local $FlickrLabel = ucfirst($size) if ($size);
  145. local $FlickrExtension = $FlickrExtensions{$FlickrLabel};
  146. my $ua = LWP::UserAgent->new;
  147. # $ua->timeout(10);
  148. my $url = $FlickrBaseUrl . "?method=flickr.photos.getInfo&api_key=" .
  149. $FlickrAPIKey . "&photo_id=" . $id;
  150. $url .= "&secret=" . $secret if ($secret);
  151. # my $response = $ua->get($url);
  152. my $response = $ua->request(HTTP::Request->new(GET=>$url));
  153. $response->content =~ m/\<photo\s+id=\"(\d+)\"\s+secret=\"(.+?)\"\s+server=\"(\d+)\"/g;
  154. $secret = $2;
  155. my $server = $3;
  156. return FlickrPhoto($id,$secret,$server);
  157. }