lib/DBIx/Class/TokenGroup.pm

   1 package DBIx::Class::TokenGroup;
   2 use strict;
   3 use warnings;
   4
   5 use base qw( DBIx::Class );
   6
   7 =head1 NAME
   8
   9 DBIx::Class::TokenGroup - Search for tokens in a tree of groups. (EXPERIMENTAL)
  10
  11 =head1 SYNOPSIS
  12
  13 Define your user tokens class.
  14
  15   package Schema::User::Token;
  16   use base qw( DBIx::Class::Core );
  17   __PACKAGE__->table('user_tokens');
  18   __PACKAGE__->add_columns(qw( name user_id value ));
  19   __PACKAGE__->set_primary_key(qw( name user_id ));
  20   1;
  21
  22 Define your group tokens class.
  23
  24   package Schema::Group::Token;
  25   use base qw( DBIx::Class::Core );
  26   __PACKAGE__->table('group_tokens');
  27   __PACKAGE__->add_columns(qw( name group_id value ));
  28   __PACKAGE__->set_primary_key(qw( name group_id ));
  29   1;
  30
  31 Define your group class.
  32
  33   package Schema::Group;
  34   use base qw( DBIx::Class::Core );
  35   __PACKAGE__->load_components(qw(
  36     Tree::AdjacencyList
  37   ));
  38   __PACKAGE__->table('groups');
  39   __PACKAGE__->add_columns(qw( group_id parent_id ));
  40   __PACKAGE__->set_primary_key('group_id');
  41   __PACKAGE__->parent_column('parent_id');
  42   __PACKAGE__->has_many( 'tokens' => 'Group::Token' => 'group_id' );
  43   1;
  44
  45 Define your user class.
  46
  47   package Schema::User;
  48   use base qw( DBIx::Class::Core );
  49   __PACKAGE__->table('users');
  50   __PACKAGE__->add_columns(qw( user_id group_id ));
  51   __PACKAGE__->set_primary_key('user_id');
  52   __PACKAGE__->token_name_column('name');
  53   __PACKAGE__->token_value_column('value');
  54   __PACKAGE__->has_many( 'tokens' => 'User::Token' => 'user_id' );
  55   __PACKAGE__->belongs_to( 'group' => 'Group', { 'foreign.group_id' => 'self.group_id' } );
  56   1;
  57
  58 =head1 DESCRIPTION
  59
  60 This L<DBIx::Class> component provides several utilities for
  61 retrieving tokens for a tree of groups.  A token is, at a minimum,
  62 a name and a value.  Groups are associated using either
  63 L<DBIx::Class::Tree::AdjacencyList> or L<DBIx::Class::Tree::NestedSet>.
  64
  65 This component itself is fairly simple, but it requires that you
  66 structure your classes in a certain way.
  67
  68 =head1 REQUIREMENTS
  69
  70 The sample shown in the SYNOPSIS is just that, an example.
  71 As long your clases respond the way that this component
  72 expects it doesn't care how things are structure.  So, here
  73 are the requirements for the class that uses this component.
  74
  75 =over 4
  76
  77 =item *
  78
  79 A tokens() method that returns a DBIx::Class::ResultSet object.  The
  80 objects (tokens) that the result set returns must have the name and
  81 value columns that you specified with the...
  82
  83 =item *
  84
  85 TODO
  86
  87 =back
  88
  89 =head1 METHODS
  90
  91 =head2 token_name_column
  92
  93   __PACKAGE__->token_name_column('name');
  94
  95 Sets the name of the column that can be queried to
  96 retrieve a token's name.
  97
  98 =cut
  99
 100 __PACKAGE__->mk_classdata( 'token_name_column' => 'name' );
 101
 102 =head2 token_value_column
 103
 104   __PACKAGE__->token_value_column('value');
 105
 106 Sets the name of the column that can be queried to
 107 retrieve a token's value.  This settings is optional
 108 as long as you do not use the token_true() and
 109 token_false() methods.
 110
 111 =cut
 112
 113 __PACKAGE__->mk_classdata( 'token_value_column' => 'value' );
 114
 115 =head2 token
 116
 117   $object->token('name');
 118
 119 Returns the token object, or 0 if none was found.
 120
 121 =cut
 122
 123 sub token {
 124     my( $self, $name ) = @_;
 125     my $name_col = $self->token_name_column();
 126     my $token = $self->tokens->search({
 127         $name_col => $name
 128     })->all();
 129     return $token if ($token);
 130     $token = $self->group->tokens->search({
 131         $name_col => $name
 132     })->all();
 133     return $token if ($token);
 134     my $descendant = $self->group->descendant_by_depth();
 135     while (my $group = $descendant->next()) {
 136         $token = $group->tokens->search({
 137             $name_col => $name
 138         })->all();
 139         return $token if ($token);
 140     }
 141     return 0;
 142 }
 143
 144 =head2 token_exists
 145
 146   if ($object->token_exists('name')){ ... }
 147
 148 Tests whether there is a token defined of the
 149 specified name.
 150
 151 =cut
 152
 153 sub token_exists {
 154     my( $self, $name ) = @_;
 155     my $name_col = $self->token_name_column();
 156     return 1 if( $self->tokens->search({
 157         $name_col => $name
 158     })->count() );
 159     return 1 if( $self->group->tokens->search({
 160         $name_col => $name
 161     })->count() );
 162     my $ancestors = $self->group->ancestors_by_depth();
 163     while (my $group = $ancestors->next()) {
 164         return 1 if( $group->tokens->search({
 165             $name_col => $name
 166         })->count() );
 167     }
 168     return 0;
 169 }
 170
 171 =head2 token_true
 172
 173   if ($object->token_true('name')) {
 174
 175 Returns 1 if the token exists and its value is a
 176 true value.  Returns 0 otherwise.
 177
 178 =cut
 179
 180 sub token_true {
 181     my( $self, $name ) = @_;
 182     my $token = $self->token( $name );
 183     return 0 if(!$token);
 184     return ( $token->get_column($self->token_value_column()) ? 1 : 0 );
 185 }
 186
 187 =head2 token_false
 188
 189   if ($object->token_false('name')) {
 190
 191 Returns 1 if the token exists and its value is a
 192 false value.  Returns 0 otherwise.
 193
 194 =cut
 195
 196 sub token_false {
 197     my( $self, $name ) = @_;
 198     my $token = $self->token( $name );
 199     return 0 if(!$token);
 200     return ( $token->get_column($self->token_value_column()) ? 0 : 1 );
 201 }
 202
 203 1;
 204 __END__
 205
 206 =head1 AUTHOR
 207
 208 Aran Clary Deltac <bluefeet@cpan.org>
 209
 210 =head1 LICENSE
 211
 212 You may distribute this code under the same terms as Perl itself.
 213