lib/DBIx/Class/Table.pm

   1 package DBIx::Class::Table;
   2
   3 use strict;
   4 use warnings;
   5
   6 use DBIx::Class::ResultSet;
   7 use Data::Page;
   8
   9 use base qw/Class::Data::Inheritable/;
  10
  11 __PACKAGE__->mk_classdata('_columns' => {});
  12
  13 __PACKAGE__->mk_classdata('_table_name');
  14
  15 __PACKAGE__->mk_classdata('table_alias'); # FIXME: Doesn't actually do anything yet!
  16
  17 __PACKAGE__->mk_classdata('_resultset_class' => 'DBIx::Class::ResultSet');
  18
  19 __PACKAGE__->mk_classdata('_page_object');
  20
  21 sub iterator_class { shift->_resultset_class(@_) }
  22
  23 =head1 NAME
  24
  25 DBIx::Class::Table - Basic table methods
  26
  27 =head1 SYNOPSIS
  28
  29 =head1 DESCRIPTION
  30
  31 This class is responsible for defining and doing basic operations on
  32 L<DBIx::Class> objects.
  33
  34 =head1 METHODS
  35
  36 =over 4
  37
  38 =cut
  39
  40 sub _register_columns {
  41   my ($class, @cols) = @_;
  42   my $names = { %{$class->_columns} };
  43   $names->{$_} ||= {} for @cols;
  44   $class->_columns($names);
  45 }
  46
  47 sub _mk_column_accessors {
  48   my ($class, @cols) = @_;
  49   $class->mk_group_accessors('column' => @cols);
  50 }
  51
  52 =item add_columns
  53
  54   __PACKAGE__->add_columns(qw/col1 col2 col3/);
  55
  56 Adds columns to the current package, and creates accessors for them
  57
  58 =cut
  59
  60 sub add_columns {
  61   my ($class, @cols) = @_;
  62   $class->_register_columns(@cols);
  63   $class->_mk_column_accessors(@cols);
  64 }
  65
  66 =item search_literal
  67
  68   my @obj    = $class->search_literal($literal_where_cond, @bind);
  69   my $cursor = $class->search_literal($literal_where_cond, @bind);
  70
  71 =cut
  72
  73 sub search_literal {
  74   my ($class, $cond, @vals) = @_;
  75   $cond =~ s/^\s*WHERE//i;
  76   my $attrs = (ref $vals[$#vals] eq 'HASH' ? { %{ pop(@vals) } } : {});
  77   $attrs->{bind} = \@vals;
  78   return $class->search(\$cond, $attrs);
  79 }
  80
  81 =item count_literal
  82
  83   my $count = $class->count_literal($literal_where_cond);
  84
  85 =cut
  86
  87 sub count_literal {
  88   my $class = shift;
  89   return $class->search_literal(@_)->count;
  90 }
  91
  92 =item count
  93
  94   my $count = $class->count({ foo => 3 });
  95
  96 =cut
  97
  98 sub count {
  99   my $class = shift;
 100   return $class->search(@_)->count;
 101 }
 102
 103 =item search
 104
 105   my @obj    = $class->search({ foo => 3 });
 106   my $cursor = $class->search({ foo => 3 });
 107
 108 =cut
 109
 110 sub search {
 111   my $class = shift;
 112   #warn "@_";
 113   my $attrs = { };
 114   if (@_ > 1 && ref $_[$#_] eq 'HASH') {
 115     $attrs = { %{ pop(@_) } };
 116   }
 117   $attrs->{where} = (@_ == 1 || ref $_[0] eq "HASH" ? shift: {@_});
 118
 119   # for pagination, we create the resultset with no limit and slice it later
 120   my $page = {};
 121   if ( $attrs->{page} ) {
 122     map { $page->{$_} = $attrs->{$_} } qw/rows page/;
 123     delete $attrs->{$_} for qw/rows offset page/;
 124   }
 125
 126   my $rs = $class->resultset($attrs);
 127
 128   if ( $page->{page} ) {
 129     my $pager = Data::Page->new(
 130       $rs->count,
 131       $page->{rows} || 10,
 132       $page->{page} || 1 );
 133     $class->_page_object( $pager );
 134     return $rs->slice( $pager->skipped,
 135       $pager->skipped + $pager->entries_per_page - 1 );
 136   }
 137
 138   return (wantarray ? $rs->all : $rs);
 139 }
 140
 141 sub resultset {
 142   my $class = shift;
 143
 144   my $rs_class = $class->_resultset_class;
 145   eval "use $rs_class;";
 146   my $rs = $rs_class->new($class, @_);
 147 }
 148
 149 =item search_like
 150
 151 Identical to search except defaults to 'LIKE' instead of '=' in condition
 152
 153 =cut
 154
 155 sub search_like {
 156   my $class    = shift;
 157   my $attrs = { };
 158   if (@_ > 1 && ref $_[$#_] eq 'HASH') {
 159     $attrs = pop(@_);
 160   }
 161   my $query    = ref $_[0] eq "HASH" ? { %{shift()} }: {@_};
 162   $query->{$_} = { 'like' => $query->{$_} } for keys %$query;
 163   return $class->search($query, { %$attrs });
 164 }
 165
 166 sub _select_columns {
 167   return keys %{$_[0]->_columns};
 168 }
 169
 170 =item table
 171
 172   __PACKAGE__->table('tbl_name');
 173
 174 =cut
 175
 176 sub table {
 177   shift->_table_name(@_);
 178 }
 179
 180 =item find_or_create
 181
 182   $class->find_or_create({ key => $val, ... });
 183
 184 Searches for a record matching the search condition; if it doesn't find one,
 185 creates one and returns that instead
 186
 187 =cut
 188
 189 sub find_or_create {
 190   my $class    = shift;
 191   my $hash     = ref $_[0] eq "HASH" ? shift: {@_};
 192   my $exists = $class->find($hash);
 193   return defined($exists) ? $exists : $class->create($hash);
 194 }
 195
 196 sub columns { return keys %{shift->_columns}; }
 197
 198 =item page
 199
 200   $pager = $class->page;
 201
 202 Returns a Data::Page object for the most recent search that was performed
 203 using the page parameter.
 204
 205 =cut
 206
 207 sub page { shift->_page_object }
 208
 209 1;
 210
 211 =back
 212
 213 =head1 AUTHORS
 214
 215 Matt S. Trout <mst@shadowcatsystems.co.uk>
 216
 217 =head1 LICENSE
 218
 219 You may distribute this code under the same terms as Perl itself.
 220
 221 =cut
 222