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('table_class' => 'DBIx::Class::Table');
  12
  13 sub iterator_class { shift->result_source->resultset_class(@_) }
  14 sub resultset_class { shift->result_source->resultset_class(@_) }
  15 sub _table_name { shift->result_source->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->result_source->add_columns(@cols);
  47   $class->_mk_column_accessors(@cols);
  48 }
  49
  50 sub _select_columns {
  51   return shift->result_source->columns;
  52 }
  53
  54 =head2 table
  55
  56   __PACKAGE__->table('tbl_name');
  57
  58 Gets or sets the table name.
  59
  60 =cut
  61
  62 sub table {
  63   my ($class, $table) = @_;
  64   return $class->result_source->name unless $table;
  65   unless (ref $table) {
  66     $table = $class->table_class->new(
  67       {
  68         name => $table,
  69         result_class => $class,
  70       });
  71     if ($class->can('result_source')) {
  72       $table->{_columns} = { %{$class->result_source->{_columns}||{}} };
  73     }
  74   }
  75   $class->mk_classdata('result_source' => $table);
  76   if ($class->can('schema_instance')) {
  77     $class =~ m/([^:]+)$/;
  78     $class->schema_instance->register_class($class, $class);
  79   }
  80 }
  81
  82 =head2 has_column
  83
  84   if ($obj->has_column($col)) { ... }
  85
  86 Returns 1 if the class has a column of this name, 0 otherwise.
  87
  88 =cut
  89
  90 sub has_column {
  91   my ($self, $column) = @_;
  92   return $self->result_source->has_column($column);
  93 }
  94
  95 =head2 column_info
  96
  97   my $info = $obj->column_info($col);
  98
  99 Returns the column metadata hashref for a column.
 100
 101 =cut
 102
 103 sub column_info {
 104   my ($self, $column) = @_;
 105   return $self->result_source->column_info($column);
 106 }
 107
 108 =head2 columns
 109
 110   my @column_names = $obj->columns;
 111
 112 =cut
 113
 114 sub columns {
 115   return shift->result_source->columns(@_);
 116 }
 117
 118 sub set_primary_key { shift->result_source->set_primary_key(@_); }
 119 sub primary_columns { shift->result_source->primary_columns(@_); }
 120
 121 1;
 122
 123 =head1 AUTHORS
 124
 125 Matt S. Trout <mst@shadowcatsystems.co.uk>
 126
 127 =head1 LICENSE
 128
 129 You may distribute this code under the same terms as Perl itself.
 130
 131 =cut
 132