martes, 25 de abril de 2017

Convertir XML a Hash en Harbour ( Update V )


Bueno, pues de probar con un montón de XML diferentes , me encuentro que uno de tantos cientos probamos, no lo hace como se esperaba.

Simplificando y reduciendo el XML para ver donde está el problema;


<?xml version="1.0" encoding="utf-8"?>
 <UpdateCustomerProfile> 
     <request> 
          <Id>001</Id> 
          <ReservationNumber>123456</ReservationNumber>
          <Email> 
                 <string>uno@moo.com</string>
                 <string>dos@moo.com</string>
          </Email>
     </request>
</UpdateCustomerProfile>

Al pasar por la función XMTOHASH( ), el efecto que ocurre es que solo tendremos el valor
de string, con el ultimo valor, dos@moo.com

¿ Y porque ocurre esto ? 

Ocurre simplemente, porque se ha llegado al final , y no tiene hijos,  y como el node se llama igual, lo que hace la función es volver asignarle a hash con la clave string ,que si tenemos, con el nuevo valor.
La consecuencia es que no podemos tener los valores de ninguna de las maneras.


Como podéis observa en la imagen, el hash solo podemos tener el último valor del string.

Bien, ¿ como solucionarlo  ? 

Sencillamente, vamos a crear un array de childs, que en caso que  la clave sea igual a lo que tengo, se guardará posteriormente para remplazar el valor que hay por este array child.
En casos como este, tendremos que preguntar si el valor del hash["string"] de que tipo es,
CARACTER o ARRAY, para procesar posteriormente el hash.

Aquí el código final, en color azul, el parche aplicar a la funcion recursiva NodeToHash();


STATIC FUNCTION NodeToHash( node ) Local hNext Local hHashChild := {=>} Local hHash := {=>} Local node2 Local hChild := {=>}, cKey /* hChild es un hash, que tiene la key en el cual vamos añadiendo
en el array los elementos iguales. */ WHILE node != NIL IF mxmlGetType( node ) == MXML_ELEMENT if HB_HHASKEY( hHash, mxmlGetElement( node ) ) if valtype( hHash[ mxmlGetElement( node ) ] ) <> "A" if empty( hChild ) hChild[ mxmlGetElement( node ) ] := {} aadd( hChild[ mxmlGetElement( node ) ] , hHash[ mxmlGetElement( node ) ] ) aadd( hChild[ mxmlGetElement( node ) ] , mxmlGetOpaque( node ) ) // Mas el valor del nuevo nodo else aadd( hChild[ mxmlGetElement( node ) ], mxmlGetOpaque( node ) ) // Mas el valor del nuevo nodo endif hHash[ mxmlGetElement( node ) ] := mxmlGetOpaque( node ) else // Es un array, por lo tanto, no lo tocamos endif else hHash[ mxmlGetElement( node ) ] := mxmlGetOpaque( node ) endif if empty( mxmlGetOpaque( node ) ) // Miramos dentro hNext := mxmlWalkNext( node, node, MXML_DESCEND ) if hNext != NIL hHashChild := NodeToHash( hNext ) // Correcion de Posible bug. Un elemento con espacios en blanco, deja descender un nivel!, cuando no debería! // example <element> </element> if hHashChild != NIL .and. !empty( hHashChild ) if empty( hHash[ mxmlGetElement( node ) ] ) hHash[ mxmlGetElement( node ) ] := {} endif if HB_MXMLGETATTRSCOUNT( node ) > 0 hHashChild[ mxmlGetElement( node ) + "@attr"] := HB_MXMLGETATTRS( node ) endif AADD( hHash[ mxmlGetElement( node ) ], hHashChild ) endif else //// if HB_MXMLGETATTRSCOUNT( node ) > 0 if empty( hHash[ mxmlGetElement( node ) ] ) hHash[ mxmlGetElement( node ) ] := {} endif AADD( hHash[ mxmlGetElement( node ) ], HB_MXMLGETATTRS( node ) ) endif endif else if HB_MXMLGETATTRSCOUNT( node ) > 0 hHash[ mxmlGetElement( node ) + "@attr"] := HB_MXMLGETATTRS( node ) endif endif ENDIF node := mxmlGetNextSibling( node ) END WHILE
 // En caso que el array tenga mas de un elemento, tenemos que alimentarlo
// con el array de su clave.
   if !empty( hChild )
      cKey := hb_HKeyAt( hChild, 1) 
      hHash[ cKey ] := hChild[ cKey ]
   endif   
return hHash

Como consecuencia de este trozo de código ,  ahora tenemos en un array los elementos disponibles;

Si si, eso esta muy bien, pero algo como esto; ( Incrédulos ;-)  )


<?xml version="1.0" encoding="utf-8"?>
 <UpdateCustomerProfile> 
     <request> 
          <Id>001</Id> 
          <ReservationNumber>123456</ReservationNumber>
          <Email> 
                 <string>uno@moo.com</string>
                 <string>dos@moo.com</string>
                 <string>
                      <string>compicado@es.es</string>
                 </string>
          </Email>
     </request>
</UpdateCustomerProfile>




Disfruten del parche! 

miércoles, 22 de marzo de 2017

Se rompió la BIOS.

Estaba yo dispuesto a pasar un fin de semana de relax en el ordenador , cuando de repente, lo que nunca me había pasado, y mira que se me han roto casi TODO lo que cae en mis manos ;





ACOJONADO!!! Al menos se recupero con el Backup

¿ La consecuencia de esto ? Pues el efecto lateral en Linux /Linux Ubuntu es que dejaron de funcionar los USB-2, solo los UBS-3 iban, pero lo pero de todo ello, es que las conexiones Bluetooh, Red, Impresoras, etc dejaron de funcionar.

Rebuscando por Internet, creo que hace tiempo ya lo realice en prueba y error, encontré que la placa
GIGABYTE GA-990FXA-UD3  hay que activar en la BIOS,  IOMMU to "Enabled". !!!!


Ahora ya funciona RED y USB.

"La IOMMU es una unidad de gestión de la memoria, similar a la MMU, que se sitúa entre un bus de E/S y la memoria." Pues cony, DEJALO ACTIVADO POR DEFECTO!!!! ;-)

viernes, 12 de agosto de 2016

Como auditar cambios usando triggers en Harbour

Se nos ha planteado la posibilidad que indicar quién y qué es lo que se cambia en una serie de tablas.
Sabía desde hace tiempo que el driver rdd de sixdrive permite introducir un trigger para controlar el contenido.

Pero nosotros usamos DBFNTX, y no podemos cambiar así como así el sistema de RDD.
Por suerte para nosotros, la gente de Harbour le dio soporte también a los NTX.

Hemos diseñado un sistema de tablas, log y logid, que determina que tablas hacermos logs, y el campo de la PK, para encontrar los cambios de un registro de una tabla determinada.

La estructura de la tabla LOG;


TABLA: Nombre de la tabla que se modificado un valor
ID_VALUE: El valor que usaremos de relación, debería ser una PK
CAMPO: El campo de la dbf se está modificando
NEW_VALUE: Nuevo dato en el dbf
OLD_VALUE: Valor que tenia.
CODUSU, IP, HOSTNAME, FECHA, HORA; Datos de control para saber quien hizo y el cambio y desde donde.

Después , tenemos otra tabla LOGID, que determinará que TABLA vamos a auditar, en este caso, tenemos una especie de DBU integrado que necesitamos control de todas las tablas, porque como veremos , simplemente se activa en la apertura de la tabla si queremos que se disparen los triggers o no,y cual es el campo de la tabla que queremos que se guarde en el ID_VALUE de la tabla LOG.




En el ejemplo que veremos, simplemente he sustituido la tabla LOGID, por un Hash, en la llamada a la función __GetIdLog(), en mi código, simplemente abro la tabla logid, y creo el hash.

También, en el ejemplo, evito introducir los nuevos registros, y los campos que sean iguales, tampoco se guardarán. Esto programarlo como queráis, la imaginación es solamente vuestra meta ;-)

Despues, si estamos en un cliente, por ejemplo , donde la PK es el DNI y usamos el DNI como ID a la hora de guardar el log, simplemente haciendo un SCOPE de la tabla + el DNI del cliente, obtendremos todos los cambios aplicados a ese registro ;-)

Este ejemplo lo podéis ejecutar en el directorio de \harbour\tests, y usa la tabla test.dbf con
hbmk2 trigger.prg hbct.hbc xhb.hbc

 
Lo he modificado simplemente para que veais la salida a un fichero de log, audit.log

2016-08-12 12:38:53 -- trigger start --
2016-08-12 12:38:53 INFO: Ejemplo de auditar cambios a traves de triggers.
2016-08-12 12:38:53 INFO:  TABLE:TEST FIELD:FIRST ID VALUE:Homer               Simpson              OLD VALUE:Homer NEW VALUE:Homer_TEST DATETIME:20160812123853989 HOSTNAME:NEO64
2016-08-12 12:38:54 INFO:  TABLE:TEST2 FIELD:LAST ID VALUE: 99700 OLD VALUE:Dysert NEW VALUE:Dysert_TEST DATETIME:20160812123854031 HOSTNAME:NEO64
2016-08-12 12:38:54 INFO:  TABLE:TEST2 FIELD:NOTES ID VALUE: 99700 OLD VALUE:This is a test for record 500 NEW VALUE:Changes everything DATETIME:20160812123854055 HOSTNAME:NEO64
2016-08-12 12:38:54 -- trigger end -- El resultado del ejemplo es este;




A continación el codigo fuente;

#include "Hblog.ch"
#include "dbinfo.ch"
#include "hbsix.ch"

//REQUEST DBFNTX

Function Main()
 
   setmode( 25,80 )

   rddsetdefault( 'DBFNTX' )   // Forzamos RDD por defecto de HARBOUR

  /* Activa log */
  INIT LOG FILE( NIL, "audit.log", 1000, 999 ) // Tamaño a 100K y maximo 999 ficheros
  LOG "Ejemplo de auditar cambios a traves de triggers."

  /* Activar triggers*/
  rddInfo( RDDI_TRIGGER, "SX_DEFTRIGGER", "DBFNTX" )

  /*Llamar antes de abrir la tabla que queremos controlar*/
  sx_SetTrigger( TRIGGER_PENDING, "_trigger", "DBFNTX"  )
  USE "TEST" NEW SHARED

  /* O podemos hacer de esta manera*/
  USE TEST ALIAS "TEST2" NEW SHARED TRIGGER "_trigger"

  Select TEST
  go top
  if rlock()
     replace FIRST with alltrim( field->FIRST ) + "_TEST"
     unlock
     commit
  endif


  Select TEST2
  go bottom
  if rlock()
     replace LAST with alltrim( field->LAST ) + "_TEST"
     replace NOTES with "Changes everything"
     unlock
  endif


  CLOSE LOG
  CLOSE ALL

Return 0


function _trigger( nEvent, nArea, nFieldPos, xTrigVal )
     Local xIdValue, xValue, cIdValue
  
       DO CASE

        CASE nEvent == EVENT_PREUSE
        CASE nEvent == EVENT_POSTUSE
        CASE nEvent == EVENT_UPDATE
        CASE nEvent == EVENT_APPEND
        CASE nEvent == EVENT_DELETE
        CASE nEvent == EVENT_RECALL
        CASE nEvent == EVENT_PACK
        CASE nEvent == EVENT_ZAP
        CASE nEvent == EVENT_PUT

            if empty( cIdValue := __GetIdLog( ALIAS( nArea ) ) ) // Si no viene expresion, no controlaremos el log
               return .T.
            endif  
            Sx_SetTrigger( TRIGGER_DISABLE )
          
            if FieldType( nFieldPos ) = "C"                     // Solo en caso de cambios de Caracter, igualamos tamaño
               xValue   := (nArea)->( FieldGet( nFieldPos ) )
               xTrigVal := padr( alltrim( xTrigVal ), FieldSize( nFieldPos ) )
            else
               xValue := (nArea)->( FieldGet( nFieldPos ) )
            endif

            if xTrigVal != xValue
               xIdValue := cValtoChar( &( cIdValue ) )
               if !empty( xIdValue ) // Si hay algún valor, se guarda, en registros nuevos, el valor esta vacio, no hay que dejar log
                  LOG " TABLE:" + ALIAS( nArea ) +;
                      " FIELD:" + (nArea)->( FieldName( nFieldPos ) ) +;
                      " ID VALUE:" + xIdValue +;
                      " OLD VALUE:" + alltrim( cValtoChar( (nArea)->( FieldGet( nFieldPos ) ) ) ) +;
                      " NEW VALUE:" + alltrim( cValtoChar( xTrigVal ) )+;
                      " DATETIME:" + hb_ttos( hb_datetime() ) +;
                      " HOSTNAME:" + netname()
               endif   
            endif

            sx_SetTrigger( TRIGGER_ENABLE   )

        CASE nEvent == EVENT_GET

        CASE nEvent == EVENT_PRECLOSE

        CASE nEvent == EVENT_POSTCLOSE

        CASE nEvent == EVENT_PREMEMOPACK

        CASE nEvent == EVENT_POSTMEMOPACK

       ENDCASE

    Return( .T. )

/*
  Devuelve el ID a usar segun la tabla.
  hLogId es un hash que contiene la tabla y el valor de una expresion de esa tabla que usaremos
  para identificar el registro en el log.
  Generalmente, se debe usar un PK, una clave única.
*/
static function __GetIdLog( cTable )
     Local cId
     static hLogId := { "TEST" => "FIRST + LAST", "TEST2" => "SALARY"}

     hb_default( @cTable, "" )
   
     cId :=  HB_HGetDef( hLogId, cTable, "" )

return cId

function cValToChar( u ); return CStr( u )




lunes, 8 de agosto de 2016

Un poco de protección contra CrytoLocked



En nuestras aplicaciones que usamos DBF, estamos viviendo un calvario con el tema del CrytoLocked, que como sabéis, lo que hace es cifrar nuestros datos, haciendo datos imposibles de recuperar.

Hay muchas variantes, pero básicamente, a día de hoy, se basan en buscar extensiones de archivos.
Y , desgraciadamente, los ficheros .DBF están es la lista.

Una manera simple es cambiar la extensión en nuestras aplicaciones.


cOldExt := hb_rddInfo( RDDI_TABLEEXT, ".app" ) 

Ahora, cuando usemos una tabla , por ejemplo de clientes;

USE CLIENTES NEW SHARED


Buscará el fichero "CLIENTES.APP" ;-)

Además, todas las funciones y comandos relacionados con el tema de ficheros no nos deberíamos de preocuparnos.

Es la diferencia de pasar la extensión en cada función o comando, como por ejemplo:
USE ("CLIENTES.APP") NEW SHARED
 
Para saber que extensión esta activa usaremos la función;
dbInfo( DBI_TABLEEXT )

Podéis ver opciones a través del fichero de cabecera, DBINFO.CH
Header file for the RDD API Index OrderInfo and DBInfo support

miércoles, 3 de agosto de 2016

Threads. Harbour & xBase++

Mirando más ejemplos en Harbour, he visto como Przemyslaw, a creado una clase Thread,
que la podéis localizar en /contrib/hbxpp/tthreadx.prg , para manejar los threads igual que
xBase++

En Internet, he localizado un documento en inglés,MultiThreading xBase++

He realizado un simple ejemplo del documento, y funciona perfectamente en Harbour,
para compilar hbmk2 test_xbase.prg -mt hbxpp.hbc
 

#include "hbthread.ch"

FUNCTION Main()
     LOCAL oThread, lThread1Active := .f., lThread2Active := .f.
    
     oThread := Thread():new()
     Sleep(1)
     oThread:start({||ThreadLoop( @lThread1Active) } )

     oThread := Thread():new()
     Sleep(1)
     oThread:start( {||ThreadLoop( @lThread2Active ) } )

     DO WHILE lThread1Active .OR. lThread2Active
       Sleep(1)
     ENDDO
     WAIT

RETURN nil

STATIC FUNCTION ThreadLoop( lActive )
   LOCAL i
   lActive := .t.

   FOR i := 1 TO 5
    ? 'I am running in thread ' + Alltrim(Str(hb_ThreadId()))
    hb_idleSleep(1.5)
   NEXT

   lActive := .f.
  
RETURN nil