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 Carp qw/croak/;
  10
  11 use base qw/DBIx::Class/;
  12
  13 __PACKAGE__->mk_classdata('_columns' => {});
  14
  15 __PACKAGE__->mk_classdata('_table_name');
  16
  17 __PACKAGE__->mk_classdata('table_alias'); # FIXME: Doesn't actually do anything yet!
  18
  19 __PACKAGE__->mk_classdata('_resultset_class' => 'DBIx::Class::ResultSet');
  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 table-level operations on
  32 L<DBIx::Class> classes.
  33
  34 =head1 METHODS
  35
  36 =cut
  37
  38 sub _register_columns {
  39   my ($class, @cols) = @_;
  40   my $names = { %{$class->_columns} };
  41   $names->{$_} ||= {} for @cols;
  42   $class->_columns($names);
  43 }
  44
  45 sub _mk_column_accessors {
  46   my ($class, @cols) = @_;
  47   $class->mk_group_accessors('column' => @cols);
  48 }
  49
  50 =head2 add_columns
  51
  52   __PACKAGE__->add_columns(qw/col1 col2 col3/);
  53
  54 Adds columns to the current class and creates accessors for them.
  55
  56 =cut
  57
  58 sub add_columns {
  59   my ($class, @cols) = @_;
  60   $class->_register_columns(@cols);
  61   $class->_mk_column_accessors(@cols);
  62 }
  63
  64 =head2 search_literal
  65
  66   my @obj    = $class->search_literal($literal_where_cond, @bind);
  67   my $cursor = $class->search_literal($literal_where_cond, @bind);
  68
  69 =cut
  70
  71 sub search_literal {
  72   my ($class, $cond, @vals) = @_;
  73   $cond =~ s/^\s*WHERE//i;
  74   my $attrs = (ref $vals[$#vals] eq 'HASH' ? { %{ pop(@vals) } } : {});
  75   $attrs->{bind} = \@vals;
  76   return $class->search(\$cond, $attrs);
  77 }
  78
  79 =head2 count_literal
  80
  81   my $count = $class->count_literal($literal_where_cond);
  82
  83 =cut
  84
  85 sub count_literal {
  86   my $class = shift;
  87   return $class->search_literal(@_)->count;
  88 }
  89
  90 =head2 count
  91
  92   my $count = $class->count({ foo => 3 });
  93
  94 =cut
  95
  96 sub count {
  97   my $class = shift;
  98   return $class->search(@_)->count;
  99 }
 100
 101 =head2 search
 102
 103   my @obj    = $class->search({ foo => 3 }); # "... WHERE foo = 3"
 104   my $cursor = $class->search({ foo => 3 });
 105
 106 To retrieve all rows, simply call C<search()> with no condition parameter,
 107
 108   my @all = $class->search(); # equivalent to search({})
 109
 110 If you need to pass in additional attributes (see
 111 L<DBIx::Class::ResultSet/Attributes> for details) an empty hash indicates
 112 no condition,
 113
 114   my @all = $class->search({}, { cols => [qw/foo bar/] }); # "SELECT foo, bar FROM $class_table"
 115
 116 =cut
 117
 118 sub search {
 119   my $class = shift;
 120   my $attrs = { };
 121   croak "Table not defined for ". ( ref $class || $class ) unless $class->table();
 122   if (@_ > 1 && ref $_[$#_] eq 'HASH') {
 123     $attrs = { %{ pop(@_) } };
 124   }
 125   $attrs->{where} = (@_ == 1 || ref $_[0] eq "HASH" ? shift: {@_});
 126
 127   my $rs = $class->resultset($attrs);
 128
 129   return (wantarray ? $rs->all : $rs);
 130 }
 131
 132 sub resultset {
 133   my $class = shift;
 134
 135   my $rs_class = $class->_resultset_class;
 136   eval "use $rs_class;";
 137   my $rs = $rs_class->new($class, @_);
 138 }
 139
 140 =head2 search_like
 141
 142 Identical to search except defaults to 'LIKE' instead of '=' in condition
 143
 144 =cut
 145
 146 sub search_like {
 147   my $class    = shift;
 148   my $attrs = { };
 149   if (@_ > 1 && ref $_[$#_] eq 'HASH') {
 150     $attrs = pop(@_);
 151   }
 152   my $query    = ref $_[0] eq "HASH" ? { %{shift()} }: {@_};
 153   $query->{$_} = { 'like' => $query->{$_} } for keys %$query;
 154   return $class->search($query, { %$attrs });
 155 }
 156
 157 sub _select_columns {
 158   return keys %{$_[0]->_columns};
 159 }
 160
 161 =head2 table
 162
 163   __PACKAGE__->table('tbl_name');
 164
 165 Gets or sets the table name.
 166
 167 =cut
 168
 169 sub table {
 170   shift->_table_name(@_);
 171 }
 172
 173 =head2 find_or_create
 174
 175   $class->find_or_create({ key => $val, ... });
 176
 177 Searches for a record matching the search condition; if it doesn't find one,
 178 creates one and returns that instead.
 179
 180 =cut
 181
 182 sub find_or_create {
 183   my $class    = shift;
 184   my $hash     = ref $_[0] eq "HASH" ? shift: {@_};
 185   my $exists = $class->find($hash);
 186   return defined($exists) ? $exists : $class->create($hash);
 187 }
 188
 189 =head2 has_column
 190
 191   if ($obj->has_column($col)) { ... }
 192
 193 Returns 1 if the class has a column of this name, 0 otherwise.
 194
 195 =cut
 196
 197 sub has_column {
 198   my ($self, $column) = @_;
 199   return exists $self->_columns->{$column};
 200 }
 201
 202 =head2 column_info
 203
 204   my $info = $obj->column_info($col);
 205
 206 Returns the column metadata hashref for a column.
 207
 208 =cut
 209
 210 sub column_info {
 211   my ($self, $column) = @_;
 212   croak "No such column $column" unless exists $self->_columns->{$column};
 213   return $self->_columns->{$column};
 214 }
 215
 216 =head2 columns
 217
 218   my @column_names = $obj->columns;
 219
 220 =cut
 221
 222 sub columns {
 223   croak "columns() is a read-only accessor, did you mean add_columns()?" if (@_ > 1);
 224   return keys %{shift->_columns};
 225 }
 226
 227 1;
 228
 229 =head1 AUTHORS
 230
 231 Matt S. Trout <mst@shadowcatsystems.co.uk>
 232
 233 =head1 LICENSE
 234
 235 You may distribute this code under the same terms as Perl itself.
 236
 237 =cut
 238