lib/DBIx/Class/Table.pm

   1 package DBIx::Class::Table;
   2
   3 use strict;
   4 use warnings;
   5
   6 use DBIx::Class::ResultSet;
   7
   8 use base qw/DBIx::Class/;
   9
  10 __PACKAGE__->mk_classdata('_columns' => {});
  11
  12 __PACKAGE__->mk_classdata('_table_name');
  13
  14 __PACKAGE__->mk_classdata('table_alias'); # FIXME: Doesn't actually do anything yet!
  15
  16 __PACKAGE__->mk_classdata('_resultset_class' => 'DBIx::Class::ResultSet');
  17
  18 sub iterator_class { shift->_resultset_class(@_) }
  19
  20 =head1 NAME
  21
  22 DBIx::Class::Table - Basic table methods
  23
  24 =head1 SYNOPSIS
  25
  26 =head1 DESCRIPTION
  27
  28 This class is responsible for defining and doing basic operations on
  29 L<DBIx::Class> objects.
  30
  31 =head1 METHODS
  32
  33 =over 4
  34
  35 =cut
  36
  37 sub _register_columns {
  38   my ($class, @cols) = @_;
  39   my $names = { %{$class->_columns} };
  40   while (my $col = shift @cols) {
  41     $names->{$col} = (ref $cols[0] ? shift : {});
  42   }
  43   $class->_columns($names);
  44 }
  45
  46 sub _mk_column_accessors {
  47   my ($class, @cols) = @_;
  48   $class->mk_group_accessors('column' => @cols);
  49 }
  50
  51 =item add_columns
  52
  53   __PACKAGE__->add_columns(qw/col1 col2 col3/);
  54
  55 Adds columns to the current package, and creates accessors for them
  56
  57 =cut
  58
  59 sub add_columns {
  60   my ($class, @cols) = @_;
  61   $class->_register_columns(@cols);
  62   $class->_mk_column_accessors(@cols);
  63 }
  64
  65 =item search_literal
  66
  67   my @obj    = $class->search_literal($literal_where_cond, @bind);
  68   my $cursor = $class->search_literal($literal_where_cond, @bind);
  69
  70 =cut
  71
  72 sub search_literal {
  73   my ($class, $cond, @vals) = @_;
  74   $cond =~ s/^\s*WHERE//i;
  75   my $attrs = (ref $vals[$#vals] eq 'HASH' ? { %{ pop(@vals) } } : {});
  76   $attrs->{bind} = \@vals;
  77   return $class->search(\$cond, $attrs);
  78 }
  79
  80 =item count_literal
  81
  82   my $count = $class->count_literal($literal_where_cond);
  83
  84 =cut
  85
  86 sub count_literal {
  87   my $class = shift;
  88   return $class->search_literal(@_)->count;
  89 }
  90
  91 =item count
  92
  93   my $count = $class->count({ foo => 3 });
  94
  95 =cut
  96
  97 sub count {
  98   my $class = shift;
  99   return $class->search(@_)->count;
 100 }
 101
 102 =item search
 103
 104   my @obj    = $class->search({ foo => 3 }); # "... WHERE foo = 3"
 105   my $cursor = $class->search({ foo => 3 });
 106
 107 To retrieve all rows, simply call C<search()> with no condition parameter,
 108
 109   my @all = $class->search(); # equivalent to search({})
 110
 111 If you need to pass in additional attributes (see
 112 L<DBIx::Class::ResultSet/Attributes> for details) an empty hash indicates
 113 no condition,
 114
 115   my @all = $class->search({}, { cols => [qw/foo bar/] }); # "SELECT foo, bar FROM $class_table"
 116
 117 =cut
 118
 119 sub resultset {
 120   my $class = shift;
 121
 122   my $rs_class = $class->_resultset_class;
 123   eval "use $rs_class;";
 124   my $rs = $rs_class->new($class, @_);
 125 }
 126
 127 =item search_like
 128
 129 Identical to search except defaults to 'LIKE' instead of '=' in condition
 130
 131 =cut
 132
 133 sub search_like {
 134   my $class    = shift;
 135   my $attrs = { };
 136   if (@_ > 1 && ref $_[$#_] eq 'HASH') {
 137     $attrs = pop(@_);
 138   }
 139   my $query    = ref $_[0] eq "HASH" ? { %{shift()} }: {@_};
 140   $query->{$_} = { 'like' => $query->{$_} } for keys %$query;
 141   return $class->search($query, { %$attrs });
 142 }
 143
 144 sub _select_columns {
 145   return keys %{$_[0]->_columns};
 146 }
 147
 148 =item table
 149
 150   __PACKAGE__->table('tbl_name');
 151
 152 =cut
 153
 154 sub table {
 155   shift->_table_name(@_);
 156 }
 157
 158 =item find_or_create
 159
 160   $class->find_or_create({ key => $val, ... });
 161
 162 Searches for a record matching the search condition; if it doesn't find one,
 163 creates one and returns that instead
 164
 165 =cut
 166
 167 sub find_or_create {
 168   my $class    = shift;
 169   my $hash     = ref $_[0] eq "HASH" ? shift: {@_};
 170   my $exists = $class->find($hash);
 171   return defined($exists) ? $exists : $class->create($hash);
 172 }
 173
 174 =item has_column
 175
 176   if ($obj->has_column($col)) { ... }
 177
 178 Returns 1 if the object has a column of this name, 0 otherwise
 179
 180 =cut
 181
 182 sub has_column {
 183   my ($self, $column) = @_;
 184   return exists $self->_columns->{$column};
 185 }
 186
 187 =item column_info
 188
 189   my $info = $obj->column_info($col);
 190
 191 Returns the column metadata hashref for the column
 192
 193 =cut
 194
 195 sub column_info {
 196   my ($self, $column) = @_;
 197   die "No such column $column" unless exists $self->_columns->{$column};
 198   return $self->_columns->{$column};
 199 }
 200
 201 =item columns
 202
 203   my @column_names = $obj->columns;
 204
 205 =cut
 206
 207 sub columns { return keys %{shift->_columns}; }
 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