23 de septiembre de 2017

Crear una funcionalidad Deshacer en cuadros de texto de Visual FoxPro

Artículo original: Creating Undo functionality in a Visual FoxPro TextBox
http://west-wind.com/weblog/posts/3296.aspx
Autor: Rick Strahl
Traducido por: Ana María Bisbé York


El cuadro de texto de Visual FoxPro no es precisamente un gran control como el que yo tengo en el Help Builder (http://www.west-wind.com/wwHelp/). Tuve que trabajarlo para hacer que funcione como si estuviera basado en un editor de textos que incluye formato. Pero al mismo tiempo no era capaz de encontrar una forma decente de sustitución. La mayoría de los controles ActiveX basados en textos son poco menos que un infierno (al menos en VFP) o son muy muy lentos si trata de enganchar algún evento COM a la clave al procesar, como necesito que haga el Help Builder.

En general el TextBox de VFP funciona bien, salvo en dos cosas:

  1. Existe un bug en el control que provoca que el control envuelva al original si existen avance de línea en un área específica del margen derecho. Puede causar avances de línea que sean "comidos" por el cuadro de texto con el texto que puede ser un salto súbito cuando el cuadro de texto es redimensionado u otros cuadros de texto entren  fuera del margen. Esto se puede ver como un bug muy oscuro; pero si trabaja modificando grandes cantidades de textos se lo encontrará muy pronto. Según Calvin Hsia se corrige en el VFP 9.0 SP1...
  2. Comportamiento para Deshacer. El cuadro de texto de Visual FoxPro no tiene un comportamiento para Deshacer - el buffer para Deshacer se pierde cada vez que hay cualquier tipo de actualización del dato. Esto incluye el enlace al origen de datos (ControlSource), establecer el valor explícitamente, cambiar SelText o incluso pasar texto al control. Se limpia también si se oprime la tecla Tab y sale del control e inmediatamente regresa. Todo esto es realmente limitado y no es un comportamiento estándar.

Hasta la salida del SP1 no puedo hacer nada con el punto 1; pero he pensado que puedo controlar mi propio Deshacer con buffer en mi control TextBox personalizado. Mientras hablaba con Calvin en SoutWest Fox comenzamos a colocar un mejor comportamiento en el TextBox; pero sobre el comportamiento Deshacer está profundamente dentro del runtime de VFP y cambiar eso es algo como romper mucho del código que ya está. Por tanto no hay ayuda en este sentido. Entonces Calvin me sugirió... escribe el tuyo propio....

Lo primero que pensé - sí, bien. Controlar Deshacer buffer con código Fox es muy lento y ocuparía mucha memoria, porque hay que guardar el buffer entero del valor del control ya que los eventos InteractiveChange y ProgrammaticChange no brindan información de qué es lo que ha cambiado, entonces, no hay una forma fácil de capturar cuál de los cambios es el que hay que deshacer.

Después de pensarlo un poco, intenté de todas formas para observar cómo van a trabajar las cosas y entonces trabajé con estas variantes:

  • Comportamiento opcional para Deshacer personalizado
  • Deshacer que sobreviva a cambios por programa
  • Deshacer que sobreviva al foco de otro control
  • Deshacer que se limpie sólo con Refresh o un Clear explícito del buffer de Deshacer
  • Rehacer que permita Deshacer lo deshecho

He aquí un código que se encarga de un control que controla un comportamiento Deshacer en mi clase TextBox.

DEFINE CLASS wwhtmleditbox AS editbox
  OLEDropMode = 1
  FontName = "Tahoma"
  FontSize = 8
  Alignment = 0
  AllowTabs = .T.
  Height = 188
  ScrollBars = 2
  Width = 443
  oundobuffer = .NULL.
  *-- La última vez, UndoBuffer fue actualizado  en segundos. 
  *-- Internamente el valor utilizado mantiene cada carácter 
  *-- por tenerlo añadido al buffer de deshacer. 
  nlastundoupdate = 0
  *-- El indicador utilizado inhabilita los cambios de programación
  *-- en el bufer de deshacer.
  lundonoprogrammaticchange = .F.
  lundotracking = .F.
  oredobuffer = .NULL.
  Name = "wwhtmleditbox"

  PROCEDURE Init
    this.oUndoBuffer = CREATEOBJECT("wwNameValueCollection")
    this.oRedoBuffer = CREATEOBJECT("wwNameValueCollection")
  ENDPROC

  PROCEDURE undo
    IF THIS.lundotracking AND THIS.oUndoBuffer.Count > 0
      THIS.lUndoNoProgrammaticChange = .T.
      this.oRedoBuffer.FastAdd(TRANSFORM(this.SelStart),this.Value)
      lcValue = this.oUndoBuffer.aItems[this.oUndoBuffer.Count,2] 
      IF lcValue = this.Value AND this.oUndoBuffer.Count > 1
        THIS.Value = this.oUndoBuffer.aItems[this.oUndoBuffer.Count-1,2] 
        this.oUndoBuffer.Remove(this.oUndoBuffer.Count)
      ELSE
        this.Value = lcValue
      ENDIF
      this.SelStart = VAL(this.oUndoBuffer.aItems[this.oUndoBuffer.Count,1])
      THIS.lUndoNoProgrammaticChange = .F.
      this.oUndoBuffer.Remove(this.oUndoBuffer.Count)
    ENDIF
  ENDPROC

  PROCEDURE redo
    IF THIS.lundotracking AND THIS.oRedoBuffer.Count > 0
      THIS.lUndoNoProgrammaticChange = .T.
      this.Value = this.oRedoBuffer.aItems[this.oReDoBuffer.Count,2]
      this.SelStart = VAL(this.oRedoBuffer.aItems[this.oRedoBuffer.Count,1])
      THIS.lUndoNoProgrammaticChange = .F.
      this.oRedoBuffer.Remove(this.oRedoBuffer.Count)
    ENDIF
  ENDPROC

  PROCEDURE KeyPress
    LPARAMETERS nKeyCode, nShiftAltCtrl
    *** No desea oprimir ESC para eliminar el contenido del campo.
    IF nKeyCode = 27
      *** Se come la tecla, la ignora
      NODEFAULT
    ENDIF
    *** Ctrl-Z
    IF THIS.lUndoTracking 
      IF nKeyCode = 26
        *** Debe verificar la tecla Ctrl-<- la que tiene número 26
        DECLARE INTEGER GetKeyState IN WIN32API INTEGER
        IF GetKeyState(0x25) > -1
          THIS.Undo()
          NODEFAULT
        ENDIF
      ENDIF
      *** Rehacer Ctrl-R
      IF nKeyCode = 18
        THIS.Redo() 
        NODEFAULT
      ENDIF
    ENDIF 
  ENDPROC

  PROCEDURE ProgrammaticChange
    IF THIS.lUndoTracking AND !THIS.lUndoNoProgrammaticChange
      this.oUndoBuffer.FastAdd(TRANSFORM(this.SelStart),this.Value)
      this.oRedoBuffer.Clear()
    ENDIF 
  ENDPROC

  PROCEDURE InteractiveChange
    IF THIS.lUndoTracking
      *** Actualizar sólo en la segunda mitad del intervalo, 
      *** entonces, si escribe varias letras va en lote 
      IF SECONDS() - THIS.nLastUndoUpdate < 1
        this.nLastUndoUpdate = SECONDS()
        RETURN
      ENDIF
      *** Solo deshace la escritura de la última palabra
      IF LASTKEY() = 32 OR LASTKEY() = 13 OR LASTKEY() = 44 OR ;
        LASTKEY() = 46 OR LASTKEY() = 9
        this.oUndoBuffer.FastAdd(TRANSFORM(this.SelStart),this.Value)
        this.oRedoBuffer.Clear()
        this.nLastUndoUpdate = SECONDS()
      ENDIF
    ENDIF
  ENDPROC

  PROCEDURE Refresh
    IF THIS.lUndoTracking
      THIS.oUndobuffer.Clear()
    ENDIF
  ENDPROC
ENDDEFINE

Vea que este código tiene una dependencia que no incluyo aquí. Estoy utilizando una clase de usuario llamada NameValueCollection la que guarda el nombre y el valor en una matriz. Puede cambiar este código para utilizar una Collection y un objeto que guarde el valor del buffer en la posición SelStart.

La idea es esencialmente que cada InteractiveChange y ProgrammaticChange son monitoreados y potencialmente escritos fuera del valor de la colección UndoBuffer. El método InteractiveChange se  alterna de tal forma que solo escribe fuera el dato si el usuario en realidad no lo está escribiendo activamente y si el cursor está en el límite de una palabra. Esto reduce tremendamente la cantidad de valores que se guardan. Parece  que otras aplicaciones como Word utilizan un proceder similar aunque el comportamiento de Word es algo diferente.

Vea además este código

IF nKeyCode = 26
  *** Debe verificar Ctrl-<- el cual es  26
  DECLARE INTEGER GetKeyState IN WIN32API INTEGER
  IF GetKeyState(0x25) > -1
    THIS.Undo()
    NODEFAULT
  ENDIF
ENDIF

En su infinita sabiduría alguien decidió que el mapa de código de teclas (KeyCode) fuera 26 para Ctrl-Z y para Ctrl-Flecha izquierda, por lo que no hay una forma sencilla de decir el carácter. En su lugar, tiene que hacer otra verificación sobre el KeyCode para ver si tiene una Flecha izquierda (0X25). Si devuelve -127 ó -128. Diga que esto es HACK; pero funciona. Fue simpático por unos minutos tener Ctrl+Flecha izquierda atado a la tecla Deshacer (Retroceso). Menos mal que decidí generar un comportamiento de Rehacer desde el inicio...

Ahora he colocado esto en el Help Builder y como yo trabajo con los documentos del Web Connection 5.0 (http://www.west-wind.com/wconnect/) utilizo mucho características con tópicos muy largos. Entonces, este comportamiento se ve muy bien. No he visto problemas de rendimiento ni por la memoria ni nada apreciable mientras escribo.

Puedo imaginar que puedo marcar este en mi lista de deseos para VFP que nunca iba a tener.


19 de septiembre de 2017

El dilema de controlar una excepción en Visual FoxPro

Artículo original: Exception Handling Dilemma in VFP
http://west-wind.com/weblog/posts/4538.aspx
Autor: Rick Strahl
Traducido por: Ana María Bisbé York


Me ha llamado la atención, hace un par de días, que cambiando el mecanismo de control de errores de Web Connection por uno nuevo basado en TRY/CATCH, en lugar del método tradicional de controlar el error, que tiene mucha menos funcionalidad.

En Web Connection 4.0 todas las clases para procesar errores se controlan en el método Error en la clase Process la que básicamente captura todos los errores no controlados. El problema con el método de error es que no puede inhabilitarlo fácilmente, entonces, para tener un entorno de desarrollo donde los errores no sean controlados y el entorno de ejecución donde están tengo que utilizar un código como este:

*** Este bloque anula el método Error para que pueda tener los errores en
*** tiempo de depuración interactiva mientras ejecuta dentro de VFP.
#IF !DEBUGMODE
**************************************
FUNCTION Error(nError, cMethod, nLine)
**************************************
  LOCAL lcLogString, llOldLogging, lcOldError
  *** ¿Hemos sobrecargado la pila de llamadas? Si es así, nos vamos
  IF PROGLEVEL() > 125
    RETURN TO PROCESSHIT
  ENDIF
  nError = IIF(VARTYPE(nError) = "N", nError, 0)
  cMethod = IIF(VARTYPE(cMethod) = "C", cMethod, "")
  nLine = IIF(VARTYPE(nLine) = "N", nLine, 0)
  *** Guardamos el valor actual
  lcOldError = ON("ERROR")
  ON ERROR *
  *** Cerramos esta petición con una página de error 
  *** - SAFE MESSAGE (no confiar en ningún objeto)
  This.ErrorMsg("Ha ocurrido un error..",;
    "En este momento no se puede servir esta petición " + ;
    "debido a dificultades técnicas.<P>" + ;
    "No. Error: " + STR(nError) + "<BR>" + CRLF + ;
    "Error: " + MESSAGE()+ "<P>" + CRLF + ;
    "Método: " + cMethod + "<BR>" + CRLF + ;
    "Código actual: "+ MESSAGE(1) + "<BR>" + CRLF + ;
    "Línea de código actual: " + STR(nLine) + "<p>" + ;
    "Excepción controlada por " + This.CLASS + ".Error()")
  *** Obriga a cerrar el archivo y es recuperable por wc.dll/exe
  *** NOTA: Los objetos HTML no se liberan aquí debido a otra
  *** referencia de objeto como Response.
  IF TYPE("This.oResponse") = "O" AND !ISNULL(This.oResponse)
    This.oResponse.DESTROY()
  ENDIF
  * wait window MESSAGE() + CRLF + MESSAGE(1) + ;
  *   CRLF + "Método: " + cMethod nowait
  IF TYPE("This.oServer") = "O" AND !ISNULL(This.oServer)
    *** Intenta obtener un log del error - Fuerza el log!!!
    * llOldLogging = This.oServer.GetLogToFile()
    llOldLogging = This.oServer.lLogToFile
    lcLogString = "Procesando Error - " + ;
      This.oServer.oRequest.GetCurrentUrl() + ;
      CRLF + CRLF + "<PRE>" + CRLF + ;
      " Error: " + STR(nError) + CRLF + ;
      " Mensaje: " + MESSAGE() + CRLF + ;
      " Código: " + MESSAGE(2) + CRLF + ;
      " Programa: " + cMethod + CRLF + ;
      " Línea No: " + STR(nLine) + CRLF + ;
      " Cliente: " + This.oRequest.GetIpAddress() + CRLF + ;
      "Post Buffer: " + This.oRequest.cFormVars + CRLF + ;
      "</PRE>" + CRLF + ;
      "Excepción controlada por: " + This.CLASS+".Error()"
    This.oServer.LogRequest(lcLogString,"Local",0,.T.)
    This.oServer.SetLogging(llOldLogging)
    This.SendErrorEmail("Web Connection Error - " + ;
      This.oServer.oRequest.GetCurrentUrl(), lcLogString)
  ENDIF
  ON ERROR &lcOldError
  *** Regresa al método Process!
  RETURN TO ROUTEREQUEST
ENDFUNC
* EOF wwProcess::Error
#ENDIF 

Ahora está trabajando bien; pero siempre ha sido un esquema que huele mal. El primer punto es que existe un requerimiento del compilador para habilitar y deshabilitar el interruptor para el modo debug. Entonces, necesita ser recompilado para hacer que cambie entre los dos.

El otro problema más delicado, es que confía en RETURN TO para devolver a un método especificado que lo haya llamado, lo que no es siempre confiable. De hecho, si en algún lugar en la cadena de llamada causa error una ejecución EVAL() el mecanismo de error entero se rompe porque VFP 8 y 9 no admiten RETURN TO en llamadas EVALUATE(). Cuando este es el caso, RETURN TO hace return sencillo y usted termina la ejecución del código SIGUIENDO el error.

Nunca me había gustado el método Error en estos casos porque no existe una forma determinista para devolverlo a algún lugar, entonces VFP 8 llegó con algo que me gustó mucho ver: TRY/CATCH y la capacidad de tener más control determinista del error que permite volver a un lugar específico del código.

Entonces, con Web Connection 5.0 el método Error y el proceder DEBUGMODE (el que de paso, es aplicado también a otras clases) fue sustituido por un controlador TRY/CATCH como centro del motor de proceso. He aquí la implementación que no tiene ningún método de error especial; pero en su lugar, el lo llama:

************************
FUNCTION Process()
************************
  LOCAL loException
  PRIVATE Response, REQUEST, Server, Session, Process
  Process = THIS
  Server = This.oServer
  Request = This.oRequest
  Response = This.oResponse
  Session = This.oSession
  Config = This.oConfig
  *** Método gancho
  IF !This.OnProcessInit()
    RETURN
  ENDIF
  IF Server.lDebugMode
    This.RouteRequest()
  ELSE
    TRY
      This.RouteRequest()
    CATCH TO loException
      This.OnError(loException)
    ENDTRY
  ENDIF
  This.OnProcessComplete()
  RETURN .T.
ENDFUNC
* EOF wwProcess::Process 

El controlador TRY/CATCH captura cualquier error y entonces, sencillamente llama a un método sobreescribible que es utilizado para controlar el error. Un controlador predeterminado es proporcionado o el desarrollador puede sustituir OnError para hacer cualquier cosa que necesite. Desde la perspectiva del diseñador esto está mucho más claro y no tiene un error potencial utilizando RETURN TO.

Pero, existe desafortunadamente, una funcionalidad perdida. TRY/CATCH está bien; pero su empleo termina con algunas limitaciones. Este controlador:

  • No nos brinda una información detallada del error
  • No tenemos la pila de llamada - el control se devuelve al nivel que lo llama.

CATCH permite recibir un objeto exception; pero desafortunadamente este objeto no brinda mucha información y la información disponible no está completa como en el método Error. La razón principal para esto es que cuando ocurre una operación CATCH limpia la pila de llamada con lo que lo coloca en el método inicial que ha realizado la llamada. Esto significa que puede obtener información detallada del error desde el nivel de la pila de llamadas donde, realmente ocurra el error. Cualquier variable, PRIVATE o LOCAL se habrá perdido y ASTACKINFO() solamente devolverá la pila actual, la que en realidad no se corresponde con callstack de el lugar donde ocurrió el error.

Esto significa además, que su información de error está limitada por lo que provee el objeto Exception y no es tan completa como lo que brinda LINENO(), PROCEDURE y SYS(16). El resultado es que en muchas situaciones puede obtener LineNo y ejecutar el nombre del programa de la forma en que tiene en el método Error, especialmente en tiempo de ejecución sin tener información de depuración.

Alternativas? Realmente no ...

Entonces, estuve intentando obtener algunas soluciones para esta limitación - desafortunadamente no he encontrado la forma correcta de hacerlo. Mi primera idea fue hacer que funcione el método Error además del controlador TRY/CATCH. Un par de ideas que vinieron a mi mente:

  • Sobreescribir Try/Catch con el método Error
  • Utilizar un método Error junto al Try/Catch y emplear THROW para crear una excepción personalizada
FUNCTION Error(lnerror,lcMethod,lnLine)
  *** Aquí su controlador de error personalizado
  RETURN TO RouteRequest
ENDFUNC

Desafortunadamente esto no va a funcionar: VFP no permitirá RETURN TO ni RETRY dentro de un bloque TRY/CATCH. Denegado.

La segunda opción tendría un proceder similar; pero en su lugar de devuelve la información del error capturado y luego crea una excepción personalizada que contenga información adicional:

FUNCTION Error(lnerror,lcMethod,lnLine)
  This.StandardPage("Error Ocurrido","Prueba")
  LOCAL loException as Exception
  loException = CREATEOBJECT("Exception")
  loException.LineNo = lnLine
  loException.ErrorNo = lnError
  loException.Message = MESSAGE()
  THROW loException
ENDFUNC

Desafortunadamente, esto tampoco funciona el error arrojado en el método Error es arrojado a su vez, al nuevo controlador de errores. Lo único que puede controlar una excepción en el método Error es ON ERROR. Por tanto, esto tampoco funciona.

Próxima idea: Capturar la excepción y adjuntarla en una propiedad, para que la información adicional esté disponible. Entonces, sencillamente devolvemos el Error del método Error. Desafortunadamente esto tampoco funciona, porque no se puede acortar el circuito de procesamiento del error - Cualquier código siguiente al error original continúa ejecutándose.

Entonces, al final está claro que el método Error() que necesita mostrar la cadena de error no coexiste de manera limpia con el controlador TRY/CATCH. No veo al forma que puedo hacer que esto funcione utilizando un proceder donde se empleen ambos .

Al final, mi solución es agregar un indicador lUseErrorMethodErrorHandling a la clase que procesa y luego, basarme en el salto de la llamada TRY/CATCH

IF Server.lDebugMode OR ;
  This.lUseErrorMethodErrorHandling
  This.RouteRequest()
ELSE
  TRY
    This.RouteRequest()
  CATCH TO loException
    This.OnError(loException)
  ENDTRY
ENDIF

Entonces, el controlador de error funciona como en la versión vieja de Web Connection, excepto en que el desarrollador es responsable por hacer su propio controlador de error. Para simular un comportamiento similar y para componer el mensaje de error como TRY/CATCH puede hacer lo siguiente:

FUNCTION Error(lnerror,lcMethod,lnLine)
  LOCAL loException as Exception
  loException = CREATEOBJECT("Exception")
  loException.LineNo = lnLine
  loException.LineContents = MESSAGE(1)
  loException.ErrorNo = lnError
  loException.Message = MESSAGE()
  loException.Procedure = SYS(16)
  This.OnError(loException)
  RETURN TO RouteRequest
ENDFUNC

Esto funciona; pero no es lo que yo considero la implementación más limpia. Sería muy bueno que VFP nos permitiera alguna opción para tener un gancho que pueda controlarse cuando es creado un objeto Exception. En lugar de pasar una referencia a un objeto Exception podría pasar un tipo - VFP podría instanciar el tipo y usted podría sobreescribir, digamos el Init() de ese tipo para reunir toda la información relevante de la pila de llamadas hasta ese punto. O tener la referencia que tenga un método que sea llamado en la inicialización. O al menos, si TRY/CATCH admite THROW para encadenar el método error.

Bueno, esto funciona aunque tiene truco...


15 de septiembre de 2017

Guardar y restaurar configuraciones en aplicaciones VFP

Artículo original: Saving and restoring settings in VFP applications
http://www.sweetpotatosoftware.com/SPSBlog/PermaLink,guid,e5d49608-9752-42a5-b7f7-867df325a780.aspx
Autor: Craig Boyd
Traducido por: Ana María Bisbé York


El problema

Muchas veces, los desarrolladores Visual FoxPro van a encontrarse a si mismo guardando estados previos de alguna configuración para restaurarlo una vez que está ejecutando el código. Los más usuales son:

  • comandos SET (tales como SET SAFETY, SET DELETED, etc.)
  • comandos ON (ON ERROR, ON ESCAPE, etc.)
  • posición del puntero de registro
  • área de trabajo actual

La solución

En lugar de escribir las mismas líneas de código una y otra vez en sus programas, podríamos crear una clase que lo controle. Esto hace la siguiente clase SettingHandler, que he escrito y he preparado unos ejemplos de cómo utilizarla. Notará que cuando instancio la clase envío el comando que estoy por ejecutar (tales como SET SAFETY OFF) como un parámetro tipo cadena. La clase va a guardar la configuración actual del parámetro Safety y luego lo iguala a OFF. Cuando deseo restablecer la configuración anterior, libero la instancia de SettingHandler y la clase restablece el valor de Safety a lo que hubiera antes de que yo lo hubiera cambiado.

Inconvenientes y ventajas

El único inconveniente que encuentro en este proceder es que no trabaja IntelliSense cuando escribo el comando como parámetro de cadena. Y sobre las mejoras, puedo pensar en más de una, por ejemplo, operaciones sobre tablas. Se podría agregar que permita guardar la sesión actual de datos y que luego la restablezca (habrá probablemente otros parámetros que también se podrían proporcionar Captions, ForeColor, BackColor, Tag, etc) Además, se podría agregar alguna lógica para controlar si un desarrollador cambia las áreas de trabajo; pero no especifica un área de trabajo en el comando GOTO.

He aquí un ejemplo listo para correr y la definición de clase (copie y pegue el código que aparece a continuación en un prg y ejecútelo)

*************************
*!* EJEMPLO DE USO
*************************
CLEAR
LOCAL loSetting
? "SET COMMANDS:"
SET SAFETY ON
? SET("SAFETY")
**  Guarda y cambia el valor de Safety 
loSetting = CREATEOBJECT("SettingHandler", "SET SAFETY OFF")
? SET("SAFETY")
** Restaura el valor previo de Safety 
RELEASE loSetting 
? SET("SAFETY")
?
? "ON COMMANDS:"
ON ERROR ? "Controlador de error previo "
? ON("ERROR")
** Guarda y cambia el valor del controlador de error
loSetting = CREATEOBJECT("SettingHandler", "ON ERROR ?'New Error Handler'") 
? ON("ERROR")
** Restaura el valor previo del controlador de error
RELEASE loSetting 
? ON("ERROR")
?
? "RECORD NUMBER:"
IF !USED("customers")
  USE (HOME(2) + "northwind\customers.dbf") IN 0 SHARED
ENDIF
GOTO 5 IN "customers"
? RECNO("customers")
** Guarda y cambia el valor de la posición del puntero de registro
loSetting = CREATEOBJECT("SettingHandler", "GO 12 in [customers]") 
? RECNO("customers")
** Restaura el valor previo de la posición del puntero de registro
RELEASE loSetting 
? RECNO("customers")
?
? "SELECT:"
IF !USED("orders")
  USE (HOME(2) + "northwind\orders.dbf") IN 0 SHARED
ENDIF
SELECT "Orders"
? ALIAS()
** Guarda y cambia el valor del Alias actual
loSetting = CREATEOBJECT("SettingHandler", "Select Customers") 
? ALIAS()
** Restaura el valor previo del Alias actual
RELEASE loSetting 
? ALIAS()
USE IN SELECT("Customers")
USE IN SELECT("Orders")
*
******* Final de los ejemplos ******
*
************************************
*!* DEFINICIÓN DE CLASE
************************************
DEFINE CLASS SettingHandler as custom
  PROTECTED PreviousValue
  PreviousValue = .NULL.
  PROTECTED SettingCommand
  SettingCommand = ""
  PROTECTED SettingType && 0 = SET/ON, 1 = RECNO
  SettingType = -1
  #DEFINE SETTINGDELIMITERS [('" ] + "[])"

  PROCEDURE Init (tcCommand)
    This.Setup(tcCommand)
  ENDPROC

  PROTECTED PROCEDURE Destroy
    This.RevertSetting()
  ENDPROC

  PROCEDURE Setup (tcCommand)
    This.SettingCommand = ALLTRIM(tcCommand)
    This.SaveSetting()
    This.UpdateSetting()
  ENDPROC

  PROTECTED PROCEDURE SaveSetting
    LOCAL lcFirstPart, lcSecondPart, lnSecondPosition, lcCommand
    lcFirstPart = UPPER(ALLTRIM(GETWORDNUM(this.SettingCommand, ;
      1, SETTINGDELIMITERS)))
    DO CASE
      CASE INLIST(lcFirstPart, "SET", "ON")
        lcSecondPart = UPPER(ALLTRIM(GETWORDNUM(this.SettingCommand, ;
          2, SETTINGDELIMITERS)))
        lcCommand = lcFirstPart + [("] + lcSecondPart + [")]
        This.SettingType = 0
      CASE INLIST(lcFirstPart, "GOTO", "GO")
        lnSecondPosition = ATC(" IN ", this.SettingCommand)
        IF lnSecondPosition > 0
          lcSecondPart = SUBSTR(this.settingcommand, lnSecondPosition + 4)
        ELSE
          lcSecondPart = ""
        ENDIF
        lcCommand = [RECNO(] + lcSecondPart + [)]
        This.SettingType = 1
      CASE lcFirstPart = "SELECT"
        lcSecondPart = UPPER(ALLTRIM(GETWORDNUM(this.SettingCommand, ;
          2, SETTINGDELIMITERS)))
        lcCommand = [ALIAS()]
        This.SettingType = 2
    ENDCASE
    IF !EMPTY(lcCommand)
      This.PreviousValue = EVALUATE(lcCommand)
    ENDIF
  ENDPROC

  PROTECTED PROCEDURE UpdateSetting
    EXECSCRIPT(This.SettingCommand) && Cambia los valores
  ENDPROC

  PROTECTED PROCEDURE RevertSetting
    LOCAL lcCommand, lnStuffPosition, lnStuffLength, lcAliasWas
    DO CASE
      CASE This.SettingType = 0 && SET/ON
        lnStuffPosition = AT(" ", this.Settingcommand, 2) + 1
        lnStuffLength = LEN(this.settingcommand) - lnStuffPosition + 1
      CASE This.SettingType = 1 && GOTO/GO
        lnStuffPosition = AT(" RECORD ", UPPER(this.Settingcommand), 1) + 8
        IF lnStuffPosition < 9
          lnStuffPosition = AT(" ", this.Settingcommand, 1) + 1
          lnStuffLength = AT(" ", this.Settingcommand, 2)
          IF lnStuffLength > 0
            lnStuffLength = lnStuffLength - lnStuffPosition + 1
          ELSE
            lnStuffLength = LEN(this.settingcommand) - lnStuffPosition + 1
          ENDIF
        ELSE
          lnStuffLength = LEN(this.settingcommand) - lnStuffPosition + 1
        ENDIF
      CASE This.SettingType = 2 && SELECT
        lnStuffPosition = AT(" ", this.Settingcommand, 1) + 1
        lnStuffLength = LEN(this.settingcommand) - lnStuffPosition + 1
    ENDCASE
    IF !EMPTY(lnStuffPosition)
      lcCommand = STUFF(This.SettingCommand, lnStuffPosition, ;
        lnStuffLength, TRANSFORM(this.PreviousValue))
      ** Restablece el estado inicial antes de que fueran cambiado
      EXECSCRIPT(lcCommand) 
    ENDIF
  ENDPROC
ENDDEFINE

11 de septiembre de 2017

Detectar y solucionar conflictos de actualización en VFP

Detectar y solucionar conflictos de actualización en VFP

Artículo original: Detecting and resolving update conflicts in VFP
http://weblogs.foxite.com/andykramek/archive/2006/02/18/1155.aspx
Autor: Andy Kramek
Traducido por: Ana María Bisbé York


En el último artículo en esta serie veré el problema acerca de cómo detectar y solucionar que Visual FoxPro piensa actualizar conflictos. La idea detrás de esto es que queremos asegurar que cuando VFP informa aquí el conflicto es realmente uno. La razón por la que aquí existe una duda es que VFP va a reportar un conflicto de actualización en algún cambio se ha hecho en la copia de disco del registro que se va a guardar - aunque los cambios hechos por el usuario actual realmente crean un conjunto con los datos generados o no. Como un ejemplo, considere el siguiente caso:

  • Usuario # 1 abre un registro cliente para modificar un número de teléfono
  • Usuario # 2 abre el mismo registro cliente para agregar el código postal y cuatro valores
  • El Usuario # 1 guarda sus cambios en el número de teléfono.
  • El usuario # 2 trata de guardar sus cambios del código postal y puede ser un error de "conflicto de actualización", incluso pensando que el valor que este usuario está cambiando no estuvo afectado por los cambios y fueron hechos y guardados por el usuario # 1.

Con un pequeño esfuerzo, puede detectar y solucionar este tipo de errores y solamente rechaza un cambio de usuario cuando realmente entra en conflicto con el dato existente. Para hacer esto podría aprovechar la capacidad de Visual FoxPro para devolver los valores CurVal() y OldVal() para cada columna (para una explicación del rol de estas funciones vea mi artículo Diciembre 2005 en "Handling buffered data in Visual FoxPro").

El proceso consiste en varios pasos y es mostrado aquí (por claridad) como un simple programa con alguna función asociada, por supuesto, puede ser creado en una clase e instanciado como un objeto. El programa mostrado aquí solamente devuelve Verdadero cuando el conflicto ha sido solucionado. Si devuelve Falso indica o que un error ocurre, o que se mantiene este conflicto. En el último caso un cursor contiene el detalle de todo el conflicto no resuelto.

[1] Lo primero que necesita verificar es que tenemos un nombre de tabla que está actualmente en buffer. Por tanto, como veremos, la solución del problema se basa en utilizar TableUpdate(), podemos solamente controlar los conflictos para tablas en buffer. El programa crea un cursor, el que utilizaremos para guardar todos los detalles de cualquier conflicto que no podemos solucionar programáticamente hasta su culminación, pueden ser presentados por el usuario para su revisión y decisión.

LPARAMETERS tuTable
LOCAL llRetval, lnBuffMode, lcTable, lnOldArea, lnNextRec, lnRows
*** Verificar parámetros
IF EMPTY(tuTable)
  *** No pasa nada, utiliza la tabla actual
  lcTable = ALLTRIM( ALIAS() )
  IF EMPTY( lcTable )
    *** No hay tabla, por tanto no podemos dar 
    *** seguimiento a ningún conflicto - return 
    RETURN lLRetVal
  ENDIF
ELSE
  DO CASE
    CASE TYPE( "tuTable" ) = "C"
      *** Asume que la cadena de caracteres es el Alias requerido
      lcTable = ALLTRIM( tuTable)
    CASE TYPE( "tuTable" ) = "N"
      *** Toma el Alias para el área de trabajo especificado
      lcTable = ALIAS( tuTable )
    OTHERWISE
      *** Parámetro no válido
      RETURN llRetVal
  ENDCASE
ENDIF 
*** Crea un cursor local para guardar los conflictos
CREATE CURSOR curcflix ( ;
  cfxRecNum C ( 8), ; && Número del conflicto
  cfxFldNam C (200), ; && Nombre del campo
  cfxOldVal C (200), ; && Valor original 
  cfxCurVal C (200), ; && Valor actual en el disco
  cfxUsrVal C (200), ; && Cambia en el buffer
  cfxForcit N ( 1) ) && Acción definida por el usuario
*** Verifica BufferMode
llRetVal = .T.
lnBuffMode = CURSORGETPROP( 'Buffering', lcTable )
IF lnBuffMode < 2
  *** Si la tabla no tiene Buffer devuelve Falso
  ***  no podemos confiar en TableUpdate() 
  RETURN .F.
ELSE
  *** Guarda el área de trabajo actual y 
  *** selecciona la tabla requerida
  lnOldArea = SELECT()
  SELECT (lcTable)
ENDIF

[2] La otra parte del proceso depende del tipo de buffering que va a ser utilizado. Si la tabla tiene buffer de filas, entonces podemos necesitas solamente verificar la fila actual. Cuando está en efecto de Buffer de Tabla necesitamos procesar todos los registros con cambios pendientes. Esto significa envolver la verificación a nivel de fila dentro del código que utiliza GetNextModified() para encontrar todos los registros con cambios pendientes.

*** Si tiene buffer de fila, sólo procesa esta fila
IF lnBuffMode < 4
  *** Buffer de fila
  llRetVal = CheckRow( RECNO(), lcTable )
ELSE
  *** Buffer de Tabla - necesita encontrar todos los registros modificados
  *** Lo que significa llamar a GetNextModified() hasta tanto devuelva 0
  *** indicando que no existen más registros con cambios
  lnNextRec = 0
  DO WHILE .T.
    lnNextRec = GETNEXTMODIFIED( lnNextRec )
    IF lnNextRec = 0
      EXIT
    ENDIF
    *** Intenta y actualiza el registro
    llRetVal = CheckRow( lnNextRec, lcTable )
    IF ! llRetVal
      *** Si falla, salir 
      EXIT
    ENDIF
  ENDDO
ENDIF

[3] La función CheckRow() (o el método si está creando un objeto para esto) es donde se hace el trabajo real. Para cada campo en el registro, este método lee el valor actual del usuario en el buffer, los valores OldVal() y CurVal() y los pasa a través de una verificación lógica, como sigue:

SI el usuario no ha cambiado este campo, y los valores Old y Current son idénticos.
  ignora este campo - igualmente, no ocasionará un conflicto 
SI_NO
  SI el usuario no ha cambiado el campo, pero los valores Old y Current son diferentes
    actualiza el buffer directamente con el valor Current
  SI_NO
    SI el usuario no ha cambiado este campo, pero el valor en el buffer es en realidad idéntico
      al valor Current, ignora este cambio
    SI_NO
      Esto ES realmente un conflicto, así que lo grabamos

Pero, esto se basa en saber si el usuario actual cambia realmente cualquier campo dado. Para obtener la lista de los campos que VFP recuerda que están siendo cambiados utilizamos una función llamada GetUserChanges() que devuelve una lista separada por comas de columnas con cambios pendientes:

FUNCTION GetUserChanges
LOCAL lcRetVal, lcTable, lcFldState, lnCnt, lcStatus
*** Initializa el valor de retorno
lcRetVal = ''
*** Y el alias actual - que está controlada en el código llamado antes
lcTable = ALIAS()
*** Primero verifica los campos que VFP ve al tener valores cambiados
lcFldState = NVL( GETFLDSTATE( -1, lcTable ), "")
IF EMPTY( CHRTRAN( lcFldState, '1', ''))
  *** Nada; pero '1', por tanto no cambia nada
  RETURN lcRetVal
ENDIF
*** Entonces, TENEMOS, al menos un campo modificado! 
*** Pero primero tenemos que controlar el indicador DELETED.
*** Aquí podemos utilizar "DELETED()" como nombre de campo!
IF ! INLIST( LEFT( lcFldState, 1), "1", "3" )
  lcRetVal = "DELETED()"
ENDIF
*** Ahora podemos olvidarnos del indicador de borrado
lcFldState = SUBSTR( lcFldState, 2 )
*** Toma el nombre de los campos para los campos modificados
FOR lnCnt = 1 TO FCOUNT()
  *** Hacemos un lazo con los campos
  lcStatus = SUBSTR( lcFldState, lnCnt, 1 )
  IF INLIST( lcStatus, "2", "4" )
    lcRetVal = lcRetVal + ;
      IIF( ! EMPTY( lcRetVal ), ",", "") + FIELD( lnCnt )
  ENDIF
NEXT
*** Devuelve la lista de campos modificados
RETURN lcRetVal

Vea que cuando utilizamos la función nativa DELETED() como un nombre de campo en esta función. Ambos, CurVal() y OldVal() aceptarán este como "nombre válido" de campo (devolviendo un valor lógico indicando si el campo fue eliminado en la tabla original) así que pueda verificar tanto lo datos eliminados, como los datos modificados.

[4] Como ha visto antes, la función CheckRow se llama una vez por cada línea que necesite verificar y es donde se toma la decisión y si la intervención del usuario es requerida o no. Para las filas donde un conflicto no se puede solucionar por programa escribimos los detalles del cursor que creamos antes. Esta es la función:

FUNCTION CheckRow( tnRecNum, tcTable )
LOCAL lnCnt, luCurVal, luOldVal, lnRows, llRetVal, lcFldList, lcFldName, luUsrVal
*** Fuerza el registro correcto a ser el actual
SELECT (tcTable)
IF RECNO() # tnRecNum
  GOTO tnRecNum
ENDIF
*** Toma la lista de campos cambiados por el usuario actual
lcFldList = ""
lcFldList = ThisForm.GetUserChanges( tcTable )
*** Recorre todos los campos
FOR lnCnt = 1 TO FCOUNT()
  lcFldName = FIELD( lnCnt )
  luCurVal = CURVAL( FIELD( lnCnt ))
  luOldVal = OLDVAL( FIELD( lnCnt ))
  luUsrVal = EVAL( FIELD( lnCnt ))
  *** ¿Este campo causará un conflicto?
  IF luCurVal == luOldVal
    *** No se han hecho cambios en este campo
    *** Por tanto, no hay problemas
  ELSE
    *** Se han hecho cambios en este campo
    IF ! FIELD( lnCnt ) $ lcFldList
      *** Pero el usuario actual no ha modificado este campo
      *** Por lo que podemos actualizarlo con el valor de CurVal()
      REPLACE (FIELD(lnCnt)) WITH luCurVal
    ELSE
      *** ¡Algo ha cambiado! La pregunta es ¿QUÉ?
      IF EVAL( FIELD(lnCnt) ) == luCurval
        *** El usuario no ha cambiado nada
        LOOP
      ELSE
        *** Este es un conflicto que no podemos solucionar por programa
        *** Entonces, escribe la información como cadena de caracteres al cursor
        INSERT INTO curcflix ( cfxRecNum, cfxFldNam, cfxOldVal, cfxCurVal, ;
          cfxUsrVal, cfxForcit) VALUES ;
          ( TRANSFORM(RECNO()), lcFldName, TRANSFORM(luOldVal), ;
          TRANSFORM(luCurVal), TRANSFORM(luUsrVal), 2 )
      ENDIF 
    ENDIF
  ENDIF
NEXT

[5] La sección final del proceso principal meramente verifica la cantidad de registros en el cursor de conflicto para ver si algo necesita ser hecho por el usuario. Si no existen registros en ese cursor, todos los conflictos se han resuelto al forzar el buffer de usuario para que coincida con el dato original donde haya discrepancias. Entonces, nosotros ahora utilizamos TableUpdate() e incluimos el parámetro FORCE para actualizar el dato y limpia el buffer:

*** Verifica el cursor de conflictos
IF RECCOUNT( "curcflix") = 0
  *** No hay conflictos sin resolver, 
  *** por tanto fuerza la actualización
  llRetVal = TableUpdate( .T., .T., lcTable )
ELSE
  GO TOP IN curcflix
  llRetVal = .F.
ENDIF
*** Devuelve el estado final
RETURN llRetVal

Obviamente si hay registros en el cursor de conflictos necesita permitir al usuario que decida qué hacer y entonces, o fuerza la actualización, o la revierte. Pero esto es un ejercicio para usted, el lector.