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