source: wiki-toolkit-plugin-categoriser/trunk/lib/CGI/Wiki/Plugin/Categoriser.pm @ 261

Last change on this file since 261 was 261, checked in by Dominic Hargreaves, 15 years ago

More renames.

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