schema.pm

bugzilla

    my @indexes = @{ $self->{schema}{$table}{INDEXES} || [] };
    while (@indexes) {
        my $index_name = shift(@indexes);
        my $index_info = shift(@indexes);
        my $index_sql  = $self->get_add_index_ddl($table, $index_name, 
                                                  $index_info);
        push(@ddl, $index_sql) if $index_sql;
    }

    push(@ddl, @{ $self->{schema}{$table}{DB_EXTRAS} })
      if (ref($self->{schema}{$table}{DB_EXTRAS}));

    return @ddl;

} #eosub--get_table_ddl
#--------------------------------------------------------------------------
sub _get_create_table_ddl {

=item C<_get_create_table_ddl>

 Description: Protected method to generate the "create table" SQL statement
              for a given table.
 Parameters:  $table - the table name
 Returns:     a string containing the DDL statement for the specified table

=cut

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

    my $thash = $self->{schema}{$table};
    die "Table $table does not exist in the database schema."
        unless (ref($thash));

    my $create_table = "CREATE TABLE $table \(\n";

    my @fields = @{ $thash->{FIELDS} };
    while (@fields) {
        my $field = shift(@fields);
        my $finfo = shift(@fields);
        $create_table .= "\t$field\t" . $self->get_type_ddl($finfo);
        $create_table .= "," if (@fields);
        $create_table .= "\n";
    }

    $create_table .= "\)";

    return($create_table)

} #eosub--_get_create_table_ddl
#--------------------------------------------------------------------------
sub _get_create_index_ddl {

=item C<_get_create_index_ddl>

 Description: Protected method to generate a "create index" SQL statement
              for a given table and index.
 Parameters:  $table_name - the name of the table
              $index_name - the name of the index
              $index_fields - a reference to an array of field names
              $index_type (optional) - specify type of index (e.g., UNIQUE)
 Returns:     a string containing the DDL statement

=cut

    my ($self, $table_name, $index_name, $index_fields, $index_type) = @_;

    my $sql = "CREATE ";
    $sql .= "$index_type " if ($index_type && $index_type eq 'UNIQUE');
    $sql .= "INDEX $index_name ON $table_name \(" .
      join(", ", @$index_fields) . "\)";

    return($sql);

} #eosub--_get_create_index_ddl
#--------------------------------------------------------------------------

sub get_add_column_ddl {

=item C<get_add_column_ddl($table, $column, \%definition, $init_value)>

 Description: Generate SQL to add a column to a table.
 Params:      $table - The table containing the column.
              $column - The name of the column being added.
              \%definition - The new definition for the column,
                  in standard C<ABSTRACT_SCHEMA> format.
              $init_value - (optional) An initial value to set 
                            the column to. Should already be SQL-quoted
                            if necessary.
 Returns:     An array of SQL statements.

=cut

    my ($self, $table, $column, $definition, $init_value) = @_;
    my @statements;
    push(@statements, "ALTER TABLE $table ADD COLUMN $column " .
        $self->get_type_ddl($definition));

    # XXX - Note that although this works for MySQL, most databases will fail
    # before this point, if we haven't set a default.
    (push(@statements, "UPDATE $table SET $column = $init_value"))
        if defined $init_value;

    return (@statements);
}

sub get_add_index_ddl {

=item C<get_add_index_ddl>

 Description: Gets SQL for creating an index.
              NOTE: Subclasses should not override this function. Instead,
              if they need to specify a custom CREATE INDEX statement, 
              they should override C<_get_create_index_ddl>
 Params:      $table - The name of the table the index will be on.
              $name  - The name of the new index.
              $definition - An index definition. Either a hashref 
                            with FIELDS and TYPE or an arrayref 
                            containing a list of columns.
 Returns:     An array of SQL statements that will create the 
              requested index.

=cut

    my ($self, $table, $name, $definition) = @_;

    my ($index_fields, $index_type);
    # Index defs can be arrays or hashes
    if (ref($definition) eq 'HASH') {
        $index_fields = $definition->{FIELDS};
        $index_type = $definition->{TYPE};
    } else {
        $index_fields = $definition;
        $index_type = '';
    }
    
    return $self->_get_create_index_ddl($table, $name, $index_fields, 
                                        $index_type);
}

sub get_alter_column_ddl {

=item C<get_alter_column_ddl($table, $column, \%definition)>

 Description: Generate SQL to alter a column in a table.
              The column that you are altering must exist,
              and the table that it lives in must exist.
 Params:      $table - The table containing the column.
              $column - The name of the column being changed.
              \%definition - The new definition for the column,
                  in standard C<ABSTRACT_SCHEMA> format.
              $set_nulls_to - A value to set NULL values to, if
                  your new definition is NOT NULL and contains
                  no DEFAULT, and when there is a possibility
                  that the column could contain NULLs. $set_nulls_to
                  should be already SQL-quoted if necessary.
 Returns:     An array of SQL statements.

=cut

    my ($self, $table, $column, $new_def, $set_nulls_to) = @_;

    my @statements;
    my $old_def = $self->get_column_abstract($table, $column);
    my $specific = $self->{db_specific};

    # If the types have changed, we have to deal with that.
    if (uc(trim($old_def->{TYPE})) ne uc(trim($new_def->{TYPE}))) {
        push(@statements, $self->_get_alter_type_sql($table, $column, 
                                                     $new_def, $old_def));
    }

    my $default = $new_def->{DEFAULT};
    my $default_old = $old_def->{DEFAULT};
    # This first condition prevents "uninitialized value" errors.
    if (!defined $default && !defined $default_old) {
        # Do Nothing
    }
    # If we went from having a default to not having one
    elsif (!defined $default && defined $default_old) {
        push(@statements, "ALTER TABLE $table ALTER COLUMN $column"
                        . " DROP DEFAULT");
    }
    # If we went from no default to a default, or we changed the default.
    elsif ( (defined $default && !defined $default_old) || 
            ($default ne $default_old) ) 
    {
        $default = $specific->{$default} if exists $specific->{$default};
        push(@statements, "ALTER TABLE $table ALTER COLUMN $column "
                         . " SET DEFAULT $default");
    }

    # If we went from NULL to NOT NULL.
    if (!$old_def->{NOTNULL} && $new_def->{NOTNULL}) {
        my $setdefault;
        # Handle any fields that were NULL before, if we have a default,
        $setdefault = $new_def->{DEFAULT} if exists $new_def->{DEFAULT};
        # But if we have a set_nulls_to, that overrides the DEFAULT 
        # (although nobody would usually specify both a default and 
        # a set_nulls_to.)
        $setdefault = $set_nulls_to if defined $set_nulls_to;
        if (defined $setdefault) {
            push(@statements, "UPDATE $table SET $column = $setdefault"
                            . "  WHERE $column IS NULL");
        }
        push(@statements, "ALTER TABLE $table ALTER COLUMN $column"
                        . " SET NOT NULL");
    }
    # If we went from NOT NULL to NULL
    elsif ($old_def->{NOTNULL} && !$new_def->{NOTNULL}) {
        push(@statements, "ALTER TABLE $table ALTER COLUMN $column"
                        . " DROP NOT NULL");
    }

    # If we went from not being a PRIMARY KEY to being a PRIMARY KEY.
    if (!$old_def->{PRIMARYKEY} && $new_def->{PRIMARYKEY}) {
        push(@statements, "ALTER TABLE $table ADD PRIMARY KEY ($column)");
    }
    # If we went from being a PK to not being a PK
    elsif ( $old_def->{PRIMARYKEY} && !$new_def->{PRIMARYKEY} ) {
        push(@statements, "ALTER TABLE $table DROP PRIMARY KEY");
    }

    return @statements;
}

sub get_drop_index_ddl {

=item C<get_drop_index_ddl($table, $name)>

 Description: Generates SQL statements to drop an index.
 Params:      $table - The table the index is on.
              $name  - The name of the index being dropped.
 Returns:     An array of SQL statements.

=cut

    my ($self, $table, $name) = @_;

    # Although ANSI SQL-92 doesn't specify a method of dropping an index,
    # many DBs support this syntax.
    return ("DROP INDEX $name");
}

sub get_drop_column_ddl {

=item C<get_drop_column_ddl($table, $column)>

 Description: Generate SQL to drop a column from a table.
 Params:      $table - The table containing the column.
              $column - The name of the column being dropped.
 Returns:     An array of SQL statements.

=cut

    my ($self, $table, $column) = @_;
    return ("ALTER TABLE $table DROP COLUMN $column");
}

=item C<get_drop_table_ddl($table)>

 Description: Generate SQL to drop a table from the database.
 Params:      $table - The name of the table to drop.
 Returns:     An array of SQL statements.

=cut

sub get_drop_table_ddl {
    my ($self, $table) = @_;
    return ("DROP TABLE $table");
}

sub get_rename_column_ddl {

=item C<get_rename_column_ddl($table, $old_name, $new_name)>

 Description: Generate SQL to change the name of a column in a table.
              NOTE: ANSI SQL contains no simple way to rename a column,
                    so this function is ABSTRACT and must be implemented
                    by subclasses.
 Params:      $table - The table containing the column to be renamed.
              $old_name - The name of the column being renamed.
              $new_name - The name the column is changing to.
 Returns:     An array of SQL statements.

=cut

    die "ANSI SQL has no way to rename a column, and your database driver\n"
        . " has not implemented a method.";
}


sub get_rename_table_sql {

=item C<get_rename_table_sql>

=over

=item B<Description>

Gets SQL to rename a table in the database.

=item B<Params>

=over

=item C<$old_name> - The current name of the table.

=item C<$new_name> - The new name of the table.

=back

=item B<Returns>: An array of SQL statements to rename a table.

=back

=cut

    my ($self, $old_name, $new_name) = @_;
    return ("ALTER TABLE $old_name RENAME TO $new_name");
}

=item C<delete_table($name)>

 Description: Deletes a table from this Schema object.
              Dies if you try to delete a table that doesn't exist.
 Params:      $name - The name of the table to delete.
 Returns:     nothing

=cut

sub delete_table {
    my ($self, $name) = @_;

    die "Attempted to delete nonexistent table '$name'." unless
        $self->get_table_abstract($name);

    delete $self->{abstract_schema}->{$name};
    delete $self->{schema}->{$name};
}

sub get_column_abstract {

=item C<get_column_abstract($table, $column)>

 Description: A column definition from the abstract internal schema.
              cross-database format.
 Params:      $table - The name of the table
              $column - The name of the column that you want
 Returns:     A hash reference. For the format, see the docs for
              C<ABSTRACT_SCHEMA>.
              Returns undef if the column or table does not exist.

=cut

    my ($self, $table, $column) = @_;

    # Prevent a possible dereferencing of an undef hash, if the
    # table doesn't exist.
    if ($self->get_table_abstract($table)) {
        my %fields = (