lib/DBIx/Class/TableInstance.pm

   1 package DBIx::Class::TableInstance;
   2
   3 use strict;
   4 use warnings;
   5
   6 use base qw/DBIx::Class/;
   7 use DBIx::Class::Table;
   8
   9 __PACKAGE__->mk_classdata('table_alias'); # FIXME: Doesn't actually do anything yet!
  10
  11 __PACKAGE__->mk_classdata('_resultset_class' => 'DBIx::Class::ResultSet');
  12
  13 sub iterator_class { shift->table->resultset_class(@_) }
  14 sub resultset_class { shift->table->resultset_class(@_) }
  15 sub _table_name { shift->table->name }
  16
  17 =head1 NAME
  18
  19 DBIx::Class::TableInstance - provides a classdata table object and method proxies
  20
  21 =head1 SYNOPSIS
  22
  23   __PACKAGE__->table('foo');
  24   __PACKAGE__->add_columns(qw/id bar baz/);
  25   __PACKAGE__->set_primary_key('id');
  26
  27 =head1 METHODS
  28
  29 =cut
  30
  31 sub _mk_column_accessors {
  32   my ($class, @cols) = @_;
  33   $class->mk_group_accessors('column' => @cols);
  34 }
  35
  36 =head2 add_columns
  37
  38   __PACKAGE__->add_columns(qw/col1 col2 col3/);
  39
  40 Adds columns to the current class and creates accessors for them.
  41
  42 =cut
  43
  44 sub add_columns {
  45   my ($class, @cols) = @_;
  46   $class->table->add_columns(@cols);
  47   $class->_mk_column_accessors(@cols);
  48 }
  49
  50 sub resultset_instance {
  51   my $class = shift;
  52   $class->table->storage($class->storage);
  53   $class->next::method($class->table->resultset);
  54 }
  55
  56 sub _select_columns {
  57   return shift->table->columns;
  58 }
  59
  60 =head2 table
  61
  62   __PACKAGE__->table('tbl_name');
  63
  64 Gets or sets the table name.
  65
  66 =cut
  67
  68 sub table {
  69   my ($class, $table) = @_;
  70   die "$class->table called and no table instance set yet" unless $table;
  71   unless (ref $table) {
  72     $table = DBIx::Class::Table->new(
  73       {
  74         name => $table,
  75         result_class => $class,
  76         #storage => $class->storage,
  77       });
  78   }
  79   $class->mk_classdata('table' => $table);
  80 }
  81
  82 =head2 find_or_create
  83
  84   $class->find_or_create({ key => $val, ... });
  85
  86 Searches for a record matching the search condition; if it doesn't find one,
  87 creates one and returns that instead.
  88
  89 =cut
  90
  91 sub find_or_create {
  92   my $class    = shift;
  93   my $hash     = ref $_[0] eq "HASH" ? shift: {@_};
  94   my $exists = $class->find($hash);
  95   return defined($exists) ? $exists : $class->create($hash);
  96 }
  97
  98 =head2 has_column
  99
 100   if ($obj->has_column($col)) { ... }
 101
 102 Returns 1 if the class has a column of this name, 0 otherwise.
 103
 104 =cut
 105
 106 sub has_column {
 107   my ($self, $column) = @_;
 108   return $self->table->has_column($column);
 109 }
 110
 111 =head2 column_info
 112
 113   my $info = $obj->column_info($col);
 114
 115 Returns the column metadata hashref for a column.
 116
 117 =cut
 118
 119 sub column_info {
 120   my ($self, $column) = @_;
 121   return $self->table->column_info($column);
 122 }
 123
 124 =head2 columns
 125
 126   my @column_names = $obj->columns;
 127
 128 =cut
 129
 130 sub columns {
 131   return shift->table->columns(@_);
 132 }
 133
 134 1;
 135
 136 =head1 AUTHORS
 137
 138 Matt S. Trout <mst@shadowcatsystems.co.uk>
 139
 140 =head1 LICENSE
 141
 142 You may distribute this code under the same terms as Perl itself.
 143
 144 =cut
 145