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
  49     my $column_info = ref $cols[0] ? shift : {};
  50       # If next entry is { ... } use that for the column info, if not
  51       # use an empty hashref
  52
  53     $self->_columns->{$col} = $column_info;
  54   }
  55 }
  56
  57 *add_column = \&add_columns;
  58
  59 =head2 add_columns
  60
  61   $table->add_columns(qw/col1 col2 col3/);
  62
  63   $table->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
  64
  65 Adds columns to the result source. If supplied key => hashref pairs uses
  66 the hashref as the column_info for that column.
  67
  68 =head2 add_column
  69
  70   $table->add_column('col' => \%info?);
  71
  72 Convenience alias to add_columns
  73
  74 =cut
  75
  76 sub resultset {
  77   my $self = shift;
  78   return $self->resultset_class->new($self);
  79 }
  80
  81 =head2 has_column
  82
  83   if ($obj->has_column($col)) { ... }
  84
  85 Returns 1 if the source has a column of this name, 0 otherwise.
  86
  87 =cut
  88
  89 sub has_column {
  90   my ($self, $column) = @_;
  91   return exists $self->_columns->{$column};
  92 }
  93
  94 =head2 column_info
  95
  96   my $info = $obj->column_info($col);
  97
  98 Returns the column metadata hashref for a column.
  99
 100 =cut
 101
 102 sub column_info {
 103   my ($self, $column) = @_;
 104   croak "No such column $column" unless exists $self->_columns->{$column};
 105   return $self->_columns->{$column};
 106 }
 107
 108 =head2 columns
 109
 110   my @column_names = $obj->columns;
 111
 112 =cut
 113
 114 sub columns {
 115   croak "columns() is a read-only accessor, did you mean add_columns()?" if (@_ > 1);
 116   return keys %{shift->_columns};
 117 }
 118
 119 =head2 ordered_columns
 120
 121   my @column_names = $obj->ordered_columns;
 122
 123 Like columns(), but returns column names using the order in which they were
 124 originally supplied to add_columns().
 125
 126 =cut
 127
 128 sub ordered_columns {
 129   return @{shift->{_ordered_columns}||[]};
 130 }
 131
 132 =head2 set_primary_key(@cols)
 133
 134 Defines one or more columns as primary key for this source. Should be
 135 called after C<add_columns>.
 136
 137 =cut
 138
 139 sub set_primary_key {
 140   my ($self, @cols) = @_;
 141   # check if primary key columns are valid columns
 142   for (@cols) {
 143     $self->throw("No such column $_ on table ".$self->name)
 144       unless $self->has_column($_);
 145   }
 146   $self->_primaries(\@cols);
 147 }
 148
 149 =head2 primary_columns
 150
 151 Read-only accessor which returns the list of primary keys.
 152
 153 =cut
 154
 155 sub primary_columns {
 156   return @{shift->_primaries||[]};
 157 }
 158
 159 =head2 from
 160
 161 Returns an expression of the source to be supplied to storage to specify
 162 retrieval from this source; in the case of a database the required FROM clause
 163 contents.
 164
 165 =cut
 166
 167 =head2 storage
 168
 169 Returns the storage handle for the current schema
 170
 171 =cut
 172
 173 sub storage { shift->schema->storage; }
 174
 175 1;
 176
 177 =head1 AUTHORS
 178
 179 Matt S. Trout <mst@shadowcatsystems.co.uk>
 180
 181 =head1 LICENSE
 182
 183 You may distribute this code under the same terms as Perl itself.
 184
 185 =cut
 186