RPG

 

Ficheros virtuales

 

 

 

El banco de pruebas verifica la supresión de registros con la función SRAGMV_DELETE que consiste en un bucle de llamadas a SRAGM_DELETE y otro de restitución llamando a SRAGM_WRITE.

 

En la primera se van eliminando uno de cada P_Bloq registros, y en la segunda se restablecen a su valor original.

 

Hay que destacar que en ambas rutinas se utiliza la vía de acceso lógica, pero el interfaz de presentación hace uso de la vía de acceso principal.

 

 

Un extracto del detalle del código fuente sigue a continuación:

 

 

      *

      *

      *    PPPPPPPPPPPPPPPPPPPPPPPPPPPPPPP

      * PPPPPP                         PPPPPP

      * SRAGMV_Delete: Rutina para pruebas de SRAGM_DELETE

      * PPPPPP                         PPPPPP

      *    PPPPPPPPPPPPPPPPPPPPPPPPPPPPPPP

      *

      * Opción por defecto: Formato conjunto (Formato_0 & Formato_1)

      * Formato 0:

      *  ELIMINA UN 1% DE ITEMS

      * Formato 1:

      *  RECONSTITUYE LOS ITEMS BORRADOS

      *

     PSRAGMV_DELETE    B                   EXPORT

      *

     DSRAGMV_DELETE    PI              N                                        0/1 Error         *O

     D P_LF                          33    VALUE                                NombrFileLFactual1*I

     D P_NUME                         6  0 VALUE                                NºElementosPrueba2*I

     D P_Bloq                         6  0 VALUE                                NºEl.bloque DSPLY3*I

     D P_OnErr                        1    VALUE                                0=Iter1=Leav2=Fin4*I

     D P_DspSts                       1    VALUE                                0/1 emitir dspd  5*I

     D P_Formato                      1    VALUE OPTIONS(*NOPASS)               0:Del 1:Writ/*ALL6*I

 

      ***

      * * DEFINICION DE CAMPOS E INDICADORES

      ***

      *

      * Paso de parámetros opcionales

     D T_Parm          S             10I 0

      *

      * SRAGM

     D T_I             S              6  0

     D T_J             S              6  0

     D T_K             S              6  0

     D T_L             S              6  0

     D T_IJ            S              6  0

     D T_JI            S              6  0

     D T_Erro          S             10I 0

     D T_MENS          S             80

     D T_Resu          S             10I 0

 

      *

      * Instancia de DS8888c para soporte de DS8888 virtual

     DDS8888           DS                  LIKEDS(DS8888c) INZ

 

 

 

 

Insertamos ahora la definición de DS8888 para tenerla a mano:

 

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

      *  DS8888   *  Banco de pruebas de SRAGM

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

 

      ***

      * *  Definición fichero virtual DS8888

      ***

     D DS8888c         DS                  QUALIFIED BASED(pDS8888c)            Soporte  DS8888

     D  DSK                                LIKEDS(DSCc)                         ClavesPF DS8888

     D  DSK01                              LIKEDS(DSC01c)                       ClavesLF DS8888

     D  DSD                                LIKEDS(DSDc)                         Datos    DS8888

 

      ***

      * *  Definición claves PF (Es la definición de una red [I,J], como en la emulación de una hoja de cálculo)

      ***

     D DSCc            DS                  QUALIFIED BASED(pDSCc)

     D  I                            10S 0                                      I

     D  J                            10S 0                                      J

 

      ***

      * *  Definición claves LF (Orden inverso)

      ***

     D DSC01c          DS                  QUALIFIED BASED(pDSC01c)

     D  JI                           10S 0                                      N*N - IJ + 1

 

      ***

      * *  Definición datos fichero virtual DS8888

      ***

     D DSDc            DS                  QUALIFIED BASED(pDSDc)

     D  IJ                           10S 0                                      N*(I-1) + J

     D  IMPT                         10S 0                                      [100000]+N*(I-1) + J

      * La constante [100000] se añadirá/retirará en los UPDATE de prueba

 

 

 

Continuamos con el fuente del código de SRAGMV_DELETE:

 
 

 

      /FREE

 

 

         // Proceso para nº de parámetros limitado (Es el uso por defecto de la rutina. Se autoinvocan los dos pasos)

 

         T_Parm = %parms();

         if T_Parm <= 5;

 

            *IN90 = SRAGMV_Delete(P_LF:P_NUME:P_Bloq:P_OnErr:P_DspSts:'0');

            *IN90 = SRAGMV_Delete(P_LF:P_NUME:P_Bloq:P_OnErr:P_DspSts:'1');

            return *IN90;

 

         endif;

 

 

 

         // BORRADO

 

         if P_Formato = '0';

 

 

            // Ciclo de borrado

 

            for T_I = 1 to P_NUME;

               for T_J = 1 to P_NUME;

 

                  T_L += 1;

 

 

                  // Solo borra uno de cada P_Bloq ítems

 

                  if %rem(T_L:P_Bloq) <> *ZEROS;

                     iter;

                  endif;

 

                  T_K += 1;

 

 

                  // Indice I,J

 

                  T_IJ = P_NUME * (T_I - 1) + T_J;

 

 

                  // Construye clave de supresión, en la vía lógica

 

                  clear DS8888;

 

                  DS8888.DSK01.JI = P_NUME*P_NUME - T_IJ + 1;

 

   
                  // Actualiza. Sentencia principal de la rutina

 

                  T_Resu = SRAGM_DELETE(P_LF:%addr(DS8888.DSK01));

 

 

                  if T_Resu = *ZEROS;

 

                     // Control de errores
                     ...
                     return *ON;

 

                  endif;

 

 

               endfor;

            endfor;

 

 

            // Fin de proceso satisfactorio

 

            return *OFF;

 

         endif;

 

 

 

         // RECONSTITUCIÓN

 

         T_L = *ZEROS;

 

         for T_I = 1 to P_NUME;

            for T_J = 1 to P_NUME;

 

               T_L += 1;

 

 

               // Solo reconstruye uno de cada P_Bloq ítems

 

               if %rem(T_L:P_Bloq) <> *ZEROS;

                  iter;

               endif;

 

               T_K += 1;

 

 

               // Construye registro a reconstituir

 

               clear DS8888;

 

               DS8888.DSK.I = T_I;

               DS8888.DSK.J = T_J;

 

               DS8888.DSD.IJ = P_NUME * (T_I - 1) + T_J;

 

               DS8888.DSK01.JI = P_NUME*P_NUME - DS8888.DSD.IJ + 1;

 

               if %rem(DS8888.DSD.IJ:2) <> *ZEROS;

                  DS8888.DSD.IMPT = DS8888.DSD.IJ;

               else;

                  DS8888.DSD.IMPT = 100000 + DS8888.DSD.IJ;

               endif;

 

 

               // Graba registro reconstruido

 

               T_Resu = SRAGM_WRITE(P_LF:%addr(DS8888.DSK01):%addr(DS8888));

 

 

               if T_Resu = *ZEROS;

 

 

                  // Control de errores
                  ...
                  return *ON;

 

               endif;

 

 

            endfor;

         endfor;

 

 

         // Fin de proceso satisfactorio

 

         return *OFF;

 

 

         Begsr *PSSR;

            SRAGG_AnotPSSR(P1STAT);

            return *On;

         Endsr;

 

 

      /END-FREE

 

 

     PSRAGMV_DELETE    E

 

 

 

Veamos ahora una muestra gráfica del resultado para un fichero de tamaño 324 = 18 x 18:

 

 

Tras la supresión:


 

 

Tras la restauración:


 

 

El código del interfaz de presentación se encuentra en

 

 Archivo de pantalla CCD8810: http://iseries.ficherosvirtuales.com/QDDSSRC/QDDSSRC.CCD8810

 Código del programa CC8810 : http://iseries.ficherosvirtuales.com/QRPGLESRC/QRPGLESRC.CC8810

 Código adicional DS8810  . : http://iseries.ficherosvirtuales.com/QRPGLESRC/QRPGLESRC.COCCD_8810

 

 

Donde se invocan los servicios de prueba que se extrajeron de CC8888 y se volcaron al programa de servicio SRAGMV


      Prototipos de exportación: http://iseries.ficherosvirtuales.com/QCOPYSRC/QCOPYSRC.PSRAGMV
  (*) Fuente principal . . . . : http://iseries.ficherosvirtuales.com/QRPGLESRC/QRPGLESRC.SRAGMV 
      Fuente de enlace . . . . : http://iseries.ficherosvirtuales.com/QSRVSRC/QSRVSRC.SSRAGMV