gavinc/tags

   1 # Blosxom Plugin: tags
   2 # Author(s): Gavin Carr <gavin@openfusion.com.au>
   3 # Version: 0.001000
   4 # Documentation: See the bottom of this file or type: perldoc tags
   5
   6 package tags;
   7
   8 use strict;
   9 use File::stat;
  10
  11 # Uncomment next line to enable debug output (don't uncomment debug() lines)
  12 #use Blosxom::Debug debug_level => 2;
  13
  14 use vars qw($tagroot $tag_cache $tag_entries $tag_counts);
  15
  16 # --- Configuration variables -----
  17
  18 # What path prefix is used for tag-based queries?
  19 $tagroot = "/tags";
  20
  21 # What story header to you use for your tags?
  22 my $tag_header = 'Tags';
  23
  24 # Where is our $tag_cache file?
  25 my $tag_cache_file = "$blosxom::plugin_state_dir/tag_cache";
  26
  27 # ---------------------------------
  28 # __END_CONFIG__
  29
  30 $tag_cache = {};
  31 $tag_entries = {};
  32 $tag_counts = {};
  33 my $tag_cache_dirty = 0;
  34
  35 my @path_tags;
  36 my $path_tags_op;
  37
  38 sub start {
  39     # Load tag_cache
  40     if (-f $tag_cache_file) {
  41         my $fh = FileHandle->new( $tag_cache_file, 'r' )
  42            or warn "[tags] cannot open cache: $!";
  43         {
  44             local $/ = undef;
  45             eval <$fh>;
  46         }
  47         close $fh;
  48     }
  49
  50     1;
  51 }
  52
  53 sub entries {
  54     @path_tags = ();
  55     my $path_info = "/$blosxom::path_info";
  56     # debug(3, "entries, path_info $path_info");
  57
  58     if ($path_info =~ m!^$tagroot/(.*)!) {
  59         $blosxom::flavour = '';
  60         my $taglist = $1;
  61         # debug(3, "entries, path_info matches tagroot (taglist $taglist)");
  62
  63         # Allow flavours appended to tags after a slash
  64         # Dot-flavour versions are problematic, because tags can include dot e.g. web2.0
  65         if ($taglist =~ m! /(\w+)$ !x) {
  66             $blosxom::flavour = $1;
  67             $taglist =~ s! /$blosxom::flavour$ !!x;
  68         }
  69
  70         # Split individual tags out of taglist
  71         if ($taglist =~ m/;/) {
  72             @path_tags = split /\s*;\s*/, $taglist;
  73             $path_tags_op = ';';
  74         }
  75         else {
  76             @path_tags = split /\s*,\s*/, $taglist;
  77             $path_tags_op = ',';
  78         }
  79         # If $path_info matches $tagroot it's a virtual path, so reset
  80         $blosxom::path_info = '';
  81         $blosxom::flavour ||= $blosxom::default_flavour;
  82     }
  83
  84     return 0;
  85 }
  86
  87 sub filter {
  88     my ($pkg, $files_ref) = @_;
  89     return 1 unless @path_tags;
  90
  91     my %tagged = ();
  92     for my $tag (@path_tags) {
  93         if ($tag_entries->{$tag} && @{ $tag_entries->{$tag} }) {
  94             for my $entry ( @{ $tag_entries->{$tag} } ) {
  95                 $tagged{"$blosxom::datadir$entry.$blosxom::file_extension"}++;
  96             }
  97         }
  98     }
  99     # debug(2, "entries tagged with " . join($path_tags_op,@path_tags) . ":\n  " .  join("\n  ", sort keys %tagged));
 100
 101     # Now delete all entries from $files_ref except those tagged
 102     my $tag_count = scalar @path_tags;
 103     for (keys %$files_ref) {
 104         if ($path_tags_op eq ';') {
 105             # OR semantics - delete unless at least one tag
 106             delete $files_ref->{$_} unless exists $tagged{$_};
 107         }
 108         else {
 109             # AND semantics - delete unless ALL tags
 110             delete $files_ref->{$_} unless $tagged{$_} == $tag_count;
 111         }
 112     }
 113
 114     return 1;
 115 }
 116
 117 # Update tag cache on new or updated stories
 118 sub story {
 119     my ($pkg, $path, $filename, $story_ref, $title_ref, $body_ref) = @_;
 120
 121     my $file = "$blosxom::datadir$path/$filename.$blosxom::file_extension";
 122     unless (-f $file) {
 123         warn "[tags] cannot find story file '$file'";
 124         return 0;
 125     }
 126
 127     # Check story mtime
 128     my $st = stat($file) or die "bad stat: $!";
 129     my $mtime = $st->mtime;
 130     if ($tag_cache->{"$path/$filename"}->{mtime} == $mtime) {
 131         # debug(3, "$path/$filename found up to date in tag_cache - skipping");
 132         return 1;
 133     }
 134
 135     # mtime has changed (or story is new) - compare old and new tagsets
 136     my $tags_new = $blosxom::meta{$tag_header};
 137     my $tags_old = $tag_cache->{"$path/$filename"}->{tags};
 138     # debug(2, "tags_new: $tags_new, tags_old: $tags_old");
 139
 140     return 1 if defined $tags_new && defined $tags_old && $tags_old eq $tags_new;
 141
 142     # Update tag_cache
 143     # debug(2, "updating tag_cache, mtime $mtime, tags '$tags_new'");
 144     $tag_cache->{"$path/$filename"} = { mtime => $mtime, tags => $tags_new };
 145     $tag_cache_dirty++;
 146 }
 147
 148 # Write tag_cache to disk if updated
 149 sub last {
 150     if ($tag_cache_dirty) {
 151         # Refresh tag entries and tag counts
 152         $tag_entries = {};
 153         $tag_counts  = {};
 154         for my $entry (keys %{$tag_cache}) {
 155             next unless $tag_cache->{$entry}->{tags};
 156             for (split /\s*,\s*/, $tag_cache->{$entry}->{tags}) {
 157                 $tag_entries->{$_} ||= [];
 158                 push @{ $tag_entries->{$_} }, $entry;
 159                 $tag_counts->{$_}++;
 160             }
 161         }
 162
 163         # Save tag caches back to $tag_cache_file
 164         my $fh = FileHandle->new( $tag_cache_file, 'w' )
 165            or warn "[tags] cannot open cache '$tag_cache_file': $!"
 166              and return 0;
 167         print $fh Data::Dumper->Dump([ $tag_cache, $tag_entries, $tag_counts ],
 168                                      [ qw(tag_cache tag_entries tag_counts) ]);
 169         close $fh;
 170     }
 171 }
 172
 173 1;
 174
 175 __END__
 176
 177 =head1 NAME
 178
 179 tags - blosxom plugin to read tags from story files, maintain a tag cache,
 180 and allow tag-based filtering
 181
 182 =head1 DESCRIPTION
 183
 184 L<tags> is a blosxom plugin to read tags from story files, maintain a tag
 185 cache, and allow tag-based filtering.
 186
 187 Tags are defined in a comma-separated list in a $tag_header header at the
 188 beginning of a blosxom post, with $tag_header defaulting to 'Tags'. So for
 189 example, your post might look like:
 190
 191     My Post Title
 192     Tags: dogs, cats, pets
 193
 194     Post text goes here ...
 195
 196 L<tags> uses the L<metamail> plugin to parse story headers, and stores
 197 the tags in a cache (in $tag_cache_file, which defaults to
 198 $blosxom::plugin_state_dir/tag_cache). The tag cache is only updated
 199 when the mtime of the story file changes, so L<tags> should perform
 200 pretty well.
 201
 202 L<tags> also supports tag-based filtering. If the blosxom $path_info
 203 begins with $tagroot ('/tags', by default, e.g. '/tags/dogs'), then
 204 L<tags> filters the entries list to include only posts with the
 205 specified tag. The following syntaxes are supported (assuming the
 206 default '/tags' for $tagroot):
 207
 208 =over 4
 209
 210 =item /tags/<tag> e.g. /tags/dog
 211
 212 Show only posts with the specified tag.
 213
 214 =item /tags/<tag1>,<tag2>[,<tag3>...] e.g. /tags/dogs,cats
 215
 216 (Comma-separated) Show only posts with ALL of the specified tags i.e.
 217 AND semantics.
 218
 219 =item /tags/<tag1>;<tag2>[;<tag3>...] e.g. /tags/dogs;cats
 220
 221 (Comma-separated) Show only posts with ANY of the specified tags i.e.
 222 OR semantics.
 223
 224 =back
 225
 226 Tag filtering also supports a trailing flavour after the taglist,
 227 separated by a slash e.g.
 228
 229     /tags/dogs/html
 230     /tags/dogs,cats/rss
 231     /tags/dogs;cats;pets/atom
 232
 233 Note that this is different to L<tagging>, which treats trailing
 234 components as additional tags.
 235
 236 At this point L<tags> don't support dot-flavour paths e.g.
 237
 238     /tags/mysql.html
 239
 240 The problem with this is that tags can include dots, so it's
 241 ambiguous how to parse C</tags/web2.0>, for instance. If you'd
 242 like this supported and have suggestions about how to handle
 243 the ambiguities, please get in touch.
 244
 245 =head1 USAGE
 246
 247 L<tags> should be loaded early as it modifies blosxom $path_info when
 248 doing tag-based filtering. Specifically, it needs to be loaded BEFORE
 249 any C<entries> plugins (e.g. L<entries_index>, L<entries_cache>,
 250 L<entries_timestamp>, etc.)
 251
 252 L<tags> depends on the L<metamail> plugin to parse the tags header,
 253 though, so it must be loaded AFTER L<metamail>.
 254
 255 Also, because L<tags> does tag-based filtering, any filter plugins
 256 that you want to have a global view of your entries (like
 257 L<recententries>, for example) should be loaded BEFORE L<tags>.
 258
 259 =head1 ACKNOWLEDGEMENTS
 260
 261 This plugin was inspired by xtaran's excellent L<tagging> plugin.
 262 Initially I was just looking to add caching to L<tagging>, but found
 263 I wanted to use a more modular approach, and wanted to do slightly
 264 different filtering than L<tagging> offered as well. L<tagging> is
 265 still more full-featured.
 266
 267 =head1 SEE ALSO
 268
 269 L<tags> only handles maintaining the tags cache and doing tag-based
 270 filtering. For displaying tag lists in stories, see L<storytags>.
 271 For displaying a tagcloud, see L<tagcloud>.
 272
 273 L<metamail> is used for the tags header parsing.
 274
 275 See also xtaran's L<tagging> plugin, which inspired L<tags>.
 276
 277 Blosxom: http://blosxom.sourceforge.net/
 278
 279 =head1 AUTHOR
 280
 281 Gavin Carr <gavin@openfusion.com.au>, http://www.openfusion.net/
 282
 283 =head1 LICENSE
 284
 285 Copyright 2007, Gavin Carr.
 286
 287 This plugin is licensed under the same terms as blosxom itself i.e.
 288
 289 Permission is hereby granted, free of charge, to any person obtaining a
 290 copy of this software and associated documentation files (the "Software"),
 291 to deal in the Software without restriction, including without limitation
 292 the rights to use, copy, modify, merge, publish, distribute, sublicense,
 293 and/or sell copies of the Software, and to permit persons to whom the
 294 Software is furnished to do so, subject to the following conditions:
 295
 296 The above copyright notice and this permission notice shall be included
 297 in all copies or substantial portions of the Software.
 298
 299 THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
 300 IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 301 FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
 302 THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
 303 OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
 304 ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
 305 OTHER DEALINGS IN THE SOFTWARE.
 306
 307 =cut
 308
 309 # vim:ft=perl:sw=4
 310