PC World 1998 October/PCWorld_1998-10_cd.bin/software/prehled/komix/DATA.Z/sqlerror.tcl

Text File | 1996-06-05 | 5.8 KB | 223 lines

#---------------------------------------------------------------------------
#
# Copyright (c) 1992-1996 by Cadre Technologies, Inc.
#
# This software is furnished under a license and may be used only in
# accordance with the terms of such license and with the inclusion of
# the above copyright notice. This software or any other copies thereof
# may not be provided or otherwise made available to any other person.
# No title to and ownership of the software is hereby transferred.
#
# The information in this software is subject to change without notice
# and should not be construed as a commitment by Cadre Technologies, Inc.
#
#---------------------------------------------------------------------------
#
#    File        : @(#)sqlerror.tcl    2.1 (2.1)
#    Original date    : 18-8-1992
#    Description    : Tcl script containing error messages for
#                         the SQL
#
#---------------------------------------------------------------------------
#
# @(#)sqlerror.tcl    2.1 (2.1)\t19 Apr 1996 Copyright 1992-1996 Cadre Technologies, Inc
#
#---------------------------------------------------------------------------


#
#
proc gen_iierror_null { current_section tab_name } {

    $current_section pushIndent
    expand_text $current_section {
        IF iierrornumber <> 0 THEN
            msg = 'Nullify in detail table "~$tab_name" failed';
            RAISE ERROR 99001 :msg;
            RETURN 0;
        ENDIF;
    }
    $current_section popIndent
}

#
#
proc gen_iierror_null_current { current_section tab_name } {

    $current_section pushIndent
    expand_text $current_section {
        IF iierrornumber <> 0 THEN
            msg = 'Nullify in table "~$tab_name" failed';
            RAISE ERROR 99001 :msg;
            RETURN 0;
    ELSE
        msg = 'Nullified foreign keys';
        ENDIF;
    }
    $current_section popIndent
}

#
#
proc gen_iierror_cas_ins { current_section tab_name } {

    $current_section pushIndent
    expand_text $current_section {
        IF iierrornumber > 0 THEN
            msg = 'Cascade insert into table "~$tab_name" failed';
            RAISE ERROR 99002 :msg;
            RETURN 0;
        ENDIF;
    }
    $current_section popIndent
}


#
#
proc gen_iierror_cas_del { current_section tab_name } {

    $current_section pushIndent
    expand_text $current_section {
       IF iierrornumber > 0 THEN
           msg = 'Cascade delete from table "~$tab_name" failed';
           RAISE ERROR 99003 :msg;
           RETURN 0;
       ENDIF;
    }
    $current_section popIndent
}


#
#
proc gen_iierror_cas_upd { current_section tab_name } {

    $current_section pushIndent
    expand_text $current_section {
        IF iierrornumber > 0 THEN
            msg = 'Cascade update of "~$tab_name" failed';
            RAISE ERROR 99004 :msg;
            RETURN 0;
        ENDIF;
    }
    $current_section popIndent
}


#
#
proc gen_error_del_rej { current_section cur_name other_name } {

    $current_section pushIndent
    expand_text $current_section {
        IF counter > 0 THEN
            msg = 'Delete from table "~$cur_name" rejected: ' +
            'tuple referred from table "~$other_name"';
            RAISE ERROR 99006 :msg;
            RETURN 0;
        ENDIF;
    }
    $current_section popIndent
}


#
#
proc gen_error_del_rej_last { current_section tab_name } {

    $current_section pushIndent
    expand_text $current_section {
        IF counter = 1 THEN
            msg = 'Delete from table "~$tab_name" would violate' +
                  ' referential integrity, delete rejected';
            RAISE ERROR 99007 :msg;
            RETURN 0;
        ENDIF;
    }
    $current_section popIndent
}


#
#
proc gen_error_upd_rej_sub { current_section tab_name sub_type_name } {

    $current_section pushIndent
    expand_text $current_section {
        IF counter > 0 THEN
            msg = 'Tuple already exist in subtype table "~$sub_type_name"' +
                  ', update of table "~$tab_name" rejected';
            RAISE ERROR 99008 :msg;
            RETURN 0;
        ENDIF;
    }
    $current_section popIndent
}


#
#
proc gen_error_upd_rej_not_exist { current_section tab_name mas_name } {

    $current_section pushIndent
    expand_text $current_section {
        IF counter = 0 THEN
            msg = 'Update of table "~$tab_name" rejected: foreign key does' +
                  ' not exist in master table "~$mas_name"';
            RAISE ERROR 99009 :msg;
            RETURN 0;
        ENDIF;
    }
    $current_section popIndent
}


#
#
proc gen_error_upd_rej_exist { current_section tab_name } {

    $current_section pushIndent
    expand_text $current_section {
        IF counter > 0 THEN
            msg = 'Updated column(s) exist in detail table' +
                  ' "~$tab_name": update rejected';
            RAISE ERROR 99010 :msg;
            RETURN 0;
        ENDIF;
    }
    $current_section popIndent
}


#
#
proc gen_error_ins_rej_not_exist_in_detail { current_section tab_name } {

    $current_section pushIndent
    expand_text $current_section {
        IF counter = 0 THEN
            msg = 'Insert into table "~$tab_name" rejected';
            RAISE ERROR 99012 :msg;
            RETURN 0;
        ENDIF;
    }
    $current_section popIndent
}

#
#
proc gen_error_ins_rej_not_exist_in_master { current_section tab_name master_name} {

    $current_section pushIndent
    expand_text $current_section {
        IF counter = 0 THEN
            msg = 'Insert into table "~$tab_name" rejected: '
          + 'foreign key does not exist in master table "~$master_name"';
            RAISE ERROR 99011 :msg;
            RETURN 0;
        ENDIF;
    } tab_name $tab_name master_name $master_name
    $current_section popIndent
}