Made debugging work and it now exports its parse method.
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Schema / Field.pm
CommitLineData
3c5de62a 1package SQL::Translator::Schema::Field;
2
3# ----------------------------------------------------------------------
42c8fad4 4# $Id: Field.pm,v 1.12 2003-08-12 22:03:59 kycl4rk Exp $
3c5de62a 5# ----------------------------------------------------------------------
6# Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>
7#
8# This program is free software; you can redistribute it and/or
9# modify it under the terms of the GNU General Public License as
10# published by the Free Software Foundation; version 2.
11#
12# This program is distributed in the hope that it will be useful, but
13# WITHOUT ANY WARRANTY; without even the implied warranty of
14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15# General Public License for more details.
16#
17# You should have received a copy of the GNU General Public License
18# along with this program; if not, write to the Free Software
19# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
20# 02111-1307 USA
21# -------------------------------------------------------------------
22
23=pod
24
25=head1 NAME
26
27SQL::Translator::Schema::Field - SQL::Translator field object
28
29=head1 SYNOPSIS
30
31 use SQL::Translator::Schema::Field;
32 my $field = SQL::Translator::Schema::Field->new(
33 name => 'foo',
34 sql => 'select * from foo',
35 );
36
37=head1 DESCRIPTION
38
39C<SQL::Translator::Schema::Field> is the field object.
40
41=head1 METHODS
42
43=cut
44
45use strict;
46use Class::Base;
43b9dc7a 47use SQL::Translator::Schema::Constants;
ec2ab48d 48use SQL::Translator::Utils 'parse_list_arg';
3c5de62a 49
50use base 'Class::Base';
51use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT);
52
42c8fad4 53$VERSION = sprintf "%d.%02d", q$Revision: 1.12 $ =~ /(\d+)\.(\d+)/;
3c5de62a 54
55# ----------------------------------------------------------------------
56sub init {
57
58=pod
59
60=head2 new
61
62Object constructor.
63
64 my $schema = SQL::Translator::Schema::Field->new;
65
66=cut
67
68 my ( $self, $config ) = @_;
43b9dc7a 69
ec2ab48d 70 for my $arg (
71 qw[
72 table name data_type size is_primary_key is_nullable
5ac417ad 73 is_auto_increment default_value comments
ec2ab48d 74 ]
75 ) {
43b9dc7a 76 next unless defined $config->{ $arg };
c941e9bf 77 defined $self->$arg( $config->{ $arg } ) or return;
43b9dc7a 78 }
c941e9bf 79
3c5de62a 80 return $self;
81}
82
83# ----------------------------------------------------------------------
5ac417ad 84sub comments {
85
86=pod
87
88=head2 comments
89
90Get or set the comments on a field. May be called several times to
91set and it will accumulate the comments. Called in an array context,
92returns each comment individually; called in a scalar context, returns
93all the comments joined on newlines.
94
95 $field->comments('foo');
96 $field->comments('bar');
97 print join( ', ', $field->comments ); # prints "foo, bar"
98
99=cut
100
101 my $self = shift;
aadf4042 102
103 for my $arg ( @_ ) {
104 $arg = $arg->[0] if ref $arg;
c33df5c4 105 push @{ $self->{'comments'} }, $arg if $arg;
aadf4042 106 }
5ac417ad 107
c33df5c4 108 if ( @{ $self->{'comments'} || [] } ) {
109 return wantarray
110 ? @{ $self->{'comments'} || [] }
111 : join( "\n", @{ $self->{'comments'} || [] } );
112 }
113 else {
114 return wantarray ? () : '';
115 }
5ac417ad 116}
117
118
119# ----------------------------------------------------------------------
3c5de62a 120sub data_type {
121
122=pod
123
124=head2 data_type
125
43b9dc7a 126Get or set the field's data type.
3c5de62a 127
128 my $data_type = $field->data_type('integer');
129
130=cut
131
132 my $self = shift;
133 $self->{'data_type'} = shift if @_;
134 return $self->{'data_type'} || '';
135}
136
137# ----------------------------------------------------------------------
43b9dc7a 138sub default_value {
139
140=pod
141
142=head2 default_value
143
144Get or set the field's default value. Will return undef if not defined
145and could return the empty string (it's a valid default value), so don't
146assume an error like other methods.
147
148 my $default = $field->default_value('foo');
149
150=cut
151
152 my ( $self, $arg ) = @_;
153 $self->{'default_value'} = $arg if defined $arg;
154 return $self->{'default_value'};
155}
156
157# ----------------------------------------------------------------------
9966eebc 158sub extra {
159
160=pod
161
162=head2 extra
163
164Get or set the field's "extra" attibutes (e.g., "ZEROFILL" for MySQL).
165Accepts a hash(ref) of name/value pairs to store; returns a hash.
166
167 $field->extra( qualifier => 'ZEROFILL' );
168 my %extra = $field->extra;
169
170=cut
171
172 my $self = shift;
173 my $args = ref $_[0] eq 'HASH' ? shift : { @_ };
174
175 while ( my ( $key, $value ) = each %$args ) {
176 $self->{'extra'}{ $key } = $value;
177 }
178
179 return %{ $self->{'extra'} || {} };
180}
181
182# ----------------------------------------------------------------------
183sub foreign_key_reference {
184
185=pod
186
187=head2 foreign_key_reference
188
189Get or set the field's foreign key reference;
190
191 my $constraint = $field->foreign_key_reference( $constraint );
192
193=cut
194
195 my $self = shift;
196
197 if ( my $arg = shift ) {
198 my $class = 'SQL::Translator::Schema::Constraint';
199 if ( UNIVERSAL::isa( $arg, $class ) ) {
200 return $self->error(
201 'Foreign key reference for ', $self->name, 'already defined'
202 ) if $self->{'foreign_key_reference'};
203
204 $self->{'foreign_key_reference'} = $arg;
205 }
206 else {
207 return $self->error(
208 "Argument to foreign_key_reference is not an $class object"
209 );
210 }
211 }
212
213 return $self->{'foreign_key_reference'};
214}
215
216# ----------------------------------------------------------------------
43b9dc7a 217sub is_auto_increment {
218
219=pod
220
221=head2 is_auto_increment
222
223Get or set the field's C<is_auto_increment> attribute.
224
225 my $is_pk = $field->is_auto_increment(1);
226
227=cut
228
229 my ( $self, $arg ) = @_;
230
231 if ( defined $arg ) {
232 $self->{'is_auto_increment'} = $arg ? 1 : 0;
233 }
234
235 unless ( defined $self->{'is_auto_increment'} ) {
236 if ( my $table = $self->table ) {
237 if ( my $schema = $table->schema ) {
238 if (
239 $schema->database eq 'PostgreSQL' &&
240 $self->data_type eq 'serial'
241 ) {
242 $self->{'is_auto_increment'} = 1;
243 }
244 }
245 }
246 }
247
248 return $self->{'is_auto_increment'} || 0;
249}
250
251# ----------------------------------------------------------------------
9966eebc 252sub is_foreign_key {
253
254=pod
255
256=head2 is_foreign_key
257
258Returns whether or not the field is a foreign key.
259
260 my $is_fk = $field->is_foreign_key;
261
262=cut
263
264 my ( $self, $arg ) = @_;
265
266 unless ( defined $self->{'is_foreign_key'} ) {
267 if ( my $table = $self->table ) {
268 for my $c ( $table->get_constraints ) {
269 if ( $c->type eq FOREIGN_KEY ) {
270 my %fields = map { $_, 1 } $c->fields;
271 if ( $fields{ $self->name } ) {
272 $self->{'is_foreign_key'} = 1;
273 $self->foreign_key_reference( $c );
274 last;
275 }
276 }
277 }
278 }
279 }
280
281 return $self->{'is_foreign_key'} || 0;
282}
283
9966eebc 284# ----------------------------------------------------------------------
ec2ab48d 285sub is_nullable {
286
287=pod
288
289=head2 is_nullable
290
291Get or set the whether the field can be null. If not defined, then
292returns "1" (assumes the field can be null). The argument is evaluated
293by Perl for True or False, so the following are eqivalent:
294
295 $is_nullable = $field->is_nullable(0);
296 $is_nullable = $field->is_nullable('');
297 $is_nullable = $field->is_nullable('0');
298
299While this is technically a field constraint, it's probably easier to
300represent this as an attribute of the field. In order keep things
301consistent, any other constraint on the field (unique, primary, and
302foreign keys; checks) are represented as table constraints.
303
304=cut
305
306 my ( $self, $arg ) = @_;
307
308 if ( defined $arg ) {
309 $self->{'is_nullable'} = $arg ? 1 : 0;
310 }
311
42c8fad4 312 if (
313 defined $self->{'is_nullable'} &&
314 $self->{'is_nullable'} == 1 &&
315 $self->is_primary_key
316 ) {
317 $self->{'is_nullable'} = 0;
318 }
319
ec2ab48d 320 return defined $self->{'is_nullable'} ? $self->{'is_nullable'} : 1;
321}
322
323# ----------------------------------------------------------------------
3c5de62a 324sub is_primary_key {
325
326=pod
327
328=head2 is_primary_key
329
ec2ab48d 330Get or set the field's C<is_primary_key> attribute. Does not create
331a table constraint (should it?).
3c5de62a 332
333 my $is_pk = $field->is_primary_key(1);
334
335=cut
336
337 my ( $self, $arg ) = @_;
338
339 if ( defined $arg ) {
340 $self->{'is_primary_key'} = $arg ? 1 : 0;
341 }
342
43b9dc7a 343 unless ( defined $self->{'is_primary_key'} ) {
344 if ( my $table = $self->table ) {
345 if ( my $pk = $table->primary_key ) {
346 my %fields = map { $_, 1 } $pk->fields;
347 $self->{'is_primary_key'} = $fields{ $self->name } || 0;
348 }
349 else {
350 $self->{'is_primary_key'} = 0;
351 }
352 }
353 }
354
3c5de62a 355 return $self->{'is_primary_key'} || 0;
356}
357
358# ----------------------------------------------------------------------
ee2766f4 359sub is_unique {
360
361=pod
362
363=head2 is_unique
364
365Determine whether the field has a UNIQUE constraint or not.
366
367 my $is_unique = $field->is_unique;
368
369=cut
370
371 my $self = shift;
372
373 unless ( defined $self->{'is_unique'} ) {
374 if ( my $table = $self->table ) {
375 for my $c ( $table->get_constraints ) {
376 if ( $c->type eq UNIQUE ) {
377 my %fields = map { $_, 1 } $c->fields;
378 if ( $fields{ $self->name } ) {
379 $self->{'is_unique'} = 1;
380 last;
381 }
382 }
383 }
384 }
385 }
386
387 return $self->{'is_unique'} || 0;
388}
389
390# ----------------------------------------------------------------------
ec2ab48d 391sub is_valid {
392
393=pod
394
395=head2 is_valid
396
397Determine whether the field is valid or not.
398
399 my $ok = $field->is_valid;
400
401=cut
402
403 my $self = shift;
404 return $self->error('No name') unless $self->name;
405 return $self->error('No data type') unless $self->data_type;
406 return $self->error('No table object') unless $self->table;
407 return 1;
408}
409
410# ----------------------------------------------------------------------
3c5de62a 411sub name {
412
413=pod
414
415=head2 name
416
417Get or set the field's name.
418
419 my $name = $field->name('foo');
420
421=cut
422
423 my $self = shift;
43b9dc7a 424
425 if ( my $arg = shift ) {
426 if ( my $table = $self->table ) {
427 return $self->error( qq[Can't use field name "$arg": table exists] )
428 if $table->get_field( $arg );
429 }
430
431 $self->{'name'} = $arg;
432 }
433
3c5de62a 434 return $self->{'name'} || '';
435}
436
437# ----------------------------------------------------------------------
ec2ab48d 438sub order {
3c5de62a 439
440=pod
441
ec2ab48d 442=head2 order
3c5de62a 443
ec2ab48d 444Get or set the field's order.
3c5de62a 445
ec2ab48d 446 my $order = $field->order(3);
3c5de62a 447
448=cut
449
450 my ( $self, $arg ) = @_;
451
ec2ab48d 452 if ( defined $arg && $arg =~ /^\d+$/ ) {
453 $self->{'order'} = $arg;
3c5de62a 454 }
455
ec2ab48d 456 return $self->{'order'} || 0;
43b9dc7a 457}
458
459# ----------------------------------------------------------------------
460sub size {
461
462=pod
463
464=head2 size
465
466Get or set the field's size. Accepts a string, array or arrayref of
467numbers and returns a string.
468
469 $field->size( 30 );
470 $field->size( [ 255 ] );
471 $size = $field->size( 10, 2 );
472 print $size; # prints "10,2"
473
474 $size = $field->size( '10, 2' );
475 print $size; # prints "10,2"
476
477=cut
478
479 my $self = shift;
ec2ab48d 480 my $numbers = parse_list_arg( @_ );
43b9dc7a 481
482 if ( @$numbers ) {
483 my @new;
484 for my $num ( @$numbers ) {
485 if ( defined $num && $num =~ m/^\d+(?:\.\d+)?$/ ) {
486 push @new, $num;
487 }
488 }
489 $self->{'size'} = \@new if @new; # only set if all OK
490 }
491
ec2ab48d 492 return wantarray
aadf4042 493 ? @{ $self->{'size'} || [0] }
ec2ab48d 494 : join( ',', @{ $self->{'size'} || [0] } )
495 ;
43b9dc7a 496}
497
498# ----------------------------------------------------------------------
499sub table {
500
501=pod
502
503=head2 table
504
505Get or set the field's table object.
506
507 my $table = $field->table;
508
509=cut
510
511 my $self = shift;
512 if ( my $arg = shift ) {
513 return $self->error('Not a table object') unless
514 UNIVERSAL::isa( $arg, 'SQL::Translator::Schema::Table' );
515 $self->{'table'} = $arg;
516 }
517
518 return $self->{'table'};
3c5de62a 519}
520
ec2ab48d 521# ----------------------------------------------------------------------
522sub DESTROY {
9966eebc 523#
524# Destroy cyclical references.
525#
ec2ab48d 526 my $self = shift;
9966eebc 527 undef $self->{'table'};
528 undef $self->{'foreign_key_reference'};
ec2ab48d 529}
530
3c5de62a 5311;
532
533# ----------------------------------------------------------------------
534
535=pod
536
537=head1 AUTHOR
538
539Ken Y. Clark E<lt>kclark@cpan.orgE<gt>
540
541=cut