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