/usr/share/perl5/Wiki/Toolkit/Plugin/Categoriser.pm is in libwiki-toolkit-plugin-categoriser-perl 0.08-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 | package Wiki::Toolkit::Plugin::Categoriser;
use strict;
use Wiki::Toolkit::Plugin;
use vars qw( $VERSION @ISA );
$VERSION = '0.08';
@ISA = qw( Wiki::Toolkit::Plugin );
=head1 NAME
Wiki::Toolkit::Plugin::Categoriser - Category management for Wiki::Toolkit.
=head1 DESCRIPTION
Uses node metadata to build a model of how nodes are related to each
other in terms of categories.
=head1 SYNOPSIS
use Wiki::Toolkit;
use Wiki::Toolkit::Plugin::Categoriser;
my $wiki = Wiki::Toolkit->new( ... );
$wiki->write_node( "Red Lion", "nice beer", $checksum,
{ category => [ "Pubs", "Pub Food" ] }
) or die "Can't write node";
$wiki->write_node( "Holborn Station", "busy at peak times", $checksum,
{ category => "Tube Station" }
) or die "Can't write node";
my $categoriser = Wiki::Toolkit::Plugin::Categoriser->new;
$wiki->register_plugin( plugin => $categoriser );
my $isa_pub = $categoriser->in_category( category => "Pubs",
node => "Red Lion" );
my @categories = $categoriser->categories( node => "Holborn Station" );
=head1 METHODS
=over 4
=item B<new>
my $categoriser = Wiki::Toolkit::Plugin::Categoriser->new;
$wiki->register_plugin( plugin => $categoriser );
=cut
sub new {
my $class = shift;
my $self = {};
bless $self, $class;
return $self;
}
=item B<in_category>
my $isa_pub = $categoriser->in_category( category => "Pubs",
node => "Red Lion" );
Returns true if the node is in the category, and false otherwise. Note
that this is B<case-insensitive>, so C<Pubs> is the same category as
C<pubs>. I might do something to make it plural-insensitive at some
point too.
=cut
sub in_category {
my ($self, %args) = @_;
my @catarr = $self->categories( node => $args{node} );
my %categories = map { lc($_) => 1 } @catarr;
return $categories{lc($args{category})};
}
=item B<subcategories>
$wiki->write_node( "Category Pub Food", "mmm food", $checksum,
{ category => [ "Pubs", "Food", "Category" ] }
) or die "Can't write node";
my @subcats = $categoriser->subcategories( category => "Pubs" );
# will return ( "Pub Food" )
# Or if you prefer CamelCase node names:
$wiki->write_node( "CategoryPubFood", "mmm food", $checksum,
{ category => [ "Pubs", "Food", "Category" ] }
) or die "Can't write node";
my @subcats = $categoriser->subcategories( category => "Pubs" );
# will return ( "PubFood" )
To add a subcategory C<Foo> to a given category C<Bar>, write a node
called any one of C<Foo>, C<Category Foo>, or C<CategoryFoo> with
metadata indicating that it's in categories C<Bar> and C<Category>.
Yes, this pays specific attention to the Wiki convention of defining
categories by prefacing the category name with C<Category> and
creating a node by that name. If different behaviour is required we
should probably implement it using an optional argument in the
constructor.
=cut
sub subcategories {
my ($self, %args) = @_;
return () unless $args{category};
my $datastore = $self->datastore;
my %cats = map { $_ => 1 }
$datastore->list_nodes_by_metadata(
metadata_type => "category",
metadata_value => "Category" );
my @in_cat = $datastore->list_nodes_by_metadata(
metadata_type => "category",
metadata_value => $args{category} );
return map { s/^Category\s+//; $_ } grep { $cats{$_} } @in_cat;
}
=item B<categories>
my @cats = $categoriser->categories( node => "Holborn Station" );
Returns an array of category names in no particular order.
=cut
sub categories {
my ($self, %args) = @_;
my $dbh = $self->datastore->dbh;
my $sth = $dbh->prepare( "SELECT metadata_value
FROM node
INNER JOIN metadata
ON ( node.id = metadata.node_id
AND node.version = metadata.version )
WHERE name = ? AND metadata_type = 'category'" );
$sth->execute( $args{node} );
my @categories;
while ( my ($cat) = $sth->fetchrow_array ) {
push @categories, $cat;
}
return @categories;
}
=back
=head1 SEE ALSO
=over 4
=item * L<Wiki::Toolkit>
=item * L<Wiki::Toolkit::Plugin>
=back
=head1 AUTHOR
Kake Pugh (kake@earth.li).
The Wiki::Toolkit team (http://www.wiki-toolkit.org/)
=head1 COPYRIGHT
Copyright (C) 2003-4 Kake Pugh. All Rights Reserved.
Copyright (C) 2006-2009 the Wiki::Toolkit team. All Rights Reserved.
This module is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut
1;
|