Add set of Todd Larason plugins to general.
[matthijs/upstream/blosxom-plugins.git] / general / allconsuming
1 # Blosxom Plugin: allconsuming                                    -*- cperl -*-
2 # Author: Todd Larason (jtl@molehill.org)
3 # Version: 0+4i
4 # Blosxom Home/Docs/Licensing: http://www.raelity.org/blosxom
5 # Netflix plugin Home/Docs/Licensing:
6 # http://molelog.molehill.org/blox/Computers/Internet/Web/Blosxom/AllConsuming/
7 package allconsuming;
8
9 # http://allconsuming.net/news/000012.html
10
11 # -------------- Configuration Variables --------------
12 # AllConsuming username
13 $username = undef
14   unless defined $username;
15
16 # Amazon Associate ID; feel free to leave this =)
17 $associate_id = 'mtmolel-20'
18   unless defined $associate_id;
19
20 # undef == "list all"
21 #     0 == "don't list at all"
22 #    >0 == list first N (or all, if < N)
23 #    <0 == list random N (or all in random order, if < N)
24 %num = (
25         purchased => 5,          # most recent 5
26         reading   => undef,      # all
27         rereading => undef,      # all
28         favorite  => -5,         # random 5
29         completed => 5,          # most recent 5
30         nofinish  => 0           # none
31        ) unless scalar keys %num > 0;
32
33 # one of: SOAP::Lite, LWP, wget (or a pathname to wget), curl (or a pathname)
34 # SOAP::Lite should be fastest and most likely to stay working long-term,
35 # but is the hardest to get installed
36 $networking = 'LWP'
37   unless defined $networking;
38
39 # Whether to try to use caching; default is yes, and caching is very
40 # strongly recommended
41 $use_caching = 1
42   unless defined $use_caching;
43
44 # how long to go between re-fetching the data, in seconds
45 # default value is 1 week
46 $max_cache_data_age = 60 * 60 * 24 * 7
47   unless defined $max_cache_data_age;
48
49 # how long to go between re-formatting the lists, in seconds
50 # default is 5 minutes
51 $max_cache_layout_age = 60 * 5
52   unless defined $max_cache_layout_age;
53
54 $debug_level = 1
55   unless defined $debug_level;
56 # -----------------------------------------------------
57 \f
58 $purchased = '';
59 $reading   = '';
60 $rereading = '';
61 $favorite  = '';
62 $completed = '';
63 $nofinish  = '';
64 \f
65 use CGI qw/param/;
66 use strict;
67 use vars qw/$username $associate_id $max_cache_data_age $max_cache_layout_age
68   %num $networking $use_caching $debug_level
69   $purchased $reading $rereading $favorite $completed $nofinish/;
70 \f
71 my $cache;
72 my $package = "allconsuming";
73 my $cachefile = "$blosxom::plugin_state_dir/.$package.cache";
74 my $save_cache = 0;
75 \f
76 # General utility functions
77
78 sub debug {
79     my ($level, @msg) = @_;
80
81     if ($debug_level >= $level) {
82         print STDERR "$package debug $level: @msg\n";
83     }
84 }
85
86 sub load_template {
87     my ($bit) = @_;
88     return $blosxom::template->('', "$package.$bit", $blosxom::flavour);
89 }
90
91 sub report {
92     my ($bit, $listname, $title, $author, $asin, $image, $allconsuming_url, $amazon_url) = @_;
93     my $f   = load_template("$listname.$bit") || load_template($bit);
94     $title  = encode_entities($title);
95     $author = encode_entities($author);
96     $f =~ s/((\$[\w:]+)|(\$\{[\w:]+\}))/$1 . "||''"/gee;
97     return $f;
98 }
99
100 sub encode_entities {
101     my ($text) = @_;
102     eval "require HTML::Entities";
103     if ($@) {
104         my %map = ('<' => 'lt', '&' => 'amp', '>' => 'gt');
105         my $keys = join '',keys %map;
106         $text =~ s:([$keys]):&$map{$1};:g;
107         return $text;
108     }
109     return HTML::Entities::encode_entities($text);
110 }
111 \f
112 # General networking
113
114 sub GET {
115     my ($url) = @_;
116
117     if ($networking =~ m:curl:) {
118         return `$networking -m 30 -s "$url"`;
119     } elsif ($networking =~ m:wget:) {
120         return `$networking --quiet -O - "$url"`;
121     } elsif ($networking eq 'LWP') {
122         foreach (qw/LWP::UserAgent HTTP::Request::Common/) {
123             eval "require $_";
124             if ($@) {
125                 debug(0, "Can't load $_, can't use LWP networking: $@");
126                 return undef;
127             }
128         }
129         my $ua  = LWP::UserAgent->new;
130         my $res = $ua->request(HTTP::Request::Common::GET $url);
131         if (!$res->is_success) {
132             my $error = $res->status_line;
133             debug(0, "HTTP GET error: $error");
134             return undef;
135         }
136         return $res->content;
137     } else {
138         debug(0, "ERROR: invalid \$networking $networking");
139     }
140 }
141 \f
142 # AllConsuming-specific networking
143
144 sub allconsuming_handle {
145     if ($networking eq 'SOAP::Lite') {
146         eval "require SOAP::Lite;";
147         if ($@) {
148             debug(0, "SOAP::Lite couldn't be loaded");
149             return undef;
150         }
151         my @now = localtime;
152         my $soap = SOAP::Lite
153           -> uri('http://www.allconsuming.net/AllConsumingAPI')
154             -> proxy('http://www.allconsuming.net/soap.cgi');
155         my $obj = $soap
156               -> call(new => $now[2], $now[3], $now[4] + 1, $now[5] + 1900)
157                 -> result;
158         return {soap => $soap,
159                 obj  => $obj,
160                 map  => {purchased => 'GetPurchasedBooksList',
161                          reading   => 'GetCurrentlyReadingList',
162                          rereading => 'GetRereadingBooksList',
163                          favorite  => 'GetFavoriteBooksList',
164                          completed => 'GetCompletedBooksList',
165                          nofinish  => 'GetNeverFinishedBooksList'}
166                };
167     } else {
168         return {
169                 map => {purchased => 'purchased_books',
170                         reading   => 'currently_reading',
171                         rereading => 'rereading_books',
172                         favorite  => 'favorite_books',
173                         completed => 'completed_books',
174                         nofinish  => 'never_finished_books'}
175                };
176     }
177 }
178
179 sub allconsuming_lookup {
180     my ($handle, $username, $list) = @_;
181
182     return undef unless defined $handle;
183
184     if ($networking eq 'SOAP::Lite') {
185         return undef unless defined $handle->{map}{$list};
186         return $handle->{soap}
187           -> call($handle->{map}{$list} => $handle->{obj}, $username)
188             -> result;
189     } else {
190         my $data = GET('http://allconsuming.net/soap-client.cgi?' .
191                        "$handle->{map}{$list}=1&username=$username");
192         $data =~ s:\A\<pre>\$VAR1 =(.*)</pre>\Z:\1:ms;
193         return eval $data;
194     }
195 }
196
197 sub get_data {
198     if (defined $cache->{data} and
199         $^T - $cache->{data_timestamp} < $max_cache_data_age) {
200         return;
201     }
202     debug(1, "cache miss data");
203     $cache->{data_timestamp} = $^T;
204     my $obj = allconsuming_handle();
205
206     foreach (keys %num) {
207         next if defined($num{$_}) && $num{$_} == 0;
208         $cache->{data}{$_} = allconsuming_lookup($obj, $username, $_);
209     }
210     $save_cache = 1;
211 }
212 \f
213 # Cache handling
214
215 sub prime_cache {
216     return if (!$use_caching);
217     eval "require Storable";
218     if ($@) {
219         debug(1, "cache disabled, Storable not available");
220         $use_caching = 0;
221         return 0;
222     }
223     if (!Storable->can('lock_retrieve')) {
224         debug(1, "cache disabled, Storable::lock_retrieve not available");
225         $use_caching = 0;
226         return 0;
227     }
228     $cache = (-r $cachefile ? Storable::lock_retrieve($cachefile) : {});
229     if (defined(param('allconsuming'))) {
230         if (param('allconsuming') eq 'refresh_data') {
231             $cache = {};
232         } elsif (param('allconsuming') eq 'refresh_layout') {
233             $cache->{layout} = {};
234         }
235     }
236 }
237
238 sub save_cache {
239     return if (!$use_caching || !$save_cache);
240     debug(1, "Saving cache");
241     -d $blosxom::plugin_state_dir
242         or mkdir $blosxom::plugin_state_dir 
243         or (debug(0, "State dir $blosxom::plugin_state_dir nonexistant and noncreatable: $!") and return);
244     Storable::lock_store($cache, $cachefile);
245 }
246 \f
247 sub build_list {
248     my ($listname, $num, $list) = @_;
249     my $count = 0;
250     my $results;
251
252     return '' if (defined $num and $num == 0);
253     $list = [$list] if (ref $list eq 'HASH');
254     if (defined $list and defined $num and $num < 0) {
255         # algorithm from Algorithm::Numerical::Shuffle by Abigail
256         for (my $i = @$list; -- $i;) {
257             my $r = int rand ($i + 1);
258             ($list -> [$i], $list -> [$r]) = ($list -> [$r], $list -> [$i]);
259         }
260         $num = -$num;
261     }
262     $results = report('head', $listname);
263     foreach (@$list) {
264         $results .= report('item', $listname,
265                            @{$_}{qw/title author asin image allconsuming_url
266                                    amazon_url/});
267         $count++;
268         last if (defined $num and $count == $num);
269     }
270     $results .= report('foot', $listname);
271
272     return $results;
273 }
274 \f
275 # Blosxom plugin interface
276
277 sub head {
278     prime_cache();
279     get_data();
280     save_cache();
281
282     foreach (keys %num) {
283         next if defined($num{$_}) && $num{$_} == 0;
284         no strict;
285         $$_ = $cache->{layout}{$_}{$blosxom::flavour};
286         next if (defined $$_ &&
287                  ($^T - $cache->{layout_timestamp}{$_}{$blosxom::flavour}
288                   < $max_cache_layout_age));
289         debug(1, "cache miss layout $_ $blosxom::flavour");
290         $$_ = build_list($_, $num{$_}, $cache->{data}{$_}{asins});
291         $cache->{layout}{$_}{$blosxom::flavour} = $$_;
292         $cache->{layout_timestamp}{$_}{$blosxom::flavour} = $^T;
293         $save_cache = 1;
294         use strict;
295     }
296     save_cache();
297     
298     1;
299 }
300
301 sub start {
302     return 0 unless defined $username;
303     while (<DATA>) {
304         last if /^(__END__)?$/;
305         chomp;
306         my ($flavour, $comp, $txt) = split ' ',$_,3;
307         $txt =~ s:\\n:\n:g;
308         $blosxom::template{$flavour}{"$package.$comp"} = $txt;
309     }
310     return 1;
311 }
312
313 1;
314 __DATA__
315 error head <table class="allconsuming $listname">\n
316 error item <tr><td><a href="http://www.amazon.com/exec/obidos/ASIN/$asin/$associate_id/ref=nosim"><img border="0" src="$image" alt="$title Book cover"></a></td><td><a href="http://www.amazon.com/exec/obidos/ASIN/$asin/$associate_id/ref=nosim"><i>$title</i></a>, $author</td></tr>\n
317 error foot </table>
318 __END__
319
320 =head1 NAME
321
322 Blosxom Plug-in: allconsuming
323
324 =head1 SYNOPSIS
325
326 Purpose: Lets you easily share your AllConsuming information
327
328   * $allconsuming::purchased -- list of books you've purchased
329   * $allconsuming::reading -- list of books you're reading
330   * $allconsuming::rereading -- list of books you're re-reading
331   * $allconsuming::favorite -- list of your favorite books
332   * $allconsuming::completed -- list of books you've completed
333   * $allconsuming::nofinish -- list of books you never finished
334
335 =head1 VERSION
336
337 0+3i
338
339 2nd test release
340
341 =head1 AUTHOR
342
343 Todd Larason  <jtl@molehill.org>, http://molelog.molehill.org/
344
345 =head1 BUGS
346
347 None known; address bug reports and comments to me or to the Blosxom
348 mailing list [http://www.yahoogroups.com/groups.blosxom].
349
350 =head1 Customization
351
352 =head2 Configuration variables
353
354 C<$username> is your AllConsuming username.  Until it's defined, this plugin does nothing. 
355
356 C<$associate_id> is an Amazon Associate ID.  By default, it's mine;
357  change it to yours if you have one.
358
359 C<%num> sets how many items to include in each list.  Each of C<purchased>,
360 C<reading>, C<rereading>, C<favorite>, C<completed> and C<nofinish> can be
361 set separately.  Setting C<$num{foo}> to undef means to include the whole
362 list; setting it to 0 means to not build the list at all (or retrieve the
363 data from AllConsuming); setting it to a positive number N means to list the
364 first N items (or the whole list, if there aren't that many items) in order;
365 setting it to a negative number -N means to list a randomly selected set of
366 N items (or the whole list, in a random order, if there are fewer than N
367 items).
368
369 C<$networking> controls which networking implemenentation to use.  If set to
370 'SOAP::Lite', then the SOAP::Lite module will be used to communicate with
371 AllConsuming's official SOAP interface; this method is preferable for both
372 speed and reliability, but requires by far the most work to get working if
373 you don't already have the modules installed.  If set to 'LWP', then the
374 LWP family of modules will be used to communicate with a demonstration CGI
375 script.  If set to 'wget' or 'curl' (or a pathname that includes one of
376 those), then the respective external utility is used to communicate with
377 the demonstration CGI script.
378
379 C<$use_caching> is a boolean controlling whether to use caching at all.
380 Caching is very strongly recommended -- AllConsuming is rather slow.
381
382 C<$max_cache_data_age> sets how long to cache the downloaded AllConsuming
383 information for.  Fetching the data is pretty slow, so this defaults to a high
384 value -- 1 week.
385
386 C<$max_cache_layout_age> sets how long to cache the formatted data.
387 Formatting the data is relatively fast, so this defaults to a small value -- 5
388 minutes.  If you aren't modifying templates and aren't using randomized lists,
389 this can be set to the same as $max_cache_data_age without ill effects.
390
391 C<$debug_level> can be set to a value between 0 and 5; 0 will output
392 no debug information, while 5 will be very verbose.  The default is 1,
393 and should be changed after you've verified the plugin is working
394 correctly.
395
396 =head2 Classes for CSS control
397
398 There's are some classes used, available for CSS customization.
399
400   * C<allconsuming> -- all lists are in the netflix class
401   * C<purchased>, etc -- each list is also in a class named for the list
402
403 =head2 Flavour-style files
404
405 If you want a format change that can't be made by CSS, you can
406 override the HTML generated by creating files similar to Blosxom's
407 flavour files.  They should be named allconsuming.I<bit>.I<flavour>; for
408 available I<bit>s and their default meanings, see the C<__DATA__>
409 section in the plugin.
410
411 =head1 Caching
412
413 Because fetching the queue information is relatively slow, caching is very
414 strongly recommended.  Caching requires a version of the Storable module
415 that supports the 'lock_save' and 'lock_retrieve' functions.
416
417 Since the data reload is so slow, you may wish to raise the $max_cache_data_age
418 even higher, and use explicit cache reloading.  The cache can be reloaded
419 either by deleting the cache file $plugin_state_dir/.allconsuming.cache, or
420 by passing an C<allconsuming=refresh_data> parameter to the blosxom script;
421 the latter is preferable, as you can insure that you take the time hit, not
422 a random visitor.
423
424 =head1 LICENSE
425
426 this Blosxom Plug-in
427 Copyright 2003, Todd Larason
428
429 (This license is the same as Blosxom's)
430
431 Permission is hereby granted, free of charge, to any person obtaining a
432 copy of this software and associated documentation files (the "Software"),
433 to deal in the Software without restriction, including without limitation
434 the rights to use, copy, modify, merge, publish, distribute, sublicense,
435 and/or sell copies of the Software, and to permit persons to whom the
436 Software is furnished to do so, subject to the following conditions:
437
438 The above copyright notice and this permission notice shall be included
439 in all copies or substantial portions of the Software.
440
441 THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
442 IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
443 FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
444 THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
445 OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
446 ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
447 OTHER DEALINGS IN THE SOFTWARE.
448
449 =cut