Fix testing bug. Windows only.
[dbsrgits/DBIx-Class.git] / 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 __PACKAGE__->mk_classdata(table_class => 'DBIx::Class::ResultSource::Table');
9
10 __PACKAGE__->mk_classdata('table_alias'); # FIXME: Doesn't actually do
11                                           # anything yet!
12
13 sub _init_result_source_instance {
14     my $class = shift;
15
16     $class->mk_classdata('result_source_instance')
17         unless $class->can('result_source_instance');
18
19     my $table = $class->result_source_instance;
20     my $class_has_table_instance = ($table and $table->result_class eq $class);
21     return $table if $class_has_table_instance;
22
23     my $table_class = $class->table_class;
24     $class->ensure_class_loaded($table_class);
25
26     if( $table ) {
27         $table = $table_class->new({
28             %$table,
29             result_class => $class,
30             source_name => undef,
31             schema => undef
32         });
33     }
34     else {
35         $table = $table_class->new({
36             name            => undef,
37             result_class    => $class,
38             source_name     => undef,
39         });
40     }
41
42     $class->result_source_instance($table);
43
44     return $table;
45 }
46
47 =head1 NAME
48
49 DBIx::Class::ResultSourceProxy::Table - provides a classdata table
50 object and method proxies
51
52 =head1 SYNOPSIS
53
54   __PACKAGE__->table('cd');
55   __PACKAGE__->add_columns(qw/cdid artist title year/);
56   __PACKAGE__->set_primary_key('cdid');
57
58 =head1 METHODS
59
60 =head2 add_columns
61
62   __PACKAGE__->add_columns(qw/cdid artist title year/);
63
64 Adds columns to the current class and creates accessors for them.
65
66 =cut
67
68 =head2 table
69
70   __PACKAGE__->table('tbl_name');
71
72 Gets or sets the table name.
73
74 =cut
75
76 sub table {
77   my ($class, $table) = @_;
78   return $class->result_source_instance->name unless $table;
79   unless (ref $table) {
80
81     my $table_class = $class->table_class;
82     $class->ensure_class_loaded($table_class);
83
84     $table = $table_class->new({
85         $class->can('result_source_instance') ?
86           %{$class->result_source_instance||{}} : (),
87         name => $table,
88         result_class => $class,
89         source_name => undef,
90     });
91   }
92
93   $class->mk_classdata('result_source_instance')
94     unless $class->can('result_source_instance');
95
96   $class->result_source_instance($table);
97
98   return $class->result_source_instance->name;
99 }
100
101 =head2 has_column
102
103   if ($obj->has_column($col)) { ... }
104
105 Returns 1 if the class has a column of this name, 0 otherwise.
106
107 =cut
108
109 =head2 column_info
110
111   my $info = $obj->column_info($col);
112
113 Returns the column metadata hashref for a column. For a description of
114 the various types of column data in this hashref, see
115 L<DBIx::Class::ResultSource/add_column>
116
117 =cut
118
119 =head2 columns
120
121   my @column_names = $obj->columns;
122
123 =cut
124
125 1;
126
127 =head1 AUTHORS
128
129 Matt S. Trout <mst@shadowcatsystems.co.uk>
130
131 =head1 LICENSE
132
133 You may distribute this code under the same terms as Perl itself.
134
135 =cut
136