lib/DBIx/Class/ResultSourceProxy/Table.pm

   1 package DBIx::Class::ResultSourceProxy::Table;
   2
   3 use strict;
   4 use warnings;
   5
   6 use base qw/DBIx::Class::ResultSourceProxy/;
   7
   8 use DBIx::Class::ResultSource::Table;
   9 use Scalar::Util 'blessed';
  10 use namespace::clean;
  11
  12 # FIXME - both of these *PROBABLY* need to be 'inherited_ro_instance' type
  13 __PACKAGE__->mk_classaccessor(table_class => 'DBIx::Class::ResultSource::Table');
  14 # FIXME: Doesn't actually do anything yet!
  15 __PACKAGE__->mk_group_accessors( inherited => 'table_alias' );
  16
  17 sub _init_result_source_instance {
  18     my $class = shift;
  19
  20     $class->mk_group_accessors( inherited => [ result_source_instance => '_result_source' ] )
  21       unless $class->can('result_source_instance');
  22
  23     # might be pre-made for us courtesy of DBIC::DB::result_source_instance()
  24     my $rsrc = $class->result_source_instance;
  25
  26     return $rsrc
  27       if $rsrc and $rsrc->result_class eq $class;
  28
  29     my $table_class = $class->table_class;
  30     $class->ensure_class_loaded($table_class);
  31
  32     if( $rsrc ) {
  33         #
  34         # NOTE! - not using clone() here and *NOT* marking source as derived
  35         # from the one already existing on the class (if any)
  36         #
  37         $rsrc = $table_class->new({
  38             %$rsrc,
  39             result_class => $class,
  40             source_name => undef,
  41             schema => undef
  42         });
  43     }
  44     else {
  45         $rsrc = $table_class->new({
  46             name            => undef,
  47             result_class    => $class,
  48             source_name     => undef,
  49         });
  50     }
  51
  52     $class->result_source_instance($rsrc);
  53 }
  54
  55 =head1 NAME
  56
  57 DBIx::Class::ResultSourceProxy::Table - provides a classdata table
  58 object and method proxies
  59
  60 =head1 SYNOPSIS
  61
  62   __PACKAGE__->table('cd');
  63   __PACKAGE__->add_columns(qw/cdid artist title year/);
  64   __PACKAGE__->set_primary_key('cdid');
  65
  66 =head1 METHODS
  67
  68 =head2 add_columns
  69
  70   __PACKAGE__->add_columns(qw/cdid artist title year/);
  71
  72 Adds columns to the current class and creates accessors for them.
  73
  74 =cut
  75
  76 =head2 table
  77
  78   __PACKAGE__->table('tbl_name');
  79
  80 Gets or sets the table name.
  81
  82 =cut
  83
  84 sub table {
  85   return $_[0]->result_source->name unless @_ > 1;
  86
  87   my ($class, $table) = @_;
  88
  89   unless (blessed $table && $table->isa($class->table_class)) {
  90
  91     my $ancestor = $class->can('result_source_instance')
  92       ? $class->result_source_instance
  93       : undef
  94     ;
  95
  96     # Folks calling ->table on a class *might* expect the name
  97     # to shift everywhere, but that can't happen
  98     # So what we do is mark the ancestor as "dirty"
  99     # even though it will have no "derived" link to the one we
 100     # will use afterwards
 101     if(
 102       defined $ancestor
 103         and
 104       $ancestor->name ne $table
 105         and
 106       scalar $ancestor->__derived_instances
 107     ) {
 108       # Trigger the "descendants are dirty" logic, without giving
 109       # it an explicit externally-callable interface
 110       # This is ugly as sin, but likely saner in the long run
 111       local $ancestor->{__in_rsrc_setter_callstack} = 1
 112         unless $ancestor->{__in_rsrc_setter_callstack};
 113       my $old_name = $ancestor->name;
 114       $ancestor->set_rsrc_instance_specific_attribute( name => "\0" );
 115       $ancestor->set_rsrc_instance_specific_attribute( name => $old_name );
 116     }
 117
 118
 119     my $table_class = $class->table_class;
 120     $class->ensure_class_loaded($table_class);
 121
 122
 123     # NOTE! - not using clone() here and *NOT* marking source as derived
 124     # from the one already existing on the class (if any)
 125     # This is logically sound as we are operating at class-level, and is
 126     # in fact necessary, as otherwise any base-class with a "dummy" table
 127     # will be marked as an ancestor of everything
 128     $table = $table_class->new({
 129         %{ $ancestor || {} },
 130         name => $table,
 131         result_class => $class,
 132     });
 133   }
 134
 135   $class->mk_group_accessors( inherited => [ result_source_instance => '_result_source' ] )
 136     unless $class->can('result_source_instance');
 137
 138   $class->result_source_instance($table)->name;
 139 }
 140
 141 =head2 table_class
 142
 143   __PACKAGE__->table_class('DBIx::Class::ResultSource::Table');
 144
 145 Gets or sets the table class used for construction and validation.
 146
 147 =head2 has_column
 148
 149   if ($obj->has_column($col)) { ... }
 150
 151 Returns 1 if the class has a column of this name, 0 otherwise.
 152
 153 =head2 column_info
 154
 155   my $info = $obj->column_info($col);
 156
 157 Returns the column metadata hashref for a column. For a description of
 158 the various types of column data in this hashref, see
 159 L<DBIx::Class::ResultSource/add_column>
 160
 161 =head2 columns
 162
 163   my @column_names = $obj->columns;
 164
 165 =head1 FURTHER QUESTIONS?
 166
 167 Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
 168
 169 =head1 COPYRIGHT AND LICENSE
 170
 171 This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
 172 by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
 173 redistribute it and/or modify it under the same terms as the
 174 L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
 175
 176 =cut
 177
 178 1;
 179
 180