ÖNEMLİ HABERLER 

 PRESSEMITTEILUNGEN 

 KÜRESEL KRİZ FAİZ ENERJİ 

 PROJECTS 

 TRANSPORTATION TECHNOLOGIES 

 GLOBAL COMPETITION 

 REQUIREMENTS DEF'N  

 SERVICES 

 PREFACE  

 
New Page 1
MAIN  >  TELEKOM PROJELERİ  >
     











 
 
TELEKOM PROJELERİ

 

 

Textfeld: CAU

 

User Profile in SAP HANA SybaseIQ  DataModeling Tool: Power Designer 16.5  Overall Architecture Proposaö for Big data Analytics in telecomm Industry prepared by Prof.Dr.Mehmet Erdas/Competitive BDA for Telecomm I Industry  17.11.2013

 

 

 

SAP HANA and In-Memory Business Data Management

 

 

Configure ABAP to HANA SSL connection

I am working on a project where one of the requirements is to encrypt the traffic between the CI and the HANA back end DB. This is sort of documented in section 4.3 of the HANA Security Guide (http://help.sap.com/hana/SAP_HANA_Security_Guide_en.pdf), but it still took me some time to figure out. I understand the next version of the security guide will have more detailed instructions, but thought I'd share some details that may help others in the meantime.

 

The below instructions are based on sapcrypto. In SP7, there is an option to use commoncrypto. OpenSSL is also an option if sapcrypto is not installed.

 

  • Install sapcrypto on both CI and HANA systems
    • This is well documented, so I won't provide details here
    • Copy libsapcrypto.so to .../lib directory
      • cp libsapcrypto.so /usr/sap/<sid>/SYS/global/security/lib
  • Create PSE files for both the CI and HANA systems
    • See 1718944 - SAP HANA DB: Securing External SQL Communication (SAPCrypto)
    • If a Certificate Authority (CA) is not available, SAP provides an option to create a test cert that is valid for 8 weeks: https://websmp110.sap-ag.de/tcs
      • This option can be used to sign the sapcli.req from Note 1718944
    • In my case, the customer created a PFX file using their own CA
      • This requires a conversion of the *.PFX files provided by customer to PSE using command below
        • sapgenpse import_p12 -p sapcli.pse <existing_cert>.pfx
    • copy sapcli.pse to sapsrv.pse
        • cp sapcli.pse sapsrv.pse
    • sapsrv.pse is required for server authentication – HANA DB
    • sapcli.pse is required for client authentication – CI ABAP system
      • Even though only the above files are required on the respective systems for our scenario, it is easy to create both pse files on both systems.
  • Enable SSL on HANA
    • su to <sid>adm
    • Create $SECUDIR
      • mkdir -p $SECUDIR
    • Copy both pse files to $SECUDIR
      • cp sapcli.pse sapsrv.pse $SECUDIR
    • Restart the HANA DB to enable SSL
  • Configure CI to connect via SSL
    • Copy sapcli.pse to /usr/sap/<SID>/DVEBMGS00/sec
      • If sec directory above doesn’t exist, then create it while logged on as <sid>adm
    • Add the following parameter in the DEFAULT.PFL to enable encryption on the DB connection
      • dbs/hdb/connect_property = ENCRYPT=TRUE
    • Stop and start CI.
    • Check dev_w0 and verify connection to DB. Should look something like below.

Loading SQLDBC client runtime ...

C  SQLDBC Module  : /usr/sap/<SID>/hdbclient/libSQLDBCHDB.so

C  SQLDBC Runtime : libSQLDBCHDB 1.00.70.00 Build 0386119-1510

C  SQLDBC client runtime is 1.00.70.00.0386119

C  connect property [ENCRYPT = TRUE]

C

C  Try to connect via secure store (DEFAULT) on connection 0 ...

C

C Sun Jan 12 19:41:31 2014

C  Attach to HDB : 1.00.70.00.386119 (NewDB100_REL)

C  Database release is HDB 1.00.70.00.386119

C  INFO : Database '<SID>/00' instance is running on '<HANA_Host>'

C  INFO : Connect to DB as 'SAP<SID>', connection_id=300100

C  DB max. input host variables  : 32767

 

 

I rant into a few errors on the CI that caused the workservers to crash. I've outlined the errors I saw in the dev_w* traces, the cause and the steps to resolve the errors.

  • Troubleshooting -
    • Error message
      • "Cannot create SSL context" - This message does not provide additional details as the below error messages do. Very generic.
        • Possible Causes
          • sapcrypto library is not accessible
          • PSE key/trust store is not available or not properly filled
        • Solution
          • Ensure sapcrypto is installed correctly and the PSEs are created properly
    • Error message

C SQLERRTEXT : Connection failed (RTE:[300010] Cannot create SSL context: ERROR in SSL_CTX_set_default_pse_by_name:\

C                (4129/0x1021) The PSE does not exist : "/usr/sap/<SID>/DVEBMGS00/sec/sapcli.pse",ERROR in ssl_set_pse\

C               : (4129/0x1021) The PSE does not exist : "/usr/sap/<SID>/DVEBMGS00/sec/sapcli.pse",ERROR in af_open: (\

C               4129/0x1021) The PSE does not exist : "/usr/sap/<SID>/DVEBMGS00/sec/sapcli.pse",ERROR in secsw_open: (\

C               4129/0x1021) The PSE does not exist : "/usr/sap/<SID>/DVEBMGS00/sec/sapcli.pse",ERROR in secsw_open_ps\

        • Solution
          • Verify Sapcli.pse is available in the directory and SIDADM has permissions to it.
    • Error message

SQLERRTEXT : Connection failed (RTE:[300015] SSL certificate validation failed: host name '<hostname>' does not m\

C               atch name in certificate '<DifferentHostname.domain.com')

B  ***LOG BV3=> severe db error -10709    ; work process is stopped [dbsh         1244]

B  ***LOG BY2=> sql error -10709 performing CON [dblink       550]

B  ***LOG BY0=> Connection failed (RTE:[300015] SSL certificate validation failed: host name '<hostname> does not match name in certificate '<DifferentHostname.domain.com') [dblink       550]

M  ***LOG R19=> ThDbConnect, db_connect ( DB-Connect 000256) [thDatabase.c 75]

M  in_ThErrHandle: 1

M  *** ERROR => ThInit: db_connect (step TH_INIT, thRc ERROR-DB-CONNECT_ERROR, action STOP_WP, level 1) [thxxhead.c   2151]

 

        • Cause/Solution
          • Ensure that the CI is using the hostname that exists in the certificate to establish the connection
          • Force the connection to use the hostname specified in the cert by updating the dbs/hdb/connect_property in DEFAULT.PFL
            • Example: dbs/hdb/connect_property = ENCRYPT=TRUE, sslHostNameInCertificate=DifferentHostname.domain.com
            •  

The configuration is really simple once figuring it, but I did run into various issues trying to get it to work. Feel free to ask questions in the comment and I'll do my best to answer right away.

Currently Being Moderated

 

ABAP News for 7.40, SP08 - Grouping Internal Tables

 

You know the GROUP BY clause from SQL. There was not such a clause for internal tables up to now. All we had was that clumsy group level processing with statements AT NEW ... that relied on the order of table columns and contents that is sorted respectively.

 

With release 7.40, SP08 there is a real GROUP BY clause for LOOP AT itab that is much more powerful than the SQL one.

 

DATA flights TYPE TABLE OF spfli WITH EMPTY KEY.

SELECT * FROM  spfli
         WHERE carrid = '...'
         INTO TABLE @flights.

 

DATA members LIKE flights.
LOOP AT flights INTO DATA(flight)
     GROUP BY ( carrier = flight-carrid cityfr = flight-cityfrom )
              ASCENDING
              ASSIGNING FIELD-SYMBOL(<group>).
  CLEAR members.
  LOOP AT GROUP <group> ASSIGNING FIELD-SYMBOL(<flight>).
    members = VALUE #( BASE members ( <flight> ) ).
  ENDLOOP.
  cl_demo_output=>write( members ).
ENDLOOP.
cl_demo_output=>display( ).

 

Looks like dreaded nested LOOPs, but it isn't quite that!  What happens here is that the first LOOP statement is executed over all internal table lines in one go and the new GROUP BY addition groups the lines. Technically, the lines are bound internally  to a group that belongs to a group key that is specified behind GROUP BY.The group key is calculated for each loop pass. And the best is, it must not be as simple as using column values only, but you can use any expressions here that normally depend on the contents of the current line, e.g. comparisons, method calls, .... The LOOP body is not evaluated in this phase!

 

Only after the grouping phase, the LOOP body is evaluated. Now a second (but not nested) loop is carried out over the groups constructed in the first phase. Inside this group loop you can access the group using e.g. the field symbol <group> that is assigned to the group in the above example. If you want to access the members of the group, you can us the new LOOP AT GROUP statement, which enables a member loop within the group loop. In the example, the members are inserted into a member table and displayed.

 

Here another example, where the group key is evaluated from method calls:

 

LOOP AT flights INTO DATA(wa)

     GROUP BY ( tz_from = get_time_zone( wa-airpfrom )

                tz_to   = get_time_zone( wa-airpto ) )

     ASSIGNING FIELD-SYMBOL(<group>).

  ...

ENDLOOP.

 

Of course, there is also expression enabled syntax for grouping internal tables.

 

In a first step, we get rid of LOOP AT GROUP by replacing it with a FOR expression:

 

DATA members LIKE flights.

LOOP AT flights INTO DATA(flight)

     GROUP BY ( carrier = flight-carrid cityfr = flight-cityfrom )

              ASCENDING

              ASSIGNING FIELD-SYMBOL(<group>).

  members = VALUE #( FOR m IN GROUP <group> ( m ) ).

  cl_demo_output=>write( members ).

ENDLOOP.

cl_demo_output=>display( ).

 

The IN GROUP is a new addition to FOR. Second, away with the outer LOOP:

 

TYPES t_flights LIKE flights.

DATA out TYPE REF TO if_demo_output.

out = REDUCE #( INIT o = cl_demo_output=>new( )

                FOR GROUPS <group> OF flight IN flights

                GROUP BY ( carrier = flight-carrid cityfr = flight-cityfrom )

                  ASCENDING

                LET members = VALUE t_flights( FOR m IN GROUP <group> ( m ) ) IN

                NEXT o = o->write( members ) ).

out->display( ).

 

FOR GROUPS is another new FOR variant. Believe me, it does the same as the variants above. But for reasons of readability, the combination

Evaluation of PLM Systems

 

Prof Dr Mehmet Erdas

Product Life Cycle Management PLM is the key software for investment protection of end to end enterprise ITC Systems Software. Without a strategic approach on how to match , how to align  the business processes to data modeling and enterprise architecture assuring the investment protection and data quality using best practices and maximum value added KPI derivation to make things .ie. changes in business processes and master data   (end to end)  measurable and controllable enabling the ITC systems or installing and developing  PLM  Systems with maximum attention on service deliverability and controllability just in time(real time)! This is the essence of PLM systems verification by using pe-defined metrics derived from alignment of business strategy and IT Strategy goal settings.The Transformation of business infrastructure as Business and ITC Processes have to be assessed systematical approach to enable the investment protection and pay off periods to derive how to enable buy and install the PLM Systems. The level of detail coverage and systems architecture systems interfaces are to be analyzed and precisely defined in Requirements definition  and scope management for for PLM Systems investments.

 

 

 

 

Camtasia Studio for ppt

 

Data Model BSS OSS COTS OTT Segmentation DWH

 

The fact table is based on the MSISDN csv file

                               

F_Customer_Data

Type

 

D_Product_Data

Type

   

This is a pre-provisioned table of available products

                 

Customer_ID

CHAR(16)

 

Product_ID

NUMERIC(3,0)

                         

MSISDN

CHAR(16)

 

Product_Class

CHAR(20)

                         

Account_Num

NUMBERIC(20,0)

 

Product_Description

CHAR(64)

                         

Bus_ID

NUMERIC(2,0)

                               

Base_Type_ID

NUMERIC(2,0)

                               

Bill_Cycle

Date(5)

       

F_Customer_Product

Type

This table is to join the Customer with the products for that Customer based on the Product csv file

     

Payment_Method_ID

NUMERIC(2,0)

       

Customer_ID

CHAR(16)

There will be multiple Products for each Customer. Hence there may be multiple Customer_ID in this table identifying the Products.

Credit_Class_ID

NUMERIC(2,0)

       

Product_ID

CHAR(64)

Need to be consider the performance impact of loading all Customers * the number of products per Customer

   

Customer_Value

NUMERIC(20,0)

                               

Gender

NUMERIC(1,0)

                               

Age

CHAR(3)

   

D_Bus_Flag

Type

 

These dimenion tables are either pre-populated or populated based on the Customer environment

         

Geo_Postcode

CHAR(8)

   

Bus_ID

NUMERIC(2,0)

                       

Geo_Region

CHAR(20)

   

Label

CHAR(20)

                       

Demo_Group

CHAR(20)

                               

Demo_Type

CHAR(20)

                               

Account_Open_Date

Date(10)

   

D_Base_Type

Type

                       

Contract_Start_Date

Date(10)

   

Base_ID

NUMERIC(2,0)

                       

Contract_End_Date

Date(10)

   

Label

CHAR(20)

                       

Contract_Length

NUMERIC(3,0)

                               

Months_Into_Contract

NUMERIC(3,0)

                               

Rem_Months_Contract

NUMERIC(3,0)

   

D_Payment_Type

Type

                       

Prev_Contract_Ren_Mths

NUMERIC(3,0)

   

Payment_ID

NUMERIC(2,0)

                       

Acq_Channel_ID

NUMERIC(2,0)

   

Label

CHAR(20)

                       

Ret_Channel_ID

NUMERIC(2,0)

                               

Channel_Type_ID

NUMERIC(2,0)

                               

Connection_Date

Date(10)

   

D_Credit_Class

Type

                       

Upgrade_Ret_Date

Date(10)

   

Credit_ID

NUMERIC(2,0)

                       

Upgrade_Ret_Type

NUMERIC(2,0)

   

Label

CHAR(20)

                       

Tenure

NUMERIC(3,0)

                               

Ported_In_From (Carrier_ID)

NUMERIC(2,0)

                               

Disconnection_Date

Date(10)

   

D_Channel

Type

 

D_Channel_Type

Type

                 

Disconnection_Reason_ID

NUMERIC(2,0)

   

Channel_ID

NUMERIC(2,0)

 

Channel_Type_ID

NUMERIC(2,0)

                 

Disconnect_Reason_Group_ID

NUMERIC(2,0)

   

Label

CHAR(20)

 

Label

CHAR(20)

                 

Mig_From_Prepay

Date(10)

   

Channel_Type_ID

NUMERIC(2,0)

                       

Mig_From_Postpay

Date(10)

                               

Price_Plan_Code_ID

NUMERIC(2,0)

                               

Price_Plan_Name_ID

NUMERIC(2,0)

   

D_Carrier

Type

                       

Price_Plan_Group_ID

NUMERIC(2,0)

   

Carrier_ID

NUMERIC(2,0)

                       

Port_Date

Date(10)

   

Label

CHAR(20)

                       

Port_Status

NUMERIC(2,0)

                               

Port_MSISDN

CHAR(16)

                               

DNO (Carrier_ID)

NUMERIC(3,0)

   

D_Disconnect_Reason

Type

 

D_Disconnect_Reason_Group

Type

                 

RNO (Carrier_ID)

NUMERIC(3,0)

   

Disconnect_Reason_ID

NUMERIC(2,0)

 

Reason_Group_ID

NUMERIC(2,0)

                 

DSP (Carrier_ID)

NUMERIC(3,0)

   

Label

CHAR(20)

 

Label

CHAR(20)

                 

RSP (Carrier_ID)

NUMERIC(3,0)

   

Reason_Group_ID

NUMERIC(2,0)

                       

Market_Method_ID

NUMERIC(3,0)

                               
                                   
       

D_Price_Plan

Type

 

D_Price_Plan_Group

Type

                 
       

Price_Plan_ID

NUMERIC(2,0)

 

Price_Plan_Group_ID

NUMERIC(2,0)

                 
       

Name

CHAR(20)

 

Label

CHAR(20)

                 
       

Code

CHAR(20)

                       
       

Price_Plan_Group_ID

NUMERIC(2,0)

                       
                                   
                                   
       

D_Marketing_Method

Type

                       
       

Marketing_Method_ID

NUMERIC(2,0)

                       
       

Label

CHAR(20)

                       
                                   
                                   
       

D_Port_Status

Type

                       
       

Port_Status_ID

NUMERIC(2,0)

                       
       

Label

CHAR(20)

                       
                                   
                                   
       

D_Gender

Type

                       
       

Gender_ID

NUMERIC(2,0)

                       
       

Label

CHAR(20)

                       
                                   
                                   
       

D_Upgrade_Ret_Type

Type

                       
       

Ret_Type_ID

NUMERIC(2,0)

                       
       

Label

CHAR(20)

                       
                                   
                                   
                                   

BKPI Tables /SDR Tables

In this instance the BKPI and SDR tables are identical

                           
                                   

BKPI_Product_Daily

Type

                               

Product_ID

NUMERIC(3,0)

                               

DD_Payment_Customers

NUMERIC(10,0)

                               

Total_Customers_Payment

NUMERIC(10,0)

                               

Credit_Payment_Customers

NUMERIC(10,0)

                               

Debit_Payment_Customers

NUMERIC(10,0)

                               

Manual_Payment_Customers

NUMERIC(10,0)

                               

Customers_with_lessthan_3months

NUMERIC(6,0)

                               

Customers_with_lessthan_6months

NUMERIC(6,0)

                               
                                   
                                   
                                   

BKPI_Customer_Type_Daily

Type

                               

Customer_Type_ID

NUMERIC(3,0)

                               

DD_Payment_Customers

NUMERIC(10,0)

                               

Total_Customers_Payment

NUMERIC(10,0)

                               

Credit_Payment_Customers

NUMERIC(10,0)

                               

Debit_Payment_Customers

NUMERIC(10,0)

                               

Manual_Payment_Customers

NUMERIC(10,0)

                               

Customers_with_lessthan_3months

NUMERIC(6,0)

                               

Customers_with_lessthan_6months

NUMERIC(6,0)

                               
                                   
                                   
                                   

BKPI_Price_Plan_Daily

Type

                               

Price_Plan_ID

NUMERIC(3,0)

                               

DD_Payment_Customers

NUMERIC(10,0)

                               

Total_Customers_Payment

NUMERIC(10,0)

                               

Credit_Payment_Customers

NUMERIC(10,0)

                               

Debit_Payment_Customers

NUMERIC(10,0)

                               

Manual_Payment_Customers

NUMERIC(10,0)

                               

Customers_with_lessthan_3months

NUMERIC(6,0)

                               

Customers_with_lessthan_6months

NUMERIC(6,0)

                               
                                   
                                   

BKPI_Channel_Daily

Type

                               

Channel_ID

NUMERIC(3,0)

                               

Acquisition_Customers

NUMERIC(8,0)

                               

Retention_Customers

NUMERIC(8,0)

                               

Total_Customers_Acq_Ret

NUMERIC(8,0)

                               
                                   
                                   
                                   

BKPI_Carrier_Daily

Type

                               

Carrier_ID

NUMERIC(3,0)

                               

Transferred_From_Operator

NUMERIC(8,0)

                               

Transferred_To_Operator

NUMERIC(8,0)

                               

Total_Operator_Transfer_In

NUMERIC(8,0)

                               

Total_Operator_Transfer_Out

NUMERIC(8,0)

                               
                                   
                                   
                                   
                                   
                                   

This extension allows you to create PowerDesigner model objects from tables of data imported from an Microsoft Excel file. The wizard can import one table on each worksheet as a PowerDesigner object type, creating one instance of the object for each row in the table, and importing the value of each column of each row into a property that you specify.

 

This XEM also serves as an example of how PowerDesigner can be extended to import data into objects from external file types.

 

I. Using the Excel import feature

 

1. Attach the XEM to any kind of PowerDesigner model.

2. Right-click the model or package node in the Browser and select Import New Excel File.

3. Enter the filename of your Excel file in the wizard, and click Close to instruct it to analyze the available data.

4. Select the PowerDesigner object type that you want to import each row of the table into, and then click Close. You can specify an existing object type, choose to create a new extended object, or skip the import of the table.

5. For each column in the table on the worksheet, specify the object property into which you want to import that column's values. You can specify an existing property, choose to create a new extended attribute (which will be named after the column heading), or skip the import of the column.

6. If there are additional worksheets containing tables in your workbook, you will be prompted to specify a new object to import the data into.

7. When you have specified a mapping for the final column of the final table, the import will begin, and new objects of the specified kind(s) will be created for each row in each table.

8. In addition to the specified objects, an Import Excel object is created to allow you to resynchronize your model with changes to your Excel file. To resynchronize, right-click the Import Excel object and select the Import method.

 

II) Implementing the import

 

1) Metamodel

 

The metamodel is quite simple: All import information is stored on an abstract GenericImport object that is overridden into a concrete ExcelImport object. This generic import stores the data source identification (Excel filename) and a list of table mapping sub-objects.

A table mapping sub-object is created for each table found in the imported document. A class kind is associated to each table in addition to a list of column mappings.

Column mappings are sub-objects of the table mapping sub-object. They map a table column to an object attribute.

 

2) User Interface

 

The dialogs asking for missing mapping information are created using custom forms defined on each metaclass element.

The Select Filename form on the generic import asks for data source definition (Excel filename)

The Table Mapping Definition form on the Table Mapping sub-object metaclass asks for the kind of object to associate with a table

The Column Mapping Definition form on the column Mapping sub-object asks for the kind of attribute to associate with a table column

Standard message boxes are also used for displaying messages to the end-user

 

3) Import algorithm

 

The import algorithm is implemented by the Import method defined on the Generic Import metaclass. The main steps are the following:

 - Open the data source document.

 - Enumerate the available tables in the document.

 - Adjust the mapping persistence structure by creating missing table mapping and column mapping objects.

 - For each table of the document:

   - Ask for incomplete mapping definition (class kind or object attribute).

   - For each row of the table document:

      - Read data.

      - Search for an existing matching object or create a new one.

      - Commit each cell value into the object.

 - Close the document.

The Global Script available on the Profile item provides many more implementation details.

 

III) Advanced features demonstrated by this XEM

 

1) Defining a new metaclass

 

This is done by creating a stereotype on the base metaclass we want to extend (extended object in our case) and selecting the 'use as metaclass' check box. We define an abstract 'GenericImport' stereotype that is overridden by the concrete 'ExcelImport' metaclass. This allows sharing data and behavior that may be common to other import features.

To define a sub-object, we add an extended composition extension and click on the New button to create a new sub-object kind (stereotype on the extended sub-object metaclass)

Once each metaclass has been declared, we can define extended attributes and display those attributes in the General page of the property sheet using a custom form with the 'Replace General Tab' type.

 

2) Controlling the editing of attributes

 

We want to ensure that the Attribute extended attribute defined on the ColumnMapping extended metaclass belongs to the metaclass associated to the table.

To implement this, we specify that Attribute is 'Complete' (which means that we cannot enter a value not in the list specified) and compute the list of available attributes into a GTL template (named allAttributes)

 

The Excel filename attribute on the Excel Import metaclass cannot be reduced to a finite list of predefined values. Instead, it must correspond to a valid Excel file. This can be checked using a trick demonstrated with the DataSource extended attribute on the ExcelImport metaclass.

We define another computed attribute that encapsulates the editing of the filename persistent attribute, which lets us implement all the validations we want in the Set Method Script (if the file could not be opened, we display an error message)

We can also perform some cascade changes (for instance update the list of table mappings and column mappings when the filename changes).

 

3) Accessing existing metamodel information

 

Two GTL templates (allMainObjects and allAttributes) demonstrate how to list available metaclasses and meta attributes.

The Imported Kind attribute on the Table mapping stereotype demonstrates how to convert a class name into class kind.

The GetAttributeText and SetAttributeText methods (see for instance the GetObjectValue and CommitCellData methods in Global Script) can be used to retrieve or modify an attribute by supplying just its public name.

The GetOrCreateExtendedAttribute method implemented also in Global Script demonstrates the retrieve and creation of meta extensions in scripts.

 

4) Making an extension available to all modules

 

An extension is generally designed for a specific module. However, in some cases (including the generic import), and where only metaclasses available in all modules (extended object, extended sub-object) are used, it may be interesting to make it available to all modules.

This is possible (though not via the PowerDesigner interface) by modifying the header of the XEM file in a text editor and replacing the existing LibID="{xxx}" string by LibID="{00000000-0000-0000-0000-000000000000}"

Note that this change is not preserved if you edit the XEM in the PowerDesigner resource editor. Just remember to perform this manual change before sharing your XEM with end-users.

 

Sub %Method%(obj)

  

   ' Create new object

   Dim import

   set import = obj.ExtendedObjects.CreateNew()

   if not import is nothing then

      import.Stereotype = "ExcelImport"    

     

      ' Launch import

      import.ExecuteCustomMethod "%CurrentTargetCode%.Import"

     

      ' Detect error

      If import.GetExtendedAttribute( "%CurrentTargetCode%.DataSourcePersist") = "" then

         import.Delete

      End If

      set import = nothing

   End If

  

End Sub

 

 

******************************************************************************

'* Purpose:  This VB-Script holds global definitions shared by all the custom-

'*            checks scripts of the model extension.

'*

'* Versions:

'*           2.1 - Aug 24, 2010 - Fix non-reuse of previously imported objects when they

'*                                have a local namespace (links on components in EAM)

'*                                + Consider name/code as link identifiers if they are mapped

'*           2.0 - Feb 19, 2010 - + Simplify UI + import sub-objects and composition links

'*                                + match link objects by source and destination

'*                                + support of qualified name for referencing objects

'*                                + import several values in cell for list of objects

'*                                + handle non-repeated values for mandatory attributes

'*                                15.2.0 version.

'*           1.9 - Jun 19, 2009 - Add Cancel buttons in mapping definition dialog

'*                                and rename Close button into Next

'*                                15.1.0 version.

'*           1.8.2 May 25, 2009 - Fix vbscript error + encapsulate error management

'*                                into functions + Initialize Reference class when

'*                                relationship or attribute is set

'*                                15.0.0.EBF 7 version.

'*           1.8.1 May 19, 2009 - Fix missing items in class, attribute or relationship lists

'*                                + improve error messages in some other cases

'*                                + handle global object case

'*                                Internal version.

'*           1.8 - May 15, 2009 - Several fixes for 15.1.0 beta1 + Improve error messages

'*                                + improve metamodel extension support

'*                                15.1.0 beta1 version.

'*           1.7 - Apr 24, 2009 - Fix import of composition collections + sort combo boxes

'*                                + add option for symbols + add string literal for Boolean

'*                                Internal version.

'*           1.6 - Dec  2, 2008 - Several fixes on set attribute and object creation,

'*                                provide more error messages in the output.

'*                                Internal version.

'*           1.5 - Nov 20, 2008 - Enhanced version with support of reference and relationships,

'*                                ability to map to new concept, new extended attribute or new

'*                                extended collection.

'*                                Used for several internal demonstrations.

'*           1.0 - Oct  2, 2008 - First version with basic support of standard attributes

'*                                Delivered in 15.0 official build.

'******************************************************************************

 

Option Explicit ' This is to ensure all used variables are defined

 

Dim debugMode

debugMode = false  ' Set it to true for logging more debug information and stop on first error

 

'******************************************************************************

'*

'*                    Implementation Details

'*

'*

'* This Import feature is designed to be adapted to any data source describing

'* objects in table of data. It can be adapted for instance for an import of

'* database tables, CSV files or even another model kind from which we know how

'* to enumerate object instances and attributes.

'*

'* The functions implemented in this global script are therefore grouped into

'* two separated categories: the ones dependent of the data source kind (Excel

'* in this case) and the ones that implement the import generic logic.

'*

'* The methods to be implemented to support a new data source are the following:

'*    - Function CheckApplicationExist(): Checks if the application associated

'*          to the source document can be used on the machine and returns an error

'*          message if it is not the case. Returns an empty string if such

'*          application exists.

'*    - Function OpenSourceDocument(value): Opens the datasource.

'*          The value first parameter is a string corresponding to the data

'*          source identification (Excel filename in our case) and the return

'*          value corresponds to the data source object (An Excel workbook in

'*          our case)

'*    - Sub CloseSourceDocument(document): Closes the datasource.

'*          The first parameter must be the document returned by the Open function.

'*    - Function EnumerateDocumentTables(document): Enumerates the list of data

'*          tables available in the document. A table of data will be mapped to a

'*          list of objects of same kind. The first parameter must be the document

'*          object returned by the Open method. The return value must be a

'*          VB Script Dictionary object (key/value map) with the table name as key

'*          and an object identifying the table as value (an Excel Range object

'*          in our case)

'*   - Function EnumerateTableColumns(table, name): Enumerates the available

'*          columns for a table identified by the previous method. The first

'*          parameter must be a table object (Excel Range) and the second one

'*          must be the table name. The return value is a VB Script Dictionary

'*          object with the column name as key and a column object (Excel Column

'*           range in our case) as value

'*   - Function GetTableRowCount(table, name): Optional method to count number of

'*          rows available in the table. Used by the progress bar. If this

'*          information cannot be retrieved easily, return 0

'*   - Function GetNextTableRow(table, line, name): Retrieves the next line of a table

'*          The first parameter is the table object provided by the

'*          EnumerateDocumentTables method. The second object is an object

'*          identifying the current line of the table (An Excel Row Range in our case)

'*          This parameter is set to nothing to retrieve the first line.

'*          The third parameter corresponds to the table name.

'*          The return value is a line object corresponding to the next table line.

'*          The method must return 'Nothing' when there is no more data in the table.

'*   - Function GetRowValues(table, line, name): Retrieves the values of a table line.

'*          The first parameter is the table object provided by the

'*          EnumerateDocumentTables method.

'*          The second parameter is the line object provided by GetNextTableRow

'*          The third parameter is the table name.

'*          The expected return value is a VB Script Dictionary object with the

'*          column name as key and the cell data as value. The cell data can be

'*          a string or a variant

'*

'* The generic import algorithm is implemented in the Import method of the 'GenericImport' stereotype.

'* In addition to calling the data source specific methods described above, it is

'* decomposed into the following categories of functions:

'*

'*  Import Functions

'*  - Function ImportDocumentData(tablDict, importDefn, totalCreate, totalUpdate, totalWarning): The

'*          entry point for the generic import. The parameters are the dictionay

'*          of table documents retrieved by EnumerateDocumentTables method, the object

'*          storing all mapping information for this document and two output integer

'*          parameters to return the total number of objects created or updated by

'*          the import. The return value is false if the import has been aborted.

'*  - Function CanImportTableData(tablMap, colnCol, classId, fldr, totalWarning, subObj)

'*          Performs some checks to detect if all mandatory mapping have been defined.

'*          For instance, a sub-object must have a column mapped to <Parent> specific attribute.

'*  - Function ImportTableData(tablSrc, tablMap, totalCreate, totalUpdate, totalWarning, globalDict):

'*          Imports data from a single document table. The parameters are the document table,

'*           its associated table mapping object, the two output parameters for returning

'*          the number of created and updated objects and at last a global dictionary object

'*          that stores for each class and key attribute a map of value/object.

'*          The return value is false if the import has been aborted by the end-user

'*  - Sub CommitRowData(dictValues, classId, strn, subObj, lnkClss, colnCol, fldr, countCreate, countUpdate, totalWarning, globalDict):

'*          Imports data from a single table row. It may create an object or update

'*          an already existing one. The parameters are the row values (retrieved by

'*          calling the GetRowValues method), the kind of object associated with the

'*          table, an optional stereotype value, the collection of all column mappings

'*          for this table, the folder where the imported object should be stored,

'*          the two count output parameters and the global dictionary

'*  - Sub CommitCellData(newobj, colnMap, vale, subObj, globalDict, countCreate, totalWarning): Assign a value retrieved from the

'*          document to the object for one table cell. The parameters are the model

'*          object to update, the column mapping information for the cell and the value

'*          retrieved from the imported document.

'*  - Function AdjustValueType(colnMap, newObj, vale, globalDict, countCreate, totalWarning):

'*          Convert the string value retrieved from data source into expected data type.

'*          Specifically for Object and Boolean data types

'*

'*  Methods to Retrieve Existing Objects

'*  - Function FindOrCreateObjectFromRow(dictValues, classId, strn, subObj, colnCol, fldr, countCreate,

'*          countUpdate, totalWarning, globalDict): Find an existing object from row values or create a new one.

'*          This function will search for a column that is mapped to an identifying attribute

'*          like name or code to try to retrieve the object from information provided in row values.

'*          The parameters are the same as for CommitRowData function. The return value

'*          is the retrieved or created object.

'*  - Function FindOrCreateSubObjectFromRow(dictValues, classId, strn, colnCol, fldr, created, countCreate,

'*          countUpdate, totalWarning, globalDict): The same as previous method but for sub-objects.

'*  - Function FindOrCreateObjectFromCell(colnMap, vale, newObj, countCreate, totalWarning, globalDict):

'*          find an existing object from a value and a single column mapping or create a new one.

'*  - Function RetrieveClassKeyDictionary(globalDict, classId, strn, attrName, fldr, create):

'*          Retrieve or build a VB script dictionary object that stores for a class attribute the map of

'*          attribute value (as key) and associated oject (as value). This dictionary is

'*          created on first call with create=true and then stored in the global dictionary to reuse it.

'*          This is an optimization that avoid looping on all objects each one we need to solve

'*          a referential key. If the folder parameter is nothing, we just try to retrieve it

'*          and not to create it.

'*  - Sub FillClassKeyDictionary(keyDict, classId, strn, attrName, fldr): Fill a new class key dictionary

'*          with all available values in the model. The attribute value is the key and the

'*          corresponding object is the value.

'*  - Function GetObjectValue(obj, attrName): Retrieves the object value.

'*          The parameters are the object and the attribute public name.

'*

'*   Mapping Definition Functions

'*   - Sub AdjustTableMappings(obj, dict): Each document table needs to be associated

'*          to an object kind. This mapping information is stored on a table mapping

'*          sub-object created for each document table. This method creates those

'*          table mapping sub-objects (or deletes obsolete ones).

'*          The first parameter is the ExcelImport object that stores all mapping

'*          information and the second parameter is the dictionary returned by

'*          the EnumerateDocumentTables method and containing the list of tables

'*          available in the document.

'*  - Function GetOrDefineTableMapping(tablMap, showDialog):  Retrieve mapping information

'*          for a table and displays if necessary a dialog to the end-user to

'*          enter this information when it is incomplete

'*          The table mapping sub-object is provided in parameter and the return

'*          value is the kind of object associated to this document table.

'*          The second parameter allows to display the mapping dialog even if it is

'*          already correctly defined

'*  - Sub AdjustColumnMappings(tablSrc, tablMap): Each column of a document table

'*          needs to be associated to an object attribute. This mapping information

'*          is stored on a column mapping sub-object created for each document table

'*          column. This method creates those column mapping sub-objects (or deletes

'*          obsolete ones).

'*          The first parameter is the table document object returned by

'*          the EnumerateDocumentTables method. The second parameter is the table

'*          mapping sub-object corresponding to this document table.

'*  - Function GetOrDefineColumnMapping(colnMap, showDialog):  Retrieve mapping information

'*          for a table column and displays if necessary a dialog to the end-user to

'*          enter this information when it is incomplete

'*          The column mapping sub-object is provided in parameter and the return

'*          value is the public name of the object attribute associated to this column.

'*          The second parameter allows to display the mapping dialog even if it is

'*          already correctly defined

'*

'*  Metamodel Extension Creation Functions

'*  - Function GetOrCreateExtendedAttribute(obj, colnMap): Retrieves or creates a new

'*          extended attribute definition corresponding to a document column.

'*          Extended attributes are retrieved from any extension associated to current

'*          model. Creation of a new extended attribute definition is done in the

'*          extension associated to the import object. If no extension

'*          is associated at the beginning of the import, a new extension is automatically created.

'*  - Function CreateNewMetaclass(tablMapp, kind): Displays a dialog to create a new metaclass

'*          based on the one specified by kind and return the corresponding stereotype definition.

'*          The fist parameter must be any table mapping object.

'*  - Function CreateNewAttribute(colnMapp, kind): Displays a dialog to create a new extended attribute

'*          on the class specified by kind and return the corresponding attribute definition.

'*          The fist parameter must be any column mapping object.

'*  - Function CreateNewCollection(colnMapp, kind): Displays a dialog to create a new extended collection

'*          on the class specified by kind and return the corresponding collection definition.

'*          The fist parameter must be any column mapping object.

'*

'* Some utility methods are also used in this generic import algorithm:

'*  - Sub DisplayError(text): Display an error message box with specified text

'*  - Sub LogText(text): Display a text in the ouput window to warn the user

'*  - Sub Debug(text): Display a text in the ouput window but only in debug mode

'*          This debug mode can be activated by assigning true value to the debugMode

'*          global variable on the top of this script.

'*  - Function SearchInCollByName(coll, name, acceptShortcut): Search for an object

'*          in a collection, knowing its name.

'*

'******************************************************************************

 

 

' <localize string>

Dim const_colnType_Attribute, const_colnType_List, const_colnType_Reference, const_colnType_Relationship, const_colnType_Standard

const_colnType_Attribute = "Attribute"

const_colnType_List = "List"

const_colnType_Reference = "Reference"

const_colnType_Relationship = "Relationship"

const_colnType_Standard = "Standard"

Dim txtOpenDoc, txtCloseDoc, txtError, txtNextBtn, txtOkBtn

txtOpenDoc = "Opening document "

txtCloseDoc = "Closing document "

txtError = "Error"

txtNextBtn = "Next>"

txtOkBtn = "OK"

Dim txtExcelNotFound, txtExcelNotLoad

txtExcelNotFound = "Could not find Excel application on this machine"

txtExcelNotLoad = "Could not load Excel file "

Dim txtNoMapping, txtNoTableToImport, txtImportingData, txtImportingTableData, txtImportingTable

txtNoMapping = "No mapping defined for this import"

txtNoTableToImport = "No table to import"

txtImportingData = "Importing data from source document"

txtImportingTableData = "Importing data from table "

txtImportingTable = "Importing table "

Dim txtObjectsCreated, txtUpdated, txtObjectsUpdated, txtNoCreation, txtUserAbort

txtObjectsCreated = " object(s) created"

txtUpdated = " updated"

txtObjectsUpdated = " object(s) updated"

txtNoCreation = "  no object created or updated"

txtUserAbort = "  Import aborted by user"

Dim txtExtensionXEM, txtCreatingXEM, txtCreatingExa, txtCreatingCol, txtOnMetaclass

txtExtensionXEM = "Import Extensions"

txtCreatingXEM = "  Creating extension "

txtCreatingExa = "  Creating new attribute "

txtCreatingCol = "  Creating new extended collection "

txtOnMetaclass = " on metaclass "

Dim txtDlgPrntMapping, txtDlgImportComplete

txtDlgPrntMapping = "Specify Parent Object Column"

txtDlgImportComplete = "import complete"

Dim txtListDttpString, txtListDttpBoolean, txtListDttpObject

txtListDttpString = "String"

txtListDttpBoolean = "Boolean"

txtListDttpObject = "Object"

Dim txtErrNoClss, txtErrSubObjNoPrnt, txtErrAbstractClass

txtErrNoClss = "The associated object type does not exist"

txtErrSubObjNoPrnt = "The import of a sub-object requires a " & const_parentAttrValue & " column"

txtErrAbstractClass = "The associated object type is abstract"

Dim txtQAttrName, txtQAttrCode, txtQAttrQName, txtQAttrQCode

txtQAttrName = "Name"

txtQAttrCode = "Code"

txtQAttrQName = "Qualified name"

txtQAttrQName = "Qualified node"

Dim txtConfirmImport, txtImportConfirmation

txtConfirmImport = "Do you want to import the content of this Excel file?"

txtImportConfirmation = "Excel File Import"

 

' <Do not localize strings>

Dim const_newAttrValue, const_newBoolAttrValue, const_newObjAttrValue, const_newAttrValue_old, const_newBoolAttrValue_old, const_parentAttrValue

const_newAttrValue = "<New Attribute>"

const_newAttrValue_old = "<New Extended Attribute>"

const_newBoolAttrValue = "<New Boolean Attribute>"

const_newBoolAttrValue_old = "<New Boolean Extended Attribute>"

const_newObjAttrValue = "<New Object Attribute>"

const_parentAttrValue = "<Parent>"

 

 

'******************************************************************************

'*

'*                    Specific Import Methods to be implemented

'*                    for each kind of import (Excel in this case)

'*

'******************************************************************************

 

'******************************************************************************

'*                         CheckApplicationExist

'******************************************************************************

Function CheckApplicationExist()

   CheckApplicationExist = ""

   Dim objExcel

   Set objExcel = nothing

   On Error Resume next

   Set objExcel = nothing

   Set objExcel = CreateObject("Excel.Application") ' NO-NLS

   HandleErrorCase -1, vbcrlf + vbcrlf

   if objExcel is nothing then

      CheckApplicationExist = txtExcelNotFound

   end if

   set objExcel = nothing

End Function

 

'******************************************************************************

'*                         OpenSourceDocument

'******************************************************************************

Function OpenSourceDocument(value)

   LogText txtOpenDoc + value

   Set OpenSourceDocument = nothing

   Dim objExcel, objWorkbook

  

   Set objExcel = nothing

   On Error Resume next

   Set objExcel = CreateObject("Excel.Application") ' NO-NLS

   HandleErrorCase -1, vbcrlf + vbcrlf

     

   if objExcel is nothing then

      ' No Excel Application

      DisplayError txtExcelNotFound + errorMsg

   else

      Set objWorkbook = nothing

      On Error Resume next

      Set objWorkbook = objExcel.Workbooks.Open(value, false, true)

      HandleErrorCase -1, vbcrlf + vbcrlf

      if objWorkbook is nothing then

         ' Not an Excel file

         DisplayError txtExcelNotLoad + value + errorMsg

      else

         set OpenSourceDocument = objWorkbook

         set objWorkbook = nothing

      End If

      set objExcel = nothing

   end if

End Function

 

 

'******************************************************************************

'*                         CloseSourceDocument

'******************************************************************************

sub CloseSourceDocument(document)

   If not document is nothing then

      LogText txtCloseDoc + document.Name

      Dim App     

      set App = document.Application

      document.Close

      if not App is nothing then

         App.Quit

         set App = nothing

      end if

   End If

End Sub

 

 

'******************************************************************************

'*                         EnumerateDocumentTables

'******************************************************************************

Function EnumerateDocumentTables(document)

   set EnumerateDocumentTables = nothing

 

   ' Create a dictionary to return table list

   Dim dict  

   Set dict = CreateObject("Scripting.Dictionary") ' NO-NLS

   if not dict is nothing then

      ' Loop on document spreadsheets

      Debug "  Enumerating tables in document"

      Dim objWorksheet

      for each objWorksheet in document.Worksheets

         If objWorksheet.UsedRange.Rows.Count > 1 then

            ' Non empty worksheet, search first region with value

            Dim region

            set region = GetFirstExcelUsedRegion(objWorksheet)

            if not region is nothing then

               if region.Rows.Count >= 1 then

                  Debug "    Table " + objWorksheet.Name + " is not empty"

                  dict.Add objWorksheet.Name, region

               End If

               set region = nothing

            end if

         End If

      next

      set EnumerateDocumentTables = dict              

      set dict = nothing

      set objWorksheet = nothing           

   end if

 

End Function

 

 

'******************************************************************************

'*                         EnumerateTableColumns

'******************************************************************************

Function EnumerateTableColumns(table, name)

   set EnumerateTableColumns = nothing

 

   ' Create a dictionary to return column list

   Dim dict2  

   Set dict2 = CreateObject("Scripting.Dictionary") ' NO-NLS

   if not dict2 is nothing then

      Dim range

      set range = table

      if not range is nothing then

         if range.Rows.count > 1 then

            Dim objColumn

            for each objColumn in range.Columns

               dict2.Add objColumn.Cells(1), objColumn

            next

            Debug "  Enumerating columns for table " + name + ", " + CStr(dict2.Count) + " column(s) found"           

            set objColumn = nothing

         end if

         set EnumerateTableColumns = dict2              

         set range = nothing           

      end if

      set dict2 = nothing

   end if

 

End Function

 

 

'******************************************************************************

'*                         GetTableRowCount

'******************************************************************************

Function GetTableRowCount(table, name)

   GetTableRowCount = table.Rows.Count

End Function

 

 

'******************************************************************************

'*                         GetNextTableRow

'******************************************************************************

Function GetNextTableRow(table, line, name)

   Dim found

   set found = nothing

   ' Initialize first line if necessary

   if line is nothing then

      If table.Rows.Count > 1 then

         set line = table.Rows(1)

      End If

   end if

   ' Find next line

   if not line is nothing then

      Dim row, nextLine

      nextLine = false

      set found = nothing

      For each row in table.Rows

         if row.Row = line.Row then

            nextline = true

         elseif nextline then

            if debugMode then

               Debug "   Next line of table " + name + " is " + CStr(row.Row)

            end if

            set found = row

            Exit For

         end if

      Next

      set row = nothing

   end if

   set GetNextTableRow = found

   set found = nothing

End Function

 

 

'******************************************************************************

'*                         GetRowValues

'******************************************************************************

Function GetRowValues(table, line, name)

   Dim dict3  

   Set dict3 = CreateObject("Scripting.Dictionary")' NO-NLS

   if not dict3 is nothing then

      ' Retrieve used range information

      Dim topRow, leftCol, rowCount, colCount

      topRow = table.Row

      leftCol = table.Column

      rowCount = table.Rows.Count

      colCount = table.Columns.Count

      ' Loop on row cells

      Dim cell, vale, key

      For cell = 1 to colCount

         key = table.Cells(1, cell).Value

         if not dict3.Exists(key) then

            vale = table.Cells(line.Row-topRow+1, cell).Value

            'Debug "    Reading Cell value " + key + "(" + CStr(line.Row) + "," + CStr(leftCol+cell-1) + ")=" + CStr(vale)

            dict3.Add key, CStr(vale)

         end if

      Next

      if debugMode then

         Debug "    Reading values for line "  + CStr(line.Row) + ", " + CStr(dict3.Count) + " column(s) found"

      end if

   end if

   set GetRowValues = dict3

   set dict3 = nothing

End Function

 

 

 

 

 

 

 

 

 

 

'******************************************************************************

'*

'*                         Specific Excel Helpers

'*

'******************************************************************************

 

'******************************************************************************

'*                         GetFirstExcelUsedRegion

'******************************************************************************

Function GetFirstExcelUsedRegion(objWorksheet)

   set GetFirstExcelUsedRegion = nothing

   ' The UsedRange property is not reliable in Excel

   ' because it includes cells without value but with other property (format...)

   Dim line, cell, firstCell, lastCell, lastColumn

   set firstCell = nothing

   set lastCell = nothing

   lastColumn = 0

   ' Loop on all cells of used range to detect first non-empty line

   For each line in objWorksheet.usedRange.Rows

      For each cell in line.Cells

         If firstCell is nothing then

            ' Searching for first cell with non-empty value

            if not cell.Value = "" then

               Debug "   Found first cell for table " + objWorksheet.Name + ": (" + CStr(cell.Row) + "," + CStr(cell.Column) + ")"

               set firstCell = cell

               lastColumn = cell.Column

            End If

         Else

            ' Searching for last cell on the row with non-empty value

            If cell.Value = "" then

               Exit For

            Else

               lastColumn = cell.Column

            End If

         end if

      Next

      ' Stop if we already found a non-empty line

      if not firstCell is nothing then

         Exit For

      end if

   Next

   ' Loop on all cells of used range to detect last non-empty line

   If not firstCell is nothing then

      Dim emptyLine, lastLine

      emptyLine = false

      set lastLine = nothing

      For each line in objWorksheet.usedRange.Rows

         If line.Row > firstCell.Row then

            emptyLine = true

            For each cell in line.Cells

               If not cell.Value="" then

                  emptyLine = false

                  set lastLine = line

                  Exit For

               Elseif cell.Column > lastColumn then

                  Exit For

               End If

            Next

            If emptyLine then

               If not lastLine is nothing then

                  set lastCell = objWorksheet.Cells(lastLine.Row, lastColumn)

               End If

               Exit For

            Else

               If not lastLine is nothing then

                  set lastCell = objWorksheet.Cells(lastLine.Row, lastColumn)

               End If

            End If

         End If

      Next  

   End If

   set line = nothing

   set cell = nothing

   set lastLine = nothing

   ' Construct a range with first and last cells

   if not firstCell is nothing and not lastCell is nothing then

      Debug "   Found last cell for table " + objWorksheet.Name + ": (" + CStr(lastCell.Row) + "," + CStr(lastCell.Column) + ")"

      If lastCell.Row > firstCell.Row then

         set GetFirstExcelUsedRegion = objWorksheet.Range(firstCell, lastCell)

      End If

   end if

   set firstCell = nothing

   set lastCell = nothing

End Function  

 

 

 

 

 

 

 

 

 

 

'******************************************************************************

'*

'*                         Generic Import Methods

'*

'******************************************************************************

 

' Declare a global variable in order to keep some objects alive

' when they are returned by a function (static objects like meta attribute)

Dim globalObject

set globalObject = nothing

 

' Declare global variable to handle user abort in a dialog

Dim globalUserAbort

globalUserAbort = false

 

'******************************************************************************

'*                         DisplayError

'******************************************************************************

Sub DisplayError(text)

   LogText text

   if interactivemode = im_Dialog then

      msgbox text, vberror, txtError

   end if

End Sub

 

 

'******************************************************************************

'*                         Debug

'******************************************************************************

Sub Debug(text)

   if debugMode then

      output "[Dbg] " + text ' NO-NLS

   end if

End Sub

 

 

'******************************************************************************

'*                         LogText

'******************************************************************************

Sub LogText(text)

   if debugMode then

      output "[Log] " + text ' NO-NLS

   else

      output text

   end if

End Sub

 

 

'******************************************************************************

'*                         ErrorOccurs

'******************************************************************************

Function ErrorOccurs()

   ErrorOccurs = false

   if not Err is nothing then

      if not Err.Number = 0 then            

         ErrorOccurs = true

      end if

   end if

end Function

 

'******************************************************************************

'*                         HandleErrorCase

'******************************************************************************

Sub HandleErrorCase(warningCount, msg)

   ' Check if an error occurred

   if not Err is nothing then

      if not Err.Number = 0 then

         ' Do not display anything if initial message is empty

         if not msg = "" then

            Dim errDesc        

            errDesc = Err.Description

            if not errDesc = "" then

               errDesc = " (" + errDesc + ")" ' NO-NLS

            end if

            LogText msg + errDesc

         end if

         ' Do not increment warning count if negative

         if not warningCount = -1 then

            warningCount = warningCount + 1

         end if

         Err.Number = 0

      end if

   end if

   ' Restore normal error mode

   if not debugMode then

      On Error Resume next

   else

      On Error Goto 0

   end if

End Sub

 

 

'******************************************************************************

'*                         SearchInCollByName

'******************************************************************************

Function SearchInCollByName(coll, name, acceptShortcut)

   Set SearchInCollByName = nothing

   Dim found

   set found = nothing

   for each found in coll

      if not found.IsShortcut() or acceptShortcut then

         if found.name = name then

            Set SearchInCollByName = found

            exit for

         end if

      end if

   next

   set found = nothing

End Function

 

 

'******************************************************************************

'*                         AdjustTableMappings

'******************************************************************************

Sub AdjustTableMappings(obj, dict)

   if not dict is nothing and not obj is nothing then

      Dim tablCol, tablMap, tablSrc, tablNam

      set tablCol = obj.GetCollectionByName("TableMappings")

      if not tablCol is nothing then

         ' Create new table mappings

         for each tablNam in dict.Keys

            set tablMap = SearchInCollByName(tablCol, tablNam, false)

            if tablMap is nothing then

               set tablMap = tablCol.CreateNew()

            end if

            if not tablMap is nothing then

               tablMap.SetNameAndCode tablNam, tablNam, true

               set tablSrc = dict.Item(tablNam)

               AdjustColumnMappings tablSrc, tablMap

            end if

         next   

         ' Delete obsolete table mapping

         For each tablMap in tablCol

            if not dict.Exists(tablMap.Name) then

               tablMap.Delete

            end if

         Next

        

         ' Clean up

         set tablMap = nothing

         set tablCol = nothing

         set tablSrc = nothing

      End If

   end If

End sub

 

 

'******************************************************************************

'*                         AdjustColumnMappings

'******************************************************************************

Sub AdjustColumnMappings(tablSrc, tablMap)

   if not tablSrc is nothing and not tablMap is nothing then

      Dim colnCol

      set colnCol = tablMap.GetCollectionByName("ColumnMappings")

      if not colnCol is nothing then

         dim dict

         set dict = EnumerateTableColumns(tablSrc, tablMap.Name)

         if not dict is nothing then

            ' Create new column mappings        

            Dim colnSrc, colnMap, newMap

            For each colnSrc in dict.Keys

               set colnMap = SearchInCollByName(colnCol, colnSrc, false)

               newMap = false

               if colnMap is nothing then

                  newMap = true

                  set colnMap = colnCol.CreateNew()

               end if

               if not colnMap is nothing then

                  colnMap.SetNameAndCode colnSrc, colnSrc

                  if newMap then

                     ' Initialize values for common options

                     InitializeColumnMappingOptions colnMap

                  end if

               end if

            Next

            ' Delete obsolete column mappings

            Dim found

            For each colnMap in colnCol

               found = false

               for each colnSrc in dict.Keys

                  if colnMap.Name = colnSrc then

                     found = true

                     Exit For

                  end if

               next

               if not found then

                  colnMap.Delete

               end if

            Next   

            ' Clean up       

            set dict = nothing

            set colnMap = nothing

         end if

      end if

   end if

End Sub

 

 

'******************************************************************************

'*                         ImportDocumentData

'******************************************************************************

Function ImportDocumentData(tablDict, importDefn, totalCreate, totalUpdate, totalWarning)

   ImportDocumentData = true

   globalUserAbort = false

   ' Import each table separatly

   Dim tablSrc, tablMap, tablCol, tablNam

   set tablCol = importDefn.GetCollectionByName("TableMappings")

   if tablCol is nothing then

      DisplayError txtNoMapping

   elseif tablDict.Count = 0 then

      DisplayError txtNoTableToImport

   else

      ' Initialize progress dialog

      Dim prgs

      set prgs = Progress("GenericImport", true) ' NO-NLS

      if not prgs is nothing then

         prgs.CanBeCanceled = true

         prgs.Text = txtImportingData

         prgs.Min = 0

         prgs.Max = 0

         prgs.Stepping = 1

         for each tablNam in tablDict.Keys

            set tablMap = SearchInCollByName(tablCol, tablNam, false)

            if not tablMap is nothing then

               Set tablSrc = tablDict.Item(tablNam)

               if not tablSrc is nothing then

                  prgs.Max = prgs.Max + GetTableRowCount(tablSrc, tablNam)

               end if

            end if

         next

         Debug " Total number of rows to import: " + CStr(prgs.Max)

         prgs.Start()

      end if

      ' Define missing mappings

      if not DefineMapping(tablCol, false) then

         ImportDocumentData = false ' User abort

      end if

      ' Import each table

      If ImportDocumentData then

         ' Create a global dictionary for key/object retrieve

         Dim globalDict

         set globalDict = CreateObject("Scripting.Dictionary") ' NO-NLS

         ' Import tables     

         for each tablNam in tablDict.Keys

            set tablMap = SearchInCollByName(tablCol, tablNam, false)

            if not tablMap is nothing then

               if not CLng(tablMap.GetExtendedAttribute("%CurrentTargetCode%.ImportedKind")) = 0 then

                  Set tablSrc = tablDict.Item(tablNam)           

                  If not ImportTableData(tablSrc, tablMap, totalCreate, totalUpdate, totalWarning, globalDict) then

                     ' Import canceled by user

                     ImportDocumentData = false

                     Exit For

                  End If

               end if

            end if

         next

         set globalDict = nothing

      End if

      set tablSrc = nothing

      set tablMap = nothing

      ' Refresh active diagram

      if not ActiveDiagram is nothing then

         ActiveDiagram.RedrawAllViews  

      end if

      ' Stop progress

      if not prgs is nothing then

         prgs.Stop()

         set prgs = nothing

      end if

   end if

   set tablCol = nothing

End Function

 

 

'******************************************************************************

'*                         DefineMapping

'******************************************************************************

Function DefineMapping(tablCol, alwaysShowDialog)

   ' Define missing mappings

   DefineMapping = true

   Dim tablMap

   for each tablMap in tablCol

      GetOrDefineTableMapping tablMap, alwaysShowDialog

      If globalUserAbort then

         DefineMapping = false

         Exit For

      Elseif not tablMap.GetExtendedAttribute("%CurrentTargetCode%.Skip") then

         Dim colnMap

         for each colnMap in tablMap.GetCollectionByName("ColumnMappings") ' NO-NLS

            If not globalUserAbort then

               GetOrDefineColumnMapping colnMap, alwaysShowDialog

            End If

         next

         set colnMap = nothing

         If globalUserAbort then

            DefineMapping = false

            Exit For

         End If        

      End if

   next

   set tablMap = nothing

End Function

 

 

'******************************************************************************

'*                         ImportTableData

'******************************************************************************

Function ImportTableData(tablSrc, tablMap, totalCreate, totalUpdate, totalWarning, globalDict)

   ImportTableData = true

   Dim classId, strn

   classId = GetOrDefineTableMapping(tablMap, false)

   if not globalUserAbort then

      strn = tablMap.GetExtendedAttribute("%CurrentTargetCode%.ImportedStereotype")

      Dim colnCol, fldr

      set colnCol = tablMap.GetExtendedCollection("ColumnMappings", false) ' NO-NLS

      set fldr = tablMap.Folder

      if not colnCol is nothing and not fldr is nothing and not classId = 0 then

         Dim subObj, mandcoln, lnkClss

         subObj = false

         mandColn = false

         lnkClss = 0

         ' Read and commit data

         LogText txtImportingTableData + tablMap.Name

         if CanImportTableData(tablMap, colnCol, classId, fldr, totalWarning, subObj, mandColn, lnkClss) then

            ' Get first row of the table

            Dim countCreate, countUpdate  

            dim nextLine, dictValues, dictOldValues

            set dictValues = nothing

            set dictOldValues = nothing

            set nextLine = GetNextTableRow (tablSrc, nothing, tablMap.Name)

            countCreate = 0

            countUpdate = 0

            ' Change 2nd text of progress dialog

            Dim prgs

            set prgs = Progress("GenericImport", true) ' NO-NLS

            if not prgs is nothing then

               prgs.Text2 = txtImportingTable + tablMap.Name

            end if

            ' Loop on all rows of the table

            while (not nextLine is nothing and not globalUserAbort)

               ' Preserve old values for non-repeated column values

               if mandColn then

                  set dictOldValues = dictValues

               end if

               ' Read and commit current row

               set dictValues = GetRowValues(tablSrc, nextLine, tablMap.Name)

               if not dictValues is nothing then

                  ' Copy mandatory values from previous line

                  CopyMandatoryValues colnCol, dictOldValues, dictValues, mandColn              

                  ' Commit data

                  CommitRowData dictValues, classId, strn, subObj, lnkClss, colnCol, fldr, countCreate, countUpdate, totalWarning, globalDict

               end if

               if not globalUserAbort then

                  ' Get next row

                  set nextLine = GetNextTableRow (tablSrc, nextLine, tablMap.Name)

                  ' Step progress dialog

                  if not prgs is nothing then

                     prgs.Step

                     ' Debug "  Progress position is " + CStr(prgs.Position) + "/" + CStr(prgs.Max)

                     if prgs.Canceled() then

                        ' The user clicked on Cancel

                        ImportTableData = false

                        set nextLine = nothing

                     end if

                  end if

               else

                  ' User abort in dialog

                  ImportTableData = false

                  set nextLine = nothing

               end if

            wend

            set prgs = nothing

            ' Log message with creation and update count

            if not globalUserAbort then

               Dim msg

               msg = ""

               if countCreate > 0 then

                  msg = "  " + CStr(countCreate) + txtObjectsCreated

                  if countUpdate > 0 then

                     msg = msg + ", " + CStr(countUpdate) + txtUpdated   

                  end if

               elseif countUpdate > 0 then

                  msg = "  " + CStr(countUpdate) + txtObjectsUpdated

               else

                  msg = txtNoCreation

               end if

               LogText msg

               if not ImportTableData then

                  LogText txtUserAbort

               end if

               totalCreate = totalCreate + countCreate

               totalUpdate = totalUpdate + countUpdate

            end if

            set dictValues = nothing

         end if

      end if

   else

      ImportTableData = false ' user abort in dialog

   end if

   set colnCol = nothing

   set fldr = nothing

   globalUserAbort = false

End Function

 

 

'******************************************************************************

'*                         CanImportTableData

'******************************************************************************

Function CanImportTableData(tablMap, colnCol, classId, fldr, totalWarning, subObj, mandColn, lnkClss)

   Dim canImport

   canImport = false

   ' Retrieve the associated metaclass

   Dim metaClss, colnMap

   subObj = false

   mandColn = false

   lnkClss = 0

   set metaClss = Metamodel.GetMetaClassByKind(classId)

   if not metaClss is nothing then

      canImport = true

      if (metaClss.Flags and SCLSS_SUBOBJECT) = SCLSS_ABSTRACT then

         ' Abstract case

          canImport = false

          DisplayError txtErrAbstractClass

      end if

      if (metaClss.Flags and SCLSS_SUBOBJECT) = SCLSS_SUBOBJECT then

         ' Sub-object case

         subObj = true

         Dim prntColnMap

         set prntColnMap = nothing

         for each colnMap in colnCol

            if colnMap.GetExtendedAttribute("%CurrentTargetCode%.Attribute") = const_parentAttrValue then

               set prntColnMap = colnMap

               exit for

            end if

         next

         set colnMap = nothing

         if prntColnMap is nothing then

            DisplayError txtErrSubObjNoPrnt

            canImport = false

         else

            set prntColnMap = nothing

         end if

      end if

      ' Detect link class

      if not metaClss.GetMetaMemberByPublicName("Object1") is nothing and not metaClss.GetMetaMemberByPublicName("Object2") is nothing then ' NO-NLS

         lnkClss = 1

         if metaClss.InheritsFrom(PdCommon.Cls_CompositionLink) then

            lnkClss = 2

         end if

         if debugMode then

            if lnkClss = 1 then

               Debug "    Link class detected for " & GetClassname(classId, "")

            else

               Debug "    Composition link class detected for " & GetClassname(classId, "")

            end if

         end if  

      end if

      ' Detect missing key

      if lnkClss = 0 then

      end if

      set metaClss = nothing

   else

      DisplayError txtErrNoClss

   end if

   ' Search for any mandatory column

   if canImport then

      for each colnMap in colnCol

         if colnMap.GetExtendedAttribute("%CurrentTargetCode%.Mandatory") then

            if debugMode then

               Debug "    Table has at least one mandatory column: " & colnMap.Name

            end if  

            mandColn = true

            exit for

         end if

      next

   end if

   set colnMap = nothing

   ' Return value

   CanImportTableData = canImport

End Function

 

 

'******************************************************************************

'*                         CopyMandatoryValues

'******************************************************************************

Sub CopyMandatoryValues(colnCol, dictOldValues, dictValues, mandColn)

   if mandColn then

      Dim colnMap, key

      for each colnMap in colnCol

         if colnMap.GetExtendedAttribute("%CurrentTargetCode%.Mandatory") then

            key = colnMap.Name

            if not dictOldValues is nothing then

               if dictOldValues.Exists(key) then

                  if dictValues.Exists(key) then

                     Dim currVale

                     currVale = TrimWhitespace(dictValues.Item(key))

                     if currVale = "" then

                        if debugMode then

                           Debug "    Copying mandatory value for " & key & " using previous row: " & dictOldValues.Item(key)

                        end if

                        dictValues.Item(key) = dictOldValues.Item(key)

                     end if

                  else

                     if debugMode then

                        Debug "    Adding mandatory value for " & key & " using previous row: " & dictOldValues.Item(key)

                     end if

                     dictValues.Add key, dictOldValues.Item(key)

                  end if

               end if

            end if

            ' Trim whitespaces for mandatory values

            if dictValues.Exists(key) then

               dictValues.Item(key) = TrimWhitespace(dictValues.Item(key))

            end if

         end if

      next

      set colnMap = nothing

   end if

End Sub

 

 

'******************************************************************************

'*                         GetOrDefineTableMapping

'******************************************************************************

Function GetOrDefineTableMapping(tablMap, alwaysShowDialog)

   Dim classId, Skip

   classId = CLng(tablMap.GetExtendedAttribute("%CurrentTargetCode%.ImportedKind"))

   skip = tablMap.GetExtendedAttribute("%CurrentTargetCode%.Skip")

   If Skip and not alwaysShowDialog then

      classId = 0

   ElseIf classId = 0 or alwaysShowDialog then  

      ' Class kind not defined, try to guess it

      classId = GuessDefaultTableMapping(tablMap, false)

      If alwaysShowDialog or (classId = 0 and interactiveMode = im_Dialog) then

         ' Propose to define it now

         Dim dlg

         set dlg = tablMap.CreateCustomDialog("%CurrentTargetCode%.ImportTable")

         If not dlg is nothing then

            GuessDefaultTableMapping tablMap, true

            dlg.EnforceCancelButton = true

            dlg.CloseButtonLabel = txtNextBtn

            globalUserAbort = not dlg.ShowDialog()

            set dlg = nothing

            if not globalUserAbort then

               classId = CLng(tablMap.GetExtendedAttribute("%CurrentTargetCode%.ImportedKind"))

               Skip = tablMap.GetExtendedAttribute("%CurrentTargetCode%.Skip")

               If Skip then

                  classId = 0

               End If

            end if

         End If

      End If

   End If

   GetOrDefineTableMapping = classId

End Function

 

 

'******************************************************************************

'*                         GuessDefaultTableMapping

'******************************************************************************

Function GuessDefaultTableMapping(tablMap, enforceGuess)

   Dim classId

   classId = CLng(tablMap.GetExtendedAttribute("%CurrentTargetCode%.ImportedKind"))

   If classId = 0 then

      Dim shouldGuess

      if enforceGuess then

         shouldGuess = true

      else

         shouldGuess = tablMap.ParentObject.GetExtendedAttribute("%CurrentTargetCode%.DefaultColumnMapping")

      end if

      if shouldGuess then

         ' compute class name

         Dim lib, clssname

         set lib = tablMap.model.metaclass.library

         if not lib is nothing then

            clssname = lib.PublicName+"."+tablMap.Name

            set lib = nothing

         else

            clssname = tablMap.Name

         end if

         clssname = TrimWhitespace(clssName)

         clssname = replace(clssname, " ", "")

         ' retrieve metaclass     

         Dim metaclss

         set metaclss = Metamodel.GetMetaclassByPublicName(clssname)

         if not metaclss is nothing then

            ' standard

            if not metaclss.Abstract then

               if not (metaclss.Flags and SCLSS_SUBOBJECT) = SCLSS_SUBOBJECT then

                  tablMap.SetExtendedAttribute "%CurrentTargetCode%.ImportedClassName", metaclss.PublicName

                  classId = CLng(tablMap.GetExtendedAttribute("%CurrentTargetCode%.ImportedKind"))

               end if

            end if

         end if

         if metaclss is nothing then

            ' search for an extended metaclass

            if Version > "15.1.0.9999" then ' NO-NLS the next method is not available in 15.1

               set metaclss = tablMap.Model.GetExtendedMetaclassByName(tablMap.Name)

               if not metaclss is nothing then

                  ' we retrieved the stereotype definition,

                  ' retrieve now the metaclass target item

                  Dim strnName

                  strnName = metaclss.Name

                  set metaclss = metaclss.GetMetaclass()

                  if not metaclss is nothing then

                     ' retrieve hte metaclass associated to the target item

                     set metaclss = metaclss.TargetMetaclass

                     if not metaclss is nothing then

                        ' check if this one is a sub-object metaclass

                        if not (metaclss.Flags and SCLSS_SUBOBJECT) = SCLSS_SUBOBJECT then

                           tablMap.SetExtendedAttribute "%CurrentTargetCode%.ImportedClassName", strnName

                           classId = CLng(metaclss.Kind)

                        end if

                     end if

                  end if

               end if

            end if

         end if

         ' Search using the list of predefined values

         if metaclss is nothing then

            Dim lstValues

            lstValues = tablMap.EvaluateTemplateFor("allClassNames", "%CurrentTargetCode%") ' NO-NLS

            if not lstValues = "" then

               Dim pos

               pos = InStr(lstValues, tablMap.Name)

               if pos > 1 then

                  Dim nxtChar

                  nxtChar = asc(Mid(lstValues, pos + Len(tablMap.Name)))

                  On Error Resume Next

                  if nxtChar = asc(vbTab) then

                     ' We found a code

                     tablMap.SetExtendedAttribute "%CurrentTargetCode%.ImportedClassName", tablMap.Name                    

                     classId = CLng(tablMap.GetExtendedAttribute("%CurrentTargetCode%.ImportedKind"))

                  elseif nxtChar = asc(";") then

                     ' We found a label

                     Dim pos2

                     pos2 = InStrRev(Mid(lstValues, 1, pos-1), ";")

                     if pos2 > 1 then

                        Dim code, pos3

                        code = Mid(lstValues, pos2+1)

                        pos3 = InStr(code, vbTab & tablMap.Name + ";")

                        if pos3 > 1 then

                           code = Mid(code, 1, pos3-1)

                        else

                           code = tablMap.Name ' Label = code

                        end if

                        tablMap.SetExtendedAttribute "%CurrentTargetCode%.ImportedClassName", code

                        classId = CLng(tablMap.GetExtendedAttribute("%CurrentTargetCode%.ImportedKind"))

                     end if

                  end if

                  HandleErrorCase -1, "" ' Silent

               end if

            end if

         end if

         set metaclss = nothing

      end if

   end if

   GuessDefaultTableMapping = classId

End Function

 

 

'******************************************************************************

'*                         CommitRowData

'******************************************************************************

Sub CommitRowData(dictValues, classId, strn, subObj, lnkClss, colnCol, fldr, countCreate, countUpdate, totalWarning, globalDict)

   if not colnCol is nothing and not fldr is nothing then

      ' create new object or retrieve it    

      Dim newObj, created

      created = false

      if subObj then

         set newObj = FindOrCreateSubObjectFromRow(dictValues, classId, strn, lnkClss, colnCol, fldr, created, countCreate, countUpdate, totalWarning, globalDict)

      elseif not lnkClss = 0 then

         set newObj = FindOrCreateLinkFromRow(dictValues, classId, strn, false, false, colnCol, fldr, created, countCreate, countUpdate, totalWarning, globalDict)

      else

         set newObj = FindOrCreateObjectFromRow(dictValues, classId, strn, false, colnCol, fldr, created, countCreate, countUpdate, totalWarning, globalDict)

      end if

      if not newObj is nothing and not globalUserAbort then

         Dim nameSet, codeSet

         nameSet = ""

         codeSet = ""

         ' Commit all row values

         Dim key, vale, colnMap, keyDict, attrName, localNmspc

         if subObj then

            localNmspc = true

         elseif Version > "15.1.0.9999" then ' NO-NLS The HasLocalNamespace method is not available in 15.1

            localNmspc = newObj.Model.HasLocalNamespace(classId)

         else

            localNmspc = false

         end if

         For each colnMap in colnCol

            key = colnMap.Name

            if dictValues.Exists(key) and not colnMap.GetExtendedAttribute("%CurrentTargetCode%.Skip") then

               Dim oldVale

               oldVale = dictValues.Item(key)

               vale = oldVale

               ' Commit the current value

               CommitCellData newobj, colnMap, vale, subObj, globalDict, countCreate, totalWarning

               if not globalUserAbort then

                  ' If Column is a key, add new value in dictionary

                  if colnMap.GetExtendedAttribute("%CurrentTargetCode%.IsKey") then

                     attrName = colnMap.GetExtendedAttribute("%CurrentTargetCode%.Attribute")

                     if not localNmspc then

                        ' Update dictionary

                        set keyDict = RetrieveClassKeyDictionary(globalDict, classId, strn, attrName, newObj.Folder, false)

                        if not keyDict is nothing then

                           if not keyDict.Exists(vale) then

                              keyDict.Add vale, newObj

                           end if

                           set keyDict = nothing

                        end if

                     end if

                     ' Remember if name or code has been set

                     if created then

                        if LCase(attrName) = "name" then ' NO-NLS

                           nameSet = oldVale

                        elseif LCase(attrName) = "code" then ' NO-NLS

                           codeSet = oldVale

                        end if

                     end if

                  end if

               else

                  Exit for ' user abort in dialog

               end if

            else

               Debug "    Column mapping not found for " + key

            end if

            ' Synchronize name and code if only one has been set

            if created then

               if (nameSet = "" and not codeSet = "") or (codeSet = "" and not nameSet = "") then

                  if IsNamedObject(newObj) then

                     Dim nameOrCode

                     if nameSet = "" then

                        nameOrCode = codeSet

                     else

                        nameOrCode = nameSet

                     end if

                     newObj.SetNameAndCode nameOrCode, nameOrCode

                     if not localNmspc then

                        ' Update associated dictionary

                        if nameSet = "" then

                           set keyDict = RetrieveClassKeyDictionary(globalDict, classId, strn, "Name", newObj.Folder, false) ' NO-NLS

                           if not keyDict is nothing then

                              if not keyDict.Exists(nameOrCode) then

                                 keyDict.Add nameOrCode, newObj

                              end if

                              set keyDict = nothing

                           end if             

                        end if   

                        if codeSet = "" then

                           set keyDict = RetrieveClassKeyDictionary(globalDict, classId, strn, "Code", newObj.Folder, false) ' NO-NLS

                           if not keyDict is nothing then

                              if not keyDict.Exists(nameOrCode) then

                                 keyDict.Add nameOrCode, newObj

                              end if

                              set keyDict = nothing

                           end if         

                        end if

                     end if

                  end if

               end if

            end if

         Next

         if debugMode then

            Debug "    Imported object: " + newObj.ShortDescription

         end if

         ' Create default symbol when possible

         if created and not subObj then

            CreateDefaultSymbol newObj, ActiveDiagram, colnCol.Source.Parent

         end if

         ' Verify imported object      

         CheckImportedObject newObj, colnCol.Source.Parent, created, countCreate, totalWarning, globalDict

         set colnMap = nothing

         set newObj = nothing

         set keyDict = nothing

      end if

   End If

End Sub

 

 

'******************************************************************************

'*                         CheckImportedObject

'******************************************************************************

Sub CheckImportedObject(newObj, tablMap, created, countCreate, totalWarning, globalDict)

   if created then

      if IsLinkObject(newObj) then

         ' Check that link object has both extremities defined

         Dim obj1, obj2, del, msg

         del = false

         set obj1 = newObj.Object1

         set obj2 = newObj.Object2

         if obj1 is nothing and not newObj.CanSetAttribute("Object1", nothing, msg) then ' NO-NLS

            Debug "Missing source extremity for " & newObj.ShortDescription

            del = true

         end if

         if not del and obj2 is nothing and not newObj.CanSetAttribute("Object2", nothing, msg) then

            Debug "Missing destination extremity for " & newObj.ShortDescription

            del = true

         end if

         set obj1 = nothing

         set obj2 = nothing

         if del then

            LogText "Error: " & newObj.Shortdescription & " will not be imported due to missing link extremity"

            totalWarning = totalWarning + 1

            if countCreate > 0 then

               countCreate = countCreate - 1

            end if

            newObj.Delete

         end if

      end if

   end if

End Sub

 

 

'******************************************************************************

'*                         FindMainObjectParent

'******************************************************************************

Function FindMainObjectParent(dictValues, colnCol, fldr, totalWarning)

   Dim newFldr, colnMap

   set newFldr = fldr

   for each colnMap in colnCol

      if colnMap.GetExtendedAttribute("%CurrentTargetCode%.Attribute") = const_parentAttrValue then

         if dictValues.Exists(colnMap.Name) then

            Dim prntVale

            prntVale = dictValues.Item(colnMap.Name)

            if not prntVale = "" then

               Dim qualifierFound

               qualifierFound = false

               set newFldr = FindQualifiedFolder(fldr, "", prntVale, colnMap.ParentObject.ParentObject, false, qualifierFound)

               if newFldr is nothing then

                  LogText "Error: Could not find parent object '" + prntVale + "'"

                  totalWarning = totalWarning + 1

               end if

            end if

         end if

         exit for

      end if

   next

   set colnMap = nothing

   set FindMainObjectParent = newFldr

   set newFldr = nothing

End Function

 

 

'******************************************************************************

'*                         FindLinkExtremityColumns

'******************************************************************************

Function FindLinkExtremityColumns(colnCol, colnObj1, colnObj2, hasKey, compLink)

   set colnObj1 = nothing

   set colnObj2 = nothing

   hasKey = false

   Dim colnMap, attrDefn, id

   for each colnMap in colnCol

      set attrDefn = colnMap.GetExtendedAttribute("%CurrentTargetCode%.AttributeDefinition")

      if not attrDefn is nothing then

         if attrDefn.IsKindOf(Cls_MetaAttribute) then

            if attrDefn.Alias then

               set attrDefn = attrDefn.AliasBase

            end if

            if not attrDefn is nothing then

               if attrDefn.PublicName = "Object1" then ' NO-NLS

                  set colnObj1 = colnMap

               elseif attrDefn.PublicName = "Object2" then ' NO-NLS

                  set colnObj2 = colnMap

               elseif compLink and attrDefn.PublicName = "LinkedObject" then ' NO-NLS

                  set colnObj2 = colnMap

               elseif colnMap.GetExtendedAttribute("%CurrentTargetCode%.IsKey") then

                  hasKey = true

               end if

               if not colnObj1 is nothing and not colnObj2 is nothing and hasKey then

                  exit for

               end if

          end if

        end if

      elseif colnMap.GetExtendedAttribute("%CurrentTargetCode%.Attribute") = const_parentAttrValue then

         set colnObj1 = colnMap

      end if

   next

   set colnMap = nothing

   if colnObj1 is nothing or colnObj2 is nothing then

      FindLinkExtremityColumns = false

   else

      FindLinkExtremityColumns = true

   end if

End Function

 

 

'******************************************************************************

'*                         FindOrCreateObjectFromRow

'******************************************************************************

Function FindOrCreateObjectFromRow(dictValues, classId, strn, subObj, colnCol, fldr, created, countCreate, countUpdate, totalWarning, globalDict)

   Dim newObj, compCol

   set newObj = nothing

   set compCol = nothing

   created = false

   if not colnCol is nothing and not fldr is nothing and not classId = 0 then

      ' Try to find an existing object

      Dim key, vale, colnMap, keyDict, attrName, strn2

      strn2 = strn

      if subObj then

     

         Dim pos

         pos = InStrRev(strn, ".")

         if pos > 0 then

            strn2 = Mid(strn, pos+1)

         end if

      end if

      ' Search for the parent column first (if any) for main objects

      Dim newFldr

      set newFldr = fldr

      if not subObj then

         set newFldr = FindMainObjectParent(dictValues, colnCol, fldr, totalWarning)

      end if

      If not newFldr is nothing then

         Dim localNmspc

         if su