134 lines
		
	
	
		
			7.0 KiB
		
	
	
	
		
			Plaintext
		
	
	
	
	
	
			
		
		
	
	
			134 lines
		
	
	
		
			7.0 KiB
		
	
	
	
		
			Plaintext
		
	
	
	
	
	
| Compile insert Action_Setup
 | |
| /***********************************************************************************************************************
 | |
| 
 | |
|     This program is proprietary and is not to be used by or disclosed to others, nor is it to be copied without written
 | |
|     permission from SRP Computer Solutions, Inc.
 | |
| 
 | |
|     Name        :   Action_Setup
 | |
| 
 | |
|     Description :   Declarations and equates used by the table action commuters.
 | |
| 
 | |
|     Notes       :   Action_Setup also populates several variables that will often be useful within action handler code.
 | |
| 
 | |
|     History     :   (Date, Initials, Notes)
 | |
|         08/13/10    dmb     Original programmer.
 | |
|         09/18/19    dmb     Add TableVolumes@ and new Unused global commons in the /Tables/ common block. Remove
 | |
|                             dependency upon the Locate statement in @Tables to find the volume of the current table.
 | |
|                             - [SRPFW-282]
 | |
| 
 | |
| ***********************************************************************************************************************/
 | |
| 
 | |
| Common /Tables/ TableNames@, TableAccounts@, TableHandles@, SysObjHandle@, ActionListHandle@, PromotedListHandle@, NoActionListHandle@, NoPromotedListHandle@, TableVolumes@, Unused10@, Unused11@, Unused12@, Unused13@
 | |
| 
 | |
| Declare function RetStack
 | |
| 
 | |
| 
 | |
| // SRP List declarations.
 | |
| Declare function    SRP_List_Create, SRP_List_CreateFromFastArray, SRP_List_Count, SRP_List_GetAt, SRP_List_GetVariable, SRP_List_Locate
 | |
| Declare subroutine  SRP_List_Add, SRP_List_InsertAt, SRP_List_Release, SRP_List_RemoveAt, SRP_List_SetAt
 | |
| 
 | |
| 
 | |
| // Initialize handles if necessary.
 | |
| // The handle to SYSOBJ is formatted for use with MFS/BFS calls.
 | |
| If Len(SysObjHandle@)           else Open 'SYSOBJ' to SysObjHandle@ then SysObjHandle@ = SysObjHandle@<0, 2>
 | |
| If Len(ActionListHandle@)       else ActionListHandle@ = SRP_List_Create()
 | |
| If Len(PromotedListHandle@)     else PromotedListHandle@ = SRP_List_Create()
 | |
| If Len(NoActionListHandle@)     else NoActionListHandle@ = SRP_List_Create()
 | |
| If Len(NoPromotedListHandle@)   else NoPromotedListHandle@ = SRP_List_Create()
 | |
| 
 | |
| 
 | |
| // Return values to indicate how the action flow should continue.
 | |
| Equ ACTION_STOP$                    to 0    ; // Action flow should stop
 | |
| Equ ACTION_CONTINUE$                to 1    ; // Action flow should continue until a later process changes this value
 | |
| Equ ACTION_CONTINUE_NO_PROMOTED$    to 2    ; // Action flow should by-pass the promoted (generic) logic but allow the system action to execute
 | |
| Equ ACTION_CONTINUE_NO_SYSTEM$      to 3    ; // Action flow should execute the promoted (generic) logic but stop the system action from executing
 | |
| Equ ACTION_SYSTEM_ONLY$             to 4    ; // Action flow should execute the system action only
 | |
| 
 | |
| 
 | |
| // Make sure any action parameters which have not been assigned are nulled.
 | |
| If Assigned(Code)           else Code           = ''
 | |
| If Assigned(Action)         else Action         = ''
 | |
| If Assigned(CalcColName)    else CalcColName    = ''
 | |
| If Assigned(FSList)         else FSList         = ''
 | |
| If Assigned(Handle)         else Handle         = ''
 | |
| If Assigned(Name)           then KeyID          = Name
 | |
| If Assigned(KeyID)          else KeyID          = ''
 | |
| If Assigned(FMC)            else FMC            = ''
 | |
| If Assigned(Record)         else Record         = ''
 | |
| If Assigned(Param1)         else Param1         = ''
 | |
| If Assigned(Param2)         else Param2         = ''
 | |
| If Assigned(Param3)         else Param3         = ''
 | |
| If Assigned(Param4)         else Param4         = ''
 | |
| If Assigned(Param5)         else Param5         = ''
 | |
| If Assigned(Param6)         else Param6         = ''
 | |
| If Assigned(Param7)         else Param7         = ''
 | |
| If Assigned(Param8)         else Param8         = ''
 | |
| If Assigned(Param9)         else Param9         = ''
 | |
| If Assigned(Param10)        else Param10        = ''
 | |
| If Assigned(OrigRecord)     else OrigRecord     = ''
 | |
| 
 | |
| 
 | |
| // Get the program stack
 | |
| RetStack        = RetStack()
 | |
| 
 | |
| 
 | |
| // 11 is the code value for the OPEN.FILE primitive. No need to call the following logic since it would be premature.
 | |
| If Code NE 11 then
 | |
|     // Get the name of the database table if it has already been opened with the OPEN.FILE action.
 | |
|     If Len(Handle) then
 | |
|         // Being called from within the MFS. Most methods will pass in the valid database table handle. This should already
 | |
|         // be stored in the TableHandles@ global common. The associated regular database table name will be found in the
 | |
|         // TableNames@ global common.
 | |
|         Locate Handle in TableHandles@ using @FM Setting fPos then
 | |
|             TableName       = TableNames@<fPos>
 | |
|             DictName        = 'DICT.' : TableName
 | |
|             AccountName     = TableAccounts@<fPos>
 | |
|             Volume          = TableVolumes@<fPos>
 | |
|             TableHandle     = FSList : @VM : Handle
 | |
|         end else
 | |
|             // If the handle was unable to be located in the TableHandles@ global common, this could be a situation where
 | |
|             // the handle was modified on-the-fly by the calling procedure (such as the MFS stack being manipulated for
 | |
|             // some reason). In this case, loop though each hnadle in TableHandles@ and see if it is contained within the
 | |
|             // handle being passed into the MFS. This isn't as precise, but a match will almost certainly be the correct
 | |
|             // handle.
 | |
|             FoundHandle = 0
 | |
|             NumberHandles = DCount(TableHandles@, @FM)
 | |
|             For fPos = 1 to NumberHandles
 | |
|                 CompareHandle   = TableHandles@<fPos>
 | |
|                 If Index(Handle, CompareHandle, 1) then
 | |
|                     FoundHandle = 1
 | |
|                     TableName   = TableNames@<fPos>
 | |
|                 end
 | |
|             Until FoundHandle
 | |
|             Next CompareHandle
 | |
|             If FoundHandle then
 | |
|                 DictName        = 'DICT.' : TableName
 | |
|                 AccountName     = TableAccounts@<fPos>
 | |
|                 Locate TableName in @Tables(0) using @FM setting fPos then
 | |
|                     VolumeName  = @Tables(1)<fPos>
 | |
|                     BFSType     = VolumeName[1, '*']
 | |
|                     Volume      = VolumeName[Col2() + 1, 99]
 | |
|                 end else
 | |
|                     Volume      = ''
 | |
|                 end
 | |
|                 TableHandle     = FSList : @VM : Handle
 | |
|             end
 | |
|         end
 | |
|     end
 | |
| 
 | |
|     If Assigned(TableName) else
 | |
|         // Either the Handle argument wasn't assigned or no match could be found in the TableHandles@ global common.
 | |
|         // Most likely this is because an ACTION commuter is being called directly from a program other than an MFS.
 | |
|         // Therefore the name of the database table will be extracted from the name of the ACTIONS program (which is
 | |
|         // assumed to follow the format <TableName>_ACTIONS.
 | |
|         CurProc     = RetStack[1, 'F' : @FM]
 | |
|         TableName   = CurProc
 | |
|         Swap '_ACTIONS' with '' in TableName
 | |
| 
 | |
|         DictName    = 'DICT.' : TableName
 | |
|         AccountName = ''
 | |
|         Volume      = ''
 | |
|         Open TableName to TableHandle else TableHandle = ''
 | |
|     end
 | |
| end
 |