Add set of Todd Larason plugins to general.
[matthijs/upstream/blosxom-plugins.git] / general / blogroll
1 # Blosxom Plugin: blogroll                                         -*- perl -*-
2 # Author: Todd Larason (jtl@molehill.org)
3 # Author: Kevin Scaldeferri (kevin@scaldeferri.com)
4 # (line and version added by Doug Nerad to show latest version)
5 # Version: 0+5i
6 # Blosxom Home/Docs/Licensing: http://www.raelity.org/blosxom
7 # Blogroll plugin Home/Docs/Licensing:
8 #   http://molelog.molehill.org/blox/Computers/Internet/Web/Blosxom/Blogroll/
9
10 package blogroll;
11
12 # -------------- Configuration Variables --- -------------
13
14 # files to read; should be either OPML, NewNewsWire .plist, or 'table'
15 # files (<title>tab<url>\n); with the default, just create a directory
16 # "$plugin_state_dir/.blogroll" and put your files (or symlinks to
17 # them) in it
18
19 @source_files = glob "$blosxom::plugin_state_dir/.blogroll/*" if ($#source_files < 0);
20
21 $use_caching = 1 unless defined $use_caching;
22
23 $debug_level = 0 unless defined $debug_level;
24 # -------------------------------------------------------------------
25
26 use IO::File;
27 use File::stat;
28
29 my $package = 'blogroll';
30 my $cachefile = "$blosxom::plugin_state_dir/.$package.cache";
31 my $save_cache = 0;
32 my $cache;
33
34 sub debug {
35     my ($level, @msg) = @_;
36
37     $debug .= "@msg<br>\n";
38     if ($debug_level >= $level) {
39         print STDERR "$package debug $level: @msg\n";
40     }
41 }
42
43 sub load_template {
44     my ($bit) = @_;
45     return $blosxom::template->('', "$package.$bit", $blosxom::flavour);
46 }
47 \f
48 # Output & formatting functions
49
50 sub report {
51     my ($bit, $title, $htmlurl, $xmlurl) = @_;
52
53     my $f = load_template($bit);
54     $f =~ s/((\$[\w:]+)|(\$\{[\w:]+\}))/$1 . "||''"/gee;
55     return $f;
56 }
57
58 sub finish_file_tree {
59     my ($tree) = @_;
60     my $results;
61
62     if ($tree->{items}) {
63         $results .= report('sub_head', $tree->{title});
64         $results .= finish_file_tree($_) foreach @{$tree->{items}};
65         $results .= report('sub_foot', $tree->{title});
66     } else {
67         $results .= report($tree->{xmlurl} ? 'item_xml':'item_no_xml', 
68                            $tree->{title}, $tree->{htmlurl}, $tree->{xmlurl});
69     }
70     return $results;
71 }
72
73 sub finish_file {
74     my ($fc, $filename, $tree) = @_;
75     local $_;
76     my $results;
77
78     $filename =~ s:.*/::;
79     $filename =~ s:[^a-zA-Z0-9]+:_:g;
80     $$filename = $fc->{blogroll}{$blosxom::flavour};
81     return if defined $$filename;
82
83     $results = report('head');
84     foreach (@{$tree->{items}}) {
85         $results .= finish_file_tree($_);
86     }
87     $results .= report('foot');
88
89     $$filename = $fc->{blogroll}{$blosxom::flavour} = $results;
90 }
91
92 sub finish {
93     my (@filenames) = @_;
94     my $key = '';
95
96     foreach (@filenames) {
97         my $fc = $cache->{file}{$_};
98         $key .= "|$fc->{mtime}";
99         finish_file($fc, $_, $fc->{tree}) if ($fc->{tree});
100     }   
101     return $cache->{blogroll}{$blosxom::flavour} 
102       if ($cache->{blogroll_key}{$blosxom::flavour} eq $key);
103
104     debug(1, "cache miss: blogroll results: $key");
105     my @items;
106     foreach my $filename (@filenames) {
107         my $fc = $cache->{file}{$filename};
108         foreach (@{$fc->{items}}) {
109             push @items, $_;
110         }
111     }
112
113     my $results;
114     
115     $results = report('head');
116     foreach (sort {lc($a->[0]) cmp lc($b->[0])} @items) {
117         $results .= report(defined($_->[2]) ? 'item_xml':'item_no_xml', @{$_});
118     }
119     $results .= report('foot');
120
121     $cache->{blogroll_key}{$blosxom::flavour} = $key;
122     $cache->{blogroll}{$blosxom::flavour} = $results;
123     $save_cache = 1;
124
125     return $results;
126 }
127 \f
128 # input and parsing functions
129
130 sub handle_item {
131     my ($fc, @record) = @_;
132     push @{$fc->{items}}, [@record];
133     debug(3, "handle_item(@record)");
134 }
135
136 sub handle_tree {
137     my ($fc, $tree) = @_;
138
139     if ($tree->{items}) {
140         handle_tree($fc, $_) foreach @{$tree->{items}};
141     } else {
142         handle_item($fc, $tree->{title}, $tree->{htmlurl}, $tree->{xmlurl});
143     }
144 }
145
146 sub handle_opml_subscription_file {
147     my ($fh, $fc) = @_;
148     my $count = 0;
149     # XXX this should maybe do 'real' xml parsing
150     # XML::Simple fast enough?  worth requiring more
151     # modules installed?
152     my $text = join '',<$fh>;
153     while ($text =~ m!\s<outline (.*?)>!msg) {
154         $_ = $1;
155         next unless m|/$|;
156         my ($htmlurl, $title, $xmlurl);
157         ($htmlurl) = m:html[uU]rl=" ( [^\"]+ ) ":x;
158         ($title  ) = m:title     =" ( [^\"]+ ) ":x;
159         ($xmlurl ) = m:xml[uU]rl =" ( [^\"]+ ) ":x;
160         if (defined($title) && (defined($htmlurl) || defined($xmlurl))) {
161             push @{$fc->{tree}{items}}, 
162             {title   => $title, 
163              htmlurl => $htmlurl,
164              xmlurl  => $xmlurl};
165             $count++;
166         }
167     }
168     debug(2, "handle_opml_subscription_file finished, $count items");
169 }
170
171 sub handle_tab_file {
172     my ($fh, $fc) = @_;
173     my $count = 0;
174     while ($_ = $fh->getline) {
175         chomp;
176         my ($title, $htmlurl) = split /\t+/;
177         push @{$fc->{tree}{items}},
178         {title   => $title, 
179          htmlurl => $htmlurl,
180          xmlurl  => $xmlurl};
181     }
182     debug(2, "handle_tab_file finished, $count items");
183 }
184
185 sub read_plist_dict {
186     my ($fh) = @_;
187     my $self = { type => 'dict'};
188
189     my ($key, $value);
190     while ($_ = $fh->getline) {
191         if (m!<key>(.*)</key>!) {
192             $key = $1;
193         } elsif (m!<array>!) {
194             $self->{$key} = read_plist_array($fh);
195         } elsif (m!<array/>!) {
196             $self->{$key} = {type => 'array', array => []};
197         } elsif (m!<string>(.*)</string>!) {
198             $self->{$key} = $1;
199         } elsif (m!</dict>!) {
200             return $self;
201         } else {
202             die "$_ in dict";
203         }
204     }
205 }
206
207 sub read_plist_array {
208     my ($fh) = @_;
209     my $self = { type => 'array'};
210     
211     $self->{array} = [];
212     while ($_ = $fh->getline) {
213         if (/<dict>/) {
214             push @{$self->{array}}, read_plist_dict($fh);
215         } elsif (m!</array>!) {
216             return $self;
217         } else {
218             die "$_ in <array>";
219         }
220     }
221 }
222
223 sub prettify_plist_tree {
224     my ($tree) = @_;
225
226     if ($tree->{type} eq 'array') {
227         return [map {prettify_plist_tree($_)} @{$tree->{array}}];
228     } elsif ($tree->{isContainer}) {
229         return {title => $tree->{name},
230                 items => prettify_plist_tree($tree->{childrenArray})};
231     } elsif ($tree->{type} eq 'dict' &&
232              $tree->{name} && $tree->{home} && $tree->{rss}) {
233         return {title   => $tree->{name},
234                 htmlurl => $tree->{home},
235                 xmlurl  => $tree->{rss}};
236     } else {
237         die "Unexpected node: $tree->{type}";
238     }
239 }
240
241 sub handle_nnw_file {
242     my ($fh, $fc) = @_;
243     my $count = 0;
244
245     do {
246         $_ = $fh->getline
247     } while ($_ && !m!<key>Subscriptions</key>!);
248     $_ = $fh->getline;
249     m:<array>: or die "Unexpected format: $_ at nnw toplevel";
250     my $tree = read_plist_array($fh);
251     $fc->{tree} = {items => prettify_plist_tree($tree)};
252 }
253
254 sub handle_file {
255     my ($filename) = @_;
256
257     my $filecache = $cache->{file}{$filename};
258     my $mtime = stat($filename)->mtime;
259
260     # If this file is in the cache, and hasn't been modified, we're
261     # done here
262     return if (defined($filecache) && $filecache->{mtime} == $mtime);
263
264     debug(1, "cache miss $filename: $mtime");
265
266     # Either not there or outdated, start over
267     $filecache = {mtime => $mtime, items => []};
268
269     my $fh = new IO::File("< $filename");
270     if (!$fh) {
271         warn "Couldn't open $filename";
272         return;
273     }
274
275     if ($filename =~ m:\.opml$:) {
276         handle_opml_subscription_file($fh, $filecache)
277     } elsif ($filename =~ m:\.tab$:) {
278         handle_tab_file($fh, $filecache);
279     } elsif ($filename =~ m:/com\.ranchero\.NetNewsWire\.plist:) {
280         handle_nnw_file($fh, $filecache);
281     } else {
282         warn "Unrecognized filetype $filename";
283     }
284     $fh->close;
285     handle_tree($filecache, $filecache->{tree});
286
287     $cache->{file}{$filename} = $filecache;
288 }
289 \f
290 # blosxom plugin interface
291
292 $blogroll;
293 $last_flavour = '';
294
295 sub prime_cache {
296     return 0 if !$use_caching;
297     eval "require Storable";
298     if ($@) {
299         debug(1, "cache disabled, Storable not available"); 
300         $use_caching = 0; 
301         return 0;
302     }
303     if (!Storable->can('lock_retrieve')) {
304         debug(1, "cache disabled, Storable::lock_retrieve not available");
305         $use_caching = 0;
306         return 0;
307     }
308     $cache = (-r $cachefile ? Storable::lock_retrieve($cachefile) : undef);
309     # for this, the cache is always valid if it exists
310     if (defined($cache)) {
311         debug(1, "Loaded cache");
312         return 1;
313     }
314     $cache = {};
315     return 0;
316 }
317
318 sub save_cache {
319     return if (!$use_caching || !$save_cache);
320     debug(1, "Saving cache");
321     Storable::lock_store($cache, $cachefile);
322 }
323
324 sub start {
325     debug(1, "start() called, enabled");
326     while (<DATA>) {
327         chomp;
328         last if /^(__END__)?$/;
329         my ($flavour, $comp, $txt) = split ' ',$_,3;
330         $txt =~ s:\\n:\n:g;
331         $blosxom::template{$flavour}{"$package.$comp"} = $txt;
332     }
333     prime_cache();
334     return 1;
335 }
336
337 sub head {
338     my ($pkg, $currentdir, $head_ref) = @_;
339
340     local $_;
341
342     # for static generation, don't do the same work over and over
343
344     return 1 if ($blogroll && $last_flavour eq $blosxom::flavour); 
345     $last_flavour = $blosxom::flavour;
346
347     debug(1, "head() called");
348     foreach my $filename (@source_files) {
349         handle_file($filename) ;
350     }
351     $blogroll = finish(@source_files);
352     debug(1, "head() finished, length(\$blogroll) =", length($blogroll));
353
354     save_cache();
355     1;
356 }
357
358 1;
359 # default flavour files; the 'error' flavour is default
360 # 'blogroll.' is prepended to the name given here
361 # to create an html flavour, then, create files 'blogroll.head.html' and so on.
362 __DATA__
363 error head <ul class="blogroll">\n
364 error sub_head <li>$title<ul>\n
365 error item_no_xml <li><a href="$htmlurl">$title</a></li>\n
366 error item_xml <li><a href="$htmlurl">$title</a> (<a href="$xmlurl">xml</a>)</li>\n
367 error sub_foot </ul></li>\n
368 error foot </ul>\n
369 __END__
370
371 =head1 NAME
372
373 Blosxom Plug-in: blogroll
374
375 =head1 SYNOPSIS
376
377 Purpose: Provides a blogroll from pre-exsting data files and/or an simple text file
378
379   * $blogroll::blogroll -- blogroll, sorted, combined from all input files
380   * $blogroll::<sanitized filename> -- blogroll of items from C<filename>, 
381     in their original order.  <sanitized filename> is C<filename> with all 
382     non-alphanumerics replaced with underscores
383
384 =head1 VERSION
385
386 0+4i
387
388 4th test release
389
390 =head1 AUTHOR
391
392 Todd Larason  <jtl@molehill.org>, http://molelog.molehill.org/
393
394 =head1 BUGS
395
396 None known; address bug reports and comments to me or to the Blosxom
397 mailing list [http://www.yahoogroups.com/groups.blosxom].
398
399 =head1 Customization
400
401 =head2 Input files
402
403 Three file formats are currently supported
404
405 =head3 OPML subscription files
406
407 These are recognized by a '.opml' extension.  
408
409 Only subscription files are supported; general OPML files are not.  Although 
410 OPML itself is standardized, the subscription subset is not, and there's
411 more variation than you might expect.  This is known to work with AmphetaDesk
412 and Radio native subscription files (but not Radio's other OPML files), and 
413 NetNewsWire export files; I'm interested in both success and failure reports
414 for files from other OPML generators.
415
416 =head3 TAB files
417
418 These are recognized by a '.tab' extension.
419
420 This is a simple text format intended for human editing, either to supplment
421 the items from the other file formats or for people who don't wish to use
422 one of the others.
423
424 Each line represents a record.  Each record contains two fields, separated
425 by a tab.  The first field is the name of the item, the second feld is the 
426 URL.
427
428 =head3 NNW plist files
429
430 These are recognized by the full name "com.ranchero.NetNewsWire.plist" (there
431 may be other plist formats supported in the future, so ".plist" isn't enough).
432
433 This is the native subscription format for NetNewsWire and NetNewsWire Pro.
434
435 This format supports hierarchical categorization of entries, available via the
436 $blogroll::com_ranchero_NetNewsWire_plist variable.
437
438 =head2 Configuration variables
439
440 C<@source_files> is the list of files to be used; by default, it's all the 
441 files in $blosxom::plugin_state_dir/.blogroll.
442
443 C<$use_caching> controls whether or not to try to cache data and
444 formatted results; caching requires Storable, but the plugin will work
445 just fine without it.
446
447 C<$debug_level> can be set to a value between 0 and 5; 0 will output
448 no debug information, while 5 will be very verbose.  The default is 1,
449 and should be changed after you've verified the plugin is working
450 correctly.
451
452 =head2 Class for CSS control
453
454 There's a class used, available for CSS customization.
455
456   * C<blogroll> -- the blogroll list as a whole
457
458 =head2 Flavour-style files
459
460 If you want a format change that can't be made by CSS, you can
461 override the HTML generated by creating files similar to Blosxom's
462 flavour files.  They should be named blogroll.I<bit>.I<flavour>; for
463 available I<bit>s and their default meanings, see the C<__DATA__>
464 section in the plugin.
465
466 =head1 Caching
467
468 If the Storable module is available and $use_caching is set, various
469 bits of data will be cached; this includes the parsed items from the
470 input files and the final formatted output of any blogrolls generated.
471
472 The cache will never be entirely flushed, but relevant pieces are invalidated
473 when input files are modified.  If you're making template changes, 
474 you may wish to either disable the cache (by setting $use_caching to 0) or 
475 manually flush the cache; this can be done by removing
476 $plugin_state_dir/.calendar.cache, and is always safe to do.
477
478 =head1 LICENSE
479
480 this Blosxom Plug-in
481 Copyright 2003, Todd Larason
482
483 (This license is the same as Blosxom's)
484
485 Permission is hereby granted, free of charge, to any person obtaining a
486 copy of this software and associated documentation files (the "Software"),
487 to deal in the Software without restriction, including without limitation
488 the rights to use, copy, modify, merge, publish, distribute, sublicense,
489 and/or sell copies of the Software, and to permit persons to whom the
490 Software is furnished to do so, subject to the following conditions:
491
492 The above copyright notice and this permission notice shall be included
493 in all copies or substantial portions of the Software.
494
495 THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
496 IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
497 FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
498 THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
499 OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
500 ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
501 OTHER DEALINGS IN THE SOFTWARE.
502
503