Inside xCase

Einleitung

Diese Session zeigt wie man das Datenmodellierungs-Tool xCase erweitern kann. Wer schon einmal mit xCase oder einem Konkurrenzprodukt gearbeitet hat wird sicher einen größeren Nutzen daraus ziehen als jemand der xCase nur vom Hörensagen kennt. J 
Trotzdem möchte ich natürlich niemenden davon abhalten meine Session zu besuchen. Ich versuche mit dem Vortrag rechtzeitig fertig zu werden, so daß am Ende noch genügend Zeit ist ihre Fragen zu beantworten, falls Sie Probleme beim Umgang mit xCase haben.

Grenzen und wie man sie erweitert

xCase ist ein hervorragendes Tool zur Modellierung von Daten. In der Praxis trifft man bald auf Grenzen, die allerdings elegant umgangen werden können. 

Neue Feldeigenschaften hinzufügen

Ein erster Schritt ist die Erweiterung der xCase Metadaten um eigene Felder.
Achtung: Bei Änderungen am xCase Data Dictionary darf kein Modell geöffnet sein.

In der Praxis wird man die Erweiterung des Data Dictionaries lieber programmatisch durchführen. Damit könenn nach einer Neuinstallation die Änderungen Problemlos wiederhergestellt werden. Erklärungen entnehmen Sie bitte den Kommentaren im Code. In der Session werde ich im Detail darauf eingehen.


*--------------------------------------------
* Insert/Update eines Feldes in xCase\DDM.dbf.
*--------------------------------------------
#DEFINE XCASEDIR C:\xCase
USE XCASEDIR\DDM SHARED IN 0 ORDER TAG ddm

UpdDDM( "Field", "U_LBL_GRID", "C", 20, 0, ;
"Grid Caption", "VPME: Grid Header Caption", "", "", ;
"Nur eintragen, wenn die Caption fuer die Anzeige im Grid zu lang ist." )

*===========================================================
* Unterstützende Funktionen.
*===========================================================
*--------------------------------------------
* Hier wird das eigentliche Update
* durchgeführt.
*--------------------------------------------
FUNCTION UpdDDM
LPARAMETERS tcDDElement, tcName, tcType, tnLen, tnDec, ;
tcTitle, tcDescript, tcDef_Value, tcValues, tcNotes

ASSERT "|" + m.tcDDElement +"|" $ "|Field|ViewField|" MESSAGE ;
"Ungültiges DD-Element " + m.tcDDElement + " gewählt!"

DO CASE
CASE m.tcDDElement == "Field"
UpdDDM_2( "DDFLD", m.tcName, m.tcType, m.tnLen, m.tnDec, ;
m.tcTitle, m.tcDescript, m.tcDef_Value, m.tcValues, m.tcNotes )
UpdDDM_2( "DDVEL", m.tcName, m.tcType, m.tnLen, m.tnDec, ;
m.tcTitle, m.tcDescript, m.tcDef_Value, m.tcValues, m.tcNotes )
UpdDDM_2( "DDDOM", m.tcName, m.tcType, m.tnLen, m.tnDec, ;
m.tcTitle, m.tcDescript, m.tcDef_Value, m.tcValues, m.tcNotes )
CASE m.tcDDElement == "ViewField"
UpdDDM_2( "DDVEL", m.tcName, m.tcType, m.tnLen, m.tnDec, ;
m.tcTitle, m.tcDescript, m.tcDef_Value, m.tcValues, m.tcNotes )
ENDCASE

ENDFUNC

*--------------------------------------------
* Unterfunktion zu UpdDDM.
*--------------------------------------------
FUNCTION UpdDDM_2
LPARAMETERS tcDDElement, tcName, tcType, tnLen, tnDec, ;
tcTitle, tcDescript, tcDef_Value, tcValues, tcNotes

*--------------------------------------------
* Gibts das DD-Element schon?
*--------------------------------------------
SELECT DDM
tcName = PADR( m.tcName, LEN(Name) )
LOCATE FOR D_Name == m.tcDDElement ;
AND Name == m.tcName
IF NOT FOUND()
*--------------------------------------------
* Höchste Feldnummer ermitteln.
*--------------------------------------------
LOCAL ARRAY laFldCnt[1]
SELECT MAX( Number ) ;
FROM "DDM" ;
WHERE D_Name == m.tcDDElement ;
INTO ARRAY laFldCnt
*--------------------------------------------
* Neuen Satz mit der nächsthöheren Feldnummer
* ins DD schreiben.
*--------------------------------------------
SELECT DDM
APPEND BLANK
REPLACE Number WITH laFldCnt[1] + 1
ENDIF

*--------------------------------------------
* Werte im DD aktualisieren.
*--------------------------------------------
REPLACE ;
D_Name WITH m.tcDDElement, ;
Category WITH "U", ;
Name WITH m.tcName, ;
Type WITH m.tcType, ;
Len WITH m.tnLen, ;
Dec WITH m.tnDec, ;
Title WITH m.tcTitle, ;
Descript WITH m.tcDescript, ;
Def_Value WITH m.tcDef_Value, ;
Values WITH m.tcValues, ;
Inherit WITH "A", ;
Notes WITH m.tcNotes, ;
Read_Only WITH .F., ;
VFP WITH .T.

ENDFUNC

Ändern des Triggercodes den xCase erzeugt

Das Problem: Leere Fremdschlüssel sollen zulässig sein, ohne daß in der Parent-Tabelle ein leerer Schlüssel vorhanden ist.
Es entspricht zwar nicht den allgemeinen RI-Standards wird aber trotzdem in vielen aus FP 2.x-Tagen übernommenen Datenmodellen weiter verwendet: Ein leerer Fremdschlüssel gilt hier als ein nicht zugeordneter Fremdschlüssel. 
Streng nach der Lehre müßte der Zustand "nicht zugeordnet" durch den Wert .NULL. ausgedrückt werden. Da FP 2.x noch keine .NULL.-Werte kannte nahm man damals ersatzweise "leere" (EMPTY()) Schlüssel. Es ist möglich den Triggercode-Generator von xCase dahingehend anzupassen.
Das Schema für den Triggercode steht in xCase\Vfp5\Vfp_RI.tcl. Es ist in der Sprache TCL verfaßt. Die xCase Hilfe enthält eine grundlegende Dokumentation zu TCL und den in xCase verwendeten Funktionen. Weitergehende Informationen und Links finden Sie z.B. unter http://dev.scriptics.com/software/tcltk/.
Der folgende Code-Ausschnitt enthält die nötigen Anpassungen und gibt gleichzeitig einen Einblick in die für VFP-Programmierer eher ungewöhnliche TCL-Syntax.

######################## 
proc write_insert_triger { ent } {
######################## 

global header_done
set in_rels [$ent in_relations]
set need_triger FALSE

### Wi.: begin 1.part of new choice "Empty or Restrict" for insert trigger ###
### old version:
### foreach rel $in_rels
### if { [ $rel E_INS_RULE] == "R" }
### new Version:
foreach rel $in_rels {
if { [ $rel E_INS_RULE] == "R" || [ $rel E_INS_RULE] == "E" } {
if {[[ $rel PARENT] I_INDEX] != 0} {
set need_triger TRUE
break
}
}
}
### Wi.: end 1.part of new choice "Empty or Restrict" for insert trigger ###


remove_trigger_from_slot $ent INS_TRIG "__ri_insert_.+\\(\\)"
if { $need_triger == "FALSE" } {
return
}


if {$header_done == "FALSE" } {
write_ri_header
set header_done TRUE
}

regsub -all " " [string tolower [$ent TITLE]] "_" low_under_e_name
add_trigger_to_slot $ent INS_TRIG "__ri_insert_${low_under_e_name}()"
>> ""
>> "********************************************************************************"
>> "** \"Referential integrity insert trigger for\" [string tolower [$ent TITLE]]"
>> "PROCEDURE __RI_INSERT_$low_under_e_name"
write_transaction
>> "LOCAL lcChildID && child's value to be sought in parent"
>> "LOCAL lcParentWkArea && parentwork area handle returned by riopen"
>> "LOCAL lcChildWkArea && child's work area"
>> "LOCAL lcStartArea"
>> "lcStartArea=select()"
>> "llRetVal=.t."
>> "lcChildWkArea=SELECT()"
foreach rel $in_rels {
if { [ $rel E_INS_RULE] == "R" && [[ $rel PARENT] I_INDEX] != 0 } {
set e_title [[$rel PARENT] TITLE]
set p_tag [[[$rel PARENT] PK_INDEX] TAG]
>> "SELECT (lcChildWkArea)"
>> "lcChildID=[$rel E_K_PAREN]"
>> "pcChildDBF=dbf(lcChildWkArea)"
>> "pnChildRec=recno(lcChildWkArea)"
>> "pcChildID=lcChildID"
>> "pcChildExpr=[addquotes [[$rel FK_INDEX] INDEX_KEY]]"
>> "lcParentWkArea=riopen(\"[string tolower $e_title]\",\"[string tolower $p_tag]\")"
>> "IF lcParentWkArea<=0"
>> " IF _triggerlevel=1"
>> " DO riend WITH .F."
>> " ENDIF at the end of the highest trigger level"
>> " SELECT (lcStartArea)"
>> " RETURN .F."
>> "ENDIF not able to open the child work area"
>> "pcParentDBF=dbf(lcParentWkArea)"
>> "llRetVal=SEEK(lcChildID,lcParentWkArea)"
>> "pnParentRec=recno(lcParentWkArea)"
>> "=rireuse(\"[string tolower $e_title]\",lcParentWkArea)"
>> "IF NOT llRetVal"
>> " DO rierror with -1,\"Insert restrict rule violated.\",\"\",\"\""
>> " IF _triggerlevel=1"
>> " DO riend WITH llRetVal"
>> " ENDIF at the end of the highest trigger level"
>> " SELECT (lcStartArea)"
>> " RETURN llRetVal"
>> "ENDIF"
}


### Wi.: begin 2.part of new choice "Empty or Restrict" for insert trigger ###
if { [ $rel E_INS_RULE] == "E" && [[ $rel PARENT] I_INDEX] != 0 } {
set e_title [[$rel PARENT] TITLE]
set p_tag [[[$rel PARENT] PK_INDEX] TAG]
>> "SELECT (lcChildWkArea)"
>> "lcChildID=[$rel E_K_PAREN]"
>> "pcChildDBF=dbf(lcChildWkArea)"
>> "pnChildRec=recno(lcChildWkArea)"
>> "pcChildID=lcChildID"
>> "pcChildExpr=[addquotes [[$rel FK_INDEX] INDEX_KEY]]"
>> "lcParentWkArea=riopen(\"[string tolower $e_title]\",\"[string tolower $p_tag]\")"
>> "IF lcParentWkArea<=0"
>> " IF _triggerlevel=1"
>> " DO riend WITH .F."
>> " ENDIF at the end of the highest trigger level"
>> " SELECT (lcStartArea)"
>> " RETURN .F."
>> "ENDIF not able to open the child work area"
>> "pcParentDBF=dbf(lcParentWkArea)"
>> "llRetVal=SEEK(lcChildID,lcParentWkArea) OR EMPTY(lcChildID) OR ISNULL(lcChildID)"
>> "pnParentRec=recno(lcParentWkArea)"
>> "=rireuse(\"[string tolower $e_title]\",lcParentWkArea)"
>> "IF NOT llRetVal"
>> " DO rierror with -1,\"Insert restrict rule violated.\",\"\",\"\""
>> " IF _triggerlevel=1"
>> " DO riend WITH llRetVal"
>> " ENDIF at the end of the highest trigger level"
>> " SELECT (lcStartArea)"
>> " RETURN llRetVal"
>> "ENDIF"
}
### Wi.: end 1.part of new choice "Empty or Restrict" for insert trigger ###


}
>> "IF _triggerlevel=1"
>> " do riend with llRetVal"
>> "ENDIF at the end of the highest trigger level"
>> "SELECT (lcStartArea)"
>> "RETURN llRetVal"
>> "** \"End of Referential integrity insert trigger for\" [string tolower [$ent TITLE]]"
>> "********************************************************************************"
}

Damit die neue Möglichkeit in xCase verfügbar wird, muß auch noch ein Eintrag im Data Dictionary Manager geändert werden.

#DEFINE XCASEDIR C:\xCase
USE XCASEDIR\DDM SHARED ORDER TAG ddm
REPLACE values WITH "R|Restrict|I|Ignore|E|Empty or Restrict|", ;
Notes WITH ;
"A String which specifies the action to be taken upon inserting a Row." +CHR(13)+ ;
"Restrict: Prohibit the Insert if a matching Key Value does not " + ;
"exist in the Parent table." +CHR(13)+ ;
"Ignore: Allow the Insert." +CHR(13)+ ;
"Empty or Restrict: Prohibit the insert if a matching key value " +CHR(13)+ ;
"does not exist in the parent table. Allow the insert if the key value " +CHR(13)+ ;
"is EMPTY or NULL." +CHR(13)+ ;
CHR(13)+ ;
"List of Values (Value|Description|): R|Restrict|I|Ignore| E|Empty or Restrict|" ;
FOR d_name="DDREL" AND name="E_INS_RULE"

Ein Wrapper für CreateDB.app

Die mit xCase gelieferte CreateDB.app muß oft um eigene Routinen ergänzt werden. Teilweise geschieht dies um Fehler auszubessern, wenn man nicht auf den nächsten Bugfix des Herstellers warten kann, teilweise um die selbst hinzugefügten Metadaten in den DBC zu übernehmen.
Es ist möglich vom Hersteller auf Anfrage den VFP-Quellcode der CreateDB.app zu bekommen. Allerdings habe ich das inzwischen aufgegeben, da der Code vom Hersteller mit jeder neuen Version geändert wird, in feinstem prozeduralen "Spaghetticode" programmiert, und schlecht dokumentiert ist. Deshalb habe ich mich entschlossen ein Wrapper-Programm um die CreateDB.app herum zu schreiben. Das ist sozusagen meine prozedurale Variante des Subclassing. J
Die Beschreibung steht wieder direkt im anschließend abgedruckten Code. Das erscheint mir übersichtlicher als eine lange Einleitung mit anschleißendem unkommentierten Code. In der Session werde ich auf die wichtigen Teile in diesem Abschnitt besonders eingehen.

*===========================================================
* CreateDBX.prg: Wrapper-Programm für xCase\Vfp5\CreateDB.app.
*
*(..)Damit das funktioniert muß CreateDB.app in 
*(..)CreateDB_xCase.app umbenannt werden.
*===========================================================
LPARAMETERS m.tcMode

*--------------------------------------------
* Setup.
*--------------------------------------------
LOCAL lcDefault, lcDeleted, lcAssert
lcDefault = SYS(5)+CURDIR()
lcDeleted = SET( "DELETED" )
lcAssert = SET( "ASSERT" )
SET CPDIALOG OFF
SET DELETED ON
SET ASSERT ON

*--------------------------------------------
* Hier deklarieren und initialisieren wir
* Variablen, die in CreateDB_xCase.app
* ohne Deklaration verwendet werden.
* Damit verwendet CreateDB_xCase.app
* automatisch unsere Variablen. Nach dem Ende
* von CreateDB_xCase.app bleiben die Werte
* der Variablen erhalten.
*--------------------------------------------
PRIVATE model
STORE "" TO model

*--------------------------------------------
* Das Original-CreateDB.app von xCase
* aufrufen.
*--------------------------------------------
DO JUSTPATH(SYS(16))+"\CreateDB_xCase.app" WITH m.tcMode


IF UPPER(ALLTRIM( m.tcMode )) == "EXPORT"
*--------------------------------------------
* Öffnen der Tabellen des xCase Modells
* geht mit 
* DO Open_xCase IN CreateDB_xCase.app,
* Schließen mit 
* DO Close_xCase IN CreateDB_xCase.app.
*--------------------------------------------
WAIT WINDOW NOWAIT "Öffnen der xCase Tabellen"
PRIVATE xcase_dir, mode
xcase_dir = m.gcxCaseDir
mode = UPPER(ALLTRIM( m.tcMode ))
LOCAL lcDummy
lcDummy = "IN " + JUSTPATH(SYS(16)) + "\CreateDB_xCase.app"
DO Open_xCase &lcDummy. && damit der Projekt-Manager die APP nicht einbindet

*--------------------------------------------
* DBC schließen.
*--------------------------------------------
LOCAL lcDBC
lcDBC = FULLPATH( ALLTRIM(ddGlb.LocationDB) + "\" ) + ;
ALLTRIM(ddGlb.Model_Name) + ".dbc"
IF DBUSED( JUSTSTEM( m.lcDBC) )
SET DATABASE TO (m.lcDBC)
CLOSE DATABASE
ENDIF

SET DELETED ON
SET ASSERT ON

*--------------------------------------------
* DBC-Struktur erweitern.
*--------------------------------------------
WAIT WINDOW NOWAIT "DBC Struktur wird erweitert"
Alter_DBC( m.lcDBC )

*--------------------------------------------
* Erweiterte Tabellen- und Feldinformationen
* in die neuen Felder schreiben.
*--------------------------------------------
WAIT WINDOW NOWAIT "Übertragen der erweiterten Eigenschaften für Tabellen"
Process_Tables( m.lcDBC )

*--------------------------------------------
* View-Attribute aus der Tabelle übernehmen.
*--------------------------------------------
WAIT WINDOW NOWAIT "Übertragen der erweiterten Eigenschaften für Views"
Process_Views( m.lcDBC )

*--------------------------------------------
* Prüfen, was dem "Check Data Dictionary 
* Integrity" von xCase nicht auffällt.
*--------------------------------------------
WAIT WINDOW NOWAIT "Prüfen des xCase Modells"
CheckModelIntegrity()

*--------------------------------------------
* Schließen der xCase-Tabellen.
* Kommentar siehe Öffnen der xCase-Tabellen.
*--------------------------------------------
WAIT WINDOW NOWAIT "Tabellen werden geschlossen"
DO Close_xCase &lcDummy. && damit der Projekt-Manager die APP nicht einbindet

ENDIF

*--------------------------------------------
* Normalerweise wird hier immer noch die
* zuletzt geöffnete Tabelle angezeigt. Das
* irritiert, weil die Tabelle nicht mehr
* offen ist. Sieht aus, als ob des VFP-Team
* hier etwas zu viel optimiert hat...
*--------------------------------------------
SET MESSAGE TO

*--------------------------------------------
* Cleanup.
*--------------------------------------------
SET DEFAULT TO &lcDefault.
SET DELETED &lcDeleted.
SET ASSERT &lcAssert.
SET CPDIALOG ON
WAIT CLEAR

RETURN

*===========================================================
* Unterstützende Funktionen.
*===========================================================
*--------------------------------------------
* DBC-Struktur erweitern.
*--------------------------------------------
FUNCTION Alter_DBC
LPARAMETERS tcDBC

*--------------------------------------------
* Setup.
*--------------------------------------------
LOCAL lnSelect
lnSelect = SELECT(0)
SELECT 0
USE ( m.tcDBC ) EXCLUSIVE ALIAS _DBC_

*--------------------------------------------
* Felder hinzufügen.
*--------------------------------------------
IF NOT TYPE( "_DBC_.u_Comment" ) == "M"
ALTER TABLE "_DBC_" ADD COLUMN u_Comment M
ENDIF
IF NOT TYPE( "_DBC_.u_Lbl_Grid" ) == "C"
ALTER TABLE "_DBC_" ADD COLUMN u_Lbl_Grid C(20)
ENDIF

*--------------------------------------------
* Sicherstellen, daß die erweiterten
* DBC-Felder keine Werte aus früheren
* Übernahmen enthalten.
*--------------------------------------------
SELECT _DBC_
BLANK ALL FIELDS ;
u_Comment, u_Val_Type, u_Val_Data, ;
u_Null, u_Lbl_Grid, u_F3_Text

*--------------------------------------------
* Cleanup.
*--------------------------------------------
USE IN _DBC_
SELECT (m.lnSelect)

ENDFUNC

*--------------------------------------------
* Erweiterte Tabellen- und Feldinformationen
* in die neuen Felder schreiben.
*--------------------------------------------
FUNCTION Process_Tables
LPARAMETERS tcDBC

*--------------------------------------------
* DBC zweimal als Tabelle öffnen.
*--------------------------------------------
USE ( m.tcDBC ) IN 0 SHARED ALIAS _Table_
USE ( m.tcDBC ) IN 0 AGAIN SHARED ALIAS _Field_

*--------------------------------------------
* Äußerer Scan: Alle Tabellen.
*--------------------------------------------
SELECT _Table_
SCAN FOR ObjectType = "Table"

*--------------------------------------------
* xCase Metadaten zu dieser Tabelle suchen.
*--------------------------------------------
SELECT ddEnt
LOCATE FOR UPPER(ALLTRIM(Title))==UPPER(ALLTRIM(_Table_.ObjectName))
IF NOT FOUND()
LOOP
ENDIF

*--------------------------------------------
* Tabellenkommentar übertragen.
*(..)Im DBC stehen nur die ersten 255 Zeichen.
*--------------------------------------------
SELECT _Table_
REPLACE u_Comment WITH ddEnt.Comments
*--------------------------------------------
* Objektname übertragen. Im DBC steht sonst
* alles in Kleinbuchstaben.
*--------------------------------------------
REPLACE ObjectName WITH LTRIM( ddEnt.Title )

*--------------------------------------------
* Innerer Scan: Alle Felder dieser Tabelle.
*--------------------------------------------
SELECT _Field_
SCAN FOR ParentID == _Table_.ObjectID

*--------------------------------------------
* xCase Metadaten zu diesem Feld suchen.
*--------------------------------------------
SELECT ddFld
LOCATE FOR i_Entity==ddEnt.Identifier ;
AND UPPER(ALLTRIM(Name))==UPPER(ALLTRIM(_Field_.ObjectName))
IF NOT FOUND()
LOOP
ENDIF
*--------------------------------------------
* Grid-Caption in xCase nachtragen, falls
* nötig.
*--------------------------------------------
IF EMPTY(ALLTRIM( u_Lbl_Grid ))
REPLACE u_Lbl_Grid WITH E_Message
ENDIF
*--------------------------------------------
* Feldkommentar übertragen.
*(..)Im DBC stehen nur die ersten 255 Zeichen.
*--------------------------------------------
SELECT _Field_
REPLACE u_Comment WITH ALLTRIM( ddFld.Comments )
*--------------------------------------------
* Objektname übertragen. Im DBC steht sonst
* alles in Kleinbuchstaben.
*--------------------------------------------
REPLACE ObjectName WITH LTRIM( ddFld.Name )
*--------------------------------------------
* Grid-Caption übertragen.
*--------------------------------------------
REPLACE u_Lbl_Grid WITH ddFld.u_Lbl_Grid

ENDSCAN
ENDSCAN

*--------------------------------------------
* Schließen des als Tabelle geöffneten DBCs.
*--------------------------------------------
USE IN _Table_
USE IN _Field_

ENDFUNC

*--------------------------------------------
* View-Attribute aus der Tabelle übernehmen.
*--------------------------------------------
FUNCTION Process_Views
LPARAMETERS tcDBC

LOCAL lcComment

*--------------------------------------------
* DBC öffnen.
*--------------------------------------------
OPEN DATABASE (m.tcDBC) SHARED

*--------------------------------------------
* DBC zweimal als Tabelle öffnen.
*--------------------------------------------
USE ( m.tcDBC ) IN 0 AGAIN SHARED ALIAS _View_
USE ( m.tcDBC ) IN 0 AGAIN SHARED ALIAS _ViewField_

*--------------------------------------------
* Äußerer Scan: Alle Views.
*--------------------------------------------
SELECT _View_
SCAN FOR ObjectType = "View"

*--------------------------------------------
* xCase Metadaten zu dieser View suchen.
*--------------------------------------------
SELECT ddVew
LOCATE FOR UPPER(ALLTRIM(V_Name))==UPPER(ALLTRIM(_View_.ObjectName))
IF NOT FOUND()
LOOP
ENDIF

*--------------------------------------------
* Die Tabelle suchen, unter der diese View in
* xCase gespeichert ist.
*--------------------------------------------
SELECT ddEnt
LOCATE FOR Identifier == ddVew.i_Entity

*--------------------------------------------
* Viewkommentar übertragen.
*(..)Im DBC stehen nur die ersten 255 Zeichen.
*(..)Außerdem übertragen wir den Kommentar
*(..)aus der Tabelle zusätzlich in die View.
*(..)xCase macht das nämlich nur für die
*(..)Felder der View automatisch, nicht für
*(..)die View selbst.
*--------------------------------------------
lcComment = ALLTRIM( ddVew.Comments )
IF NOT EMPTY( m.lcComment ) ; 
AND NOT EMPTY(ALLTRIM( ddEnt.Comments ))
lcComment = m.lcComment + SPACE(1)
ENDIF
lcComment = m.lcComment + ALLTRIM( ddEnt.Comments )
SELECT _View_
REPLACE u_Comment WITH m.lcComment
DBSETPROP( ALLTRIM(ObjectName), "View", "Comment", LEFT(m.lcComment,255) )
*--------------------------------------------
* Objektname übertragen. Im DBC steht sonst
* alles in Kleinbuchstaben.
*--------------------------------------------
REPLACE ObjectName WITH LTRIM( ddVew.V_Name )

*--------------------------------------------
* Innerer Scan: Alle Felder dieser View.
*--------------------------------------------
SELECT _ViewField_
SCAN FOR ParentID == _View_.ObjectID

*--------------------------------------------
* xCase Metadaten zu diesem Feld suchen.
*--------------------------------------------
SELECT ddVEl
* i_Field==0 sind z.B. Sätze für Felder die in der
* Where-Klausel enthalten sind
LOCATE FOR i_View==ddVew.Identifier AND ;
UPPER(ALLTRIM(Name))==UPPER(ALLTRIM(_ViewField_.ObjectName)) ;
AND NOT i_Field == 0
IF NOT FOUND()
LOOP
ENDIF
SELECT ddFld
LOCATE FOR Identifier==ddVEl.i_Field
*--------------------------------------------
* Grid-Caption in xCase nachtragen, falls
* nötig.
*--------------------------------------------
IF FOUND()
SELECT ddVEl
IF EMPTY(ALLTRIM( E_Message ))
REPLACE E_Message WITH ddFld.E_Message
ENDIF
ENDIF
SELECT ddVEl
IF EMPTY(ALLTRIM( u_Lbl_Grid ))
REPLACE u_Lbl_Grid WITH E_Message
ENDIF

*--------------------------------------------
* Format und InputMask von View-Feldern
* wird von CreateDB.app nicht übertragen.
*--------------------------------------------
* alte Version:
*!* DBSETPROP( ALLTRIM( ddVew.V_Name ) +"."+ ALLTRIM( ddVEl.Name ), ;
*!* "Field", "Format", ;
*!* IIF( EMPTY(RTRIM( ddVEl.Format )), RTRIM( ddFld.Format ),;
*!* RTRIM( ddVEl.Format ) ) )
*!* DBSETPROP( ALLTRIM( ddVew.V_Name ) +"."+ ALLTRIM( ddVEl.Name ), ;
*!* "Field", "InputMask", ;
*!* IIF( EMPTY(RTRIM( ddVEl.Mask )), RTRIM( ddFld.Mask ), ;
*!* RTRIM( ddVEl.Mask ) ) )
* inzwischen hat Elie Muyal das Problem behoben:
IF EMPTY(RTRIM( ddVEl.Format )) AND NOT EMPTY(RTRIM( ddFld.Format ))
DBSETPROP( ALLTRIM( ddVew.V_Name ) +"."+ ALLTRIM( ddVEl.Name ), ;
"Field", "Format", RTRIM( ddFld.Format ) )
ENDIF
IF EMPTY(RTRIM( ddVEl.Mask )) AND NOT EMPTY(RTRIM( ddFld.Mask ))
DBSETPROP( ALLTRIM( ddVew.V_Name ) +"."+ ALLTRIM( ddVEl.Name ), ;
"Field", "InputMask", RTRIM( ddFld.Mask ) )
ENDIF
*--------------------------------------------
* Feldkommentar übertragen.
*(..)Im DBC stehen nur die ersten 255 Zeichen.
*--------------------------------------------
SELECT _ViewField_
REPLACE u_Comment WITH ddVel.Comments
*--------------------------------------------
* Objektname übertragen. Im DBC steht sonst
* alles in Kleinbuchstaben.
*--------------------------------------------
REPLACE ObjectName WITH LTRIM( ddVEl.Name )
*--------------------------------------------
* Grid-Caption übertragen.
*--------------------------------------------
REPLACE u_Lbl_Grid WITH ddVEl.u_Lbl_Grid

ENDSCAN

ENDSCAN

*--------------------------------------------
* Schließen des als Tabelle geöffneten DBCs.
*--------------------------------------------
USE IN _View_
USE IN _ViewField_

*--------------------------------------------
* Rules für Plain Views können aus der Parent
* Tabelle übernommen werden.
*--------------------------------------------
LOCAL i, laViews[1], lcSQL, lcTables, lcRuleExpr, lcRuleText
FOR i=1 TO ADBOBJECTS( laViews, "View" )
*--------------------------------------------
* Wenns einen RuleText in der View gibt, dann
* hat die View bereits eine Record Rule.
*--------------------------------------------
IF NOT EMPTY(ALLTRIM( DBGETPROP( laViews[i], "View", "RuleText" )))
LOOP
ENDIF
*--------------------------------------------
* View-Attribute auslesen.
*--------------------------------------------
lcSQL = UPPER(DBGETPROP( laViews[i], "View", "SQL" ))
lcFields = SUBSTR( m.lcSQL, 7 ) && 'SELECT' ausblenden
* jetzt haben wir die Felder:
lcFields = ALLTRIM(LEFT( m.lcFields, AT("FROM",m.lcFields)-1 ))
lcTables = DBGETPROP( laViews[i], "View", "Tables" )
IF NOT "," $ m.lcFields ;
AND RIGHT( m.lcFields, 1 ) == "*" ;
AND NOT "," $ m.lcTables
*--------------------------------------------
* Wir haben eine 'Plain View'.
*--------------------------------------------
IF "!" $ m.lcTables
*--------------------------------------------
* DBC-Namen aus dem Tabellen-Namen entfernen.
*--------------------------------------------
lcTables = SUBSTR( m.lcTables, AT("!",m.lcTables)+1 )
ENDIF
*--------------------------------------------
* Rule aus der Tabelle holen.
*--------------------------------------------
lcRuleExpr = DBGETPROP( m.lcTables, "Table", "RuleExpression" )
IF NOT EMPTY(ALLTRIM( m.lcRuleExpr ))
lcRuleText = DBGETPROP( m.lcTables, "Table", "RuleText" )
*--------------------------------------------
* Record Rule der Tabelle auch in die View
* schreiben.
*--------------------------------------------
DBSETPROP( laViews[i], "View", "RuleExpression", m.lcRuleExpr )
DBSETPROP( laViews[i], "View", "RuleText", m.lcRuleText )
ENDIF
ENDIF
ENDFOR

*--------------------------------------------
* DBC schließen.
*--------------------------------------------
CLOSE DATABASE

ENDFUNC

*--------------------------------------------
* Datenmodell auf Fehler prüfen.
*--------------------------------------------
FUNCTION CheckModelIntegrity

#DEFINE MB_OK 0
#DEFINE MB_ICONSTOP 16

SELECT ddRel
LOCATE FOR EMPTY( e_k_Child )
IF FOUND()
MESSAGEBOX( "ddRel.e_k_Child ist in mindestens 1 Satz leer!", ;
MB_OK + MB_ICONSTOP, "CreateDBX" )
ENDIF
LOCATE FOR EMPTY( e_k_Paren )
IF FOUND()
MESSAGEBOX( "ddRel.e_k_Paren ist in mindestens 1 Satz leer!", ;
MB_OK + MB_ICONSTOP, "CreateDBX" )
ENDIF

ENDFUNC

Mehrere DBC in einem xCase-Modell pflegen

Bei großen Projekten wäre es oft sinnvoll das Datenmodell in mehrere DBCs aufteilen zu können, z.B. Stammdaten und Bewegungsdaten. Damit verliert man aber die für die automatische Erstellung des Referentiellen Integritäts Codes so wichtigen Beziehungen zwischen den Tabellen. D.h., man muß selbst dafür sorgen, daß z.B. ein Kunde nicht gelöscht wird, solange es noch Statistikdaten für ihn gibt.
xCase gibt uns zwar die Möglichkeit ein Modell in viele kleine übersichtliche Diagramme aufzuteilen, aber es unterstützt nicht das Erzeugen mehrerer DBCs aus einem Modell. Der Hauptgrund dafür ist, daß der DBC-Name nur einmal pro Modell gespeichert wird (ddGlb.Model_Name). 
Wenn wir das ändern wollen, müssen wir

• jeder Entity (Tabelle) im Modell eine neue Eigenschaft "gehört zu DBC xyz" geben
• beim Generieren des Triggercodes dafür sorgen, daß beim Öffnen einer Tabelle der Name der Datenbank angegeben wird
• beim Generieren der View SQL-Statements jeder Tabelle bzw. View den DBC-Namen voranstellen
• beim Generieren der DBCs dafür sorgen, daß nur die zugehörigen Tabellen/Views erzeugt werden
• beim Generieren der DBCs dafür sorgen, daß persistente Beziehungen nur erzeugt werden, wenn beide beteiligten Tabellen im gleichen DBC liegen (keine Angst, die Trigger feuern auch ohne die netten Linien zwischen den Tabellen J)

Das ist zwar keine triviale Aufgabe, aber mit den oben gezeigten Hilfsmitteln ist das möglich. Was im Detail angepaßt werden muß, werde ich in der Session zeigen.

Wieso funktioniert der Triggercode mit ODBC nicht vollständig?

Das ist weniger ein Problem von xCase als ein Problem des aktuellen VFP ODBC-Treibers. Der kommt offensichtlich mit Makrosubstitution ("&") nicht zurecht. Ich habe das Problem dem Hersteller mitgeteilt und er wird es in der nächsten xCase-Version beheben. Wer die aktuelle xCase Version 5.5 einsetzt und nicht auf das nächste Update warten will, kann das korrigierte TCL-Skript von mir haben (mailto: mw@bingo-ev.de).

xCase in deutsch

Der Hersteller trägt sich mit dem Gedanken xCase ins Deutsche zu übersetzen. Ich werde versuchen, zur Konferenz eine aktuelle Stellungnahme des Herstellers zu erhalten.

Neue xCase Features für VFP7

Zum Zeitpunkt der Erstellung dieses Skripts lag dazu leider noch keine Stellungnahme des Herstellers vor. 

Übrigens…

Den meisten xCase Anwendern dürfte schon mal aufgefallen sein, daß das FoxCase-Menü nach einem CLEAR ALL nicht mehr funktioniert. Ich habe 1998 einen Ersatz für das FoxCase Menü entwickelt der bis heute funktioniert und die oben genannten Probleme nicht hat. Es ist seitdem bei mir und einigen VFP-Programmierern in meinem Bekanntenkreis im Einsatz. Wer es haben will: mailto:mw@bingo-ev.de.