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 __PACKAGE__->load_components(qw/AccessorGroup/);
  10
  11 __PACKAGE__->mk_group_accessors('simple' =>
  12   qw/_columns name resultset_class result_class storage/);
  13
  14 =head1 NAME
  15
  16 DBIx::Class::Table - Table object
  17
  18 =head1 SYNOPSIS
  19
  20 =head1 DESCRIPTION
  21
  22 This class is responsible for defining and doing table-level operations on
  23 L<DBIx::Class> classes.
  24
  25 =head1 METHODS
  26
  27 =cut
  28
  29 sub new {
  30   my ($class, $attrs) = @_;
  31   $class = ref $class if ref $class;
  32   my $new = bless($attrs || {}, $class);
  33   $new->{resultset_class} ||= 'DBIx::Class::ResultSet';
  34   $new->{_columns} ||= {};
  35   $new->{name} ||= "!!NAME NOT SET!!";
  36   return $new;
  37 }
  38
  39 sub add_columns {
  40   my ($self, @cols) = @_;
  41   while (my $col = shift @cols) {
  42     $self->add_column($col => (ref $cols[0] ? shift : {}));
  43   }
  44 }
  45
  46 sub add_column {
  47   my ($self, $col, $info) = @_;
  48   $self->_columns->{$col} = $info || {};
  49 }
  50
  51 =head2 add_columns
  52
  53   $table->add_columns(qw/col1 col2 col3/);
  54
  55   $table->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
  56
  57 Adds columns to the table object. If supplied key => hashref pairs uses
  58 the hashref as the column_info for that column.
  59
  60 =cut
  61
  62 sub resultset {
  63   my $self = shift;
  64   my $rs_class = $self->resultset_class;
  65   eval "use $rs_class;";
  66   return $rs_class->new($self);
  67 }
  68
  69 =head2 has_column
  70
  71   if ($obj->has_column($col)) { ... }
  72
  73 Returns 1 if the table has a column of this name, 0 otherwise.
  74
  75 =cut
  76
  77 sub has_column {
  78   my ($self, $column) = @_;
  79   return exists $self->_columns->{$column};
  80 }
  81
  82 =head2 column_info
  83
  84   my $info = $obj->column_info($col);
  85
  86 Returns the column metadata hashref for a column.
  87
  88 =cut
  89
  90 sub column_info {
  91   my ($self, $column) = @_;
  92   die "No such column $column" unless exists $self->_columns->{$column};
  93   return $self->_columns->{$column};
  94 }
  95
  96 =head2 columns
  97
  98   my @column_names = $obj->columns;
  99
 100 =cut
 101
 102 sub columns {
 103   die "columns() is a read-only accessor, did you mean add_columns()?" if (@_ > 1);
 104   return keys %{shift->_columns};
 105 }
 106
 107 1;
 108
 109 =head1 AUTHORS
 110
 111 Matt S. Trout <mst@shadowcatsystems.co.uk>
 112
 113 =head1 LICENSE
 114
 115 You may distribute this code under the same terms as Perl itself.
 116
 117 =cut
 118