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