Added some plugins authored by Barijaona Ramaholimihaso
[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://blosxom.sourceforge.net/
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 This plugin is now maintained by the Blosxom Sourceforge Team,
395 <blosxom-devel@lists.sourceforge.net>.
396
397 =head1 BUGS
398
399 None known; please send bug reports and feedback to the Blosxom
400 development mailing list <blosxom-devel@lists.sourceforge.net>.
401
402 =head1 Customization
403
404 =head2 Input files
405
406 Three file formats are currently supported
407
408 =head3 OPML subscription files
409
410 These are recognized by a '.opml' extension.  
411
412 Only subscription files are supported; general OPML files are not.  Although 
413 OPML itself is standardized, the subscription subset is not, and there's
414 more variation than you might expect.  This is known to work with AmphetaDesk
415 and Radio native subscription files (but not Radio's other OPML files), and 
416 NetNewsWire export files; I'm interested in both success and failure reports
417 for files from other OPML generators.
418
419 =head3 TAB files
420
421 These are recognized by a '.tab' extension.
422
423 This is a simple text format intended for human editing, either to supplment
424 the items from the other file formats or for people who don't wish to use
425 one of the others.
426
427 Each line represents a record.  Each record contains two fields, separated
428 by a tab.  The first field is the name of the item, the second feld is the 
429 URL.
430
431 =head3 NNW plist files
432
433 These are recognized by the full name "com.ranchero.NetNewsWire.plist" (there
434 may be other plist formats supported in the future, so ".plist" isn't enough).
435
436 This is the native subscription format for NetNewsWire and NetNewsWire Pro.
437
438 This format supports hierarchical categorization of entries, available via the
439 $blogroll::com_ranchero_NetNewsWire_plist variable.
440
441 =head2 Configuration variables
442
443 C<@source_files> is the list of files to be used; by default, it's all the 
444 files in $blosxom::plugin_state_dir/.blogroll.
445
446 C<$use_caching> controls whether or not to try to cache data and
447 formatted results; caching requires Storable, but the plugin will work
448 just fine without it.
449
450 C<$debug_level> can be set to a value between 0 and 5; 0 will output
451 no debug information, while 5 will be very verbose.  The default is 1,
452 and should be changed after you've verified the plugin is working
453 correctly.
454
455 =head2 Class for CSS control
456
457 There's a class used, available for CSS customization.
458
459   * C<blogroll> -- the blogroll list as a whole
460
461 =head2 Flavour-style files
462
463 If you want a format change that can't be made by CSS, you can
464 override the HTML generated by creating files similar to Blosxom's
465 flavour files.  They should be named blogroll.I<bit>.I<flavour>; for
466 available I<bit>s and their default meanings, see the C<__DATA__>
467 section in the plugin.
468
469 =head1 Caching
470
471 If the Storable module is available and $use_caching is set, various
472 bits of data will be cached; this includes the parsed items from the
473 input files and the final formatted output of any blogrolls generated.
474
475 The cache will never be entirely flushed, but relevant pieces are invalidated
476 when input files are modified.  If you're making template changes, 
477 you may wish to either disable the cache (by setting $use_caching to 0) or 
478 manually flush the cache; this can be done by removing
479 $plugin_state_dir/.calendar.cache, and is always safe to do.
480
481 =head1 LICENSE
482
483 this Blosxom Plug-in
484 Copyright 2003, Todd Larason
485
486 (This license is the same as Blosxom's)
487
488 Permission is hereby granted, free of charge, to any person obtaining a
489 copy of this software and associated documentation files (the "Software"),
490 to deal in the Software without restriction, including without limitation
491 the rights to use, copy, modify, merge, publish, distribute, sublicense,
492 and/or sell copies of the Software, and to permit persons to whom the
493 Software is furnished to do so, subject to the following conditions:
494
495 The above copyright notice and this permission notice shall be included
496 in all copies or substantial portions of the Software.
497
498 THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
499 IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
500 FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
501 THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
502 OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
503 ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
504 OTHER DEALINGS IN THE SOFTWARE.
505
506