view release on metacpan or  search on metacpan

lib/SQL/Translator/Schema/Table.pm  view on Meta::CPAN

        or return $self->error($field_class->error);
  }

  my $existing_order = { map { $_->order => $_->name } $self->get_fields };

  # supplied order, possible unordered assembly
  if ($field->order) {
    if ($existing_order->{ $field->order }) {
      croak sprintf
          "Requested order '%d' for column '%s' conflicts with already existing column '%s'",
          $field->order,
          $field->name,
          $existing_order->{ $field->order },
          ;
    }
  } else {
    my $last_field_no = max(keys %$existing_order) || 0;
    if ($last_field_no != scalar keys %$existing_order) {
      croak sprintf
          "Table '%s' field order incomplete - unable to auto-determine order for newly added field",
          $self->name,
          ;
    }

    $field->order($last_field_no + 1);
  }

  # We know we have a name as the Field->new above errors if none given.
  my $field_name = $field->name;

  if ($self->get_field($field_name)) {
    return $self->error(qq[Can't use field name "$field_name": field exists]);
  } else {
    $self->_fields->{$field_name} = $field;
  }

  return $field;
}

=head2 drop_field

Remove a field from the table. Returns the field object if the field was
found and removed, an error otherwise. The single parameter can be either
a field name or an C<SQL::Translator::Schema::Field> object.

  $table->drop_field('myfield');

=cut

sub drop_field {
  my $self        = shift;
  my $field_class = 'SQL::Translator::Schema::Field';
  my $field_name;

  if (UNIVERSAL::isa($_[0], $field_class)) {
    $field_name = shift->name;
  } else {
    $field_name = shift;
  }
  my %args    = @_;
  my $cascade = $args{'cascade'};

  if (!($self->_has_fields && exists $self->_fields->{$field_name})) {
    return $self->error(qq[Can't drop field: "$field_name" doesn't exists]);
  }

  my $field = delete $self->_fields->{$field_name};

  if ($cascade) {

    # Remove this field from all indices using it
    foreach my $i ($self->get_indices()) {
      my @fs = $i->fields();
      @fs = grep { $_ ne $field->name } @fs;
      $i->fields(@fs);
    }

    # Remove this field from all constraints using it
    foreach my $c ($self->get_constraints()) {
      my @cs = $c->fields();
      @cs = grep { $_ ne $field->name } @cs;
      $c->fields(@cs);
    }
  }

  return $field;
}

=head2 comments

Get or set the comments on a table.  May be called several times to
set and it will accumulate the comments.  Called in an array context,
returns each comment individually; called in a scalar context, returns
all the comments joined on newlines.

  $table->comments('foo');
  $table->comments('bar');
  print join( ', ', $table->comments ); # prints "foo, bar"

=cut

has comments => (
  is      => 'rw',
  coerce  => quote_sub(q{ ref($_[0]) eq 'ARRAY' ? $_[0] : [$_[0]] }),
  default => quote_sub(q{ [] }),
);

around comments => sub {
  my $orig     = shift;
  my $self     = shift;
  my @comments = ref $_[0] ? @{ $_[0] } : @_;

  for my $arg (@comments) {
    $arg = $arg->[0] if ref $arg;
    push @{ $self->$orig }, $arg if defined $arg && $arg;
  }

  @comments = @{ $self->$orig };
  return
        wantarray ? @comments
      : @comments ? join("\n", @comments)
      :             undef;
};

=head2 get_constraints

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

  my @constraints = $table->get_constraints;