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