Procedure Passing Two File and Record Parameters for deep assign

questions tips
9

I was on my phone, now on my laptop. I tried a simple Test of Group Deep Assign 2 ways: Prop:Record or passing *GROUP. Both fail. I would suggest you work out your code with a small program like this that looks at one record and a few fields:

PROGRAM
Service1 FILE,DRIVER('TOPSPEED'),RECLAIM,PRE(SER1), BINDABLE,CREATE,THREAD
Record  RECORD,PRE()
ID         LONG
Desc       STRING(20)
Date       DATE
    END
 END
Service2 FILE,DRIVER('TOPSPEED'),RECLAIM,PRE(SER2), BINDABLE,CREATE,THREAD
Record  RECORD,PRE()
ID         LONG
Desc       STRING(20)
Date       LONG
    END
 END
 
MAP   
CopyTPS2SQL  PROCEDURE  (FILE pTPS,FILE pSQL, *GROUP pTPS_Group , *GROUP pSQL_Group)
END 

CODE
  CLEAR(Service1)
  Ser1:Desc='Hello ' & Today() 
  Ser1:Date=today()
  CopyTPS2SQL(Service1,Service2, SER1:Record, SER2:Record)
 !  ! SER2:Record :=: SER1:Record     !Test 4 this always works
  Message('Ser1:Desc=' & Ser1:Desc &'|Ser2:Desc=' & Ser2:Desc & | 
      '||Ser1:Date=' & Ser1:Date &'|Ser2:Date=' & Ser2:Date,'Deep Assign Record' ) 

RETURN
!---------------------------- 
CopyTPS2SQL  PROCEDURE  (FILE pTPS,FILE pSQL, *GROUP pTPS_Group , *GROUP pSQL_Group) 
pTPSRecord        &GROUP
pSQLRecord        &GROUP
CODE
   pTPSRecord &= pTPS{PROP:Record}
   pSQLRecord &= pSQL{PROP:Record}    
   pSQLRecord :=: pTPSRecord        !Test 1: Prop:Record Assign

!   pSQL_Group :=: pTPS_Group      !Test 2: Passed *GROUP

!Below works but not if record is different. Good to see works somewhat
!   pSQL_Group = pTPS_Group        !Test 3: Assume same record 

RETURN

image
image954×406 16.4 KB

The Help says Deep Assign is done by the Compiler. I thought it could be done it at Runtime but the above code confirms it cannot, unless I have a bug.

Maybe someone else has some ideas as it is fairly common to want to convert all files from TPS to SQL, and fairly common to change some fields especially date/time. Post a new Question about TPS to SQL, and changing record fields. Search here as it probably already exists. I know Clarion Mag has some articles on converting TPS to SQL. Also check ClarionLive.com

I would write a Utility Template to generate code like you found worked for every file. That may already exist. You can take that code and change it for individual files and fields. Note I think you had a field different ExpiryDate <> UserExpiryDate.

10

Maybe a different method
try and find the DCT2SQL templates. They might be on icetips. They allow a conversion of your dct files to a couple varietys of SQL including MySql

11

Those are on Robert’s GitHub and there are some videos on ClarionLive

12

DCT2SQL sounds like a promising idea.

For the deep assign work around, how about using a FieldPairsClass approach see Libsrc\Win\ABUtil.[inc|clw]

13

I’ve used the fieldpairs class quite a bit for that purpose. It works great.

14

Another alternative is to create a class that does the copying, but use a virtual method to do the deep assign of the fields.

CopyTPS2SQL         CLASS,TYPE
Copy                  PROCEDURE(FILE pTPS,FILE pSQL,STRING pProgressText,LONG pProgressBar,UNSIGNED pFeq)
Assign                PROCEDURE,VIRTUAL
                    END
  
CopyTPS2SQL.Copy    PROCEDURE(FILE pTPS,FILE pSQL,STRING pProgressText,LONG pProgressBar,UNSIGNED pFeq)
  CODE
  !Your existing code, wherein it calls SELF.Assign()
  
CopyTPS2SQL.Assign  PROCEDURE
  CODE
  !Abstract Virtual
  ASSERT(False, 'CopyTPS2SQL.Assign must be derived')

!For each file  
CT2S_SomeFile       CLASS(CopyTPS2SQL)
Assign                PROCEDURE,DERIVED
                    END

CT2S_SomeFile.Assign  PROCEDURE
  CODE
  SomeFileSQL.Record :=: SomeFileTps.Record
1 Like
15

You know the above Record Deep Assign works. The ADDRESS( File ) of a file is unique so you can use that instead of passing a file id or name. You could generate a big CASE statement like below, or do it in an editor that has column mode. Hopefully you can keep most your current code.

CopyTPS2SQL          PROCEDURE  (FILE pTPS,FILE pSQL,STRING pProgressText,LONG pProgressBar,UNSIGNED pFeq)
...
       LOOP
          NEXT(pTPS)
          IF ERRORCODE() THEN BREAK END

          DO AssignTps2SqlRecordRtn  !<=== was  pSQLRecord :=: pTPSRecord

          ADD(pSQL)
          pProgressBar += 1
          IF pProgressBar % 1000 = 0 THEN 
             pProgressText = 'Progress: ' & pProgressBar & '/' & TotalRecords & ' Copied'
             DISPLAY
          END  
       END


    AssignTps2SqlRecordRtn ROUTINE
            CASE ADDRESS(pTPS)   
            OF ADDRESS(UserInfov4T) ; UserInfo:Record :=: UserInfov4T:Record 
                                      UserInfo:UserExpiryDate = UserInfov4T:ExpiryDate !Renamed field
            OF ADDRESS(xxxxxxxInfo) ; XxxxInfo:Record :=: XxxxInfov4T:Record
            etc
            ELSE
                 Message('CASE ADDRESS(pTPS)  failed on file ' & pTPS{PROP:Name} )
                 RETURN   !Failed 
            END
            EXIT
16

You could make your file loop “generic” by passing in the FIleManager as a parameter so each file conversion is 1 line of code.

FileTps2Sql(UserInfov4T,UserInfo, Access:UserInfo , ....)

FileTps2Sql  PROCEDURE(FILE pTPS ,FILE pSQL, FileManager pAccess:Sql, ...) 
   CODE  
   ProgressBar2 += 1
   ProgressText2 = 'Progress: Converting UserInfo Record'
   DISPLAY()
   OPEN(pTPS)  !!was (UserInfov4T)
   IF NOT ERRORCODE()
      pAccess:Sql.Open()     !was Access:UserInfo.Open
      pAccess:Sql.UseFile()  !was Access:UserInfo.UseFile
      IF RECORDS(pTPS)
         !Was CopyTPS2SQL(UserInfov4T,UserInfo,ProgressText3,ProgressBar3,?ProgressBar3)
         CopyTPS2SQL(pTPS, pSQL, ProgressText3,ProgressBar3,?ProgressBar3)
      END
      pAccess:Sql.Close()  !was Access:UserInfo.Close
      CLOSE(pTPS) 
   ELSE 
      Message('Open TPS Error ' & ErrorCode() &' '& Error() &' |File: '& Name(pTPS) )
   END
17

I’ve tried FieldPairClass approach. Implemented the code below

   Fields.Init
   pTPSRecord &= pTPS{PROP:Record}
   pSQLRecord &= pSQL{PROP:Record}
   
   TotalRecords = RECORDS(pTPS)
   OPEN(pTPS)
   IF NOT ERRORCODE()
      pAccessSQL.Open
      pAccessSQL.UseFile
      IF RECORDS(pTPS)
         pFeq{PROP:RangeHigh} = TotalRecords
         pProgressBar = 0
         pProgressText = 'Progress: 0/' & TotalRecords & ' Copied'
         DISPLAY()
         LOGOUT(5,pSQL)
         SET(UserInfov4T)
         LOOP
            NEXT(UserInfov4T)
            IF ERRORCODE() THEN BREAK END
            Fields.AddPair(pSQLRecord,pTPSRecord)
            Fields.AssignRightToLeft()
!            UserInfo:Record :=: UserInfov4T:Record
            ADD(UserInfo)
            pProgressBar += 1
            pProgressText = 'Progress: ' & pProgressBar & '/' & TotalRecords & ' Copied'
            IF NOT pProgressBar % 500
               DISPLAY
            END
            YIELD()
         END
         COMMIT()
      END
      pAccessSQL.Close
      CLOSE(pTPS)
   END
   Fields.Kill

Still got the same result

image

I will also try other methods in here. Thank you for all the help!

18

The FieldPairs class will work only if you initialize it with all the record fields individually.

I still think the best approach is the class with virtual+derived methods that I mentioned above.

19

I see no special handling for GROUP in Field Pairs. You are getting a simple Record=Record.

Below is my simple test just checking 3 fields in a Record assignment:

PROGRAM  
INCLUDE('abutil.inc'),ONCE

Service1 FILE,DRIVER('TOPSPEED'),RECLAIM,PRE(SER1), BINDABLE,CREATE,THREAD
Record  RECORD,PRE()
ID         SHORT        
Desc       STRING(20)
Date       DATE
    END
 END
Service2 FILE,DRIVER('TOPSPEED'),RECLAIM,PRE(SER2), BINDABLE,CREATE,THREAD
Record  RECORD,PRE()
ID         LONG        !<--- Diff so Record=Record Assign breaks
Desc       STRING(30)  !<--- Diff 
Date       LONG        !<--- Diff
    END
 END
 
MAP   
CopyTPS2SQL  PROCEDURE  (BYTE TestNum, FILE pTPS,FILE pSQL, *GROUP pTPS_Group , *GROUP pSQL_Group)
END 
TryTest BYTE    
CODE
  CLEAR(Service1)
  Ser1:ID=1234
  Ser1:Desc='Hello ' & Today() 
  Ser1:Date=today()
  TryTest=4
  CopyTPS2SQL(TryTest,Service1,Service2, SER1:Record, SER2:Record)
! SER2:Record :=: SER1:Record works so LONG = DATE works
  Message('TryTest=' & TryTest & |
      '||Ser1:ID=' & Ser1:ID &'|Ser2:ID=' & Ser2:ID & | 
      '||Ser1:Desc=' & Ser1:Desc &'|Ser2:Desc=' & Ser2:Desc & | 
      '||Ser1:Date=' & Ser1:Date &'|Ser2:Date=' & Ser2:Date,'Deep Assign Record' ) 

RETURN
!---------------------------- 
CopyTPS2SQL  PROCEDURE  (BYTE TestNum, FILE pTPS,FILE pSQL, *GROUP pTPS_Group , *GROUP pSQL_Group) 
pTPSRecord        &GROUP
pSQLRecord        &GROUP 
Fields  FieldPairsClass
CODE
   pTPSRecord &= pTPS{PROP:Record}
   pSQLRecord &= pSQL{PROP:Record} 
   CASE TestNum 
   OF 1
    pSQLRecord :=: pTPSRecord        !Test 1: Prop:Record Assign
   OF 2
    pSQL_Group :=: pTPS_Group      !Test 2: Passed *GROUP
   OF 3
    !Below works but not if record is different. Good to see works somewhat
    pSQL_Group = pTPS_Group        !Test 3: Assume same record 

   OF 4 
   Fields.Init()
   Fields.AddPair(pSQLRecord,pTPSRecord)
   Fields.AssignRightToLeft()     
   Fields.Kill() 
   ELSE
    Message('Unknown TestNum=' & TestNum )
   END 
   RETURN
20

You would need to set up the field matching of the field pairs class before you loop through your table. Use WHO() to match up fields. Then WHAT() would go into your fieldpairs object. e.g. fp.AddPair(WHAT(LeftRecord, LeftNdx),WHAT(RightRecord,RightNdx))

After you do that, loop through the table. Do a fp.AssignLeftToRight to copy the values, then add the record.

2 Likes
21

Here’s a class I was playing with a while back. Maybe you can borrow something from it.JSDEEP2.ZIP (1.4 KB)

22

I thought about suggesting that but it seemed kind of complicated for a one time conversion. You have to probably skip groups and deal with arrays i.e. IsGroup and HowMany

On thinking about it more, it could be less of a black box compared to deep assign. A window could be displayed showing where WHO did not match up so there would be a sort of an orphan. You could use TUFO to highlight type changes.

2 Likes
23

Hello,
Finally I got a good transfer by the use of WHO() and WHAT()
This is what I do in my code:

   Fields.Init
   pTPSRecord &= pTPS{PROP:Record}
   pSQLRecord &= pSQL{PROP:Record}
   
   TotalRecords = RECORDS(pTPS)
   OPEN(pTPS)
   IF NOT ERRORCODE()
      pAccessSQL.Open
      pAccessSQL.UseFile
      IF RECORDS(pTPS)
         pFeq{PROP:RangeHigh} = TotalRecords
         pProgressBar = 0
         pProgressText = 'Progress: 0/' & TotalRecords & ' Copied'
         DISPLAY()
         LOGOUT(5,pSQL)
         SET(pTPS)
         LOOP
            NEXT(pTPS)
            IF ERRORCODE() THEN BREAK END
            fieldnum# = 0
            LOOP
               fieldnum# += 1
               IF WHO(pSQLRecord,fieldnum#) = '' THEN BREAK END
               Fields.AddPair(WHAT(pSQLRecord,fieldnum#),WHAT(pTPSRecord,fieldnum#))
            END
            Fields.AssignRightToLeft()
            ADD(pSQL)
            pProgressBar += 1
            pProgressText = 'Progress: ' & pProgressBar & '/' & TotalRecords & ' Copied'
            IF NOT pProgressBar % 500
               DISPLAY
            END
            YIELD()
         END
         COMMIT()
      END
      pAccessSQL.Close
      CLOSE(pTPS)
   END
   Fields.Kill

Thank you Sir @jslarve, and all who helped me here to finally get the right code.

24

The Fields.AddPair() is building a Queue of references. You only need to do that once at the top before your file Loop, right after the pSQLRecord &= pSQL{PROP:Record}. The way you have it now you add X more assignments of the same fields every record in the file.

You are assuming the fields will be in the identical order so you will not be adding any new fields in the middle of the record, or removing fields. You’ll’ have to check but I think this will assign Arrays as a Group so you cannot change the field specification

F LONG   !Don't use implicits

   Fields.Init
   pTPSRecord &= pTPS{PROP:Record}
   pSQLRecord &= pSQL{PROP:Record}
   LOOP F=1 TO 999   !moved up here to do once
       IF WHO(pSQLRecord,F) = '' THEN BREAK.
       Fields.AddPair(WHAT(pSQLRecord,F),WHAT(pTPSRecord,F))
   END   
 
   TotalRecords = RECORDS(pTPS)
   OPEN(pTPS)
   ...
           NEXT(pTPS)
           IF ERRORCODE() THEN BREAK END
           GET(pSQL,0)         !<-- Prevent Dup Error ? probably an issue only for PUT
           CLEAR(pSQLRecord)   !<-- I would clear
           Fields.AssignRightToLeft()
           ADD(pSQL)

You probably want some error checking on ADD. I would also compare the RECORDS(TPS) = SQL.

I would move the YIELD() to do with the DISPLAY every 100 records to make it go faster

2 Likes
25

Not just that, it should definitely not be inside the table’s loop. Just at the beginning, before loop through the records. Otherwise, you end up with a jillion redundant pairs inside the fieldpairs object, adding overhead and time with each loop.

3 Likes
26

Yup, I was trying to say that. I was pondering how to estimate how many “jillion”. His sample file had 8 fields and if I guess 1000 records the Pairs Queue ends up with 8000 rows. The AssignRightToLeft() would have done 8, 16,24,32 … assignments.

If there are F fields and R records I think that’s (N*(N+1))/2 * R = 1000*1001/2*8 = 500,500 assignments with just 1,000 records. With 10,000 records that becomes 400 million assignments, with 100,000 that’s 40 billion assignments and a queue of 800,000 rows. If you happen to get paid by the hour then this may be your best method

1 Like
27

Hello @CarlBarnes,

Am I doing the right thing? Here is my code

Fields            FieldPairsClass
F                 LONG !Field Loop
TotalRecords      LONG
pTPSRecord        &GROUP
pSQLRecord        &GROUP

   Fields.Init
   pTPSRecord &= pTPS{PROP:Record}
   pSQLRecord &= pSQL{PROP:Record}
   LOOP F = 1 TO 999
      IF WHO(pSQLRecord,F) = '' THEN BREAK END
      Fields.AddPair(WHAT(pSQLRecord,F),WHAT(pTPSRecord,F))
   END
   TotalRecords = RECORDS(pTPS)
   OPEN(pTPS)
   IF NOT ERRORCODE()
      pAccessSQL.Open
      pAccessSQL.UseFile
      IF RECORDS(pTPS)
         pFeq{PROP:RangeHigh} = TotalRecords
         pProgressBar = 0
         pProgressText = 'Progress: 0/' & TotalRecords & ' Copied'
         DISPLAY()
         LOGOUT(5,pSQL)
         SET(pTPS)
         LOOP
            NEXT(pTPS)
            IF ERRORCODE() THEN BREAK END
            CLEAR(pSQLRecord)
            Fields.AssignRightToLeft()
            ADD(pSQL)
            pProgressBar += 1
            pProgressText = 'Progress: ' & pProgressBar & '/' & TotalRecords & ' Copied'
            IF NOT pProgressBar % 500
               DISPLAY
            END
            YIELD()
         END
         COMMIT()
      END
      pAccessSQL.Close
      CLOSE(pTPS)
   END
   Fields.Kill

I never thought that I just need to assign fields outside the loop to avoid ending up with a jillion redundant pairs

28

Hi - I am coming a bit late to this conversation but if I am not mistaken your current code will only assign fields in the same order from one file structure to the other.

Carl said this with “You are assuming the fields will be in the identical order so you will not be adding any new fields in the middle of the record, or removing fields”.

I thought of making a queue of position and field name and matching them up but seemed to remember seeing a solution to this before. A quick search shows an article in Clarion Magazine cmag-2006-12.pdf by Alan Telford where he does just that:

A Customized Deep Assign Function
by Alan Telford
Published 2006-12-12

so maybe it is a problem solved nearly 15 years ago

you can get the pdf with the article and a zip containing the source at:

https://clarionmag.jira.com/wiki/spaces/archive/pages/399449/ClarionMag+monthly+PDFs+and+source+ZIPs+2006

hope that saves you some time - and thanks to Dave Harms for making all the issues of Clarion Magazine freely available - there is a wealth of info in there!

cheers

Geoff R