view release on metacpan or  search on metacpan

lib/Prty/Sql.pm  view on Meta::CPAN

        $constraintName = $table.'_PK';
        $self->checkName(\$constraintName);
    }

    # Statement generieren

    my ($oracle,$postgresql,$sqlite,$mysql) = $self->dbmsTestVector;

    my $stmt;
    if ($oracle || $postgresql) {
        $stmt = sprintf "ALTER TABLE %s ADD\n".
            "    CONSTRAINT %s\n".
            "    PRIMARY KEY (%s)",
            $tableName,$constraintName,join(', ',@$colNameA);

        if ($tableSpace) {
            $stmt .= "\n    USING INDEX TABLESPACE $tableSpace";
        }

        if ($oracle && $exceptionTable) {
            $stmt .= "\n    EXCEPTIONS INTO $exceptionTable";
        }
    }
    else {
        die;
    }

    return $stmt;
}

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

=head3 addForeignKeyConstraint() - Generiere FOREIGN KEY Constraint Statement

=head4 Synopsis

    $stmt = $sql->addForeignKeyConstraint($tableName,\@tableCols,
        $refTableName,@opt);

=head4 Options

=over 4

=item -constraintName => $str (Default: <TABLE>_FK_<REFTABLE>)

Name des Constraint.

=item -defer => $bool (Default: 0)

Constraint-Fehler wird verzögert gemeldet.

=item -disable => $bool (Default: 0)

Constraint wird erzeugt, ist aber abgeschaltet.

=item -exceptionTable => $tableName (Default: keiner)

Constraint-Verletzende Datensätze werden in Tabelle $tableName
protokollliert (nur Oracle).

=item -onDelete => 'cascade'|'null' (Default: keiner)

Legt fest, was bei Löschung des Parent-Datensatzes passieren soll.

=item -refTableCols => \@refTableCols (Default: undef)

Liste der Kolumnen in der referenzierten Tabelle.
Bei MySQL müssen die referenzierten Kolumnen aufgezählt werden, auch wenn
ein Primary Key auf der referenzierten Tabelle definiert ist.

=back

=head4 Description

B<Oracle Syntax>

    ALTER TABLE <TABLE_NAME> ADD
        CONSTRAINT <CONSTRAINT_NAME>
        FOREIGN KEY (<TABLE_COLUMNS>)
        REFERENCES <REF_TABLE_NAME>
        ON DELETE <ACTION>
        DEFERRABLE INITIALLY DEFERRED
        EXCEPTIONS INTO <EXCEPTION_TABLE_NAME>
        DISABLE

B<PostgreSQL Syntax>

    ALTER TABLE <TABLE_NAME> ADD
        CONSTRAINT <CONSTRAINT_NAME>
        FOREIGN KEY (<TABLE_COLUMNS>)
        REFERENCES <REF_TABLE_NAME>
        ON DELETE <ACTION>
        DEFERRABLE INITIALLY DEFERRED

B<MySQL Syntax>

    ALTER TABLE <TABLE_NAME> ADD
        CONSTRAINT <CONSTRAINT_NAME>
        FOREIGN KEY (<TABLE_COLUMNS>)
        REFERENCES <REF_TABLE_NAME> (REF_TABLE_COLUMNS)
        ON DELETE <ACTION>

=cut

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

sub addForeignKeyConstraint {
    my $self = shift;
    my $fromName = shift;
    my $cols = shift;
    my $toName = shift;

    # Optionen

    my $constraintName = undef;
    my $defer = 0;
    my $disable = 0;
    my $exceptionTable = undef;
    my $onDelete = undef;
    my $refTableColumns = undef;

    if (@_) {
        Prty::Option->extract(\@_,
            -constraintName=>\$constraintName,
            -defer=>\$defer,
            -disable=>\$disable,
            -exceptionTable=>\$exceptionTable,
            -onDelete=>\$onDelete,
            -refTableColumns=>\$refTableColumns,
        );
    }

    if (!$constraintName) {
        my ($fromTable) = $self->splitObjectName($fromName);
        my ($toTable) = $self->splitObjectName($toName);
        $constraintName = $fromTable.'_FK_'.$toTable;
        $self->checkName(\$constraintName);
    }

    # Statement generieren

    my ($oracle,$postgresql,$sqlite,$mysql) = $self->dbmsTestVector;

    my $stmt;
    if ($postgresql || $oracle || $mysql) {
        # ALTER TABLE

        $stmt = sprintf "ALTER TABLE %s ADD\n".
            "    CONSTRAINT %s\n".
            "    FOREIGN KEY (%s)\n".
            "    REFERENCES %s",
            $fromName,
            $constraintName,
            join(', ',@$cols),
            $toName;

        if ($refTableColumns) {
            my $str = '';
            for (@$refTableColumns) {
                if ($str) {
                    $str .= ', ';
                }
                $str .= $_;
            }
            if ($str) {
                $stmt .= " ($str)";
            }
        }

        # ON DELETE

        if ($onDelete) {
            $stmt .= "\n    ON DELETE ";
            if ($onDelete eq 'cascade') {
                $stmt .= 'CASCADE';
            }
            elsif ($onDelete eq 'null') {
                $stmt .= 'SET NULL';
            }
            else {
                $self->throw;
            }
        }

        # DEFERRABLE

        if ($defer) {
            $stmt .= "\n    DEFERRABLE INITIALLY DEFERRED";
        }

        if ($oracle) {
            if ($exceptionTable) {
                $stmt .= "\n    EXCEPTIONS INTO $exceptionTable";
            }
            if ($disable) {
                $stmt .= "\n    DISABLE";
            }
        }
    }
    else {
        $self->throw;
    }

    return $stmt;
}

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

=head3 addNotNullConstraint() - Generiere NOT NULL Constraint Statement

=head4 Synopsis

    $stmt = $sql->addNotNullConstraint($tableName,$colName,@opt);

=head4 Options

=over 4

=item -constraintName => $str (Default: <TABLE>_CK)

Name des Constraint (nicht PostgreSQL).

=item -exceptionTable => $tableName (Default: keiner)

Constraint-Verletzende Datensätze werden in Tabelle $tableName
protokollliert (nur Oracle).

=back

=head4 Description

B<Oracle Syntax>

    ALTER TABLE <TABLE_NAME> MODIFY (

lib/Prty/Sql.pm  view on Meta::CPAN

    # Argumente

    my $replace = 0;
    my $returns = undef;

    Prty::Option->extract(\@_,
        -replace=>\$replace,
        -returns=>\$returns,
    );
    my $name = shift;
    my $body = Prty::String->removeIndentation(shift);

    my ($oracle,$postgresql,$sqlite,$mysql) = $self->dbmsTestVector;

    my $stmt;
    if ($postgresql) {
        $stmt = 'CREATE';
        if ($replace) {
            $stmt .= ' OR REPLACE';
        }
        $stmt .= " FUNCTION $name()";
        if ($returns) {
            $stmt .= "\nRETURNS $returns";
        }
        $stmt .= "\nAS \$SQL\$";
        $stmt .= "\n$body";
        $stmt .= "\n\$SQL\$ LANGUAGE plpgsql";
    }
    else {
        $self->throw('Not implemented');
    }

    return $stmt;
}

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

=head3 dropFunction() - Generiere Statement zum Entfernen einer Funktion

=head4 Synopsis

    $stmt = $sql->dropFunction($name);

=head4 Description

B<PostgreSQL>

    DROP FUNCTION <name>() CASCADE

=cut

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

sub dropFunction {
    my $self = shift;
    # @_: $name,@opt

    # Argumente

    my $cascade = 0;

    Prty::Option->extract(\@_,
        -cascade=>\$cascade,
    );
    my $name = shift;

    my ($oracle,$postgresql,$sqlite,$mysql) = $self->dbmsTestVector;

    if ($postgresql) {
        my $stmt = "DROP FUNCTION $name()";
        if ($cascade) {
            $stmt .= ' CASCADE';
        }
        return $stmt;
    }

    $self->throw('Not implemented');
}

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

=head3 createTrigger() - Generiere Statement zum Erzeugen eines Triggers

=head4 Synopsis

    $stmt = $sql->createTrigger($table,$name,$when,$event,$level,
        $body,@opt);
    $stmt = $sql->createTrigger($table,$name,$when,$event,$level,
        -execute=>$proc,@opt);

=head4 Options

=over 4

=item -replace => $bool (Default: 0)

Generiere "OR REPLACE" Klausel (Oracle).

=item -execute => $proc (Default: undef)

Generiere "EXECUTE PROCEDURE $proc()" Klausel.

=back

=head4 Description

B<Oracle>

    $stmt = $sql->createTrigger(
        '<table>',
        '<name>',
        'before',
        'insert|update',
        'row',
        -replace=>1,'
        <body>
        '
    );
    
    CREATE OR REPLACE TRIGGER <name>
    BEFORE INSERT OR UPDATE ON <table>
    FOR EACH ROW
    <body>

=over 2

=item *

Oracle-Trigger können eine Prozedur können einen
Trigger-Body definieren.