Serie Ficheros Virtuales

 




JavaScript  Ficheros Virtuales




Sustitución de animaciones directas por gadgets en ficherosvirtuales.com


1 Introducción

2 La encapsulación del gadget AutoSk

3 La encapsulación del gadget iGoogle AutoSudoku

 

4 La programación CGI-AJAX del temporizador



                                                                                                                           _______



1 Introducción


En www.ficherosvirtuales.com se presentaron desde el principio animaciones en las esquinas superiores. En la izquierda un AutoSudoku y en la esquina superior derecha un AutoJuegoDeLaVida siguiendo las reglas de Jhon H.Conway.

 

Estas animaciones han ido evolucionando incorporando elementos como control de temporizador, animación de ítems por paso del ratón, nueva muestra y parada. Además en el JuVida un click activa una celda de forma permanente y un doble click la elimina.

 

Me planteé construir unas gadgets para iGoogle y tomé como punto de partida estas dos animaciones pues tienen el tamaño justo.

 

Cuado los terminé, comprobé mediante un primer gadget de iGoogle que ya tenía hecho, el autonumerador por IP, que iGoogle no permanece estático, dependiendo de los gadgets que tengas instalados la página se recarga periódicamente.

 

Por ello añadí un poco de programación CGI-Ajax desde un servidor iSeries utilizando lenguaje RPG, para guardar el valor del temporizador de cada gadget de valor no estándar asociado a la dirección IP, para poderlo recuperar al relanzar el gadget.

 

Una vez que tuve funcionando estos gadgets, los llevé a la página principal www.ficherosvirtuales.com lo que me permitió simplificar su estructura y sobre todo reducir en un gran porcentaje las css aplicadas. En la versión previa, la gran acumulación de reglas producía interacciones que en algunos navegadores generaban efectos colaterales indeseados que me obligaron a una codificación adicional que ahora ya he retirado.

 

En este documento presento en los epígrafes siguientes el proceso que he seguido.

 

                                                                                                                           _______



2 La encapsulación del gadget AutoSk


Para ello extraje todo el código javascript, html y css que construía la animación, que se ha presentado en un capítulo previo, y lo coloqué en una nueva página:

 

GSK.ficherosvirtuales.com/AutoSk.html

GSK.ficherosvirtuales.com/AutoSk.js

+css +Desarrollo común del control del temporizador, que se aloja en una carpeta paralela común GNU pues se compartirá en todos los gadgets con autorespuesta:

GNU.ficherosvirtuales.com/ AutoCT.js

 

Estos desarrollos construyen la página base, que presenta un aspecto similar al siguiente:


             

 

La página principal de la carpeta muestra la encapsulación del gadget como iFrame

 

 

GSK.ficherosvirtuales.com/index.html:

 

 

<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"

    "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">

   

<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="es-ES" lang="es-ES">

 

<head>

 

<title>Auto Sudoku</title>

 

<meta name="title" content="Auto Sudoku" />

<meta name="description" content="Gadget Sudoku" />

<meta name="keywords" content="Sudoku, Decorativo" />

<meta name="author" content="Carlos Conty Contreras -- www.ficherosvirtuales.com" />

<meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />

 

<link rel="shortcut icon" href="http://GSK.ficherosvirtuales.com/favicon.ico" />

 

 

</head>

 

<body>

 

<iframe id="gsk" scrolling="no" frameborder="no" width="303" height="177" noresize=""

 style="background-color: #F0F8FF; position: absolute; top: 0px; left: 0px;"

 src="http://gsk.ficherosvirtuales.com/AutoSk.html" ></iframe>

 

</body>

</html>

 

 

y que presenta una aspecto similar al siguiente:


             

El conjunto de sentencias del <iFrame> constituye la esencia del gadget, que ya puede incorporarse a cualquier página web, junto con instrucciones de estilo de posicionamiento.

                                                                                                                           _______


3 La encapsulación del gadget iGoogle AutoSudoku

Para poner un gadget a disposición de los usuarios de iGoogle, son necesarios unos pasos adicionales.

 

Debe crearse un fuente xml en un formato específico con la información que Google requiere. Para el AutoSudoku el fuente asociado AutoSk.xml tiene el siguiente contenido:

 

<?xml version="1.0" encoding="UTF-8" ?>

<Module>

 

  <ModulePrefs

  

   title="Auto Sudoku"

   author="Carlos Conty Contreras --- www.ficherosvirtuales.com ---"

   author_email="cconty+filler@ficherosvirtuales.com"

   description="Auto-Sudoku decorativo"

   thumbnail="http://gsk.ficherosvirtuales.com/AutoSk.gif"

   screenshot="http://gsk.ficherosvirtuales.com/AutoSkVista.gif"

   width="303"

   height="177"

 

  >

   

   <Icon>http://gsk.ficherosvirtuales.com/favicon.ico</Icon>

   

  </ModulePrefs>

 

  <Content type="html">

  

    <![CDATA[

 

<iframe id="gsk" noresize="" style="background-color: rgb(240, 248, 255);" src="http://gsk.ficherosvirtuales.com/AutoSk.html" frameborder="no" height="177" scrolling="no" width="303"></iframe>

     

    ]]>

  </Content>

 

</Module>

 

 

Las instrucciones para incorporar este fuente están algo dispersas en la documentación, pero finalmente hay que acudir a la siguiente dirección:

 

http://code.google.com/intl/es/apis/gadgets/docs/tools.html#GGE

 

en donde podemos archivar, publicar de forma privada y de forma pública nuestro gadget.

 

De hecho, hay un gadget para validar los parámetros de un gadget! Es el “Gadget checker”, que es muy útil para hacer una preverificación ya que el sistema no te permite publicar, ni siquiera de forma privada, si no rellenas al menos todos los parámetros que se muestran en AutoSk.xml de forma correcta.

 

Son muy importantes la viñeta (thumbnail) y la vista previa (screenshot) que han de tener una tamaño de 60 x 120 px en la viñeta y 280 x tamaño real en la vista previa. Si no cumplen estas características, se muestra un logo estándar.

 

En mi caso, primero he puesto una vista de la página http://gsk.ficherosvirtuales.com/AutoSk.html y luego publiqué el gadget de forma privada, a continuación extraje vistas del resultado real en iGoogle que finalmente establecí como viñeta y vista previa definitivas:


                

                                                                                                                           _______


4 La programación CGI-AJAX del temporizador

 

En el código del cliente se han añadido tres nuevas funciones:

 

 

PrCTLeeX Que lee el temporizador de forma remota

 

 

//-----------------------------------------------------------------------------------------------

// Proceso: PrCTLeeX. Descripcion: Lee el valor del temporizador actual de forma remota Ajax

//-----------------------------------------------------------------------------------------------

function PrCTLeeX(Origen)

{

 // Filtro de contenido     

 var AutoTime = PrCTLee(Origen);

 if (dataAjax_IP == '') return AutoTime;

 

 // Petición remota   

 dataAjax_CT = dataAjax_IP;

 dataAjax_CT += '&' + Origen;

 dataAjax_CT += '&' + AutoTime;

 dataAjax_CT += '&' + Origen;

 dataAjax_CT += '&1&1&*';

 

 $.ajax({

  url: "http://v400y.virtual400.net/cconty/cgi-bin/sumarioct.pgm?" + dataAjax_CT,

  cache: false,

  dataType: "script",

  success: function(js){eval(js);}

 });

 

 return AutoTime;

}


PrCTGrabax Que graba el valor del temporizador en remoto

 

//-----------------------------------------------------------------------------------------------

// Proceso: PrCTGrabaX. Descripcion: Graba el valor del temporizador actual de forma remota Ajax

//-----------------------------------------------------------------------------------------------

function PrCTGrabaX(Origen, AutoTime)

{

 // Filtro de contenido

 if (dataAjax_IP == '') return PrCTGraba(Origen, AutoTime);

 

 // Petición remota

 dataAjax_CT = dataAjax_IP;

 dataAjax_CT += '&' + Origen;

 dataAjax_CT += '&' + AutoTime;

 dataAjax_CT += '&' + Origen;

 dataAjax_CT += '&1&1&*';

 

 $.ajax({

  url: "http://v400y.virtual400.net/cconty/cgi-bin/sumarioct.pgm?" + dataAjax_CT,

  cache: false,

  dataType: "script",

  success: function(js){eval(js);}

 });

 

 return PrCTGraba(Origen, AutoTime);

}

 

 

y PrFVAutoInicio que recupera la dirección IP y pone en marcha el mecanismo de relojería

 

//---------------------------------------------------------------------------------------

// Funcion: PrFVAutoInicio. Descripcion: Lee referencia IP en curso y comienza animación

//---------------------------------------------------------------------------------------

function PrFVAutoInicio()

{

 $.getJSON("http://jsonip.appspot.com?callback=?", function(data)

 {

  // IP y temporizador externo

  dataAjax_IP = data.ip;

 

  var AutoTime = PrCTLeeX('SK');

    

  // AutoEvolucion ordinaria

  PrFVAutoEvolucion();

 });

 return;

}

 

El código del servidor se expone a continuación, consiste en el programa principal SUMARIOCT, el auxiliar CGI1P para extraer el valor recibido en un parámetro continuo “1P” y el auxiliar CTSUMA que descompone “1P”, actualiza contador y recupera/actualiza el temporizador desde el archivo CTFSUMAR:

 

     H DFTNAME(SUMARIOCT)

     H DATEDIT(*DMY.)

     H DECEDIT('0,')

     H EXPROPTS(*RESDECPOS)

     H FIXNBR(*ZONED:*INPUTPACKED)

     H OPTION(*SRCSTMT:*NODEBUGIO)

     H INDENT('|')

      **********************************************************************

      *  pgm: SUMARIOCT

      * desc: Contador sumario CT CGI

      **********************************************************************

 

      ***

      * *  DEFINICION DE ESTRUCTURA DE ESTADO DE PROGRAMA

      ***

     D PROGSTATUS     SDS

     D  P1STAT                 1    429

     D  P1PROC           *PROC

 

      *

      * wrstout (write standard out)

      *

     d @data_out       s          65535

     d @data_out_ln    s              9b 0 inz(%size(@data_out))

 

      *

      * rdstin (read standard input)

      *

     d @data_in        s          65535

     d @data_in_ln     s              9b 0 inz(%size(@data_in))

     d @data_in_aln    s              9b 0

 

      *

      * error data structure

      *

     d @error_ds       ds

     d  @err_bytes             1      4b 0 inz(%size(@err_data))

     d  @err_byte2             5      8b 0

     d  @err_msgid             9     15

     d  @err_rsvd             16     16

     d  @err_data             17     56

 

      *

      * initial web browser

      *

     d HTTPHeaderResp  c                   const(

     d                                     'Content-type: text/javascript')

      *

      * new line for web browser

      *

     d @nl             c                   const(x'15')

 

      ***

      * * Variables de trabajo e indicadores

      ***

      *

      * Genericos

     D true            S               N   INZ(*ON)

      *

      * CTSUMA

     D TT1P            S          65535                                         1P:Prm.en conjunto*I

     D TTIPT           S             25                                         IP x.x.x.x REMOTO *O

     D TTIP            S             20                                         IP x.x.x   REMOTO *O

     D TTIPR           S              5                                         Resto.x IP REMOTO *O

     D TTORIG          S              2                                         OrigenTemporizador*O

     D TTTEMP          S             10                                         Valor temporizador*O

     D TTCONT          S             12                                         Contador alfanuméric

      *

      * Comilla

     D Comilla         S              1    DIM(1) CTDATA PERRCD(1)              '

 

 

      *-------------------------------------------------------------------*

      * DECLARACION DE PROTOTIPOS INTERNOS                                *

      *-------------------------------------------------------------------*

 

      * write http standard output

     DPr$wrstout       Pr              N                                        0/1 Error proceso

 

 

      *--------------------------------------------------------------------------------------------*

      * DECLARACION DE PROTOTIPOS INTERNOS PARA PROCEDIMIENTOS EXTERNOS                            *

      *--------------------------------------------------------------------------------------------*

 

      * CGI1P

     DCGI1P            PR                  EXTPGM('CGI1P')

     D P_1P                       65535                                         1P:Prm.en conjunto*O

 

      * CTSUMA

     DCTSUMA           PR                  EXTPGM('CTSUMA')

     D P_1P                       65535    CONST                                1P:Prm.en conjunto*I

     D P_IPT                         25                                         IP x.x.x.x REMOTO *O

     D P_IP                          20                                         IP x.x.x   REMOTO *O

     D P_IPR                          5                                         Resto.x IP REMOTO *O

     D P_ORIG                         2                                         OrigenTemporizador*O

     D P_TEMP                        10                                         Valor temporizador*O

     D P_CONT                        12                                         Contador VFFSUMAR *O

 

 

      ***

      * *  PROGRAMA

      ***

     C     ET0000        TAG

 

 

      /FREE

 

 

         // Captura parámetros

 

         CGI1P(TT1P);

 

 

         // Actualiza contador y envía respuesta

 

         CTSUMA(TT1P:TTIPT:TTIP:TTIPR:TTORIG:TTTEMP:TTCONT);

 

 

         // Cabecera común

 

         @data_out = HTTPHeaderResp + @nl + @nl;

 

 

         // Respuesta javascript

 

         @data_out = %trim(@data_out) +

 

         '$('+Comilla(1)+'#DivSumarioCT'+Comilla(1)+')' +

 

         '.html(' + Comilla(1) +

 

         '<b>'+%trim(TT1P)+'</b>'+

 

         '<br />' +

         %trim(TTCONT) +

 

         '<br />' +

         %trim(TTIPT) +

         '&nbsp' +

         %trim(TTIP) +

         '&nbsp;' +

         %trim(TTIPR) +

 

         '<br />' +

         %trim(TTORIG) +

         '&nbsp;' +

         %trim(TTTEMP) +

 

         Comilla(1) + '); ' + @nl +

 

         'PrCTGraba(' + Comilla(1) + %trim(TTORIG) + Comilla(1) + ', ' +

                                     %trim(TTTEMP) + '); ' + @nl +

 

         'var AutoTimeX = ' + %trim(TTTEMP) + '; ' + @nl +

         'PrCTActualizaJTemporizador(AutoTimeX/100, ' +

           Comilla(1) + %trim(TTORIG) + Comilla(1) + ', ' +

           Comilla(1) + '1' + Comilla(1) +');';

 

 

         // Produce un resultado como el siguiente, que se trata con eval en la parte del cliente

         //

         // $('#DivSumarioCT').html('<b>87.222.191.36</b><br />420<br />87.222.191.36&nbsp;87.222.191&nbsp;.36<br />SK&nbsp;4250');//-Oculto-
         // PrCTGraba('SK', 4250);
         // var AutoTimeX = 4250;
         // PrCTActualizaJTemporizador(AutoTimeX/100, 'SK', '1');   

 

 

         // Envía la respuesta recién generada al navegador para su actualización

 

         Pr$wrstout();

 

 

         // exit

 

         *inlr = *on;

         return;

 

 

      /END-FREE

 

 

      *          PPPPPPPPPPPPPPPPPPPPPPPPPPPPPPP

      *       PPPPPP                        PPPPPP

      *         IMPLEMENTACION DE PROCEDIMIENTOS.

      *       PPPPPP     INTERNOS           PPPPPP

      *          PPPPPPPPPPPPPPPPPPPPPPPPPPPPPPP

      *

      *

      *

      *

      *           PPPPPPPPPPPPPPPPPPPPPPPPPPPPPP

      *        PPPPPP                        PPPPPP

      *        Pr$wrstout: write http standard output

      *        PPPPPP                        PPPPPP

      *           PPPPPPPPPPPPPPPPPPPPPPPPPPPPPP

      *

     PPr$wrstout       B

      *

     DPr$wrstout       PI              N                                        0/1 Error proceso

 

     c                   eval      @data_out_ln = %len(%trim(@data_out))

 

     c                   callb     'QtmhWrStout'

     c                   parm                    @data_out

     c                   parm                    @data_out_ln

     c                   parm                    @error_ds

 

     c                   return    *OFF

 

      *           SSSSSSSSSSSSSSSSSSSSSSSSSSSSSS

      *        SSSSSS                        SSSSSS

      *                CONTROL DE ERRORES

      *        SSSSSS                        SSSSSS

      *           SSSSSSSSSSSSSSSSSSSSSSSSSSSSSS

      *

     C     *PSSR         BEGSR

     C                   RETURN    *On

     C     ENPSSR        ENDSR

 

 

     PPr$wrstout       E

 

** Comilla

'

 

     H DFTNAME(CGI1P)

     H BNDDIR('QC2LE')

     H DATEDIT(*DMY.)

     H DECEDIT('0,')

     H EXPROPTS(*RESDECPOS)

     H FIXNBR(*ZONED:*INPUTPACKED)

     H OPTION(*SRCSTMT:*NODEBUGIO)

     H INDENT('|')

      **********************************************************************

      *  pgm: CGI1P

      * desc: Núcleo extracción 1P

      **********************************************************************

 

      ***

      * *  DEFINICION DE ESTRUCTURA DE ESTADO DE PROGRAMA

      ***

     D PROGSTATUS     SDS

     D  P1STAT                 1    429

 

      ***

      * * Variables de trabajo e indicadores

      ***

      *

      * Genericos

     D true            S               N   INZ(*ON)

 

 

      *-------------------------------------------------------------------*

      * DECLARACION DE PROTOTIPOS INTERNOS                                *

      *-------------------------------------------------------------------*

 

      * read http input for 1P

     DPrRead           Pr         65535                                         1P obtenida

 

      * Convert a character to numeric value

     Datof             Pr             8F   ExtProc('atof')                      NºSalida

     Dc                                *   value options(*string)               Cadena de entrada

 

      * Convert a character to numeric value

     Dc2n              Pr            30p 9

     Dc                              32    options(*varsize)

 

 

      ***

      * *  PROGRAMA

      ***

     C     ET0000        TAG

 

      ***

      * * PARAMETROS

      ***

     C     *ENTRY        PLIST

     C                   PARM                    XX1P          65535            1P USUARIO REMOTO *O

 

 

      /FREE

 

 

         // Captura parámetros

 

         XX1P = PrRead();

 

 

         // exit

 

         *inlr = *on;

         return;

 

 

      /END-FREE

 

 

      *          PPPPPPPPPPPPPPPPPPPPPPPPPPPPPPP

      *       PPPPPP                        PPPPPP

      *         IMPLEMENTACION DE PROCEDIMIENTOS.

      *       PPPPPP     INTERNOS           PPPPPP

      *          PPPPPPPPPPPPPPPPPPPPPPPPPPPPPPP

      *

      *

      *           PPPPPPPPPPPPPPPPPPPPPPPPPPPPPP

      *        PPPPPP                        PPPPPP

      *        PrRead: read http input for 1P

      *        PPPPPP                        PPPPPP

      *           PPPPPPPPPPPPPPPPPPPPPPPPPPPPPP

      *

     PPrRead           B

      *

     DPrRead           PI         65535                                         1P obtenida

 

      **************************************************************************

      ****                                                                   ***

      **** It reads data from standard input based on the                    ***

      **** Content_Length environment variable.  The QtmhGetEnv System API   ***

      **** is used to get the Content_Length and set the InDataLn variable   ***

      **** used by the QtmhRdStdIn API.                                      ***

      ****                                                                   ***

      **************************************************************************

 

      * Valor de retorno

     D T_1P            S          65535a

      *

      * Wk

     Dmaxdataln        S              9B 0 INZ(65535)

     DResult           S              9B 0 INZ

      *

      * Variables for the CGI interface API for QtmhRdStIn.

     DBufIn            S          65535a   INZ

     DBufInLn          S              9b 0 INZ(%len(BufIn))

     DStdInLn          S              9b 0

      *

      * Variables for the CGI interface API for QtmhGetEnv.

     DEnvRec           S           1024A   INZ

     DEnvRecLen        S              9B 0 INZ(1024)

     DEnvLen           S              9B 0 INZ

     DEnvName          S             25A   INZ('CONTENT_LENGTH')

     DEnvNameLen       S              9B 0 INZ(14)

 

      *************************************************************************

      ***                   Data structure for error reporting.             ***

      *** Copied from QSYSINC/QRPGLESRC(QUSEC).                             ***

      *** The QUSBPRV must be initialized to 16.                            ***

      * This allows for 7 bytes in QUSEI for error message id.

      *** This is the common error structure that is passed to the CGI APIs;***

      *** QtmhWrStOut, QtmhRdStin, QtmhGetEnv and QtmhCvtDb.  The Error     ***

      *** structure is documented in the "AS/400 System API Reference".     ***

      *************************************************************************

     DQUSEC            DS                                                       Qus EC

     D QUSBPRV                 1      4B 0 INZ(16)                              Bytes Provided

     D QUSBAVL                 5      8B 0                                      Bytes Available

     D QUSEI                   9     15                                         Exception Id

     D QUSERVED               16     16

 

      **************************************************************************

      *** Constants for names of CGI APIs.                                   ***

     DAPIStdIn         C                   'QtmhRdStin'

     DAPIGetEnv        C                   'QtmhGetEnv'

      **************************************************************************

 

     DContentLn        S              9B 0 INZ(0)

     DEnvCL            S             20A   INZ('CONTENT_LENGTH')

     DEnvSS            S             20A   INZ('SERVER_SOFTWARE')

     DEnvMethod        S             20A   INZ('REQUEST_METHOD')

     DEnvQS            S             20A   INZ('QUERY_STRING')

     DEnvMDResp        S             30A   INZ

     DEnvSSResp        S             50A   INZ

     DEResp            S              4A   INZ

 

 

      **************************************************************************

      **** Read the Environment variable, REQUEST_METHOD.

      **************************************************************************

     C                   callb     APIGetEnv

     C     EnvMDResp     parm                    EnvRec

     C                   parm                    EnvRecLen

     C                   parm                    EnvLen

     C                   parm      EnvMethod     EnvName

     C                   parm      14            EnvNameLen

     C                   parm                    QUSEC

 

      **************************************************************************

      **** Is the REQUEST_METHOD, POST?

      **************************************************************************

     C                   eval      EResp = %subst(EnvREc:1:4)

     C                   if        EResp = 'POST'

 

      * Get Environment Variable 'Content_Length' using 'QtmhGetEnv' API

     C                   CALLB     APIGetEnv

     C                   parm                    EnvRec

     C                   parm                    EnvRecLen

     C                   parm                    EnvLen

     C                   parm      EnvCL         EnvName

     C                   parm      14            EnvNameLen

     C                   parm                    QUSEC

 

      * Convert Content_Length to numeric.

     C                   eval      ContentLn = c2n(EnvRec)

 

      * When the Content Length is greater than the buffer, Read maxdataln.

     C                   if        ContentLn > maxdataln

     C                   eval      ContentLn = maxdataln

     C                   endif

 

      * Specify InDataLn to Content_Length value.  Never should a CGI program

      * ever attempt to read more than content length.  Specification of more

      * than content length in InDataLn is not defined.

 

      * Read standard input

     C                   callb     APIStdIn

     C                   parm                    BufIn

     C                   parm      ContentLn     BufInLn

     C     Result        parm                    StdInLn

     C                   parm                    QUSEC

 

     C                   else

      **************************************************************************

      **** Read the Environment variable, QUERY_STRING.

      **************************************************************************

     C                   callb     APIGetEnv

     C                   parm                    EnvRec

     C                   parm                    EnvRecLen

     C                   parm                    EnvLen

     C                   parm      EnvQS         EnvName

     C                   parm      12            EnvNameLen

     C                   parm                    QUSEC

 

      **************************************************************************

      **** Check length of environment value is less than

      **** the receive buffer.  When this occurs, the

      **** QtmhGetEnv sets the EnvLen to the actual value

      **** length without changing the receive buffer.

 

      /FREE

 

 

         // Control salida

 

         if EnvLen > maxdataln;

            Bufin = 'Data buffer insuficiente para los datos disponibles';

            Result = 80;

         else;

           BufIn = EnvRec;

           Result = EnvLen;

         endif;

 

       endif;

 

 

         // Devuelve 1P leído o el mayor fragmento disponible

 

         if Result > %len(T_1P);

            return %subst(BufIn:1:%len(T_1P));

         endif;

 

         T_1P = %subst(BufIn:1:Result);

         return T_1P;

 

 

      /END-FREE

 

 

      *           SSSSSSSSSSSSSSSSSSSSSSSSSSSSSS

      *        SSSSSS                        SSSSSS

      *                CONTROL DE ERRORES

      *        SSSSSS                        SSSSSS

      *           SSSSSSSSSSSSSSSSSSSSSSSSSSSSSS

      *

     C     *PSSR         BEGSR

     C                   RETURN    *Blanks

     C     ENPSSR        ENDSR

 

 

     PPrRead           E

 

 

      ********************************************************

      * Function: Convert a character to numeric value.      *

      ********************************************************

 

     Pc2n              B

     Dc2n              PI            30p 9

     Dc                              32    options(*varsize)

 

      * Valor de retorno

     Dn                s             30p 9

 

      * atof

     Df                s              8F

 

 

      /FREE

 

 

         // Conversión base y retorno

 

         f = atof(c);

         n = %dech(f:30:9);

         return n;

 

 

      /END-FREE

 

 

      *           SSSSSSSSSSSSSSSSSSSSSSSSSSSSSS

      *        SSSSSS                        SSSSSS

      *                CONTROL DE ERRORES

      *        SSSSSS                        SSSSSS

      *           SSSSSSSSSSSSSSSSSSSSSSSSSSSSSS

      *

     C     *PSSR         BEGSR

     C                   RETURN    n

     C     ENPSSR        ENDSR

 

 

     Pc2n              E

 

 

     H DFTNAME(CTSUMA)

     H DATEDIT(*DMY.)

     H DECEDIT('0,')

     H EXPROPTS(*RESDECPOS)

     H FIXNBR(*ZONED:*INPUTPACKED)

     H OPTION(*SRCSTMT:*NODEBUGIO)

     H INDENT('|')

      **********************************************************************

      *  pgm: CTSUMA

      * desc: Contador sumario AUTOCT

      **********************************************************************

     FCTFSUMAR  UF A E           K DISK

 

      ***

      * *  DEFINICION DE ESTRUCTURA DE ESTADO DE PROGRAMA

      ***

     D PROGSTATUS     SDS

     D  P1STAT                 1    429

     D  P1PROG           *PROC

     D  P1JOBR               244    253

     D  P1JOBU               254    263

     D  P1JOBN               264    269

 

      ***

      * * Variables de trabajo e indicadores

      ***

      *

      * Genericos

     D true            S               N   INZ(*ON)

      *

      * PrCuenta

     D TTCONT          S             12                                         Contador alfanuméric

 

 

      *-------------------------------------------------------------------*

      * DECLARACION DE PROTOTIPOS INTERNOS                                *

      *-------------------------------------------------------------------*

 

      * Extrae parámetros en bruto de 1P

     DPrPrm            Pr              N                                        0/1 Error proceso

     D P_1P                       65535    VALUE                                1P:Prm.en conjunto*I

     D P_IPT                         25                                         IP USUARIO REMOTO *O

     D P_ORIG                         2                                         OrigenTemporizador*O

     D P_TEMP                        10                                         Valor temporizador*O

     D P_FORM                         2                                         Formato Aplicado  *O

 

      * Extrae IP x.x.x desde IPT x.x.x.x

     DPrIP             Pr            20                                         IP xxx.xxx.xxx

     D P_IPT                         25    VALUE                                IP USUARIO REMOTO *I

     D P_IPR                          5                                         Resto IP          *O

 

      * Progresa contador

     DPrCuenta         Pr            12                                         Contador Alfanuméric

     D P_IPT                         25    VALUE                                IP x.x.x.x REMOTO *I

     D P_IP                          20    VALUE                                IP x.x.x   REMOTO *I

     D P_ORIG                         2    VALUE                                OrigenTemporizador*I

     D P_TEMP                        10                                         Valor temporizado*IO

     D P_FORM                         2                                         Formato Aplicado *IO

 

      * Estampilla

     DPrStam           Pr              N                                        0/1 Error proceso

 

 

      ***

      * *  PROGRAMA

      ***

     C     ET0000        TAG

 

      ***

      * * PARAMETROS

      ***

     C     *ENTRY        PLIST

     C                   PARM                    XX1P          65535            1P:Prm.en conjunto*I

     C                   PARM                    XXIPT            25            IP x.x.x.x REMOTO *O

     C                   PARM                    XXIP             20            IP x.x.x   REMOTO *O

     C                   PARM                    XXIPR             5            Resto.x IP REMOTO *O

     C                   PARM                    XXORIG            2            OrigenTemporizador*O

     C                   PARM                    XXTEMP           10            Valor temporizador*O

     C                   PARM                    XXCONT           12            CONTADOR CTFSUMAR *O

     C                   PARM                    XXFORM            2            Formato Aplicado  *O

 

 

      /FREE

 

 

         // Inz

 

         clear XXIPT;

         clear XXIP;

         clear XXIPR;

         clear XXORIG;

         clear XXTEMP;

         clear XXFORM;

 

         XXCONT = '0';

 

 

         // Extrae parámetros base

 

         *IN90 = PrPrm(XX1P:XXIPT:XXORIG:XXTEMP:XXFORM);

 

 

         // Extrae IP x.x.x de IPT x.x.x.x

 

         XXIP = PrIP(XXIPT:XXIPR);

 

 

         // Actualiza contador y ajusta temporizador

 

         XXCONT = PrCuenta(XXIPT:XXIP:XXORIG:XXTEMP:XXFORM);

 

 

         // exit

 

         *inlr = *on;

         return;

 

 

      /END-FREE

 

 

      *          PPPPPPPPPPPPPPPPPPPPPPPPPPPPPPP

      *       PPPPPP                        PPPPPP

      *         IMPLEMENTACION DE PROCEDIMIENTOS.

      *       PPPPPP     INTERNOS           PPPPPP

      *          PPPPPPPPPPPPPPPPPPPPPPPPPPPPPPP

      *

      *

      *           PPPPPPPPPPPPPPPPPPPPPPPPPPPPPP

      *        PPPPPP                        PPPPPP

      *        PrCuenta: Progresa contador CTFSUMAR

      *        PPPPPP                        PPPPPP

      *           PPPPPPPPPPPPPPPPPPPPPPPPPPPPPP

      *

     PPrCuenta         B

      *

     DPrCuenta         PI            12                                         Contador Alfanuméric

     D P_IPT                         25    VALUE                                IP x.x.x.x REMOTO *I

     D P_IP                          20    VALUE                                IP x.x.x   REMOTO *I

     D P_ORIG                         2    VALUE                                OrigenTemporizador*I

     D P_TEMP                        10                                         Valor temporizado*IO

     D P_FORM                         2                                         Formato Aplicado *IO

 

      ***

      * * CAMPOS DE TRABAJO E INDICADORES

      ***

      *

      * Valor de retorno

     D T_CONT          S             12

 

 

      /FREE

 

 

         // Recupera valor previo

 

         clear *ALL REGSU;

         chain (P_IP:P_ORIG) CTFSUMAR;

         *IN95 = %found(CTFSUMAR);

 

 

         // aplica el valor del formato

 

         if *IN95 and SUFORM <> *BLANKS;

            P_FORM = SUFORM;

         endif;

 

 

         // Ajusta temporizador, aplicando valor anterior si existe y se recibe estándar

 

         if *IN95 and SUTEMP <> *ZEROS;

            select;

               when P_ORIG = 'JV';

                  if P_TEMP = '2143';

                     P_TEMP = %char(SUTEMP);

                  endif;

               when P_ORIG = 'SK';

                  if P_TEMP = '1745';

                     P_TEMP = %char(SUTEMP);

                  endif;

               when P_ORIG = 'TS';

                  if P_TEMP = '347' or P_TEMP = '447';

                     P_TEMP = %char(SUTEMP);

                  endif;

            endsl;

         endif;

 

 

         // Progresa y actualiza el contador

 

         SUIP   = P_IP;

         SUORIG = P_ORIG;

 

         SUIPT  = P_IPT;

         SUTEMP = %dec(P_TEMP:10:0);

         SUFORM = P_FORM;

 

         SUNSEC += 1;

 

         *IN90 = PrStam();

 

 

         // Graba o actualiza la posición

 

         if *IN95;

            update REGSU;

         else;

            write REGSU;

         endif;

 

 

         // Devuelve el contador progresado en formato alfanumérico

 

         return %char(SUNSEC);

 

 

      /END-FREE

 

 

      *           SSSSSSSSSSSSSSSSSSSSSSSSSSSSSS

      *        SSSSSS                        SSSSSS

      *                CONTROL DE ERRORES

      *        SSSSSS                        SSSSSS

      *           SSSSSSSSSSSSSSSSSSSSSSSSSSSSSS

      *

     C     *PSSR         BEGSR

     C                   RETURN    %char(SUNSEC)

     C     ENPSSR        ENDSR

 

 

     PPrCuenta         E

      *

      *

      *           PPPPPPPPPPPPPPPPPPPPPPPPPPPPPP

      *        PPPPPP                        PPPPPP

      *        PrIP: Extrae IP x.x.x desde IPT x.x.x.x

      *        PPPPPP                        PPPPPP

      *           PPPPPPPPPPPPPPPPPPPPPPPPPPPPPP

      *

     PPrIP             B

      *

     DPrIP             PI            20                                         IP x.x.x

     D P_IPT                         25    VALUE                                IP USUARIO REMOTO *I

     D P_IPR                          5                                         Resto IP          *O

 

      ***

      * * CAMPOS DE TRABAJO E INDICADORES

      ***

      *

      * Valor de retorno

     D T_IP            S             20

      *

      * Contadores

     D T_I             S              5I 0                                      Contador de for

     D T_N             S              5I 0 Inz(%len(T_IP))                      Máx

     D T_P             S              5I 0                                      NºPts

 

 

      /FREE

 

 

         // Inz

 

         clear P_IPR;

 

 

         // Bucle de extracción x.x.x.x --> x.x.x

 

         for T_I = 1 to T_N;

 

 

            // Criterio de parada: Alcanzar el 3er.punto

 

            if %subst(P_IPT:T_I:1) = '.';

               T_P += 1;

               if T_P = 3;

                  leave;

               endif;

            endif;

 

 

            // Volcado

 

            %subst(T_IP:T_I:1) = %subst(P_IPT:T_I:1);

 

         endfor;

 

 

         // Resto

 

         P_IPR = %subst(P_IPT:T_I:T_N-T_I+1);

 

 

         // Devuelve IP x.x.x extraído

 

         return T_IP;

 

 

      /END-FREE

 

 

      *           SSSSSSSSSSSSSSSSSSSSSSSSSSSSSS

      *        SSSSSS                        SSSSSS

      *                CONTROL DE ERRORES

      *        SSSSSS                        SSSSSS

      *           SSSSSSSSSSSSSSSSSSSSSSSSSSSSSS

      *

     C     *PSSR         BEGSR

     C                   RETURN    %subst(P_IPT:1:T_N)

     C     ENPSSR        ENDSR

 

 

     PPrIP             E

      *

      *

      *           PPPPPPPPPPPPPPPPPPPPPPPPPPPPPP

      *        PPPPPP                        PPPPPP

      *        PrPrm: Extrae parámetros en bruto de 1P

      *        PPPPPP                        PPPPPP

      *           PPPPPPPPPPPPPPPPPPPPPPPPPPPPPP

      *

     PPrPrm            B

      *

     DPrPrm            Pi              N                                        0/1 Error proceso

     D P_1P                       65535    VALUE                                1P:Prm.en conjunto*I

     D P_IPT                         25                                         IP USUARIO REMOTO *O

     D P_ORIG                         2                                         OrigenTemporizador*O

     D P_TEMP                        10                                         Valor temporizador*O

     D P_FORM                         2                                         Formato Aplicado  *O

 

      ***

      * * CAMPOS DE TRABAJO E INDICADORES

      ***

      *

      * Contadores

     D T_I             S              5I 0                                      Contador de for

     D T_J             S              5I 0                                      Contador de for

     D T_N             S              5I 0 Inz(4)                               NºMáx.Prm

     D T_P             S              5I 0                                      NºP en curso

 

 

      /FREE

 

 

         // Inz

 

         clear P_IPT;

         clear P_ORIG;

         clear P_TEMP;

         clear P_FORM;

 

 

         //                     P&            P

         // Bucle de extracción w&x&y&z&* --> w x y z

 

         T_P = 1;

 

         dow true;

 

            T_I += 1;

 

 

            // Criterio de parada: Alcanzar el (N+1)ºprm (&*=Eof)

 

            if %subst(P_1P:T_I:1) = '&';

 

               T_P += 1;

               if T_P > T_N;

                  leave;

               endif;

 

               T_J = *ZEROS;

               iter;

 

            endif;

 

 

            // Elude fillers comodín

 

            if %subst(P_1P:T_I:1) = '*';

               iter;

            endif;

 

 

            // Volcado

 

            T_J += 1;

 

            select;

 

               when T_P = 1;

                  %subst(P_IPT:T_J:1) = %subst(P_1P:T_I:1);

 

               when T_P = 2;

                  %subst(P_ORIG:T_J:1) = %subst(P_1P:T_I:1);

 

               when T_P = 3;

                  %subst(P_TEMP:T_J:1) = %subst(P_1P:T_I:1);

 

               when T_P = 4;

                  %subst(P_FORM:T_J:1) = %subst(P_1P:T_I:1);

 

            endsl;

 

         enddo;

 

 

         // Fin de proceso satisfactorio

 

         return *OFF;

 

 

      /END-FREE

 

 

      *           SSSSSSSSSSSSSSSSSSSSSSSSSSSSSS

      *        SSSSSS                        SSSSSS

      *                CONTROL DE ERRORES

      *        SSSSSS                        SSSSSS

      *           SSSSSSSSSSSSSSSSSSSSSSSSSSSSSS

      *

     C     *PSSR         BEGSR

     C                   RETURN    *ON

     C     ENPSSR        ENDSR

 

 

     PPrPrm            E

      *

      *

      *           PPPPPPPPPPPPPPPPPPPPPPPPPPPPPP

      *        PPPPPP                        PPPPPP

      *        PrStam: Estampillador de CTFSUMAR

      *        PPPPPP                        PPPPPP

      *           PPPPPPPPPPPPPPPPPPPPPPPPPPPPPP

      *

     PPrStam           B

      *

     DPrStam           PI              N                                        0/1 Error proceso

 

      **

      **  DEFINICION GENERAL DE *TIME

      **

     D/COPY QRPGLESRC,COCCD_TIME

 

      *

      * IDENTIFICACION

     C                   MOVE      P1JOBR        SUJOBR

     C                   MOVE      P1JOBU        SUJOBU

     C                   MOVE      P1JOBN        SUJOBN

     C                   MOVE      P1PROG        SUPROG

      *

      * REF.HORA

     C                   TIME                    TTSTAMZ

     C                   MOVE      TTSTAMZ       TTSTAM

     C                   MOVE      TTDATE        SULFEC

     C                   MOVE      TTHORA        SULHOR

     C                   MOVE      TTMILI        SULMIL

 

     c                   return    *OFF

 

 

      *           SSSSSSSSSSSSSSSSSSSSSSSSSSSSSS

      *        SSSSSS                        SSSSSS

      *                CONTROL DE ERRORES

      *        SSSSSS                        SSSSSS

      *           SSSSSSSSSSSSSSSSSSSSSSSSSSSSSS

      *

     C     *PSSR         BEGSR

     C                   RETURN    *On

     C     ENPSSR        ENDSR

 

 

     PPrStam           E

 

      **************************************************************************

      *          *

      * CTFSUMAR * SUMARIO PARA AUTOCT

      *          *

      **************************************************************************

     A                                      UNIQUE

     A          R REGSU

      **************************************************************************

      *- Vía de acceso

      **************************************************************************

      *

      *- IDENTIFICACIÓN REMOTA

      *

     A            SUIP          20          COLHDG('SUIP' +

     A                                             'Direcc.IP clave' +

     A                                             'principal x.x.x')

      *

      *- ORIGEN REFERENCIA

      *

     A            SUORIG         2          COLHDG('SUORIG' +

     A                                             'Origen referencia' +

     A                                             'temporiz.SK-JV-TS')

      * Origen temporizador

      *  SK - Sudoku

      *  JV - JuVida

      *  TS - Tesela

 

      *

      *- ORIGEN APLICADO

      *

     A            SUFORM         2          COLHDG('SUFORM' +

     A                                             'Formato aplicado' +

     A                                             'actual JV-TS')

      * Origen aplicado en formulario actual compartido (Para JV & TS)

      *  JV & TS pueden compartir gadget. Este campo recoge el formato actual real:

      *  JV - JuVida

      *  TS - Tesela

      * (En ambos registros asociados se rellenará el común actual)

 

      **************************************************************************

      *- Datos base asociados

      **************************************************************************

     A            SUIPT         25          COLHDG('SUIPT' +

     A                                             'Direcc.IP remota' +

     A                                             'completa x.x.x.x')

 

     A            SUTEMP        10S 0       COLHDG('SUTEMP' +

     A                                             'ValorTemporizador' +

     A                                             'en milisegundos')

 

      **************************************************************************

      *- Datos complementarios

      **************************************************************************

      *

      *- CONTADOR INFORMATIVO

      *

     A            SUNSEC        12S 0       COLHDG('SUNSEC NUM.SECUE')

 

      *

      *- REFERENCIA HORARIA

      *

     A            SULFEC         8S 0       COLHDG('SULFEC FechaAnotac')

     A            SULHOR         6S 0       COLHDG('SULHOR Hora Anotac')

     A            SULMIL         3S 0       COLHDG('SULMIL MilisegAnot')

      *

      *- IDENTIFICACIÓN LOCAL

      *

     A            SUJOBU        10          COLHDG('SUJOBU USUARIO JOB')

     A            SUJOBR        10          COLHDG('SUJOBR NOMBRE  JOB')

     A            SUJOBN         6          COLHDG('SUJOBN NUMERO  JOB')

     A            SUPROG        10          COLHDG('SUPROG PROGRAM JOB')

 

      *---------------------------------------------------------------------

      *

     A          K SUIP

     A          K SUORIG

 

 

 

                                                                                                                           _______