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