lib/DBIx/Class/ResultSource.pm

   1 package DBIx::Class::ResultSource;
   2
   3 use strict;
   4 use warnings;
   5
   6 use DBIx::Class::ResultSet;
   7
   8 use Carp qw/croak/;
   9
  10 use base qw/DBIx::Class/;
  11 __PACKAGE__->load_components(qw/AccessorGroup/);
  12
  13 __PACKAGE__->mk_group_accessors('simple' =>
  14   qw/_ordered_columns _columns _primaries name resultset_class result_class schema from/);
  15
  16 =head1 NAME
  17
  18 DBIx::Class::ResultSource - Result source object
  19
  20 =head1 SYNOPSIS
  21
  22 =head1 DESCRIPTION
  23
  24 A ResultSource is a component of a schema from which results can be directly
  25 retrieved, most usually a table (see L<DBIx::Class::ResultSource::Table>)
  26
  27 =head1 METHODS
  28
  29 =cut
  30
  31 sub new {
  32   my ($class, $attrs) = @_;
  33   $class = ref $class if ref $class;
  34   my $new = bless({ %{$attrs || {}} }, $class);
  35   $new->{resultset_class} ||= 'DBIx::Class::ResultSet';
  36   $new->{_ordered_columns} ||= [];
  37   $new->{_columns} ||= {};
  38   $new->{name} ||= "!!NAME NOT SET!!";
  39   return $new;
  40 }
  41
  42 sub add_columns {
  43   my ($self, @cols) = @_;
  44   $self->_ordered_columns( \@cols )
  45     if !$self->_ordered_columns;
  46   push @{ $self->_ordered_columns }, @cols;
  47   while (my $col = shift @cols) {
  48     $self->_columns->{$col} = (ref $cols[0] ? shift : {});
  49   }
  50 }
  51
  52 *add_column = \&add_columns;
  53
  54 =head2 add_columns
  55
  56   $table->add_columns(qw/col1 col2 col3/);
  57
  58   $table->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
  59
  60 Adds columns to the result source. If supplied key => hashref pairs uses
  61 the hashref as the column_info for that column.
  62
  63 =head2 add_column
  64
  65   $table->add_column('col' => \%info?);
  66
  67 Convenience alias to add_columns
  68
  69 =cut
  70
  71 sub resultset {
  72   my $self = shift;
  73   return $self->resultset_class->new($self);
  74 }
  75
  76 =head2 has_column
  77
  78   if ($obj->has_column($col)) { ... }
  79
  80 Returns 1 if the source has a column of this name, 0 otherwise.
  81
  82 =cut
  83
  84 sub has_column {
  85   my ($self, $column) = @_;
  86   return exists $self->_columns->{$column};
  87 }
  88
  89 =head2 column_info
  90
  91   my $info = $obj->column_info($col);
  92
  93 Returns the column metadata hashref for a column.
  94
  95 =cut
  96
  97 sub column_info {
  98   my ($self, $column) = @_;
  99   croak "No such column $column" unless exists $self->_columns->{$column};
 100   return $self->_columns->{$column};
 101 }
 102
 103 =head2 columns
 104
 105   my @column_names = $obj->columns;
 106
 107 =cut
 108
 109 sub columns {
 110   croak "columns() is a read-only accessor, did you mean add_columns()?" if (@_ > 1);
 111   return keys %{shift->_columns};
 112 }
 113
 114 =head2 ordered_columns
 115
 116   my @column_names = $obj->ordered_columns;
 117
 118 Like columns(), but returns column names using the order in which they were
 119 originally supplied to add_columns().
 120
 121 =cut
 122
 123 sub ordered_columns {
 124   return @{shift->{_ordered_columns}||[]};
 125 }
 126
 127 =head2 set_primary_key(@cols)
 128
 129 Defines one or more columns as primary key for this source. Should be
 130 called after C<add_columns>.
 131
 132 =cut
 133
 134 sub set_primary_key {
 135   my ($self, @cols) = @_;
 136   # check if primary key columns are valid columns
 137   for (@cols) {
 138     $self->throw("No such column $_ on table ".$self->name)
 139       unless $self->has_column($_);
 140   }
 141   $self->_primaries(\@cols);
 142 }
 143
 144 =head2 primary_columns
 145
 146 Read-only accessor which returns the list of primary keys.
 147
 148 =cut
 149
 150 sub primary_columns {
 151   return @{shift->_primaries||[]};
 152 }
 153
 154 =head2 from
 155
 156 Returns an expression of the source to be supplied to storage to specify
 157 retrieval from this source; in the case of a database the required FROM clause
 158 contents.
 159
 160 =cut
 161
 162 =head2 storage
 163
 164 Returns the storage handle for the current schema
 165
 166 =cut
 167
 168 sub storage { shift->schema->storage; }
 169
 170 1;
 171
 172 =head1 AUTHORS
 173
 174 Matt S. Trout <mst@shadowcatsystems.co.uk>
 175
 176 =head1 LICENSE
 177
 178 You may distribute this code under the same terms as Perl itself.
 179
 180 =cut
 181