Saturday, April 17, 2021

Opening Tables

Opening Tables

One of the most frequently written snippets of code, in almost any application, looks something like this:
*** Save Current work area
lnSelect = SELECT()
*** Select Required Area
IF ! USED( <Alias> )
  USE <table_name> IN 0 AGAIN ALIAS <Alias>
ENDIF
SELECT <New Work Area>

*** Do Something There

<commands>


*** Return to original work area
SELECT (lnSelect)

Now, admittedly, this is not really very difficult, but it or some variant is repeated many times in an application. We really should be able to do better than this now that we have all the power of Object Orientation behind us and indeed we can. The SelAlias class defines an object that accepts the alias name of a table as a parameter and switches to that table's work area. If the table is not open it will open the table for us and if the table cannot be found, it will prompt us to locate it. More importantly it will 'remember' that it opened the table and when the object is released it will close the table and restore the work area that was current when the object was instantiated. The class also provides support for an additional parameter which can be used to specify a physical table name when it is necessary to open a table with an alias other than the real name of the table.

Note that this class has no exposed properties or methods and does all of its work in its Init and Destroy methods. By creating an object based on this class, and scoping it as LOCAL, we need never write code like that shown above again. The class is intended to be used whenever you need to open a table ‘on the fly’ and so typically I use it by creating a local variable to use as the reference to the object. The consequence is that as soon as the method which created the reference ends the object is released and the table is closed (if it was not open already) and the original work area is re-selected.

The class is based on a relation - it is a small and lightweight base class that is quick to instantiate but, unlike the empty base class still has the native Init() and Destroy() methods.
I have used this code extensively ‘as is’, but it could easily be extended to handle other conditions and scenarios – for example it will not work with views as it stands because it assumes that a physical file exists – but this is easily fixed if you need it to handle that scenario too. Anyway, here is the code - feel free to modify and improve it:
********************************************************************
*** Name.....: SELALIAS.PRG
*** Author...: Andy Kramek & Marcia Akins
*** Date.....: 06/10/2006
*** Notice...: Copyright (c) 2006 Tightline Computers, Inc
*** Compiler.: Visual FoxPro 09.00.0000.3504 for Windows
*** Function.: Class to Select a specific Work area and restore it
*** .........: Use as a local object to change work area.
*** .........: When released will restore the previous work area
*** .........: Accepts two parameters, the first is the Alias and is mandatory
*** .........: The second is the name of the table.  If not passed, assumed to be the
*** .........: same as the Alias you are using.
*** .........: loSel = CREATEOBJECT( 'xSelAlias', <Alias> [, |<File Name> ] )
********************************************************************

********************************************************************
DEFINE CLASS xSelAlias AS relation
******************************************************************
  PROTECTED nOldArea
  nOldArea = 0
  PROTECTED lWasOpen
  lWasOpen = .T.
  PROTECTED cAlias
  cAlias = ''

  ****************************************************************
  *** Init: Native initialization method
  ****************************************************************
  PROCEDURE Init( tcAlias, tcTable )
    LOCAL llRetVal
    *** No Alias Passed - Bail Out
    IF ! VARTYPE( tcAlias ) = "C" OR EMPTY( tcAlias )
      ASSERT .F. MESSAGE "Must Pass an Alias Name to Work Area Selector"
      RETURN .F.
    ENDIF
    tcAlias = UPPER( ALLTRIM( tcAlias ) )
    IF VARTYPE( tcTable ) # "C" OR EMPTY( tcTable )
      tcTable = tcAlias
    ELSE
      tcTable = UPPER( ALLTRIM( tcTable ) )
    ENDIF
    *** If already in correct work area - do nothing
    IF UPPER( ALLTRIM( ALIAS() ) ) == tcAlias
      RETURN .F.
    ELSE
      *** Does the table exist?
      tcTable = FORCEEXT( tcTable, 'dbf' )
      IF NOT FILE( tcTable )
        *** Try and find it....
        tcTable = LOCFILE( JUSTFNAME( tcTable ), 'dbf', "Cannot Find" )
        IF EMPTY( tcTable )
          *** Nothing more we can do
          RETURN .F.
        ELSE
          *** May have got the wrong name - set the alias to the table name
          tcAlias = JUSTSTEM( tcTable )
        ENDIF
      ENDIF
    ENDIF

    *** If Specified Alias not open - Open it
    IF ! USED( tcAlias )
      USE ( tcTable ) AGAIN IN 0 ALIAS ( tcAlias ) SHARED
      *** And Check!
      llRetVal = USED( tcAlias )
      *** If Forced Open, Note the fact
      IF llRetVal
        This.lWasOpen = .F.
      ENDIF
    ELSE
      llRetVal = .T.
    ENDIF
    *** If OK, save current work area and
    *** Now Move to the specified Work Area
    IF llRetVal
      This.nOldArea = SELECT()
      SELECT ( tcAlias )
      This.cAlias = tcAlias
    ENDIF
    *** Return Status
    RETURN llRetVal
  ENDPROC

  ****************************************************************
  *** Destroy: Native Destroy Method
  ****************************************************************
  PROCEDURE Destroy
    WITH This
      *** If table opened by this object, close it
      IF NOT .lWasOpen
        USE IN ( This.cAlias )
      ENDIF
      *** Restore Previous work area
      IF NOT EMPTY( .nOldArea )
        SELECT ( .nOldArea )
      ENDIF
    ENDWITH
  ENDPROC

ENDDEFINE
Published Saturday, June 10, 2006 1:19 PM by andykr

No comments:

Post a Comment

Writing better code (Part 1)

Writing better code (Part 1) As we all know, Visual FoxPro provides an extremely rich and varied development environment but sometimes to...