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

package SQL::Translator::Schema::Table;

# ----------------------------------------------------------------------
# $Id: Table.pm,v 1.3 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::Table - SQL::Translator table object

=head1 SYNOPSIS

  use SQL::Translator::Schema::Table;
  my $table = SQL::Translator::Schema::Table->new( name => 'foo' );

=head1 DESCSIPTION

C<SQL::Translator::Schema::Table> is the table object.

=head1 METHODS

=cut

use strict;
use Class::Base;
use SQL::Translator::Schema::Constants;
use SQL::Translator::Schema::Constraint;
use SQL::Translator::Schema::Field;
use SQL::Translator::Schema::Index;

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

$VERSION = 1.00;

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

=pod

=head2 new

Object constructor.

  my $table  =  SQL::Translator::Schema::Table->new( 
      schema => $schema,
      name   => 'foo',
  );

=cut

    my ( $self, $config ) = @_;
    
    for my $arg ( qw[ schema name ] ) {
        next unless defined $config->{ $arg };
        $self->$arg( $config->{ $arg } ) or return;
    }

    return $self;
}

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

=pod

=head2 name

Get or set the table's name.

If provided an argument, checks the schema object for a table of 
that name and disallows the change if one exists.

  my $table_name = $table->name('foo');

=cut

    my $self = shift;

    if ( my $arg = shift ) {
        if ( my $schema = $self->schema ) {
            return $self->error( qq[Can't use table name "$arg": table exists] )
                if $schema->get_table( $arg );
        }
        $self->{'name'} = $arg;
    }

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

# ----------------------------------------------------------------------
sub add_constraint {

=pod

=head2 add_constraint

Add a constraint to the table.  Returns the newly created 
C<SQL::Translator::Schema::Constraint> object.

  my $constraint1 = $table->add_constraint(
      name        => 'pk',
      type        => PRIMARY_KEY,
      fields      => [ 'foo_id' ],
  );

  my $constraint2 = SQL::Translator::Schema::Constraint->new( name => 'uniq' );
  $constraint2    = $table->add_constraint( $constraint );

=cut

    my $self             = shift;
    my $constraint_class = 'SQL::Translator::Schema::Constraint';
    my $constraint;

    if ( UNIVERSAL::isa( $_[0], $constraint_class ) ) {
        $constraint = shift;
        $constraint->table( $self );
    }
    else {
        my %args = @_;
        $args{'table'} = $self;
        $constraint = $constraint_class->new( \%args ) or 
            return $self->error( $constraint_class->error );
    }

    push @{ $self->{'constraints'} }, $constraint;
    return $constraint;
}

# ----------------------------------------------------------------------
sub add_index {

=pod

=head2 add_index

Add an index to the table.  Returns the newly created
C<SQL::Translator::Schema::Index> object.

  my $index1 = $table->add_index(
      name   => 'name',
      fields => [ 'name' ],
      type   => 'normal',
  );

  my $index2 = SQL::Translator::Schema::Index->new( name => 'id' );
  $index2    = $table->add_index( $index );

=cut

    my $self        = shift;
    my $index_class = 'SQL::Translator::Schema::Index';
    my $index;

    if ( UNIVERSAL::isa( $_[0], $index_class ) ) {
        $index = shift;
        $index->table( $self );
    }
    else {
        my %args = @_;
        $args{'table'} = $self;
        $index = $index_class->new( \%args ) or return 
            $self->error( $index_class->error );
    }

    push @{ $self->{'indices'} }, $index;
    return $index;
}

# ----------------------------------------------------------------------
sub add_field {

=pod

=head2 add_field

Add an field to the table.  Returns the newly created
C<SQL::Translator::Schema::Field> object.  The "name" parameter is 
required.  If you try to create a field with the same name as an 
existing field, you will get an error and the field will not be created.

  my $field1    =  $table->add_field(
      name      => 'foo_id',
      data_type => 'integer',
      size      => 11,
  );

  my $field2 =  SQL::Translator::Schema::Field->new( 
      name   => 'name', 
      table  => $table,
  );
  $field2    = $table->add_field( $field2 ) or die $table->error;

=cut

    my $self  = shift;
    my $field_class = 'SQL::Translator::Schema::Field';
    my $field;

    if ( UNIVERSAL::isa( $_[0], $field_class ) ) {
        $field = shift;
        $field->table( $self );
    }
    else {
        my %args = @_;
        $args{'table'} = $self;
        $field = $field_class->new( \%args ) or return 
            $self->error( $field_class->error );
    }

    my $field_name = $field->name or return $self->error('No name');

    if ( exists $self->{'fields'}{ $field_name } ) { 
        return $self->error(qq[Can't create field: "$field_name" exists]);
    }
    else {
        $self->{'fields'}{ $field_name } = $field;
        $self->{'fields'}{ $field_name }{'order'} = ++$FIELD_ORDER;
    }

    return $field;
}

# ----------------------------------------------------------------------
sub get_constraints {

=pod

=head2 get_constraints

Returns all the constraint objects as an array or array reference.

  my @constraints = $table->get_constraints;

=cut

    my $self = shift;

    if ( ref $self->{'constraints'} ) {
        return wantarray 
            ? @{ $self->{'constraints'} } : $self->{'constraints'};
    }
    else {
        $self->error('No constraints');
        return wantarray ? () : undef;
    }
}

# ----------------------------------------------------------------------
sub get_indices {

=pod

=head2 get_indices

Returns all the index objects as an array or array reference.

  my @indices = $table->get_indices;

=cut

    my $self = shift;

    if ( ref $self->{'indices'} ) {
        return wantarray 
            ? @{ $self->{'indices'} } 
            : $self->{'indices'};
    }
    else {
        $self->error('No indices');
        return wantarray ? () : undef;
    }
}

# ----------------------------------------------------------------------
sub get_field {

=pod

=head2 get_field

Returns a field by the name provided.

  my $field = $table->get_field('foo');

=cut

    my $self       = shift;
    my $field_name = shift or return $self->error('No field name');
    return $self->error( qq[Field "$field_name" does not exist] ) unless
        exists $self->{'fields'}{ $field_name };
    return $self->{'fields'}{ $field_name };
}

# ----------------------------------------------------------------------
sub get_fields {

=pod

=head2 get_fields

Returns all the field objects as an array or array reference.

  my @fields = $table->get_fields;

=cut

    my $self = shift;
    my @fields = 
        sort { $a->{'order'} <=> $b->{'order'} }
        values %{ $self->{'fields'} || {} };

    if ( @fields ) {
        return wantarray ? @fields : \@fields;
    }
    else {
        $self->error('No fields');
        return wantarray ? () : undef;
    }
}

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

=pod

=head2 is_valid

Determine whether the view is valid or not.

  my $ok = $view->is_valid;

=cut

    my $self = shift;
    return $self->error('No name')   unless $self->name;
    return $self->error('No fields') unless $self->get_fields;

    for my $object ( 
        $self->get_fields, $self->get_indices, $self->get_constraints 
    ) {
        return $object->error unless $object->is_valid;
    }

    return 1;
}

# ----------------------------------------------------------------------
sub schema {

=pod

=head2 schema

Get or set the table's schema object.

  my $schema = $table->schema;

=cut

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

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

# ----------------------------------------------------------------------
sub primary_key {

=pod

=head2 options

Gets or sets the table's primary key(s).  Takes one or more field names 
(as a string, list or arrayref) and returns an array or arrayref.

  $table->primary_key('id');
  $table->primary_key(['id']);
  $table->primary_key(['id','name']);
  $table->primary_key('id,name');
  $table->primary_key(qw[ id name ]);

  my $pk = $table->primary_key;

=cut

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

    if ( @$fields ) {
        for my $f ( @$fields ) {
            return $self->error(qq[Invalid field "$f"]) unless 
                $self->get_field($f);
        }

        my $has_pk;
        for my $c ( $self->get_constraints ) {
            if ( $c->type eq PRIMARY_KEY ) {
                $has_pk = 1;
                $c->fields( @{ $c->fields }, @$fields );
            } 
        }

        unless ( $has_pk ) {
            $self->add_constraint(
                type   => PRIMARY_KEY,
                fields => $fields,
            );
        }
    }

    for my $c ( $self->get_constraints ) {
        return $c if $c->type eq PRIMARY_KEY;
    }

    return $self->error('No primary key');
}

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

=pod

=head2 options

Get or set the table's options (e.g., table types for MySQL).  Returns
an array or array reference.

  my @options = $table->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::Table;
	2
	3	# ----------------------------------------------------------------------
43b9dc7a	4	# $Id: Table.pm,v 1.3 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::Table - SQL::Translator table object
	28
	29	=head1 SYNOPSIS
	30
	31	use SQL::Translator::Schema::Table;
0f3cc5c0	32	my $table = SQL::Translator::Schema::Table->new( name => 'foo' );
3c5de62a	33
	34	=head1 DESCSIPTION
	35
	36	C<SQL::Translator::Schema::Table> is the table object.
	37
	38	=head1 METHODS
	39
	40	=cut
	41
	42	use strict;
	43	use Class::Base;
0f3cc5c0	44	use SQL::Translator::Schema::Constants;
3c5de62a	45	use SQL::Translator::Schema::Constraint;
	46	use SQL::Translator::Schema::Field;
	47	use SQL::Translator::Schema::Index;
	48
	49	use base 'Class::Base';
0f3cc5c0	50	use vars qw( $VERSION $FIELD_ORDER );
3c5de62a	51
	52	$VERSION = 1.00;
	53
	54	# ----------------------------------------------------------------------
	55	sub init {
	56
	57	=pod
	58
	59	=head2 new
	60
	61	Object constructor.
	62
43b9dc7a	63	my $table = SQL::Translator::Schema::Table->new(
	64	schema => $schema,
	65	name => 'foo',
	66	);
3c5de62a	67
	68	=cut
	69
	70	my ( $self, $config ) = @_;
43b9dc7a	71
	72	for my $arg ( qw[ schema name ] ) {
	73	next unless defined $config->{ $arg };
	74	$self->$arg( $config->{ $arg } ) or return;
	75	}
	76
3c5de62a	77	return $self;
	78	}
	79
	80	# ----------------------------------------------------------------------
	81	sub name {
	82
	83	=pod
	84
	85	=head2 name
	86
	87	Get or set the table's name.
	88
43b9dc7a	89	If provided an argument, checks the schema object for a table of
	90	that name and disallows the change if one exists.
	91
3c5de62a	92	my $table_name = $table->name('foo');
	93
	94	=cut
	95
	96	my $self = shift;
43b9dc7a	97
	98	if ( my $arg = shift ) {
	99	if ( my $schema = $self->schema ) {
	100	return $self->error( qq[Can't use table name "$arg": table exists] )
	101	if $schema->get_table( $arg );
	102	}
	103	$self->{'name'} = $arg;
	104	}
	105
3c5de62a	106	return $self->{'name'} \|\| '';
	107	}
	108
	109	# ----------------------------------------------------------------------
	110	sub add_constraint {
	111
	112	=pod
	113
	114	=head2 add_constraint
	115
0f3cc5c0	116	Add a constraint to the table. Returns the newly created
0f3cc5c0	117	C<SQL::Translator::Schema::Constraint> object.
3c5de62a	118
43b9dc7a	119	my $constraint1 = $table->add_constraint(
	120	name => 'pk',
	121	type => PRIMARY_KEY,
	122	fields => [ 'foo_id' ],
3c5de62a	123	);
3c5de62a	124
43b9dc7a	125	my $constraint2 = SQL::Translator::Schema::Constraint->new( name => 'uniq' );
	126	$constraint2 = $table->add_constraint( $constraint );
	127
3c5de62a	128	=cut
3c5de62a	129
43b9dc7a	130	my $self = shift;
	131	my $constraint_class = 'SQL::Translator::Schema::Constraint';
	132	my $constraint;
	133
	134	if ( UNIVERSAL::isa( $_[0], $constraint_class ) ) {
	135	$constraint = shift;
	136	$constraint->table( $self );
	137	}
	138	else {
	139	my %args = @_;
	140	$args{'table'} = $self;
	141	$constraint = $constraint_class->new( \%args ) or
	142	return $self->error( $constraint_class->error );
	143	}
	144
3c5de62a	145	push @{ $self->{'constraints'} }, $constraint;
	146	return $constraint;
	147	}
	148
	149	# ----------------------------------------------------------------------
	150	sub add_index {
	151
	152	=pod
	153
	154	=head2 add_index
	155
0f3cc5c0	156	Add an index to the table. Returns the newly created
0f3cc5c0	157	C<SQL::Translator::Schema::Index> object.
3c5de62a	158
43b9dc7a	159	my $index1 = $table->add_index(
3c5de62a	160	name => 'name',
	161	fields => [ 'name' ],
	162	type => 'normal',
	163	);
	164
43b9dc7a	165	my $index2 = SQL::Translator::Schema::Index->new( name => 'id' );
	166	$index2 = $table->add_index( $index );
	167
3c5de62a	168	=cut
3c5de62a	169
43b9dc7a	170	my $self = shift;
	171	my $index_class = 'SQL::Translator::Schema::Index';
	172	my $index;
	173
	174	if ( UNIVERSAL::isa( $_[0], $index_class ) ) {
	175	$index = shift;
	176	$index->table( $self );
	177	}
	178	else {
	179	my %args = @_;
	180	$args{'table'} = $self;
	181	$index = $index_class->new( \%args ) or return
	182	$self->error( $index_class->error );
	183	}
	184
3c5de62a	185	push @{ $self->{'indices'} }, $index;
	186	return $index;
	187	}
	188
	189	# ----------------------------------------------------------------------
	190	sub add_field {
	191
	192	=pod
	193
	194	=head2 add_field
	195
43b9dc7a	196	Add an field to the table. Returns the newly created
	197	C<SQL::Translator::Schema::Field> object. The "name" parameter is
	198	required. If you try to create a field with the same name as an
	199	existing field, you will get an error and the field will not be created.
3c5de62a	200
43b9dc7a	201	my $field1 = $table->add_field(
0f3cc5c0	202	name => 'foo_id',
	203	data_type => 'integer',
	204	size => 11,
3c5de62a	205	);
3c5de62a	206
43b9dc7a	207	my $field2 = SQL::Translator::Schema::Field->new(
	208	name => 'name',
	209	table => $table,
	210	);
	211	$field2 = $table->add_field( $field2 ) or die $table->error;
	212
3c5de62a	213	=cut
	214
	215	my $self = shift;
43b9dc7a	216	my $field_class = 'SQL::Translator::Schema::Field';
	217	my $field;
	218
	219	if ( UNIVERSAL::isa( $_[0], $field_class ) ) {
	220	$field = shift;
	221	$field->table( $self );
	222	}
	223	else {
	224	my %args = @_;
	225	$args{'table'} = $self;
	226	$field = $field_class->new( \%args ) or return
	227	$self->error( $field_class->error );
	228	}
	229
	230	my $field_name = $field->name or return $self->error('No name');
	231
	232	if ( exists $self->{'fields'}{ $field_name } ) {
	233	return $self->error(qq[Can't create field: "$field_name" exists]);
	234	}
	235	else {
	236	$self->{'fields'}{ $field_name } = $field;
	237	$self->{'fields'}{ $field_name }{'order'} = ++$FIELD_ORDER;
	238	}
	239
3c5de62a	240	return $field;
	241	}
	242
	243	# ----------------------------------------------------------------------
0f3cc5c0	244	sub get_constraints {
	245
	246	=pod
	247
	248	=head2 get_constraints
	249
	250	Returns all the constraint objects as an array or array reference.
	251
	252	my @constraints = $table->get_constraints;
	253
	254	=cut
	255
	256	my $self = shift;
	257
	258	if ( ref $self->{'constraints'} ) {
	259	return wantarray
	260	? @{ $self->{'constraints'} } : $self->{'constraints'};
	261	}
	262	else {
	263	$self->error('No constraints');
	264	return wantarray ? () : undef;
	265	}
	266	}
	267
	268	# ----------------------------------------------------------------------
	269	sub get_indices {
3c5de62a	270
	271	=pod
	272
0f3cc5c0	273	=head2 get_indices
3c5de62a	274
0f3cc5c0	275	Returns all the index objects as an array or array reference.
3c5de62a	276
0f3cc5c0	277	my @indices = $table->get_indices;
3c5de62a	278
	279	=cut
	280
	281	my $self = shift;
0f3cc5c0	282
	283	if ( ref $self->{'indices'} ) {
	284	return wantarray
	285	? @{ $self->{'indices'} }
	286	: $self->{'indices'};
	287	}
	288	else {
	289	$self->error('No indices');
	290	return wantarray ? () : undef;
	291	}
	292	}
	293
	294	# ----------------------------------------------------------------------
43b9dc7a	295	sub get_field {
	296
	297	=pod
	298
	299	=head2 get_field
	300
	301	Returns a field by the name provided.
	302
	303	my $field = $table->get_field('foo');
	304
	305	=cut
	306
	307	my $self = shift;
	308	my $field_name = shift or return $self->error('No field name');
	309	return $self->error( qq[Field "$field_name" does not exist] ) unless
	310	exists $self->{'fields'}{ $field_name };
	311	return $self->{'fields'}{ $field_name };
	312	}
	313
	314	# ----------------------------------------------------------------------
0f3cc5c0	315	sub get_fields {
	316
	317	=pod
	318
	319	=head2 get_fields
	320
	321	Returns all the field objects as an array or array reference.
	322
	323	my @fields = $table->get_fields;
	324
	325	=cut
	326
	327	my $self = shift;
	328	my @fields =
	329	sort { $a->{'order'} <=> $b->{'order'} }
	330	values %{ $self->{'fields'} \|\| {} };
	331
	332	if ( @fields ) {
	333	return wantarray ? @fields : \@fields;
	334	}
	335	else {
	336	$self->error('No fields');
	337	return wantarray ? () : undef;
	338	}
3c5de62a	339	}
	340
	341	# ----------------------------------------------------------------------
	342	sub is_valid {
	343
	344	=pod
	345
	346	=head2 is_valid
	347
	348	Determine whether the view is valid or not.
	349
	350	my $ok = $view->is_valid;
	351
	352	=cut
	353
	354	my $self = shift;
43b9dc7a	355	return $self->error('No name') unless $self->name;
0f3cc5c0	356	return $self->error('No fields') unless $self->get_fields;
	357
	358	for my $object (
	359	$self->get_fields, $self->get_indices, $self->get_constraints
	360	) {
	361	return $object->error unless $object->is_valid;
	362	}
	363
	364	return 1;
3c5de62a	365	}
3c5de62a	366
43b9dc7a	367	# ----------------------------------------------------------------------
	368	sub schema {
	369
	370	=pod
	371
	372	=head2 schema
	373
	374	Get or set the table's schema object.
	375
	376	my $schema = $table->schema;
	377
	378	=cut
	379
	380	my $self = shift;
	381	if ( my $arg = shift ) {
	382	return $self->error('Not a schema object') unless
	383	UNIVERSAL::isa( $arg, 'SQL::Translator::Schema' );
	384	$self->{'schema'} = $arg;
	385	}
	386
	387	return $self->{'schema'};
	388	}
	389
	390	# ----------------------------------------------------------------------
	391	sub primary_key {
	392
	393	=pod
	394
	395	=head2 options
	396
	397	Gets or sets the table's primary key(s). Takes one or more field names
	398	(as a string, list or arrayref) and returns an array or arrayref.
	399
	400	$table->primary_key('id');
	401	$table->primary_key(['id']);
	402	$table->primary_key(['id','name']);
	403	$table->primary_key('id,name');
	404	$table->primary_key(qw[ id name ]);
	405
	406	my $pk = $table->primary_key;
	407
	408	=cut
	409
	410	my $self = shift;
	411	my $fields = UNIVERSAL::isa( $_[0], 'ARRAY' )
	412	? shift : [ map { s/^\s+\|\s+$//g; $_ } map { split /,/ } @_ ];
	413
	414	if ( @$fields ) {
	415	for my $f ( @$fields ) {
	416	return $self->error(qq[Invalid field "$f"]) unless
	417	$self->get_field($f);
	418	}
	419
	420	my $has_pk;
	421	for my $c ( $self->get_constraints ) {
	422	if ( $c->type eq PRIMARY_KEY ) {
	423	$has_pk = 1;
	424	$c->fields( @{ $c->fields }, @$fields );
	425	}
	426	}
	427
	428	unless ( $has_pk ) {
	429	$self->add_constraint(
	430	type => PRIMARY_KEY,
431	fields => $fields,
432	);
433	}
434	}
435
436	for my $c ( $self->get_constraints ) {
437	return $c if $c->type eq PRIMARY_KEY;
438	}
439
440	return $self->error('No primary key');
441	}
442
443	# ----------------------------------------------------------------------
444	sub options {
445
446	=pod
447
448	=head2 options
449
450	Get or set the table's options (e.g., table types for MySQL). Returns
451	an array or array reference.
452
453	my @options = $table->options;
454
455	=cut
456
457	my $self = shift;
458	my $options = UNIVERSAL::isa( $_[0], 'ARRAY' )
459	? shift : [ map { s/^\s+\|\s+$//g; $_ } map { split /,/ } @_ ];
460
461	push @{ $self->{'options'} }, @$options;
462
463	if ( ref $self->{'options'} ) {
464	return wantarray ? @{ $self->{'options'} \|\| [] } : $self->{'options'};
465	}
466	else {
467	return wantarray ? () : [];
468	}
469	}
470
3c5de62a	471	1;
	472
	473	# ----------------------------------------------------------------------
	474
	475	=pod
	476
	477	=head1 AUTHOR
	478
	479	Ken Y. Clark E<lt>kclark@cpan.orgE<gt>
	480
	481	=cut