[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Schema / Constraint.pm

package SQL::Translator::Schema::Constraint;

# ----------------------------------------------------------------------
# $Id: Constraint.pm,v 1.2 2003-05-05 04:32:39 kycl4rk Exp $
# ----------------------------------------------------------------------
# Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation; version 2.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
# 02111-1307  USA
# -------------------------------------------------------------------

=pod

=head1 NAME

SQL::Translator::Schema::Constraint - SQL::Translator constraint object

=head1 SYNOPSIS

  use SQL::Translator::Schema::Constraint;
  my $constraint = SQL::Translator::Schema::Constraint->new(
      name   => 'foo',
      fields => [ id ],
      type   => PRIMARY_KEY,
  );

=head1 DESCRIPTION

C<SQL::Translator::Schema::Constraint> is the constraint object.

=head1 METHODS

=cut

use strict;
use Class::Base;
use SQL::Translator::Schema::Constants;

use base 'Class::Base';
use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT);

$VERSION = 1.00;

use constant VALID_TYPE => {
    PRIMARY_KEY, 1,
    UNIQUE,      1,
    CHECK_C,     1,
    FOREIGN_KEY, 1,
};

# ----------------------------------------------------------------------
sub init {

=pod

=head2 new

Object constructor.

  my $schema           =  SQL::Translator::Schema::Constraint->new(
      table            => $table,        # the table to which it belongs
      type             => 'foreign_key', # type of table constraint
      name             => 'fk_phone_id', # the name of the constraint
      fields           => 'phone_id',    # the field in the referring table
      reference_fields => 'phone_id',    # the referenced table
      reference_table  => 'phone',       # the referenced fields
      match_type       => 'full',        # how to match
      on_delete_do     => 'cascade',     # what to do on deletes
      on_update_do     => '',            # what to do on updates
  );

=cut

    my ( $self, $config ) = @_;
#        match_type on_delete_do on_update_do
    my @fields = qw[ name type fields reference_fields reference_table table ];

    for my $arg ( @fields ) {
        next unless $config->{ $arg };
        $self->$arg( $config->{ $arg } ) or return;
    }

    return $self;
}

# ----------------------------------------------------------------------
sub deferrable {

=pod

=head2 deferrable

Get or set the whether the constraint is deferrable.  If not defined,
then returns "1."  The argument is evaluated by Perl for True or
False, so the following are eqivalent:

  $deferrable = $field->deferrable(0);
  $deferrable = $field->deferrable('');
  $deferrable = $field->deferrable('0');

=cut

    my ( $self, $arg ) = @_;

    if ( defined $arg ) {
        $self->{'deferrable'} = $arg ? 1 : 0;
    }

    return defined $self->{'deferrable'} ? $self->{'deferrable'} : 1;
}

# ----------------------------------------------------------------------
sub expression {

=pod

=head2 expression

Gets and set the expression used in a CHECK constraint.

  my $expression = $constraint->expression('...');

=cut

    my $self = shift;
    
    if ( my $arg = shift ) {
        # check arg here?
        $self->{'expression'} = $arg;
    }

    return $self->{'expression'} || '';
}

# ----------------------------------------------------------------------
sub is_valid {

=pod

=head2 is_valid

Determine whether the constraint is valid or not.

  my $ok = $constraint->is_valid;

=cut

    my $self       = shift;
    my $type       = $self->type   or return $self->error('No type');
    my $table      = $self->table  or return $self->error('No table');
    my @fields     = $self->fields or return $self->error('No fields');
    my $table_name = $table->name  or return $self->error('No table name');

    for my $f ( @fields ) {
        next if $table->get_field( $f );
        return $self->error(
            "Constraint references non-existent field '$f' ",
            "in table '$table_name'"
        );
    }

    my $schema = $table->schema or return $self->error(
        'Table ', $table->name, ' has no schema object'
    );

    if ( $type eq FOREIGN_KEY ) {
        return $self->error('Only one field allowed for foreign key')
            if scalar @fields > 1;

        my $ref_table_name  = $self->reference_table or 
            return $self->error('No reference table');

        my $ref_table = $schema->get_table( $ref_table_name ) or
            return $self->error("No table named '$ref_table_name' in schema");

        my @ref_fields = $self->reference_fields or return;

        return $self->error('Only one field allowed for foreign key reference')
            if scalar @ref_fields > 1;

        for my $ref_field ( @ref_fields ) {
            next if $ref_table->get_field( $ref_field );
            return $self->error(
                "Constraint from field(s) ", 
                join(', ', map {qq['$table_name.$_']} @fields),
                " to non-existent field '$ref_table_name.$ref_field'"
            );
        }
    }
    elsif ( $type eq CHECK_C ) {
        return $self->error('No expression for CHECK') unless 
            $self->expression;
    }

    return 1;
}

# ----------------------------------------------------------------------
sub fields {

=pod

=head2 fields

Gets and set the fields the constraint is on.  Accepts a string, list or
arrayref; returns an array or array reference.  Will unique the field
names and keep them in order by the first occurrence of a field name.

  $constraint->fields('id');
  $constraint->fields('id', 'name');
  $constraint->fields( 'id, name' );
  $constraint->fields( [ 'id', 'name' ] );
  $constraint->fields( qw[ id name ] );

  my @fields = $constraint->fields;

=cut

    my $self   = shift;
    my $fields = UNIVERSAL::isa( $_[0], 'ARRAY' ) 
        ? shift : [ map { s/^\s+|\s+$//g; $_ } map { split /,/ } @_ ];

    if ( @$fields ) {
        my ( %unique, @unique );
        for my $f ( @$fields ) {
            next if $unique{ $f };
            $unique{ $f } = 1;
            push @unique, $f;
        }

        $self->{'fields'} = \@unique;
    }

    return wantarray ? @{ $self->{'fields'} || [] } : $self->{'fields'};
}

# ----------------------------------------------------------------------
sub name {

=pod

=head2 name

Get or set the constraint's name.

  my $name = $constraint->name('foo');

=cut

    my $self = shift;
    $self->{'name'} = shift if @_;
    return $self->{'name'} || '';
}

# ----------------------------------------------------------------------
sub on_delete {

=pod

=head2 on_delete

Get or set the constraint's "on delete" action.

  my $action = $constraint->on_delete('cascade');

=cut

    my $self = shift;
    
    if ( my $arg = shift ) {
        # validate $arg?
        $self->{'on_delete'} = $arg;
    }

    return $self->{'on_delete'} || '';
}

# ----------------------------------------------------------------------
sub on_update {

=pod

=head2 on_update

Get or set the constraint's "on update" action.

  my $action = $constraint->on_update('no action');

=cut

    my $self = shift;
    
    if ( my $arg = shift ) {
        # validate $arg?
        $self->{'on_update'} = $arg;
    }

    return $self->{'on_update'} || '';
}

# ----------------------------------------------------------------------
sub reference_fields {

=pod

=head2 reference_fields

Gets and set the fields in the referred table.  Accepts a string, list or
arrayref; returns an array or array reference.

  $constraint->reference_fields('id');
  $constraint->reference_fields('id', 'name');
  $constraint->reference_fields( 'id, name' );
  $constraint->reference_fields( [ 'id', 'name' ] );
  $constraint->reference_fields( qw[ id name ] );

  my @reference_fields = $constraint->reference_fields;

=cut

    my $self   = shift;
    my $fields = UNIVERSAL::isa( $_[0], 'ARRAY' ) 
        ? shift : [ map { s/^\s+|\s+$//g; $_ } map { split /,/ } @_ ];

    if ( @$fields ) {
        $self->{'reference_fields'} = $fields;
    }

    unless ( ref $self->{'reference_fields'} ) {
        my $table          = $self->table or return $self->error('No table');
        my $schema         = $table->schema or return $self->error('No schema');
        my $ref_table_name = $self->reference_table or 
            return $self->error('No table');
        my $ref_table      = $schema->get_table( $ref_table_name ) or
            return $self->error("Can't find table '$ref_table_name'");

        if ( my $constraint = $ref_table->primary_key ) { 
            $self->{'reference_fields'} = [ $constraint->fields ];
        }
        else {
            $self->error(
                'No reference fields defined and cannot find primary key in ',
                "reference table '$ref_table_name'"
            );
        }
    }

    if ( ref $self->{'reference_fields'} ) {
        return wantarray 
            ?  @{ $self->{'reference_fields'} || [] } 
            :     $self->{'reference_fields'};
    }
    else {
        return wantarray ? () : [];
    }
}

# ----------------------------------------------------------------------
sub reference_table {

=pod

=head2 reference_table

Get or set the table referred to by the constraint.

  my $reference_table = $constraint->reference_table('foo');

=cut

    my $self = shift;
    $self->{'reference_table'} = shift if @_;
    return $self->{'reference_table'} || '';
}


# ----------------------------------------------------------------------
sub type {

=pod

=head2 type

Get or set the constraint's type.

  my $type = $constraint->type( PRIMARY_KEY );

=cut

    my $self = shift;

    if ( my $type = shift ) {
        return $self->error("Invalid constraint type: $type") 
            unless VALID_TYPE->{ $type };
        $self->{'type'} = $type;
    }

    return $self->{'type'} || '';
}


# ----------------------------------------------------------------------
sub table {

=pod

=head2 table

Get or set the field's table object.

  my $table = $field->table;

=cut

    my $self = shift;
    if ( my $arg = shift ) {
        return $self->error('Not a table object') unless
            UNIVERSAL::isa( $arg, 'SQL::Translator::Schema::Table' );
        $self->{'table'} = $arg;
    }

    return $self->{'table'};
}

# ----------------------------------------------------------------------
sub options {

=pod

=head2 options

Gets or adds to the constraints's options (e.g., "INITIALLY IMMEDIATE").  
Returns an array or array reference.

  $constraint->options('NORELY');
  my @options = $constraint->options;

=cut

    my $self    = shift;
    my $options = UNIVERSAL::isa( $_[0], 'ARRAY' ) 
        ? shift : [ map { s/^\s+|\s+$//g; $_ } map { split /,/ } @_ ];

    push @{ $self->{'options'} }, @$options;

    if ( ref $self->{'options'} ) {
        return wantarray ? @{ $self->{'options'} || [] } : $self->{'options'};
    }
    else {
        return wantarray ? () : [];
    }
}

1;

# ----------------------------------------------------------------------

=pod

=head1 AUTHOR

Ken Y. Clark E<lt>kclark@cpan.orgE<gt>

=cut
Commit	Line	Data
3c5de62a	1	package SQL::Translator::Schema::Constraint;
	2
	3	# ----------------------------------------------------------------------
43b9dc7a	4	# $Id: Constraint.pm,v 1.2 2003-05-05 04:32:39 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
	27	SQL::Translator::Schema::Constraint - SQL::Translator constraint object
	28
	29	=head1 SYNOPSIS
	30
	31	use SQL::Translator::Schema::Constraint;
	32	my $constraint = SQL::Translator::Schema::Constraint->new(
	33	name => 'foo',
	34	fields => [ id ],
43b9dc7a	35	type => PRIMARY_KEY,
3c5de62a	36	);
	37
	38	=head1 DESCRIPTION
	39
	40	C<SQL::Translator::Schema::Constraint> is the constraint object.
	41
	42	=head1 METHODS
	43
	44	=cut
	45
	46	use strict;
	47	use Class::Base;
43b9dc7a	48	use SQL::Translator::Schema::Constants;
3c5de62a	49
	50	use base 'Class::Base';
	51	use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT);
	52
	53	$VERSION = 1.00;
	54
	55	use constant VALID_TYPE => {
43b9dc7a	56	PRIMARY_KEY, 1,
	57	UNIQUE, 1,
	58	CHECK_C, 1,
	59	FOREIGN_KEY, 1,
3c5de62a	60	};
	61
	62	# ----------------------------------------------------------------------
	63	sub init {
	64
	65	=pod
	66
	67	=head2 new
	68
	69	Object constructor.
	70
	71	my $schema = SQL::Translator::Schema::Constraint->new(
43b9dc7a	72	table => $table, # the table to which it belongs
3c5de62a	73	type => 'foreign_key', # type of table constraint
	74	name => 'fk_phone_id', # the name of the constraint
	75	fields => 'phone_id', # the field in the referring table
	76	reference_fields => 'phone_id', # the referenced table
	77	reference_table => 'phone', # the referenced fields
	78	match_type => 'full', # how to match
	79	on_delete_do => 'cascade', # what to do on deletes
	80	on_update_do => '', # what to do on updates
	81	);
	82
	83	=cut
	84
	85	my ( $self, $config ) = @_;
3c5de62a	86	# match_type on_delete_do on_update_do
43b9dc7a	87	my @fields = qw[ name type fields reference_fields reference_table table ];
3c5de62a	88
	89	for my $arg ( @fields ) {
	90	next unless $config->{ $arg };
	91	$self->$arg( $config->{ $arg } ) or return;
	92	}
	93
	94	return $self;
	95	}
	96
	97	# ----------------------------------------------------------------------
43b9dc7a	98	sub deferrable {
	99
	100	=pod
	101
	102	=head2 deferrable
	103
	104	Get or set the whether the constraint is deferrable. If not defined,
	105	then returns "1." The argument is evaluated by Perl for True or
	106	False, so the following are eqivalent:
	107
	108	$deferrable = $field->deferrable(0);
	109	$deferrable = $field->deferrable('');
	110	$deferrable = $field->deferrable('0');
	111
	112	=cut
	113
	114	my ( $self, $arg ) = @_;
	115
	116	if ( defined $arg ) {
	117	$self->{'deferrable'} = $arg ? 1 : 0;
	118	}
	119
	120	return defined $self->{'deferrable'} ? $self->{'deferrable'} : 1;
	121	}
	122
	123	# ----------------------------------------------------------------------
	124	sub expression {
	125
	126	=pod
	127
	128	=head2 expression
	129
	130	Gets and set the expression used in a CHECK constraint.
	131
	132	my $expression = $constraint->expression('...');
	133
	134	=cut
	135
	136	my $self = shift;
	137
	138	if ( my $arg = shift ) {
	139	# check arg here?
	140	$self->{'expression'} = $arg;
	141	}
	142
	143	return $self->{'expression'} \|\| '';
	144	}
	145
	146	# ----------------------------------------------------------------------
	147	sub is_valid {
	148
	149	=pod
	150
	151	=head2 is_valid
	152
	153	Determine whether the constraint is valid or not.
	154
	155	my $ok = $constraint->is_valid;
	156
	157	=cut
	158
	159	my $self = shift;
	160	my $type = $self->type or return $self->error('No type');
	161	my $table = $self->table or return $self->error('No table');
162	my @fields = $self->fields or return $self->error('No fields');
163	my $table_name = $table->name or return $self->error('No table name');
164
165	for my $f ( @fields ) {
166	next if $table->get_field( $f );
167	return $self->error(
168	"Constraint references non-existent field '$f' ",
169	"in table '$table_name'"
170	);
171	}
172
173	my $schema = $table->schema or return $self->error(
174	'Table ', $table->name, ' has no schema object'
175	);
176
177	if ( $type eq FOREIGN_KEY ) {
178	return $self->error('Only one field allowed for foreign key')
179	if scalar @fields > 1;
180
181	my $ref_table_name = $self->reference_table or
182	return $self->error('No reference table');
183
184	my $ref_table = $schema->get_table( $ref_table_name ) or
185	return $self->error("No table named '$ref_table_name' in schema");
186
187	my @ref_fields = $self->reference_fields or return;
188
189	return $self->error('Only one field allowed for foreign key reference')
190	if scalar @ref_fields > 1;
191
192	for my $ref_field ( @ref_fields ) {
193	next if $ref_table->get_field( $ref_field );
194	return $self->error(
195	"Constraint from field(s) ",
196	join(', ', map {qq['$table_name.$_']} @fields),
197	" to non-existent field '$ref_table_name.$ref_field'"
198	);
199	}
200	}
201	elsif ( $type eq CHECK_C ) {
202	return $self->error('No expression for CHECK') unless
203	$self->expression;
204	}
205
206	return 1;
207	}
208
209	# ----------------------------------------------------------------------
3c5de62a	210	sub fields {
	211
	212	=pod
	213
	214	=head2 fields
	215
43b9dc7a	216	Gets and set the fields the constraint is on. Accepts a string, list or
	217	arrayref; returns an array or array reference. Will unique the field
	218	names and keep them in order by the first occurrence of a field name.
	219
	220	$constraint->fields('id');
	221	$constraint->fields('id', 'name');
	222	$constraint->fields( 'id, name' );
	223	$constraint->fields( [ 'id', 'name' ] );
	224	$constraint->fields( qw[ id name ] );
3c5de62a	225
43b9dc7a	226	my @fields = $constraint->fields;
3c5de62a	227
	228	=cut
	229
	230	my $self = shift;
43b9dc7a	231	my $fields = UNIVERSAL::isa( $_[0], 'ARRAY' )
43b9dc7a	232	? shift : [ map { s/^\s+\|\s+$//g; $_ } map { split /,/ } @_ ];
3c5de62a	233
3c5de62a	234	if ( @$fields ) {
43b9dc7a	235	my ( %unique, @unique );
	236	for my $f ( @$fields ) {
	237	next if $unique{ $f };
	238	$unique{ $f } = 1;
	239	push @unique, $f;
	240	}
	241
	242	$self->{'fields'} = \@unique;
3c5de62a	243	}
	244
	245	return wantarray ? @{ $self->{'fields'} \|\| [] } : $self->{'fields'};
	246	}
	247
	248	# ----------------------------------------------------------------------
	249	sub name {
	250
	251	=pod
	252
	253	=head2 name
	254
	255	Get or set the constraint's name.
	256
	257	my $name = $constraint->name('foo');
	258
	259	=cut
	260
	261	my $self = shift;
	262	$self->{'name'} = shift if @_;
	263	return $self->{'name'} \|\| '';
	264	}
	265
	266	# ----------------------------------------------------------------------
43b9dc7a	267	sub on_delete {
	268
	269	=pod
	270
	271	=head2 on_delete
	272
	273	Get or set the constraint's "on delete" action.
	274
	275	my $action = $constraint->on_delete('cascade');
	276
	277	=cut
	278
	279	my $self = shift;
	280
	281	if ( my $arg = shift ) {
	282	# validate $arg?
	283	$self->{'on_delete'} = $arg;
	284	}
	285
	286	return $self->{'on_delete'} \|\| '';
	287	}
	288
	289	# ----------------------------------------------------------------------
	290	sub on_update {
	291
	292	=pod
	293
	294	=head2 on_update
	295
	296	Get or set the constraint's "on update" action.
	297
	298	my $action = $constraint->on_update('no action');
	299
	300	=cut
	301
	302	my $self = shift;
	303
	304	if ( my $arg = shift ) {
	305	# validate $arg?
	306	$self->{'on_update'} = $arg;
	307	}
	308
	309	return $self->{'on_update'} \|\| '';
	310	}
	311
	312	# ----------------------------------------------------------------------
	313	sub reference_fields {
	314
	315	=pod
	316
	317	=head2 reference_fields
	318
	319	Gets and set the fields in the referred table. Accepts a string, list or
	320	arrayref; returns an array or array reference.
	321
	322	$constraint->reference_fields('id');
	323	$constraint->reference_fields('id', 'name');
	324	$constraint->reference_fields( 'id, name' );
	325	$constraint->reference_fields( [ 'id', 'name' ] );
	326	$constraint->reference_fields( qw[ id name ] );
	327
	328	my @reference_fields = $constraint->reference_fields;
	329
	330	=cut
331
332	my $self = shift;
333	my $fields = UNIVERSAL::isa( $_[0], 'ARRAY' )
334	? shift : [ map { s/^\s+\|\s+$//g; $_ } map { split /,/ } @_ ];
335
336	if ( @$fields ) {
337	$self->{'reference_fields'} = $fields;
338	}
339
340	unless ( ref $self->{'reference_fields'} ) {
341	my $table = $self->table or return $self->error('No table');
342	my $schema = $table->schema or return $self->error('No schema');
343	my $ref_table_name = $self->reference_table or
344	return $self->error('No table');
345	my $ref_table = $schema->get_table( $ref_table_name ) or
346	return $self->error("Can't find table '$ref_table_name'");
347
348	if ( my $constraint = $ref_table->primary_key ) {
349	$self->{'reference_fields'} = [ $constraint->fields ];
350	}
351	else {
352	$self->error(
353	'No reference fields defined and cannot find primary key in ',
354	"reference table '$ref_table_name'"
355	);
356	}
357	}
358
359	if ( ref $self->{'reference_fields'} ) {
360	return wantarray
361	? @{ $self->{'reference_fields'} \|\| [] }
362	: $self->{'reference_fields'};
363	}
364	else {
365	return wantarray ? () : [];
366	}
367	}
368
369	# ----------------------------------------------------------------------
370	sub reference_table {
371
372	=pod
373
374	=head2 reference_table
375
376	Get or set the table referred to by the constraint.
377
378	my $reference_table = $constraint->reference_table('foo');
379
380	=cut
381
382	my $self = shift;
383	$self->{'reference_table'} = shift if @_;
384	return $self->{'reference_table'} \|\| '';
385	}
386
387
388	# ----------------------------------------------------------------------
3c5de62a	389	sub type {
	390
	391	=pod
	392
	393	=head2 type
	394
	395	Get or set the constraint's type.
	396
43b9dc7a	397	my $type = $constraint->type( PRIMARY_KEY );
3c5de62a	398
	399	=cut
	400
	401	my $self = shift;
	402
	403	if ( my $type = shift ) {
	404	return $self->error("Invalid constraint type: $type")
	405	unless VALID_TYPE->{ $type };
	406	$self->{'type'} = $type;
	407	}
	408
	409	return $self->{'type'} \|\| '';
	410	}
	411
	412
	413	# ----------------------------------------------------------------------
43b9dc7a	414	sub table {
3c5de62a	415
	416	=pod
	417
43b9dc7a	418	=head2 table
3c5de62a	419
43b9dc7a	420	Get or set the field's table object.
3c5de62a	421
43b9dc7a	422	my $table = $field->table;
3c5de62a	423
	424	=cut
	425
	426	my $self = shift;
43b9dc7a	427	if ( my $arg = shift ) {
	428	return $self->error('Not a table object') unless
	429	UNIVERSAL::isa( $arg, 'SQL::Translator::Schema::Table' );
	430	$self->{'table'} = $arg;
	431	}
	432
	433	return $self->{'table'};
	434	}
	435
	436	# ----------------------------------------------------------------------
	437	sub options {
	438
	439	=pod
	440
	441	=head2 options
	442
	443	Gets or adds to the constraints's options (e.g., "INITIALLY IMMEDIATE").
	444	Returns an array or array reference.
	445
	446	$constraint->options('NORELY');
	447	my @options = $constraint->options;
	448
	449	=cut
	450
	451	my $self = shift;
	452	my $options = UNIVERSAL::isa( $_[0], 'ARRAY' )
	453	? shift : [ map { s/^\s+\|\s+$//g; $_ } map { split /,/ } @_ ];
	454
	455	push @{ $self->{'options'} }, @$options;
	456
	457	if ( ref $self->{'options'} ) {
	458	return wantarray ? @{ $self->{'options'} \|\| [] } : $self->{'options'};
	459	}
	460	else {
	461	return wantarray ? () : [];
	462	}
3c5de62a	463	}
	464
	465	1;
	466
	467	# ----------------------------------------------------------------------
	468
	469	=pod
	470
	471	=head1 AUTHOR
	472
	473	Ken Y. Clark E<lt>kclark@cpan.orgE<gt>
	474
	475	=cut