miércoles, 25 de abril de 2012

Utilidades REXX III: eliminar ficheros XXX.*

En esta ocasión os traemos una utilidad en REXX para el caso de querer borrar todos los ficheros que empiecen por una determinada cadena.
Por ejemplo, queremos borrar todos los ficheros que se encuentren migrados de la aplicación APL y cuya nomenclatura sería algo así:
APL.NOMBRE.FICHERO

Podríamos ir uno por uno, pero según la cantidad de ficheros que haya podría llevarnos su tiempo...

No vamos a entrar en lo que significa el código REXX, pues se trata de desribir el uso de la utilidad, y no el código en sí. Quizás algún día nos metamos con el REXX pero de momento ya tenemos bastantes frentes abiertos!!

El código al completo debemos agradecérselo a los compañeros de www.ibmmainframes.com que son los que lo han compartido.
Gracias!!

JCL:

//STEP0020 EXEC PGM=IKJEFT01,DYNAMNBR=256,
//         PARM='NOMBREPGM SCAN DASD TAPE MIGR'
//* PARM VALUES - SCAN - LIST ONLY
//*             - RUN - PROCESS REQUESTS - DELETE OR HSM
//*             - DASD - LIST/DELETE DASD DATASETS
//*             - MIGR - LIST/DELETE MIGRATED DATASETS
//*             - TAPE - LIST/DELETE TAPE DATASETS
//*             - RCALL - LIST/RECALL SELECTED DATASETS
//*             - ARCH - LIST/MIGRATE SELECTED DATASETS TO ML1
//*             - ARCH2 - LIST/MIGRATE SELECTED DATASETS TO ML2
//SYSEXEC  DD DSN=MI.LIBRERIA.REXX,DISP=SHR
//SYSOUT   DD SYSOUT=*
//SYSTSPRT DD SYSOUT=*
//SYSTSIN  DD DUMMY
//DATASETS DD *
P390A.BORRAR.**
/*
//EXCLUDE DD *
P390A.BORRAR.ESTENO
/*


Como veis el JOB incluye varias opciones:
Opción 1:
SCAN --> Lista en la salida (SYSOUT) los nombres de los ficheros encontrados.
RUN --> Ejecuta la acción elegida en opción 2 para los ficheros seleccionados (puede ser eliminar, migrar o "desmigrar").


Opción 2:
DASD --> Indica ficheros DASD
MIGR --> Indica ficheros migrados
TAPE --> Indica ficheros en cinta
RCALL --> Hace un RCALL de los ficheros seleccionados (los "desmigra")
ARCH --> Migra los ficheros seleccionados a ML1
ARCH2 --> Migra los ficheros seleccionados a ML2


En DATASETS indicaremos el prefijo de los ficheros a tratar. En nuestro caso P390A.BORRAR.**
Si quisiésemos mantener alguno de los ficheros (no queremos que se eliminen) lo indicaríamos en EXCLUDE con el nombre completo. En nuestro caso hemos indicado:
P390A.BORRAR.ESTENO

Al inicio del paso veréis que hemos indicado como parámetro (PARM) el nombre de nuestro programa REXX (NOMBREPGM). Además como opciones hemos indicado SCAN para que sólo nos liste los ficheros, y DASD, TAPE y MIGR para que liste los ficheros en esos estados.
En el SYSEXEC hemos indicado la librería donde se encuentra nuestro programa (MI.LIBRERIA.REXX).

Un ejemplo de lo que mostraría por SYSTPRT sería:


Podemos ejecutar una segunda vez con la opción RUN en lugar de SCAN y veríamos en el SYSTPRT:


Habiéndose borrado los ficheros que indica.

Lo hemos probado y podemos decir que funciona a la perfección. Esperamos que os sea útil.

Programa:

/* REXX ** INVOKE CSI VIA BATCH REXX PROCESS
** LIST OR DELETE ALL ENTRIES FOR GIVEN DSN PATTERNS
ALSO TO FILTER BY DASD TAPE OR MIGR */
ARG RUNTYP UNIT
IF RUNTYP <> "RUN" THEN RUNTYP = "SCAN"
IF POS('MIGR',UNIT) > 0 & POS('RCALL',UNIT) > 0 THEN DO
   SAY " "
   SAY "RECALL AND HDELETE BOTH SPECIFIED FOR MIGRATED DATASETS"
   SAY "EXIT REURN CODE 16 *** EXIT RETURN CODE 16 "
   EXIT(16)
END
 "EXECIO * DISKR EXCLUDE ( STEM EXC. FINIS"
 DO A = 1 TO EXC.0
    IF POS('*',EXC.A) > 0 THEN DO       EXCLDIT.A = STRIP(SUBSTR(EXC.A,1,POS('*',EXC.A)-1))
      GEN.A = "Y"
    END
    ELSE DO       EXCLDIT.A = STRIP(EXC.A)
      GEN.A = "N"
    END
 END
 "EXECIO * DISKR DATASETS ( STEM CAT. FINIS"
 DO KCNT = 1 TO CAT.0
 KEY = SUBSTR(CAT.KCNT,1,44)
MODRSNRC = SUBSTR(' ',1,4)
CSIFILTK = SUBSTR(KEY,1,44)
CSICATNM = SUBSTR(' ',1,44)
CSIRESNM = SUBSTR(' ',1,44)
CSIDTYPS = SUBSTR(' ',1,16)
CSICLDI = SUBSTR('Y',1,1)
CSIRESUM = SUBSTR(' ',1,1)
CSIS1CAT = SUBSTR(' ',1,1)
CSIRESRV = SUBSTR(' ',1,1)
CSINUMEN = '0002'X
CSIFLD1 = 'VOLSER '
CSIFLD2 = 'DEVTYP '
CSIOPTS = CSICLDI || CSIRESUM || CSIS1CAT || CSIRESRV
CSIFIELD = CSIFILTK || CSICATNM || CSIRESNM || CSIDTYPS || CSIOPTS
CSIFIELD = CSIFIELD || CSINUMEN || CSIFLD1 || CSIFLD2
WORKLEN = 4096
DWORK = '00001000'X || COPIES('00'X,WORKLEN-4)
RESUME = 'Y'
CATNAMET = SUBSTR(' ',1,44)
DNAMET = SUBSTR(' ',1,44)
DO WHILE RESUME = 'Y'
 ADDRESS LINKPGM 'IGGCSI00 MODRSNRC CSIFIELD DWORK'
 RESUME = SUBSTR(CSIFIELD,150,1)
 USEDLEN = C2D(SUBSTR(DWORK,9,4))
 POS1=15
 DO WHILE POS1 < USEDLEN
   IF SUBSTR(DWORK,POS1+1,1) = '0'
    THEN DO
         CATNAME=SUBSTR(DWORK,POS1+2,44)
         IF CATNAME <> CATNAMET THEN
           DO
             CATNAMET = CATNAME
           END
         POS1 = POS1 + 50
         END
    DNAME = SUBSTR(DWORK,POS1+2,44)
    PRO = "Y"
    DO ZZ = 1 TO EXC.0
      EXCLDLN = LENGTH(EXCLDIT.ZZ)
      IF GEN.ZZ = "N" THEN DO
        IF STRIP(DNAME) = STRIP(EXCLDIT.ZZ) THEN PRO = "N"
      END
      ELSE DO
        IF STRIP(LEFT(DNAME,EXCLDLN)) = STRIP(EXCLDIT.ZZ) THEN PRO = "N"
      END
    END
    IF SUBSTR(DWORK,POS1+1,1) = 'C' THEN DTYPE = 'CLUSTER '
     ELSE
      IF SUBSTR(DWORK,POS1+1,1) = 'D' THEN DTYPE = 'DATA '
     ELSE
      IF SUBSTR(DWORK,POS1+1,1) = 'I' THEN DTYPE = 'INDEX '
     ELSE
      IF SUBSTR(DWORK,POS1+1,1) = 'A' THEN DTYPE = 'NONVSAM '
     ELSE
      IF SUBSTR(DWORK,POS1+1,1) = 'H' THEN DTYPE = 'GDS '
     ELSE
      IF SUBSTR(DWORK,POS1+1,1) = 'B' THEN DTYPE = 'GDG '
     ELSE
      IF SUBSTR(DWORK,POS1+1,1) = 'R' THEN DTYPE = 'PATH '
     ELSE
      IF SUBSTR(DWORK,POS1+1,1) = 'G' THEN DTYPE = 'AIX '
     ELSE
      IF SUBSTR(DWORK,POS1+1,1) = 'X' THEN DTYPE = 'ALIAS '
     ELSE
      IF SUBSTR(DWORK,POS1+1,1) = 'U' THEN DTYPE = 'UCAT '
     ELSE
      DTYPE = ' '
      POS1 = POS1 + 46
      NUMVOL = C2D(SUBSTR(DWORK,POS1+4,2))/6
      POS2 = POS1+8
      DO I=1 TO NUMVOL
        VOLSER.I = SUBSTR(' ',1,6)
      END
      DO I = 1 TO NUMVOL
        VOLSER.I = SUBSTR(DWORK,POS2,6)
        POS2 = POS2 + 6
      END
      IF NUMVOL > 1 THEN MVL = '+'
        ELSE
        MVL = ' '
      DEVTY1 = SUBSTR(DWORK,POS2,4)
      DEVTY2 = C2X(DEVTY1)
      IF SUBSTR(DEVTY2,5,2) = '20' THEN DELDEV = 'DASD'
        ELSE
          IF SUBSTR(DEVTY2,5,2) = '80' THEN DELDEV = 'TAPE'
            ELSE
              DELDEV = 'XXXX'
      IF DELDEV = 'DASD' THEN MIGLEV = ' ML1'
        ELSE
          MIGLEV = ' ML2'
      IF DNAMET <> DNAME THEN
      DO
        DNAMET=DNAME
        DNAM2 = STRIP(DNAME)
        IF DTYPE = 'GDG' | DELDEV = 'XXXX' THEN PRO = 'N'
        IF PRO = "Y" THEN DO
          IF VOLSER.1 = 'MIGRAT' THEN
            DO
             IF POS('MIGR',UNIT) > 0 | POS('RCALL',UNIT) > 0 THEN DO
               IF RUNTYP = "RUN" THEN
               DO
                 IF POS('MIGR',UNIT) > 0 THEN DO
                   SAY " HDEL FOR "DNAM2
                       " HDELETE '"DNAM2"'"
                 END
                 ELSE IF POS('RCALL',UNIT) > 0 THEN DO
                   SAY " HRECALL FOR "DNAM2
                       " HRECALL '"DNAM2"'"
                 END
              END
          ELSE
            SAY COPIES(' ',8) DTYPE DNAME VOLSER.1 MVL MIGLEV
          END
        END
        ELSE IF VOLSER.1 <> 'MIGRAT' THEN
          DO
           IF DTYPE = 'CLUSTER' & POS('DASD',UNIT) > 0 THEN DO
             IF RUNTYP = "RUN" THEN DO
                " DELETE '"DNAM2"'"
             END
             ELSE
               SAY COPIES(' ',8) DTYPE DNAME VOLSER.1 MVL DELDEV
             END
          ELSE DO
            IF DELDEV = 'TAPE' & POS('TAPE',UNIT) > 0
             THEN
             DO
               IF RUNTYP = "RUN" THEN
                 DO
                    " DELETE '"DNAM2"' NOSCRATCH "
                 END
               ELSE
                 SAY COPIES(' ',8) DTYPE DNAME VOLSER.1 MVL DELDEV
            END
           IF DELDEV = 'DASD' & POS('DASD',UNIT) > 0 ,
            & VOLSER.1 <> 'MIGRAT' THEN
            DO
             IF RUNTYP = "RUN" THEN
              DO
               " DELETE '"DNAM2"'"
              END
             ELSE
              SAY COPIES(' ',8) DTYPE DNAME VOLSER.1 MVL DELDEV
            END
           IF DELDEV = 'DASD' & POS('ARCH',UNIT) > 0 ,
            & VOLSER.1 <> 'MIGRAT' THEN
            DO
             IF SUBSTR(UNIT,POS('ARCH',UNIT)+4,1) = '2'
              THEN ML = "ML2"
              ELSE ML = ""
             IF RUNTYP = "RUN" THEN
              DO
               SAY COPIES(' ',8) DTYPE DNAME VOLSER.1 MVL DELDEV
                   " HMIG '"DNAM2"'" ML
              END
             ELSE
               SAY COPIES(' ',8) DTYPE DNAME VOLSER.1 MVL DELDEV
            END
         END
       END
    END
    POS1 = POS1 + C2D(SUBSTR(DWORK,POS1,2))
  END
END
END
END

lunes, 23 de abril de 2012

Respuestas de la semana

Revisando las búsquedas que llevan a la gente a visitar el Consultorio Cobol, se nos ocurrió crear un artículo semanal en respuesta a esas búsquedas que puede que no hayan encontrado solución a su problema.
Contestaremos a aquellas cuestiones que no necesiten de un artículo entero para ser explicadas, es decir, que la solución se pueda dar en un par de frases.
Vamos con las de esta semana : )

Pregunta 1:
se puede validar una variable numerica y alfanumerica en cobol
Respuesta 1:
En cobol se puede comprobar si una variable contiene solo números (es numérica) o no con la siguiente sentencia:
01 WX-VARIABLE-NUM PIC 9(4) VALUE 1234.
...
IF WX-VARIABLE-NUM IS NOT NUMERIC
DISPLAY 'ERROR'
END-IF


Nota: la validación de IS NUMERIC e IS NOT NUMERIC es válida sólo para campos numéricos o numéricos comprimidos, es decir, PIC 9(X) y PIC 9(X) COMP-3.

Pregunta 2:
quitar numeracion amarrilla cobol
Respuesta 2:
Los números amarillos que aparecen a izquierda y derecha de un programa cobol se puden quitar escribiendo en la linea de comandos (Command ===>) los siguiente:
Primero escribimos NUM STD COB y pulsamos intro. Veréis que el código se mueve hacia la izquierda.
Luego escribimos UNNUM y pulsamos intro. Veréis que el código se vuelve a centrar y los números han desaparecido.









Pregunta 3:
indexed by in cobol como incrementar
Respuesta 3:
Cuando un índice en cobol está definido en una cláusula INDEXED BY, la manera de incrementarlo sería:
SET WI-INDICE UP BY 1

Esto sería para incrementarlo en 1, si le indicamos otro número se incrementaría en esa cantidad.

Pregunta 4:
cargar campos de longitud variable con load bmc vachar position
Respuesta 4:
Supongamos que tenemos un fichero de longitud variable (VB) donde el VARCHAR es el último campo del fichero, de tal modo que es el que hace que la longitud varíe.
Supongamos ahora que con ese fichero queremos hacer una LOAD a la tabla correspondiente. Pueden pasar dos cosas:

1- En la tabla, el campo VARCHAR no es el último:
En este caso tendremos que formatear el fichero con un OUTREC, para colocar el VARCHAR de modo que coincida con la posición en la tabla DB2. Para ello podemos pasar el fichero de VB a FB y después hacer el OUTREC (por ejemplo).
2- En la tabla, el campo VARCHAR también es el último:
Si la LOAD directamente del fichero VB no funciona, podemos pasarlo a FB y funcionará.

Para pasar de VB a FB podemos hacerlo por JCL o, más a lo bestia, hacer una copia y cuando nos pregunte si queremos copiar los atributos del fichero original le diremos que no, que se los queremos indicar (opción 2 de la imagen). Cambiaremos el Record Format de VB a FB, el Record Length a la longitud del fichero con el VARCHAR al máximo, y el Block size a algo coherente con la longitud.













No dudéis en enviarnos vuestras dudas directamente al correo del consultorio o a través del formulario de contacto.

viernes, 20 de abril de 2012

Trasladar COBOL a las "nubes"

Una nueva plataforma de desarrollo anunciada por la startup Heirloom Computing permitirá a las empresas mover las aplicaciones legacy (sistema heredado ) escritas en el venerable pero aún viable lenguaje COBOL, que generalmente se encuentra en mainframes, a una variedad de servicios de computación en la nube.

El sistema compila aplicaciones COBOL, así como las escritas para CICS de IBM, en código fuente Java. ELPaaS proporciona un ambiente de ejecución para las aplicaciones, las cuales pueden entonces correr sin ningún cambio en varias plataformas de servicio de nube, como Cloud Foundry de VMware, OpenShift de Red Hat y CloudBees, presumiendo que son ‘amigables con Java’, sostuvo Charles Krahling, vicepresidente ejecutivo de Ventas de Heirloom Computing.

La versión gratuita de ELPaaS se encuentra disponible para los desarrolladores individuales y tiene soporte y opciones de herramientas limitadas. Una edición estándar, disponible mediante suscripción, añade más herramientas, un SLA, un mejor desempeño de I/O y soporte para aplicaciones escritas para CICS.

Se encuentra disponible para “equipos que están desplegando aplicaciones de propósito general en la nube”.

La edición de gama alta Enterprise Edition soporta aplicaciones de “misión crítica” que requieren un alto nivel de desempeño de I/O.

“Cualquier cosa que le dé nueva vida a las aplicaciones legacy encontrará una audiencia atenta en las viejas organizaciones TI”, sostuvo Frank Scavo, presidente de investigación TI de la firma consultora Computer Economics.

Aunque cuesta mucho dinero mantener un mainframe, las aplicaciones COBOL que corren en ellos pueden ser muy estables y necesitan poco soporte, señaló Scavo. Por tanto, “muchos usuarios de COBOL tienen pocos incentivos para hacer la gigantesca inversión que se requiere para volver a escribir estas aplicaciones, solo para librarse del mainframe”.


Generalmente, las empresas mantienen las aplicaciones pero hacen outsourcing de las operaciones del mainframe con un tercero, sostuvo Scavo.

“El éxito no está garantizado”, agregó Scavo. “Los usuarios de mainframes son marcadamente conservadores. Se van a necesitar algunos casos de éxito para que en verdad los CIO de los mainframes lleguen a tomarlo en consideración”.

Nosotros, como usuarios de mainframe, somos también personas "marcadamente conservadoras", así que seremos suceptibles hasta ver un par de casos de éxito en grandes instalaciones.

Noticia cioperu.pe

lunes, 16 de abril de 2012

Caja Sur: integración en BBK

Desde el lunes 19 de marzo todos los sistemas de información de CajaSur operan ya sobre la Plataforma Tecnológica de BBK 'Besaide', que será además el sistema tecnológico común sobre el cual operarán todas las entidades que forman Kutxabank.



Culmina de esta manera un proceso de integración tecnológica y gestión del cambio que comenzó hace 15 meses y que se ha desarrollado en consonancia con los plazos y resultados estimados. La integración tecnológica de ambas organizaciones se da, por tanto, por concluida.

El proceso de integración ha consistido en la incorporación de los sistemas de CajaSur en la plataforma 'Besaide', así como en el desarrollo de módulos específicos que responden a las necesidades particulares de la entidad con sede principal en Córdoba. La integración engloba al conjunto de la soluciones tecnológicas de CajaSur y a todos sus canales de distribución: Oficinas, Banca por Internet, Portales, Autoservicio (Cajeros, Comercios, Venta de entradas) y Banca por Teléfono.

'Besaide' ofrece cobertura completa de las aplicaciones 'Core' del negocio bancario, tanto para clientes particulares como para empresas. Es, según CajaSur, un "todo" desarrollado con una arquitectura de aplicaciones que permite la reutilización de procesos, cubre la totalidad de las funciones y la operativa y está automatizada para todos los productos, servicios y canales.


Estaremos al tanto de como avanzan el resto de integraciones que se están produciendo en el panorama financiero español.



Noticia lainformacion.com



lunes, 9 de abril de 2012

Wiseri.com: RRHH 3.0

Desde hoy podéis ver en el blog un enlace a las ofertas de empleo de Wiseri.com relacionadas con cobol.
Se trata por un lado de un proyecto de colaboración, y por otro de ofrecer a nuestros lectores un acceso rápido a las ofertas de empleo del mundillo.

Wiseri no es un portal de empleo como los demás y la diferencia principal radica en que SI hay alguien al otro lado:
expertos en cada categoría realizan la selección de candidatos por cada oferta, lo que denominan wisors.

Vía Acerca de:
De esta manera el modelo garantiza a la empresa que varios profesionales con amplia experiencia serán quienes han revisado al candidato. Además, el profesional que esté seleccionando le ofrecerá al candidato en todo momento su valoración respecto a su candidatura. Con ello, si el wisor piensa que debe potenciar algún tipo de conocimiento o área este podrá decírselo para que mejore de cara a futuros procesos e incluso para llegar a ser wisor él mismo.

Podéis encontrar más información en su blog y no dejéis de visitar Wiseri.com : )