IBM Mainframe Forum Index
 
Log In
 
IBM Mainframe Forum Index Mainframe: Search IBM Mainframe Forum: FAQ Register
 

.XMI file record structure


IBM Mainframe Forums -> All Other Mainframe Topics
Post new topic   Reply to topic
View previous topic :: View next topic  
Author Message
vasanthz

Global Moderator


Joined: 28 Aug 2007
Posts: 1742
Location: Tirupur, India

PostPosted: Tue Sep 04, 2012 9:42 am
Reply with quote

Hi,
We can create .xmi files using XMIT command and restructure back the data using RECEIVE.

Could you please point me to the "record layout logic" of a xmi file so it can be parsed in a user written program like REXX or SAS on mainframe.

XMIT manager is a nice application on PC to view .xmi files, but unfortunately its not open source :S
Google leads to XML Metadata Interchange formats which I guess is something totally different.

Thanks in advance,
Back to top
View user's profile Send private message
Bill Woodger

Moderator Emeritus


Joined: 09 Mar 2011
Posts: 7309
Location: Inside the Matrix

PostPosted: Tue Sep 04, 2012 12:23 pm
Reply with quote

Why don't you create a file of that format on the mainframe and "browse" it?

It is a pretty simple format.
Back to top
View user's profile Send private message
PeterHolland

Global Moderator


Joined: 27 Oct 2009
Posts: 2481
Location: Netherlands, Amstelveen

PostPosted: Tue Sep 04, 2012 1:11 pm
Reply with quote

Quote:
Google leads to XML Metadata Interchange formats which I guess is something totally different.


No its not, read :

en.wikipedia.org/wiki/XML_Metadata_Interchange
Back to top
View user's profile Send private message
PeterHolland

Global Moderator


Joined: 27 Oct 2009
Posts: 2481
Location: Netherlands, Amstelveen

PostPosted: Tue Sep 04, 2012 1:43 pm
Reply with quote

The record layout for Transmit/Receive files can be found in :

z/OS TSO/E Customization SA22-7783-09
Back to top
View user's profile Send private message
enrico-sorichetti

Superior Member


Joined: 14 Mar 2007
Posts: 10872
Location: italy

PostPosted: Tue Sep 04, 2012 2:02 pm
Reply with quote

Vasanth is talking not about XML, but about XMI
TSO/E SEND/RECEIVE and the structure of the IDTF File
which is described very well in the tso/e manuals

here is the REXX script to RECEIVE an IDTF file
should work both for object rexx and regina rexx
and on windows,linux, APPLE snow leopard,lion, mountain lion

I currently use linux and the APPLE
I tested initially on windows and later on I quit testing the updates

right now i am testing the PDSE support


Code:
#!/opt/ooRexx/bin/rexx

/* Rexx - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
/* Name : receive.rx                                                 */
/* Build:                                                            */
/*  from: /Users/enrico/tools_skels/receive.rx                       */
/* alias: ../tools/_receive                                          */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
/* Copyright (c) 2005-2012 Enrico Sorichetti                         */
/* All rights reserved.                                              */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/

-- included  /Users/enrico/include/receive.rxh
/*--help:start                                                        */
/*1Copyright (c) 2005-2012 Enrico Sorichetti                          */
/*1All rights reserved.                                               */
/*1 receive.rx                                                        */
/*2                                                                   */
/*1           -h        (IMMED) short help                            */
/*1           --help    (IMMED) long help                             */
/*2                                                                   */
/*1           --auto    (FLAG) same as --mode auto                    */
/*1           --text    (FLAG) same as --mode text                    */
/*1           --binary  (FLAG) same as --mode binary                  */
/*1           --update  (FLAG) same as --mode update                  */
/*2                                                                   */
/*1           --suffix  (PARM) string                                 */
/*2                        override for default suffix                */
/*2                        .txt for text files                        */
/*2                        .xmi for xmit files                        */
/*2                        .obj for object decks                      */
/*2                        .bin for binary files                      */
/*2                                                                   */
/*1           --junk    (FLAG) same as --dest junk                    */
/*1           --dest    (KEYW/PARM) (junk/[name])/path_name           */
/*2                     where to expand the source(XMI) content       */
/*2                     junk  same level of the source(XMI) file      */
/*2                     name  path with the name of the XMI container */
/*2                        ( cbt006.xmi ==> cbt006/)                  */
/*2                     path_name                                     */
/*2                        the name tells                             */
/*2                                                                   */
/*1           --mail    (KEYW) (show/save/[name])                     */
/*2                     how to process the message file               */
/*2                     show                                          */
/*2                       display only                                */
/*2                     save                                          */
/*2                       to "mail.txt" in the dest. path             */
/*2                     name                                          */
/*2                        ( cbt006.xmi ==> cbt006.mail.txt)          */
/*1                     *** not implemented yet ***                   */
/*2                                                                   */
/*1           --ispf    (KEYW) (show/save/[name])                     */
/*2                     how to process the ISPF statistics            */
/*2                     show                                          */
/*2                       display only                                */
/*2                     save                                          */
/*2                       to "ispf.txt" in the dest. path             */
/*2                     name                                          */
/*2                        ( cbt006.xmi ==> cbt006.ispf.txt)          */
/*1                     *** not implemented yet ***                   */
/*2                                                                   */
/*1           -M                                                      */
/*1           --member  (PARM) string                                 */
/*2                        members to extracted                       */
/*2                        the option can be repeated as needed       */
/*2                        can be  a simple pattern like pref*        */
/*1                     *** not implemented yet ***                   */
/*2                                                                   */
/*1           --dump    (FLAG)                                        */
/*2                        hex dump of the control and data records   */
/*2                     *** no extraction will take place ***         */
/*2                                                                   */
/*1           --info    (FLAG)                                        */
/*2                        display the INMRxx keys and values         */
/*2                     *** no extraction will take place ***         */
/*2                                                                   */
/*1           --list    (FLAG)                                        */
/*2                        only list the PDS members                  */
/*2                     *** no extraction will take place ***         */
/*2                                                                   */
/*--help:end                                                          */
Trace "O"
parse arg __stdargs
__stdargs = strip(__stdargs)
call      __setup

__strch   = "."; __arbfr = " -"; __arbto = "fffe"x
__optopts = "3;"__strch";"__arbfr";"__arbto
__optshrt = "h;M:"
__optlong = "help;" || ,
            ";auto;text;binary;update;suffix:;dest:" || ,
            ";mail:;ispf:;member:;dump;info;list;"
args = _getopt( __optopts, __optshrt, __optlong, __stdargs )
argc = words(args)
if   lower(left(args,5)) = "--err" then do
   call __log args
   exit
end

_mode_      = "auto"
_MODEsave_  = _mode_
_asis_      = "."
_ASISsave_  = _asis_
_suff_      = "."
_SUFFsave_   = _suff_

_dest_      = "name"
__DATAfile  = "data.txt"
__DATAsuff  = ".txt"
__TXTfile   = "data.txt"
__TXTsuff   = ".txt"
__BINfile   = "data.bin"
__BINsuff   = ".bin"


_mail_      = "name"
__MAILfile  = "mail.txt"
__MAILsuff  = ".mail.txt"

_ispf_      = "name"
__ISPFfile  = "ispf.txt"
__ISPFsuff  = ".ispf.txt"

_mbrs_      = ""

__dump      = 0
__info       = 0
__list      = 0
__extr      = 1

do iarg = 1 to argc while ( word(args,1) \= "--" )
   optchar = word(args,1); optarg  = word(args,2);

   if optchar = "-h" | ,
      optchar = "--help" then do
      call __hlp 2
      exit
   end

   if   optchar = "--auto" then do
      _mode_ = "auto"
      args   = delword(args, 1, 1)
      iterate iarg
   end
   if   optchar = "--text" then do
      _mode_ = "text"
      args   = delword(args, 1, 1)
      iterate iarg
   end
   if   optchar = "--binary" then do
      say "binary at getopt"
      _mode_ = "binary"
      args   = delword(args, 1, 1)
      iterate iarg
   end
   if   optchar = "--update" then do
      _mode_ = "update"
      args   = delword(args, 1, 1)
      iterate iarg
   end

   if   optchar = "--suffix" then do
      if   left(optarg,1) = "-" then do
         call __log  "getopt: option requires an argument : "optchar
         exit
      end
      _suff_ = lower(optarg)
      args   = delword(args, 1, 2)
      iterate iarg
   end

   if   optchar = "--junk" then do
      _dest_ = "junk"
      args   = delword(args, 1, 1)
      iterate iarg
   end

   if   optchar = "--dest" then do
      if   left(optarg,1) = "-" then do
         call __log  "getopt: option requires an argument : "optchar
         exit
      end
      _dest_   = lower(optarg)
      args   = delword(args, 1, 2)
      iterate iarg
   end

   if   optchar = "--mail" then do
      if   left(optarg,1) = "-" then do
         _mail_ = "name"
         args   = delword(args, 1, 1)
         iterate iarg
      end
      _mail_ = lower(optarg)
      if wordpos(_mail_,"show save name") = 0 then do
         call __log  "invalid mail option '"_mail_"' (show/save/name)"
         exit
      end
      args   = delword(args, 1, 2)
      iterate iarg
   end

   if   optchar = "--ispf" then do
      if   left(optarg,1) = "-" then do
         _ispf_ = "name"
         args   = delword(args, 1, 1)
         iterate iarg
      end
      _ispf_ = optarg
      if wordpos(_ispf_,"show save name") = 0 then do
         call __log  "invalid ispf option '"_ispf_"' (show/save/name)"
         exit
      end
      args   = delword(args, 1, 2)
      iterate iarg
   end

   if   optchar = "-M" | ,
      optchar = "--member" then do
      if   left(optarg,1) = "-" then do
         call __log  "getopt: option requires an argument : "optchar
         exit
      end
      _mbrs_ = _mbrs_ || " " || lower(optarg)
      args   = delword(args, 1, 2)
      iterate iarg
   end

   if   optchar = "--dump" then do
      __dump   = 1
      __extr   = 0
      args   = delword(args, 1, 1)
      iterate iarg
   end

   if  optchar = "--info" then do
      __info   = 1
      __extr   = 0
      args   = delword(args, 1, 1)
      iterate iarg
   end

   if   optchar = "--list" then do
      __list    = 1
      __extr   = 0
      args   = delword(args, 1, 1)
      iterate iarg
   end
   call __log "****************************"
   call __log "Should not occur args      >"args"<"
   call __log "Should not occur argc      >"argc"<"
   call __log "Should not occur iarg      >"iarg"<"
   call __log "Should not occur optchar   >"optchar"<"
   call __log "Should not occur optarg    >"optarg"<"
   call __log "****************************"
   exit
end
args = space(delword(args, 1, 1))
argc = words(args)

/* --mode     _mode_ */
_asis_ = word(". 0 1 1"   ,wordpos(_mode_,"auto text binary update"))

/* --suffix   _suff_ */
if   _suff_ \= "." then do
   if   _mode_  = "auto" then do
      call __log  "suffix '"_suff_"' conflicts with mode '"_mode_"' "
      exit
   end
   else ,
      _suff_ = "." || lower(strip(_suff_,,"."))
end
else ,
   _suff_ = word(".    .txt .bin xxx",wordpos(_mode_,"auto text binary update"))

if   argc = 0 then do
   call __log  "need an argument! "
   call __hlp 1
   exit
end

args = _nodups(args)
argc = words(args)

call __log _align("Started") __sdate __stime

if   __dump then ,
   call __log  "'--dump' specified, all other options will be ignored"
else ,
if   __info then ,
   call __log  "'--info' specified, all other options will be ignored"
else ,
if   __list then ,
   call __log  "'--list' specified, all other options will be ignored"

__XMIheadr   = "E0C9D5D4D9F0F1"x
__POEheadr  = "01CA6D0F"x
__PDSheadr  = "00CA6D0F"x
__R1offset   = 2
__R2offset   = 12

__ESDheadr   = "02C5E2C4"x
__TXTheadr   = "02E3E7E3"x
__RLDheadr_ = "02D9D3C4"x
__ENDheadr  = "02C5D5C4"x

__TXTsuffx   = ".txt"
__BINsuffx   = ".bin"
__XMIsuffx   = ".xmi"
__OBJsuffx   = ".obj"

_MODEsave_  = _mode_
_ASISsave_  = _asis_
_SUFFsave_   = _suff_

do iarg = 1 to argc

   _mode_   = _MODEsave_
   _asis_   = _ASISsave_
   _suff_   = _SUFFsave_

   sysut1 = strip(word(args,iarg))
   if   pos(".",sysut1) = 0 then ,
      sysut1 = sysut1 || ".xmi"
   p = lastpos(__PSEP__,sysut1)
   interpret "parse var sysut1 with 1 xpath1 "p" . "p+1" xfile1"
   parse var xfile1  xname1 "." .
   if   \exists(sysut1) then do
      call __log _align("file not found") "'"sysut1"'"
      iterate iarg
   end
   if   \open(sysut1,"rb") then do
      call __log _align("error opening") "'"sysut1"'"
      iterate iarg
   end

   header = charin(sysut1,2,7)
   call close sysut1
   if header \= __XMIheadr then do
      call __log _align("not a valid XMIT file") "'"sysut1"'"
      iterate iarg
   end
   if   \open(sysut1,"r") then do
      call __log _align("error on 2nd open of") "'"sysut1"'"
      iterate iarg
   end

   call __log
   call __log _align("processing") || "'"sysut1"'"

   call    inminit

   __init    = 0
   __open    = 0
   __skip   = 0

   xfseq      = 0
   sysut2   = ""

   __HAVEpath   = 0
   path      = ""

   do   iget = 1 while ( chars(sysut1) > 0 )
      xbuff = xfget(sysut1)
      xflag = substr(xbuff,1,1)

      if '20'x = bitand(xflag,'20'x) then do
         __open   = 0
         __init   = 0
         if sysut2 \= "" then do
            call close sysut2
            call __log _align(member)"records("right(recds2,8)") file("sysut2")"
            __open = 0
            member = ""
            sysut2 = ""
            recds2 = 0
         end

         if   __dump then do
            call _EBCdmp xbuff
            iterate iget
         end

         xtype = __e2a(substr(xbuff, 2, 6))
         if   xtype    = "INMR01" then do
            inmr01c   = inmr01c + 1
            i      = inmr01c
            list    = ""
            xbuff   = substr(xbuff, 8 )
            call    process_INMR01_03
            iterate iget
         end
         else ,
         if xtype    = "INMR02" then do
            inmr02c   = inmr02c + 1
            i      = inmr02c
            inmr02.i.inmfseq = c2d(substr(xbuff, 8, 4))
            list   = "INMR02." || i || ".inmfseq"
            xbuff   = substr(xbuff,12)
            call    process_INMR01_03
            if   inmr02.i.inmdsorg = "?" then do
               call __log  _align(" ") || ": dsorg '"c2x(dsorg)"' not supp."
               __skip = 1
            end
            if   inmr02.i.inmrecfm = "?" then do
               call __log _align(" ") || ": recfm '"c2x(recfm)"' not supp."
               __skip = 1
            end
            iterate iget
         end
         else ,
         if   xtype   = "INMR03" then do
            xfseq   = xfseq + 1
            if   xfseq \= INMR02.xfseq.inmfseq then ,
               signal logic_error
            __init    = 0
            __open    = 0
            recds2   = 0
            if __extr then ,
            if   __HAVEpath   = 0 then do
               do   i = 1 to inmr02c
                  if   symbol("INMR02."i."inmdsnam") = "VAR" then do
                     rname = inmr02.i.inmdsnam
--                     if   inmr02.i.inmrecfm = "V" & ,
--                     inmr02.i.inmdsorg = "PO" then do
                     if   inmr02.i.inmrecfm = "V" then do
                        _mode_ = "text"
                        _ASISsave_  = 0
                        _asis_ = 0
                        _suff_ = __TXTsuffx
                        call __log "text mode forced for 'RECFM=V' dataset" rname
                     end
                     if   _dest_ = "junk" then ,
                        path = ""
                     else ,
                     if   _dest_ = "name" then ,
                        path = xname1
                     else ,
                        path = _dest_
                     if   \__skip &,
                        path \= "" then do
                        path = strip(path,"T",__PSEP__)
                        if   __UNIX__ then do
                           "mkdir -p    '"path"' "
                        end
                        else ,
                           "mkdir       " path
                        path = path || __PSEP__
                     end
                     __HAVEpath   = 1
                     leave i
                  end
               end
            end

            inmr03c   = inmr03c + 1
            i      = inmr03c
            list    = ""
            xbuff   = substr(xbuff, 8 )
            call    process_INMR01_03
            iterate iget
         end

         call process_INMR04_08

         if   xtype = "INMR06" then ,
            leave iget

         iterate iget
      end

      if   __dump then
         call _EBCdmp xbuff

      if   __dump | ,
         __info then ,
         iterate iget

      if   __skip then ,
         iterate iget

      if   \__init then ,
         call xinit

      if   __skip then ,
         iterate iget

      if   \__open then ,
         call xopen

      if   __skip then ,
         iterate iget

      call xfput

   end

   call close sysut1

end

__edate = date()
__etime = time()
__elaps = time("E")
parse var __elaps secs "." usec
call __log
call __log _align("ended") __etime" elapsed :" secs%60":"secs//60"."usec

exit

logic_error:
call __log  "*********************************"
call __log  "**                             **"
call __log  "** logic error ** at line " || right(sigl,4) || " **"
call __log  "**                             **"
call __log  "*********************************"
exit

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*                                                                    */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
inminit:
   drop   inmr01.
   drop   inmr02.
   drop   inmr03.
   drop   inmr04.
   drop   inmr05.
   drop   inmr06.
   drop   inmr07.
   drop   inmr08.
   drop   __MBR__.
   drop   __SPF__.

   inmr01c = 0 ; inmr01.0 = 0 ;list01  = ""
   inmr02c = 0 ; inmr02.0 = 0 ;list02  = ""
   inmr03c = 0 ; inmr03.0 = 0 ;list03  = ""
   inmr04c = 0 ; inmr04.0 = 0 ;list04  = ""
   inmr05c = 0 ; inmr05.0 = 0 ;list05  = ""
   inmr06c = 0 ; inmr06.0 = 0 ;list06  = ""
   inmr07c = 0 ; inmr07.0 = 0 ;list07  = ""
   inmr08c = 0 ; inmr08.0 = 0 ;list08  = ""

   inmtokn.1  = '0001'x; inmname.1  = "inmddnam"; inmconv.1   = "c";
   inmtokn.2  = '0002'x; inmname.2  = "inmdsnam"; inmconv.2   = "c";
   inmtokn.3  = '0003'x; inmname.3  = "inmmembr"; inmconv.3   = "c";
   inmtokn.4  = '000B'x; inmname.4  = "inmsecnd"; inmconv.4   = "d";
   inmtokn.5  = '000C'x; inmname.5  = "inmdir"  ; inmconv.5   = "d";
   inmtokn.6  = '0022'x; inmname.6  = "inmexpdt"; inmconv.6   = "c";
   inmtokn.7  = '0028'x; inmname.7  = "inmterm" ; inmconv.7   = "c";
   inmtokn.8  = '0030'x; inmname.8  = "inmblksz"; inmconv.8   = "d";
   inmtokn.9  = '003C'x; inmname.9  = "inmdsorg"; inmconv.9   = "x";
   inmtokn.10 = '0042'x; inmname.10 = "inmlrecl"; inmconv.10  = "d";
   inmtokn.11 = '0049'x; inmname.11 = "inmrecfm"; inmconv.11  = "x";
   inmtokn.12 = '1001'x; inmname.12 = "inmtnode"; inmconv.12  = "c";
   inmtokn.13 = '1002'x; inmname.13 = "inmtuid" ; inmconv.13  = "c";
   inmtokn.14 = '1011'x; inmname.14 = "inmfnode"; inmconv.14  = "c";
   inmtokn.15 = '1012'x; inmname.15 = "inmfuid" ; inmconv.15  = "c";
   inmtokn.16 = '1020'x; inmname.16 = "inmlref" ; inmconv.16  = "c";
   inmtokn.17 = '1021'x; inmname.17 = "inmlchg" ; inmconv.17  = "c";
   inmtokn.18 = '1022'x; inmname.18 = "inmcreat"; inmconv.18  = "c";
   inmtokn.19 = '1023'x; inmname.19 = "inmfvers"; inmconv.19  = "c";
   inmtokn.20 = '1024'x; inmname.20 = "inmftime"; inmconv.20  = "c";
   inmtokn.21 = '1025'x; inmname.21 = "inmttime"; inmconv.21  = "c";
   inmtokn.22 = '1026'x; inmname.22 = "inmfack" ; inmconv.22  = "c";
   inmtokn.23 = '1027'x; inmname.23 = "inmerrcd"; inmconv.23  = "c";
   inmtokn.24 = '1028'x; inmname.24 = "inmutiln"; inmconv.24  = "c";
   inmtokn.25 = '1029'x; inmname.25 = "inmuserp"; inmconv.25  = "c";
   inmtokn.26 = '102A'x; inmname.26 = "inmrecct"; inmconv.26  = "c";
   inmtokn.27 = '102C'x; inmname.27 = "inmsize" ; inmconv.27  = "d";
   inmtokn.28 = '102F'x; inmname.28 = "inmnumf" ; inmconv.28  = "d";
   inmtokn.29 = '8012'x; inmname.29 = "inmtype" ; inmconv.29  = "x";

   inmkeys      = 29

   inmdsnam_   = '0002'x
   inmdsorg_   = '003C'x
   inmrecfm_   = '0049'x

   inmutiln_   = '1028'x

   return

return -99

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*                                                                    */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
xfget:
   bleng = charin(sysut1,,1)
   bflag = charin(sysut1,,1)
   buffr = bflag || Charin(sysut1,,c2d(bleng)-2)

   do  while '00'x = Bitand(bflag,'40'x)
      bleng = charin(sysut1,,1)
      bflag = charin(sysut1,,1)
      buffr = buffr || Charin(sysut1,,c2d(bleng)-2)
   end
   return buffr
return -99

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*                                                                    */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
process_INMR04_08:
   if __info then do
      call __log  copies("- ",30)
      call __log  xtype
   end
   return
return -99

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*                                                                    */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
process_INMR01_03:
   do while ( length(xbuff)  > 0 )
      next = inmkey(xbuff)
      nfnd = 1
      select
         when tokn = inmdsorg_ then do
            dsorg = substr(value.1,1,1)
            if dsorg = '02'x then ,
               call value xtype"."i".inmdsorg" , "PO"
            else ,
            if dsorg = '40'x then ,
               call value xtype"."i".inmdsorg" , "PS"
            else ,
               call value xtype"."i".inmdsorg" , "?"
            list = strip(list) || " " || xtype"."i".inmdsorg"
            nfnd = 0
         end

         when tokn = inmrecfm_ then do
            recfm = substr(value.1,1,1)
            if   bitand(recfm,'C0'x) = 'C0'x then ,
               call value xtype"."i".inmrecfm" , "?"
            else ,
            if   bitand(recfm,'80'x) = '80'x then ,
               call value xtype"."i".inmrecfm" , "F"
             else ,
            if   bitand(recfm,'40'x) = '40'x then ,
               call value xtype"."i".inmrecfm" , "V"
            else ,
               call value xtype"."i".inmrecfm" , "?"
            list = strip(list) || " " || xtype"."i".inmrecfm"
            nfnd = 0
         end

         when tokn = inmdsnam_ then do
            dsnam =  __e2a(value.1)
            do   v = 2 to value.0
               dsnam =   dsnam || "." || __e2a(value.v)
            end
            dsnam   = lower(dsnam)
            call value xtype"."i".inmdsnam", dsnam
            list = strip(list) || " " || xtype"."i".inmdsnam"
            nfnd = 0
         end

         otherwise ,
            do   k = 1 to inmkeys
               if   tokn = inmtokn.k then do
                  nfnd = 0
                  knam  = xtype"."i"."inmname.k
                  list  = strip(list) || " " || knam
                  if   value.0 = 0 then ,
                     kval = ""
                  else,
                  if    inmconv.k = "d" then ,
                     kval = c2d(value.1)
                  else ,
                  if   inmconv.k = "x" then ,
                     kval = c2x(value.1)
                  else ,
                     kval = __e2a(value.1)
                  interpret knam "= '"kval"'"
                  leave
               end
            end
      end
      if nfnd then ,
         call __log xtype "unsupported key" c2x(substr(xbuff, 3+1,16))

      xbuff = substr(xbuff,next)
   end

   if __info then do
      call __log  copies("- ",30)
      call __log  xtype i
      do v = 1 to words(list)
         knam = word(list,v)
         kval = value(word(list,v))
          call __log  left(knam,20) || "=" kval
      end
   end
   return

return -99

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*                                                                    */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
inmkey:
   tokn   = substr(xbuff,1  ,2)
   coun    = c2d(substr(xbuff,1+2,2))
   value.0 = coun
   wptr   = 5
   do    v = 1 to coun
      wlen    = c2d(substr(xbuff,wptr  ,2))
        value.v =     substr(xbuff,wptr+2,wlen)
        wptr    = wptr + wlen + 2
   end
   return wptr
return -99

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*                                                                    */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
_EBCdmp:
    parse      arg EBC_buffr
   EBC_fillr   = copies(" ",7)
   EBC_delta   = 1
   say EBC_fillr || ">>" || copies("1234567890",8) || "<<"
   do  while ( EBC_buffr \= "" )
      parse var EBC_buffr with 1 EBC_chunk 81 EBC_buffr
      say left(right(EBC_delta,6),7) || ">>" || __e2a(EBC_chunk) || "<<"
      EBC_chunk = c2x(EBC_chunk)
      EBC_line0 = ""
      EBC_line1 = ""
      do   i = 1 to length(EBC_chunk) - 1 by 2
         EBC_line0 = EBC_line0 || substr(EBC_chunk, i    , 1 )
         EBC_line1 = EBC_line1 || substr(EBC_chunk, i + 1, 1 )
      end
      say EBC_fillr || ">>" || EBC_line0 || "<<"
      say EBC_fillr || ">>" || EBC_line1 || "<<"
      say
      EBC_delta = EBC_delta + 80
   end
   return
return -99

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*                                                                    */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
xinit:
   __init   = 1
   if   inmr02.xfseq.inmutiln = "INMCOPY" then do
      if   inmr02.xfseq.inmdsorg \= "PS" then do
         call __log  "xinit: mismatched utilid:" xfseq inmr02.xfseq.inmutiln
         call __log  "                  dsorg :" xfseq inmr02.xfseq.inmdsorg
         __skip = 1
         return
      end
      return
   end
   else ,
   if   inmr02.xfseq.inmutiln = "IEBCOPY" then do
      if   inmr02.xfseq.inmdsorg \= "PO" then do
         call __log  "xinit: mismatched utilid:" xfseq inmr02.xfseq.inmutiln
         call __log  "                  dsorg :" xfseq inmr02.xfseq.inmdsorg
         __skip = 1
         return
      end
      /* IEBCOPY first control record */
      __R1offset = 2
      if   ( substr(xbuff, __R1offset, 4) \= __PDSheadr ) then do
         call __log  "xinit: header (expected) '"upper(c2x(__PDSheadr))"'x "
         call __log  "xinit:       (found)    '"upper(c2x(substr(xbuff,__R1offset,4)))"'x "
         __skip = 1
         return
      end
      r1dsorg  = c2x(substr(xbuff, __R1offset+4 ,2))
      r1blksz  = c2d(substr(xbuff, __R1offset+6 ,2))
      r1lrecl  = c2d(substr(xbuff, __R1offset+8 ,2))
      LRECL    = c2d(substr(xbuff, __R1offset+8 ,2))
      r1recfm  = c2x(substr(xbuff, __R1offset+10,2))
      r1tblksz = c2x(substr(xbuff, __R1offset+14,2))
      r1devtyp = c2x(substr(xbuff, __R1offset+16,20))
      TRKSXCYL = c2d(substr(xbuff, __R1offset+26,2))

      /* get a data buffer for the next stage */
      xbuff   = xfget(sysut1)

      /* IEBCOPY secnd control record */
      __R2offset    = 2
      deb_ptr      = __R2offset
      deb_count   = c2d(substr(xbuff, deb_ptr, 1))
      deb_reltrk   = 0
      do  i = 1 to deb_count
         deb_ptr      = deb_ptr + 16
         deb_start   = c2d(substr(xbuff, deb_ptr+6 ,2)) * trksxcyl  + ,
                       c2d(substr(xbuff, deb_ptr+8 ,2))
         deb_end      = c2d(substr(xbuff, deb_ptr+10,2)) * trksxcyl  + ,
                       c2d(substr(xbuff, deb_ptr+12,2))
         deb_trks      = c2d(substr(xbuff, deb_ptr+14,2))

         deb_size   = deb_end   - deb_start + 1

         if   deb_size \= deb_trks then do
            call __log "shit oh shit oh debshit"
            exit
         end

         deb_tabl.i.1   = deb_start
         deb_tabl.i.2   = deb_end
         deb_tabl.i.3   = deb_reltrk
         deb_tabl.i.4   = deb_reltrk + deb_trks
         deb_reltrk      = deb_reltrk + deb_trks
      end
      deb_tabl.0 = deb_count

      /* get a data buffer for the next stage */

      /* IEBCOPY directory control records */
      __R3offset    = 2

      /* Process PDS directory */
      do   dir = 1
         xbuff = xfget(sysut1)
         xbuff = substr(xbuff,__R3offset)
         do while (xbuff \= "")
            len = c2d(substr(xbuff,21,2))
            parse var xbuff 1 key 23 blk 277 xbuff

            do ent = 1 while ( blk \= "" )
               if   length(blk) < 12 then ,
                  leave ent
               if   substr(blk,1,8) = "ffffffffffffffff"x then ,
                  leave dir
               ttr   =  lower(c2x(substr(blk, 9,3)))
               flg   =     bitand(substr(blk,12,1),'80'x)
               udl   = c2d(bitand(substr(blk,12,1),'1F'x))

               if   flg = '00'x then do
                  __MBR__.ttr = strip(__e2a(substr(blk,1,8)))
                  if    udl > 99 then do
                     __SPF__.ttr = substr(blk,13,(udl * 2))
                     say left(__MBR__.ttr,8) _spfstats(substr(blk,13,(udl * 2)))
                  end
               end

               len = 12 + udl * 2
               blk = substr(blk,len + 1)
            end
         end
      end

      /* get a data buffer for the next stage */
      xbuff = xfget(sysut1)
      return 0
   end
   else do
      call __log  "xinit: invalid utilid   :" xfseq inmr02.xfseq.inmutiln
      __skip = 1
      return
   end

return -99

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*                                                                    */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
xopen:
   member = ""
   sysut2 = ""
   if   inmr02.xfseq.inmutiln = "INMCOPY" then do
      if   symbol("inmr02."xfseq".inmterm") = "VAR" then do
         if   _mail_ = "save" then ,
            sysut2 = lower( path || __MAILfile)
         else ,
         if   _mail_ = "name" then ,
            sysut2 = lower(xname1 || __MAILsuff)
         else ,
            return
      end
      else do
         sysut2 = lower(path || __TXTfile)
         if _asis_ then ,
            sysut2 = lower(path || __BINfile)
      end
      if   __extr then do
         if   \open(sysut2,"wr") then do
            call __log _align("error opening") "'"sysut2"'"
            call __log _align(" ")  "* * * TERMINATING * * *"
            exit
         end
      end
      recds2   = 0
      __open = 1
      return
   end
   else,
   if   inmr02.xfseq.inmutiln = "IEBCOPY" then do

      /* MEMBER control data */

      __R4offset    = 2

      r4mbrcc   = c2d(substr(xbuff, __R4offset+4,2))
      r4mbrhh = c2d(substr(xbuff, __R4offset+6,2))
      r4mbrr  = c2x(substr(xbuff, __R4offset+8,1))
      trk     = r4mbrcc * TRKSXCYL  + r4mbrhh

      do   i = 1 to deb_tabl.0
         if ( trk >= deb_tabl.i.1 ) & ( trk <= deb_tabl.i.2 ) then ,
            leave
      end

      ttr     = lower(right(d2x(trk - deb_tabl.i.1 + deb_tabl.i.3),4,'0') || r4mbrr)
      member = lower(strip(__MBR__.ttr))
      __open = 1
      return
   end
   else ,
      signal logic_error

return -99

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*                                                                    */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
xfput:
   if   inmr02.xfseq.inmutiln = "INMCOPY" then do
      if   __extr then do
         if _asis_ then ,
            call charout sysut2, substr(xbuff,2)
         else ,
            call lineout sysut2, __e2a(substr(xbuff,2))
      end
      recds2 = recds2 + 1
      return
   end
   else ,
   if   inmr02.xfseq.inmutiln = "IEBCOPY" then do
      xoffs = 2
      if    inmr02.xfseq.inmrecfm = "F" then do
         do while xoffs < length(xbuff)
            blksz = c2d(substr(xbuff,xoffs+10,2))
            if blksz = 0 then do
               if   __extr & ,
                   sysut2 \= "" then ,
                  call close sysut2
               call __log _align(member)"records("right(recds2,8)") file("sysut2")"
               __open = 0
               member = ""
               sysut2 = ""
               recds2 = 0
               leave
            end

            xoffs = xoffs + 12
            do    blksz % LRECL
               if __extr then do
                  if  sysut2 = "" then do
                     if _mode_ = "auto" then do
                        if   substr(xbuff,xoffs+1,7) = __XMIheadr then do
                           _suff_ = __XMIsuffx
                           _asis_ = 1
                        end
                        else ,
                        if   substr(xbuff,xoffs,4) = __ESDheadr | ,
                           substr(xbuff,xoffs,4) = __TXTheadr | ,
                           substr(xbuff,xoffs,4) = __RLDheadr then do
                           _suff_ = __OBJsuffx
                           _asis_ = 1
                        end
                        else do
                           _suff_ = __TXTsuffx
                           _asis_ = 0
                        end
                     end
                     sysut2 = lower(path || member || _suff_)

                     if   \open(sysut2,"wr") then do
                        call __log _align("error opening") "'"sysut2"'" "for("member") "
                        call __log   "* * * TERMINATING * * *"
                        exit
                     end
                     recds2  = 0
                  end
                  if _asis_ then ,
                     call charout sysut2, substr(xbuff,xoffs,LRECL)
                  else ,
                     call lineout sysut2, __e2a(substr(xbuff,xoffs,LRECL))
               end
               recds2  = recds2  + 1
               xoffs = xoffs + LRECL
            end
         end
         return 0
      end
      else ,
      if inmr02.xfseq.inmrecfm = "V" then do
         do while xoffs < length(xbuff)
            blksz = c2d(substr(xbuff,xoffs+10,2))
            if blksz = 0 then do
               if   __extr& ,
                   sysut2 \= "" then ,
                  call close sysut2
               call __log _align(member)"records("right(recds2,8)") file("sysut2")"
               __open = 0
               member = ""
               sysut2 = ""
               recds2 = 0
               leave
            end

            xoffs    = xoffs + 12
            r3limit = xoffs + c2d(substr(xbuff,xoffs,2))
            xoffs    = xoffs + 4
            do while ( xoffs < r3limit)
               LRECL = c2d(substr(xbuff,xoffs,2))
               if   __extr then do
                  if  sysut2 = "" then do
                     sysut2 = lower(path || member || _suff_)
                     if   \open(sysut2,"wr") then do
                        call __log   "error opening :"sysut2 "for :"member
                        call __log   "* * * TERMINATING * * *"
                        exit
                     end
                     recds2  = 0
                  end
                  call lineout sysut2, __e2a(substr(xbuff,xoffs+4,LRECL-4))
               end
               recds2  = recds2  + 1
               xoffs = xoffs + LRECL
            end
         end
         return 0
      end
      else ,
         signal logic_error
   end
   else ,
      signal logic_error

return -99


-- included  /Users/enrico/include/__setup.rxh
__setup:
   __sdate   = date()
   __stime   = time()
   __elaps   = time("E")
   __error   = 0
   __abort   = 0
   __debug   = 0
   __trace   = 0

   parse version _?version
   parse var _?version __RXvers "_" .

   parse source  _?source
   parse lower var _?source _?opsys _?envir _?commnd .
   if   abbrev(_?opsys,"windows") then do
      __PSEP__   = "\"
      __UNIX__   = 0
   end
   else do
      __PSEP__   = "/"
      __UNIX__   = 1
   end

   __MYself = filespec("n",_?commnd)
   parse   var __MYself  __MYself "." .

   return

return -99

-- included  /Users/enrico/include/__utils.rxh
_nodups:procedure
   parse arg dups
   args = ""
   do   i = 1 to words(dups)
      argw = word(dups,i)
      if   wordpos(argw,args) > 0 then ,
         iterate
      args = args argw
   end
   return space(args)
return -99

_align:
   return left(arg(1),15)

-- included  /Users/enrico/include/__cmpat.rxh
exists:
   if __RXvers = "REXX-ooRexx" then do
      if SysIsFile(arg(1)) then return 1
      if SysIsFileDirectory(arg(1)) then return 1
      return 0
   end
   else ,
   if __RXvers = "REXX-Regina" then do
      if stream(arg(1), "c", "query exists") \= "" then return 1
      return 0
   end
   else ,
      return 0
return -99

isFile:
   if __RXvers = "REXX-ooRexx" then do
      if SysIsFile(arg(1)) then return 1
      return 0
   end
   else ,
   if __RXvers = "REXX-Regina" then do
      _?fstat = stream(arg(1), "c", "fstat")
      if wordpos("RegularFile",_?fstat) > 0 then return 1
      return 0
   end
   else ,
      return 0
return -99

isPath:
   if __RXvers = "REXX-ooRexx" then do
      if SysIsFileDirectory(arg(1)) then return 1
      return 0
   end
   else ,
   if __RXvers = "REXX-Regina" then do
      _?fstat = stream(arg(1), "c", "fstat")
      if wordpos("Directory",_?fstat) > 0 then return 1
      return 0
   end
   else ,
      return 0
return -99

open:
   if arg() < 2 then ,
      return 0
   if lower(arg(2)) = "r" then ,
      _?parms = " open read "
   else ,
   if lower(arg(2)) = "rb" then ,
      _?parms = " open read binary"
   else ,
    if   lower(arg(2)) = "w" then ,
      _?parms = " open write"
   else ,
    if   lower(arg(2)) = "wr" then ,
      _?parms = " open write replace"
   else ,
      return 0
   if arg() = 3 then do
      if \datatype(arg(3),"n") then ,
         return 0
      _?parms = _?parms || " reclenght " arg(3)
   end
   return ( stream(arg(1),"c", _?parms) = "READY:" )
return -99

close:
   _?parms = " close"
   return ( stream(arg(1),"c", _?parms) = "READY:" )
return -99

getenv:
   return VALUE(arg(1),,"ENVIRONMENT")
return -99

setenv:
   call VALUE arg(1),arg(2),"ENVIRONMENT"
   return 0
return -99

unsetenv:
   if __RXvers = "REXX-Regina" then ,
      return -1
   if __RXvers = "REXX-ooRexx" then do
      call VALUE arg(1), .NIL, "ENVIRONMENT"
      return 0
   end
   else ,
      return -1
return -99

-- included  /Users/enrico/include/__log.rxh
__log:
   __syslog = ""
   if arg() = 1 then ,
      call lineout __syslog, left(__MYself, 10) || "- " || strip(arg(1),"T")
   else ,
      call lineout __syslog, ""
   return
return -99

-- included  /Users/enrico/include/__hlp.rxh
__hlp:
   HLP_mode = arg(1)
   HLP_flag = 0
   do   i = 1 to sourceline()
      HLP_line = sourceline(i)
      if   strip(HLP_line) = "" then ,
         iterate
      HLP_line = strip(strip(strip(HLP_line),,"/"),,"*")
      if   strip(HLP_line) = "--help:end" then ,
         leave
      if   strip(HLP_line) = "--help:start" then do
         HLP_flag = 1
         iterate i
      end
      if   \HLP_flag then ,
         iterate i
      parse var HLP_line with 1 HLP_levl 2 HLP_line
      if   HLP_levl > HLP_mode then ,
         iterate
      call __log strip(HLP_line,"T")
   end
   exit 0
return -99

-- included  /Users/enrico/include/__a2p.rxh
__a2p:procedure
   return translate(arg(1), ,
   /*0*/ "................" || ,
   /*1*/ "................" || ,
   /*2*/ "202122232425262728292a2b2c2d2e2f"x || ,
   /*3*/ "303132333435363738393a3b3c3d3e3f"x || ,
   /*4*/ "404142434445464748494a4b4c4d4e4f"x || ,
   /*5*/ "505152535455565758595a5b5c5d5e5f"x || ,
   /*6*/ "606162636465666768696a6b6c6d6e6f"x || ,
   /*7*/ "707172737475767778797a7b7c7d7e7f"x || ,
   /*8*/ "................" || ,
   /*9*/ "................" || ,
   /*a*/ "................" || ,
   /*b*/ "................" || ,
   /*c*/ "................" || ,
   /*d*/ "................" || ,
   /*e*/ "................" || ,
   /*f*/ "................" )
   /*     0123456789abcdef*/
return -99

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* E2A simple EBCdic to ascii for printable                          */
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
__e2a:
                            /*0123456789abcdef*/
   return translate(arg(1), ,
               /*0*/    "................" || ,
               /*1*/    "................" || ,   
               /*2*/    "................" || ,   
               /*3*/    "................" || ,   
               /*4*/    " ...........<(+." || ,
               /*5*/    "&.........!$*);." || ,   
               /*6*/    "-/.........,%_>?" || ,   
               /*7*/    "..........:#@" || "'" || '="' || ,
               /*8*/    ".abcdefghi......" || ,
               /*9*/    ".jklmnopqr......" || ,
               /*a*/    "..stuvwxyz......" || ,
               /*b*/    "..........[]...." || ,
               /*c*/    "{ABCDEFGHI......" || ,
               /*d*/    "}JKLMNOPQR......" || ,
               /*e*/    "\.STUVWXYZ......" || ,
               /*f*/    "0123456789......" )
                            /*0123456789abcdef*/
return -99


-- included  /Users/enrico/include/__e2a.rxh
__e2a_dummy:procedure
   return translate(arg(1), ,
   "000102039C09867F978D8E0B0C0D0E0F"x || ,
   "101112139D0A08871819928F1C1D1E1F"x || ,
   "808182838485171B88898A8B8C050607"x || ,
   "909116939495960498999A9B14159E1A"x || ,
   "20A0E2E4E0E1E3E5E7F1A22E3C282B7C"x || ,
   "26E9EAEBE8EDEEEFECDF21242A293B5E"x || ,
   "2D2FC2C4C0C1C3C5C7D1A62C255F3E3F"x || ,
   "F8C9CACBC8CDCECFCC603A2340273D22"x || ,
   "D8616263646566676869ABBBF0FDFEB1"x || ,
   "B06A6B6C6D6E6F707172AABAE6B8C6A4"x || ,
   "B57E737475767778797AA1BFD05BDEAE"x || ,
   "ACA3A5B7A9A7B6BCBDBEDDA8AF5DB4D7"x || ,
   "7B414243444546474849ADF4F6F2F3F5"x || ,
   "7D4A4B4C4D4E4F505152B9FBFCF9FAFF"x || ,
   "5CF7535455565758595AB2D4D6D2D3D5"x || ,
   "30313233343536373839B3DBDCD9DA9F"x)
return -99

-- included  /Users/enrico/include/_getopt.rxh
_getopt:

   parse arg OPT_opts, OPT_shrt, OPT_long, OPT_args

   parse var OPT_opts OPT_abbr ";" OPT_strc ";" OPT_arbf ";" OPT_arbt

   /* fixing short options */
   OPT_shrt = translate(OPT_shrt," ",";")

   /* fixing long options */
   OPT_long = translate(OPT_long," ",";")

   /* fixing args for multi word parameters */
   if   OPT_strc \= "." then do
      f = 0
      do   i = 1 to length(OPT_args)
         if   substr(opt_args,i,1) = OPT_strc then ,
            f = 1 - f
         OPT_arbx = verify(OPT_arbf,substr(opt_args,i,1),"M")

         if   f & ,
            OPT_arbx > 0 then ,
            OPT_args = overlay(substr(OPT_arbt,OPT_arbx,1),OPT_args,i,1)

/*
            else ,
            if  substr(opt_args,i,1) = "-" then ,
               OPT_args = overlay("+",OPT_args,i,1)
*/
      end
   end

   /* fixing args for contiguous opt separators*/
   OPT_args = " " || OPT_args || " "
   OPT_argp = 1
   do   forever
      OPT_argp = pos("-", OPT_args, OPT_argp)
      if   OPT_argp = 0 then ,
         leave
      if   substr(OPT_args, OPT_argp-1, 1) \= " " &,
           substr(OPT_args, OPT_argp-1, 1) \= "-" then ,
         OPT_args = left(OPT_args,OPT_argp-1) || " " || substr(OPT_args,OPT_argp)
         OPT_argp = OPT_argp + 1
   end
   OPT_args = space(OPT_args)
   OPT_argc = words(OPT_args)

   OPT_newargs = ""
   OPT_newopts = ""

   OPT_argf = 0
   OPT_flush = 0
   do   OPT_iarg = 1 to OPT_argc
       OPT_tokn = word(OPT_args,OPT_iarg)

      if   OPT_flush then do
         OPT_newargs = OPT_newargs || " " || OPT_tokn
         iterate OPT_iarg
      end

      if   OPT_tokn = "--" then do
         OPT_flush = 1
         iterate OPT_iarg
      end

      if   left(OPT_tokn,2) = "--" then do
         OPT_argf = 0
         OPT_tokn = substr(OPT_tokn,3)
         OPT_fleq = ( pos("=",OPT_tokn) > 0 )
         parse var OPT_tokn OPT_wopt "=" OPT_warg
         OPT_nfnd = 1
         do   OPT_iopt = 1 to words(OPT_long) while(OPT_nfnd)
            if    abbrev(word(OPT_long,OPT_iopt),OPT_wopt,OPT_abbr) then do
               OPT_nfnd = 0
               OPT_newopts = OPT_newopts || " --" || strip(word(OPT_long,OPT_iopt),"t",":")
               leave OPT_iopt
            end
         end
         if   OPT_nfnd then ,
            return "--err invalid option : --"OPT_tokn
         if   \OPT_fleq then do
            OPT_argf = (right(word(OPT_long,OPT_iopt),1) = ":" )
            iterate OPT_iarg
         end
         if   OPT_warg = "" then ,
            return "--err invalid format : --"OPT_tokn
         OPT_newopts = OPT_newopts || " " || OPT_warg
         iterate OPT_iarg
      end

      if   left(OPT_tokn,1) = "-" then do
         OPT_argf = 0
         OPT_tokn = strip(substr(OPT_tokn,2))
         do   while OPT_tokn \= ""
            OPT_wopt = left(OPT_tokn,1)
            OPT_tokn = strip(substr(OPT_tokn,2))
            OPT_nfnd = 1
            do   OPT_iopt = 1 to words(OPT_shrt) while(OPT_nfnd)
               if    abbrev(word(OPT_shrt,OPT_iopt),OPT_wopt,1) then do
                  OPT_nfnd = 0
                  OPT_newopts = OPT_newopts || " -" || strip(word(OPT_shrt,OPT_iopt),"t",":")
                  leave OPT_iopt
               end
            end
            if   OPT_nfnd then ,
               return "--err invalid option : -"OPT_wopt
            OPT_argf = (right(word(OPT_shrt,OPT_iopt),1) = ":" )

            if    OPT_tokn = "" then ,
               iterate OPT_iarg

            if   OPT_argf then do
               OPT_newopts = OPT_newopts || " " || OPT_tokn
               OPT_argf = 0
               iterate OPT_iarg
            end

/*
            if   OPT_argf then ,
               return "--err invalid option sequence : -"OPT_wopt"/-"OPT_tokn
*/

         end

      end

      if   OPT_argf = 1 then do
         OPT_newopts = OPT_newopts || " " || OPT_tokn
         OPT_argf = 0
         iterate OPT_iarg
      end
      else do
         OPT_newargs = OPT_newargs || " " || OPT_tokn
         OPT_argf = 0
         iterate OPT_iarg
      end

   end

   OPT_result = space(OPT_newopts || " -- " || OPT_newargs)
   return OPT_result

return -99


-- included  /Users/enrico/include/_ebcdmp.rxh
_EBCdmp:
   parse arg EBC_buffr
   EBC_fillr = copies(" ",7)
   EBC_delta = 1
   say EBC_fillr || ">>" || copies("1234567890",8) || "<<"
   do  while ( EBC_buffr \= "" )
      parse var EBC_buffr with 1 EBC_chunk 81 EBC_buffr
      say left(right(EBC_delta,6),7) || ">>" || __e2a(EBC_chunk) || "<<"
      EBC_chunk = c2x(EBC_chunk)
      EBC_line0 = ""
      EBC_line1 = ""
      do   i = 1 to length(EBC_chunk) - 1 by 2
         EBC_line0 = EBC_line0 || substr(EBC_chunk, i    , 1 )
         EBC_line1 = EBC_line1 || substr(EBC_chunk, i + 1, 1 )
      end
      say EBC_fillr || ">>" || EBC_line0 || "<<"
      say EBC_fillr || ">>" || EBC_line1 || "<<"
      say
      EBC_delta = EBC_delta + 80
   end
   return
return -99


the script was power tested on ALL the CBT file, up to the lowest nesting level
( some CBT XMI files contain other XMITted files )
the script will ( ONLY for PDS ) check the first record
and determine the type and process accordingly

shortly I will post a cleaned up version, after many years of use most of the parameters are just plain useless
Back to top
View user's profile Send private message
PeterHolland

Global Moderator


Joined: 27 Oct 2009
Posts: 2481
Location: Netherlands, Amstelveen

PostPosted: Tue Sep 04, 2012 2:17 pm
Reply with quote

Enrico,

the TS was talking about .XMI and that is known format in the PC world, XML is not. Beside that just before your post is mentioned already the
manual that describes the Transmit/Receive reocrd lay-out.
Back to top
View user's profile Send private message
enrico-sorichetti

Superior Member


Joined: 14 Mar 2007
Posts: 10872
Location: italy

PostPosted: Tue Sep 04, 2012 2:26 pm
Reply with quote

Quote:
It is a pretty simple format.

mild disagreement icon_wink.gif
there are a few quirks on the headers and data record sequence

and the IEBCOPY and PDSE part is nowhere documented
Back to top
View user's profile Send private message
enrico-sorichetti

Superior Member


Joined: 14 Mar 2007
Posts: 10872
Location: italy

PostPosted: Tue Sep 04, 2012 2:34 pm
Reply with quote

Quote:
of a xmi file so it can be parsed in a user written program like REXX or SAS on mainframe.


why the need to parse it on the MF
insn' t enough the RECEIVE INDATASET ?
Back to top
View user's profile Send private message
vasanthz

Global Moderator


Joined: 28 Aug 2007
Posts: 1742
Location: Tirupur, India

PostPosted: Tue Sep 04, 2012 9:31 pm
Reply with quote

Hello,
Quote:
Why don't you create a file of that format on the mainframe and "browse" it?

I could give that a try and assume some logic from it, but it would only be my convenient assumption and may deviate from the actual standard :S
Quote:
z/OS TSO/E Customization SA22-7783-09

Thanks for this, I got the doc from www-05.ibm.com/e-business/linkweb/publications/servlet/pbi.wss?CTY=US&FNC=SRX&PBL=SA22-7783-03#

Enrico, Thank you for the complete code, looks GREAT.!! exactly what I was looking for.
I'm intimidated by the length/complexity of the code, So would take quite some time to get a hang of how things are handled in the program.
Quote:
why the need to parse it on the MF
insn' t enough the RECEIVE INDATASET ?

I mean no disrespect, but I would not like to disclose the reason for the requirement now. Will definitely post it here if all things work out as planned.

Thanks & Regards,
Back to top
View user's profile Send private message
dbzTHEdinosauer

Global Moderator


Joined: 20 Oct 2006
Posts: 6966
Location: porcelain throne

PostPosted: Tue Sep 04, 2012 9:44 pm
Reply with quote

Quote:
I mean no disrespect, but I would not like to disclose the reason for the requirement now.


Don't tell us, you are making a tool. icon_lol.gif
Back to top
View user's profile Send private message
vasanthz

Global Moderator


Joined: 28 Aug 2007
Posts: 1742
Location: Tirupur, India

PostPosted: Tue Sep 04, 2012 10:19 pm
Reply with quote

Quote:
Don't tell us, you are making a tool.

Im not talking :-)
Back to top
View user's profile Send private message
dick scherrer

Moderator Emeritus


Joined: 23 Nov 2006
Posts: 19244
Location: Inside the Matrix

PostPosted: Tue Sep 04, 2012 10:20 pm
Reply with quote

I suspect fighting a "fire" . . . icon_smile.gif

But we firefighters often use tools . . . icon_wink.gif

d
Back to top
View user's profile Send private message
vasanthz

Global Moderator


Joined: 28 Aug 2007
Posts: 1742
Location: Tirupur, India

PostPosted: Tue Sep 04, 2012 11:02 pm
Reply with quote

Here is me at work :-)
Back to top
View user's profile Send private message
enrico-sorichetti

Superior Member


Joined: 14 Mar 2007
Posts: 10872
Location: italy

PostPosted: Tue Sep 04, 2012 11:05 pm
Reply with quote

that link is pretty outdated,
at least one more key is present ( 8018) !

but sincerely processing on Your own an xmitted <thing> is really reinventing the wheel

and a waste of Your employer resources

I wrote the script when I started using linux and mac because xmitmgr was available only on windoze and even there it had some limitations

also beware that since the mainframe is EBCDIC most of the translate stuff will not be needed

also ...
remember answering is on our own time and free of charge
and since we are spending time helping the least You should do is to post the requirement from the beginning
so that we can judge the quality of the requirement and decide if to help or not to help

nuff said
Back to top
View user's profile Send private message
vasanthz

Global Moderator


Joined: 28 Aug 2007
Posts: 1742
Location: Tirupur, India

PostPosted: Tue Sep 04, 2012 11:17 pm
Reply with quote

Hello,
Quote:
waste of Your employer resources
Nope, I use my PC.

I was planning to write an android app to view xmi files as a hobby project.
I wanted to test out the logics using SAS since I am little familiar with SAS and then planned to convert it into Java for android.

I did not want to say it initially since I don't know if it was possible for me and show off without actually doing anything :S
Back to top
View user's profile Send private message
Nic Clouston

Global Moderator


Joined: 10 May 2007
Posts: 2455
Location: Hampshire, UK

PostPosted: Tue Sep 04, 2012 11:18 pm
Reply with quote

I think the solution is to get a smaller fire! icon_lol.gif
Back to top
View user's profile Send private message
prino

Senior Member


Joined: 07 Feb 2009
Posts: 1306
Location: Vilnius, Lithuania

PostPosted: Tue Sep 04, 2012 11:56 pm
Reply with quote

Try to make it a bit smaller than the unXmit monster...

FWIW, a Windows exe of just 39k is already available on the CBT site, with the full C source.
Back to top
View user's profile Send private message
enrico-sorichetti

Superior Member


Joined: 14 Mar 2007
Posts: 10872
Location: italy

PostPosted: Wed Sep 05, 2012 12:11 am
Reply with quote

rexx runs on android ( Regina ) icon_wink.gif

anyway I will post here the result of my last mods / simplifications / fixes
Back to top
View user's profile Send private message
enrico-sorichetti

Superior Member


Joined: 14 Mar 2007
Posts: 10872
Location: italy

PostPosted: Wed Sep 05, 2012 2:41 pm
Reply with quote

You can check also here

www.planetmvs.com/unxmit/

and ...
what happened when You googled for android xmit icon_wink.gif
You should have found
play.google.com/store/apps/details?id=de.roland.scholz.xmit&hl=en
Back to top
View user's profile Send private message
vasanthz

Global Moderator


Joined: 28 Aug 2007
Posts: 1742
Location: Tirupur, India

PostPosted: Wed Sep 05, 2012 11:09 pm
Reply with quote

Quote:
what happened when You googled for android xmit icon_wink.gif

Omg :-( It did not show up when I looked it up sometime back.
I was thrilled that im going to try something new related to mainframes, but someone already did it 3 months back.. bummer

anyway good its already there, installing it right away.

Thanks,
Is anyone aware of a good 3270 emulator for android - non commercial use? TN3270 paid version looks good but it has bad reviews(2.2 stars), so hesitant to buy it. ConnectBot, rove mobile admin and VXConnectBot apps only provide basic telnet connectivity.
Back to top
View user's profile Send private message
enrico-sorichetti

Superior Member


Joined: 14 Mar 2007
Posts: 10872
Location: italy

PostPosted: Tue Sep 11, 2012 10:31 pm
Reply with quote

here is a reviewed unxmit/receive

it supports
record format FIXED VARIABLE
file format SEQUENTIAL PDS PDSE

it extract the messages also

it check the file signatures
and it will not clobber the nested
IDTF files ( .xmi )
object decks
PDF
ZIP
WORD documents

beware tested only on MAC OS X
using OBJECT REXX

should work asis on linux
sorry(*) no docs
(*) to be politically correct,

the real dialog would go along the lines of ...
the end user: What shall I do without the docs ?
Me: Frankly, my dear, I don't give a damn. icon_wink.gif

here the two components
the rexx script

Code:
#!/usr/bin/rexx
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* Name : unxmit                                                              */
/* Copyright (c) 2012-2012 Enrico Sorichetti                                  */
/* All rights reserved.                                                       */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

Trace "O"
signal on novalue name novalue

parse source _src
parse lower var _src _sys _env _cmd .
_self = filespec("n",_cmd)
parse var _self _self "." .
.local~_self = _self

.local~_vers = "1.1.0"
.local~_cpyr = "Copyright (c) 2012-2012 Enrico Sorichetti"
.local~_cpyr = ""

havmode = 0;
mode = "auto"
asis = 0

havsuff = 0;
suff = ""

havproc = 0
repl = 0
info = 0
dump = 0
list = 0
extr = 1

skip = 0

havreal = 0
real = 0

mbrs = ""

parse arg _args
_args = space(_args) "ffffffff"x
_argc = words(_args)
iarg = 1
args = ""
do  while ( iarg < _argc )

    optc = word(_args, iarg); argv = word(_args, iarg+1)

    if  havmode = 0 & ,
        optc = "--auto" then do
        havmode = 1; mode = "auto";
        iarg += 1;
        iterate
    end
    if  havmode = 0 & ,
        optc = "--text" then do
        havmode = 1; mode = "text";
        iarg += 1;
        iterate
    end
    if  havmode = 0 & ,
        optc = "--binary" then do
        havmode = 1; mode = "binary";
        iarg += 1;
        iterate
    end

    if  havsuff = 0 & ,
        optc = "--suffix" then do
        if  argv = 'ffffffff'x | ,
            left(argv,1) = "-" then do
            call _log  "option : '"left(optc,12)"' requires an argument"
            exit
        end
        havsuff = 1
        suff = lower(argv)
        iarg += 2
        iterate
    end

    if  havproc = 0 & ,
        optc = "--repl" then do
        havproc = 1; repl = 1 ;
        iarg += 1
        iterate
    end
    if  havproc = 0 & ,
        optc = "--info" then do
        havproc = 1; info = 1; extr = 0;
        iarg += 1
        iterate
    end
    if  havproc = 0 & ,
        optc = "--dump" then do
        havproc = 1; dump = 1; extr = 0;
        iarg += 1
        iterate
    end
    if  havproc = 0 & ,
        optc = "--list" then do
        havproc = 1; list = 1; extr = 0;
        iarg += 1
        iterate
    end

    if  havreal = 0 & ,
        optc = "--real" then do
        havreal = 1; real = 1;
        iarg += 1
        iterate
    end

    if  optc = "-m" | ,
        optc = "--mbr" then do
        if  argv = 'ffffffff'x | ,
            left(argv,1) = "-" then do
            call _log  "option : '"left(optc,12)"' requires an argument"
            exit
        end
        mbrs = mbrs lower(argv)
        iarg += 2
        iterate
    end

    args = args optc
    iarg += 1

end

argc = words(args)

if  argc = 0 then do
    call _log  "need an argument (file to be UNXMITted)! "
    exit
end

call _Start
if   dump then ,
   call _log  "'--dump' specified, all other options will be ignored"
else ,
if   info then ,
   call _log  "'--info' specified, all other options will be ignored"
else ,
if   list then ,
   call _log  "'--list' specified, all other options will be ignored"

XMIheadr = "e0c9d5d4d9f0f1"x
XMIsuffx = ".xmi"
XMIsuff2 = ".xmit"

PDSheadr = "00ca6d0f"x
POEheadr = "01ca6d0f"x
R1offset = 2
R2offset = 2
R3offset = 2

PDoffset = 2
PSoffset = 2

inpf = ""
do iarg = 1 to argc
    if  inpf \= "" then ,
        call _close inpf

    argv = strip(word(args,iarg))
    inpf = argv
    if  \_isFile(inpf) then do
        inpf = argv || XMIsuffx
        if  \_isFile(inpf) then do
            inpf = argv || XMIsuff2
            if  \_isFile(inpf) then do
                call _log "file not found      : '"argv"'"
                iterate iarg
            end
        end
    end

    if  \_open(inpf,"rb") then do
        call _log "xerr opening       : '"inpf"'"
        iterate iarg
    end

    head = charin(inpf,2,7)
    call _close inpf
    if head \= XMIheadr then do
        call _log "not an XMIT file    : '"inpf"'"
        iterate iarg
    end
    if  \_open(inpf,"rb") then do
        call _log "xerr on 2nd open of: '"inpf"'"
        iterate iarg
    end
    call _log "Now processing      : '"inpf"'"

    if  extr then do
        dest = filespec("n",inpf)
        parse var dest dest "." .
    end

    call inminit

    fseq = 0
    memb = ""
    outf = ""
    outk = 0
    do  getk = 1 while ( chars(inpf) > 0 )
        buff = xgetb(inpf)

        flag = substr(buff,1,1)

        if  '20'x = bitand(flag,'20'x) then do
            /*  process control record */

         if  outf \= "" then do
            call _close outf
            call _log left(memb,10)"records("right(outk,8)") file("outf")"
            memb = ""
                outf = ""
                outk = 0
         end

            type = _e2a(substr(buff, 2, 6))

            if  dump then do
                call _hexdump buff
                iterate getk
            end

            if  type = "INMR01" then do
                inmr01c += 1
                list = ""
                buff = substr(buff, 8)
                call Process_INMR01 inmr01c
                iterate getk
            end
            if  type = "INMR02" then do
                inmr02c += 1
                INMR02.inmr02c.inmfseq = c2d(substr(buff, 8, 4))
                list = "INMR02."inmr02c".inmfseq"
                buff = substr(buff, 12)
                call Process_INMR02 inmr02c
                if  dsorg(INMR02.inmr02c.inmdsorg) = "?" then do
                    call _log "dsorg '"INMR02.inmr02c.inmdsorg"' not supported"
                    iterate iarg
                end
                if  recfm(INMR02.inmr02c.inmrecfm) = "?" then do
                    call _log "recfm '"INMR02.inmr02c.inmrecfm"' not supported"
                    iterate iarg
                end
                if   INMR02.inmr02c.inmutiln = "INMCOPY" & ,
                   dsorg(INMR02.inmr02c.inmdsorg) \= "PS" then do
                      call _log  "xinit: mismatched utilid:" inmr02c INMR02.xfseq.inmutiln
                      call _log  "                  dsorg :" inmr02c INMR02.xfseq.inmdsorg dsorg(INMR02.inmr02c.inmdsorg)
                      xerr = 1
                end
                if   INMR02.inmr02c.inmutiln = "IEBCOPY" & ,
                   dsorg(INMR02.inmr02c.inmdsorg) \= "PO" then do
                      call _log  "xinit: mismatched utilid:" inmr02c INMR02.xfseq.inmutiln
                      call _log  "                  dsorg :" inmr02c INMR02.xfseq.inmdsorg dsorg(INMR02.inmr02c.inmdsorg)
                      xerr = 1
                end
                iterate getk
            end
            if  type = "INMR03" then do
                fseq += 1
                if  fseq \= INMR02.fseq.inmfseq then ,
                    signal logic_error
                inmr03c += 1
                list = ""
                buff = substr(buff, 8)
                call Process_INMR03 inmr03c

                if  extr then do
                    if  real then ,
                        dest = INMR02.inmr03c.inmdsnam

                    call _log "Extracting to       : '"dest"'"

                    if  \_ispath(dest) then ,
                        "mkdir -p"  dest
                end
                iebcrseq = 1
                iterate getk
            end

            call process_INMRXX

            if  type = "INMR06" then ,
                leave getk

        end

        if  info then ,
            iterate getk

        if  dump then do
            call _hexdump buff
            iterate getk
        end

        if  dsorg(INMR02.inmr03c.inmdsorg) = "PS" then do
            if  outf = "" then do
               if   symbol("INMR02."inmr03c".inmterm") = "VAR" then ,
                   mail = ".mail"
                else ,
                    mail = ""

            if   substr(buff,PSoffset+1,7) = XMIheadr then do
               suff = XMIsuffx
               asis = 1
            end
            else ,
                call ftype substr(buff, PSoffset, 16)
                file = filespec("n",inpf)
                parse var file file "." .
                outf = dest || "/" || file || mail || suff

             if   \_open(outf,"wr") then do
                call _log  "error opening"  "'"outf"'"
                call _log  "* * * TERMINATING * * *"
                exit
             end
                outk = 0
            end
            outk += 1
            if asis then ,
                call charout outf,      substr(buff, PSoffset)
            else ,
                call lineout outf, _e2a(substr(buff, PSoffset))
            iterate getk
        end
        else ,
        if  dsorg(INMR02.inmr03c.inmdsorg) = "PO" then do
            if iebcrseq = 1 then do
                /* IEBCOPY first control record */
              if   ( substr(buff, R1offset, 4) = PDSheadr ) then ,
                  iebcpdst = "PDS"
              else ,
              if   ( substr(buff, R1offset, 4) = POEheadr ) then ,
                  iebcpdst = "PDSE"
              else do
                 call _log  "invalid IEBCOPY control info '"upper(c2x(substr(buff, R1offset, 4)))"'x "
                 exit
              end
              r1dsorg  = c2x(substr(buff, R1offset+4 ,2))
              r1blksz  = c2d(substr(buff, R1offset+6 ,2))
              r1lrecl  = c2d(substr(buff, R1offset+8 ,2))
              LRECL    = c2d(substr(buff, R1offset+8 ,2))
              r1recfm  = c2x(substr(buff, R1offset+10,2))
              r1tblksz = c2x(substr(buff, R1offset+14,2))
              r1devtyp = c2x(substr(buff, R1offset+16,20))
              TRKSXCYL = c2d(substr(buff, R1offset+26,2))
                iebcrseq = 2
                iterate getk
            end
            if iebcrseq = 2 then do
                /* IEBCOPY second control record */
              debp   = R2offset
              debt.0  = c2d(substr(buff, debp, 1))
              relt   = 0
              do  i = 1 to debt.0
                 debp = debp + 16
                 debf = c2d(substr(buff, debp+6 ,2)) * TRKSXCYL  + ,
                           c2d(substr(buff, debp+8 ,2))
                 debl = c2d(substr(buff, debp+10,2)) * TRKSXCYL  + ,
                           c2d(substr(buff, debp+12,2))
                 trks = c2d(substr(buff, debp+14,2))
                 size = debl - debf + 1
                 if   size \= trks then ,
                        signal logic_error
                 debt.i.1    = debf
                 debt.i.2    = debl
                 debt.i.3    = relt
                 debt.i.4    = relt + trks
                 relt        = relt + trks
              end
                iebcrseq = 3
                iterate getk
            end
            if iebcrseq = 3 then do
                /* IEBCOPY directory control record */
             buff = substr(buff,R3offset)
             do  dirk = 1 while (buff \= "")
                if  substr(buff,1,1) = "88"x then do
                    iebcrseq = 0
                    iterate getk
                end
                parse var buff . 23 dirb 277 buff
                do while ( dirb \= "" )
                   if   length(dirb) < 12 then ,
                       iterate dirk
                   if   substr(dirb,1,8) = "ffffffffffffffff"x then do
                      iebcrseq = 0
                      iterate getk
                        end
                   ttr   = lower(c2x(substr(dirb, 9,3)))
                   flg   = bitand(substr(dirb,12,1),'80'x)
                   udl   = c2d(bitand(substr(dirb,12,1),'1F'x))
                   if   flg = '00'x then do
                      MEMBER.ttr = strip(_e2a(substr(dirb,1,8)))
                   end
                    dirb = substr(dirb, 12 + udl * 2 + 1)
                end
             end
                iterate getk
            end

            /* process members */
          offs = PDoffset
         do while offs < length(buff)
            blksz = c2d(substr(buff, offs + 10, 2))
            select
                when iebcpdst = "PDS" then do
                    if  blksz = 0 then do
                         if  outf \= "" then do
                            call _close outf
                            call _log left(memb,10)"records("right(outk,8)") file("outf")"
                            end
                        memb = ""
                            outf = ""
                            outk = 0
                            iterate getk
                        end
                 end
                 when iebcpdst = "PDSE" then do
                     if  substr(buff, offs, 1) \= "00"x then do
                         if  outf \= "" then do
                            call _close outf
                            call _log left(memb,10)"records("right(outk,8)") file("outf")"
                            end
                        memb = ""
                            outf = ""
                            outk = 0
                            iterate getk
                        end
                 end
                 otherwise ,
                     signal logic_error
                end

             if  memb = "" then do
                  membcc = c2d(substr(buff, offs+4,2))
                  membhh = c2d(substr(buff, offs+6,2))
                  membrr = c2x(substr(buff, offs+8,1))
                  trk    = membcc * TRKSXCYL  + membhh
                  do   i = 1 to debt.0
                     if ( trk >= debt.i.1 ) & ( trk <= debt.i.2 ) then ,
                    leave
                  end
                  ttr  = lower(right(d2x(trk - debt.i.1 + debt.i.3),4,'0') || membrr)
                  memb = lower(strip(member.ttr))
             end

             offs += 12
             if  recfm(INMR02.inmr03c.inmrecfm) = "F" then do
                 do ( blksz % LRECL )
                     if  outf = "" then do
                        if   substr(buff, offs+1, 7) = XMIheadr then do
                           suff = XMIsuffx
                           asis = 1
                        end
                        else ,
                            call ftype substr(buff, offs, 16)
                            outf = dest || "/" || memb || suff
                         if   \_open(outf,"wr") then do
                            call _log  "error opening"  "'"outf"'"
                            call _log  "* * * TERMINATING * * *"
                            exit
                         end
                            outk = 0
                     end
                  if asis then ,
                     call charout outf,      substr(buff, offs, LRECL)
                  else ,
                     call lineout outf, _e2a(substr(buff, offs, LRECL))
                        outk += 1
                        offs += LRECL
                 end
                end
                else ,
             if  recfm(INMR02.inmr03c.inmrecfm) = "V" then do
                 limt = offs + c2d(substr(buff, offs, 2))
                offs = offs + 4
                do while ( offs < limt)
                   LRECL = c2d(substr(buff, offs, 2))
                     if outf = "" then do
                            file = filespec("n",inpf)
                            parse var file file "." .
                            outf = dest || "/" || memb || ".txt"

                         if   \_open(outf,"wr") then do
                            call _log  "error opening"  "'"outf"'"
                            call _log  "* * * TERMINATING * * *"
                            exit
                         end
                            outk = 0
                     end
                   call lineout outf, _e2a(substr(buff, offs+4, LRECL-4))
                   outk += 1
                    offs += LRECL
                end
                end
                else ,
                    signal logic_error

         end


        end
        else do
        end

    end

end

call _leave
exit

logic_error:
call _log  "*********************************"
call _log  "**                             **"
call _log  "** logic error at line    " || right(sigl,4) || " **"
call _log  "**                             **"
call _log  "*********************************"
exit

novalue:
call _log  "*********************************"
call _log  "**                             **"
call _log  "** Novalue trapped at line" || right(sigl,4) || " **"
call _log  "**                             **"
call _log  "*********************************"
exit

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
inminit:
    drop    INMR01.
    drop    INMR02.
    drop    INMR03.
    drop    INMR04.
    drop    INMR05.
    drop    INMR06.
    drop    INMR07.
    drop    INMR08.

    inmr01c = 0; INMR01.0 = 0;
    inmr02c = 0; INMR02.0 = 0;
    inmr03c = 0; INMR03.0 = 0;
    inmr04c = 0; INMR04.0 = 0;
    inmr05c = 0; INMR05.0 = 0;
    inmr06c = 0; INMR06.0 = 0;
    inmr07c = 0; INMR07.0 = 0;
    inmr08c = 0; INMR08.0 = 0;

    inmkey.1  = '0001'x; inmdesc.1  = "inmddnam"; inmconv.1  = "c";
    inmkey.2  = '0002'x; inmdesc.2  = "inmdsnam"; inmconv.2  = "c";
    inmkey.3  = '0003'x; inmdesc.3  = "inmmembr"; inmconv.3  = "c";
    inmkey.4  = '000B'x; inmdesc.4  = "inmsecnd"; inmconv.4  = "d";
    inmkey.5  = '000C'x; inmdesc.5  = "inmdir"  ; inmconv.5  = "d";
    inmkey.6  = '0022'x; inmdesc.6  = "inmexpdt"; inmconv.6  = "c";
    inmkey.7  = '0028'x; inmdesc.7  = "inmterm" ; inmconv.7  = "c";
    inmkey.8  = '0030'x; inmdesc.8  = "inmblksz"; inmconv.8  = "d";
    inmkey.9  = '003C'x; inmdesc.9  = "inmdsorg"; inmconv.9  = "x";
    inmkey.10 = '0042'x; inmdesc.10 = "inmlrecl"; inmconv.10 = "d";
    inmkey.11 = '0049'x; inmdesc.11 = "inmrecfm"; inmconv.11 = "x";
    inmkey.12 = '1001'x; inmdesc.12 = "inmtnode"; inmconv.12 = "c";
    inmkey.13 = '1002'x; inmdesc.13 = "inmtuid" ; inmconv.13 = "c";
    inmkey.14 = '1011'x; inmdesc.14 = "inmfnode"; inmconv.14 = "c";
    inmkey.15 = '1012'x; inmdesc.15 = "inmfuid" ; inmconv.15 = "c";
    inmkey.16 = '1020'x; inmdesc.16 = "inmlref" ; inmconv.16 = "c";
    inmkey.17 = '1021'x; inmdesc.17 = "inmlchg" ; inmconv.17 = "c";
    inmkey.18 = '1022'x; inmdesc.18 = "inmcreat"; inmconv.18 = "c";
    inmkey.19 = '1023'x; inmdesc.19 = "inmfvers"; inmconv.19 = "c";
    inmkey.20 = '1024'x; inmdesc.20 = "inmftime"; inmconv.20 = "c";
    inmkey.21 = '1025'x; inmdesc.21 = "inmttime"; inmconv.21 = "c";
    inmkey.22 = '1026'x; inmdesc.22 = "inmfack" ; inmconv.22 = "c";
    inmkey.23 = '1027'x; inmdesc.23 = "inmerrcd"; inmconv.23 = "c";
    inmkey.24 = '1028'x; inmdesc.24 = "inmutiln"; inmconv.24 = "c";
    inmkey.25 = '1029'x; inmdesc.25 = "inmuserp"; inmconv.25 = "c";
    inmkey.26 = '102A'x; inmdesc.26 = "inmrecct"; inmconv.26 = "c";
    inmkey.27 = '102C'x; inmdesc.27 = "inmsize" ; inmconv.27 = "d";
    inmkey.28 = '102D'x; inmdesc.28 = "inmffm"  ; inmconv.28 = "c";
    inmkey.29 = '102F'x; inmdesc.29 = "inmnumf" ; inmconv.29 = "d";
    inmkey.30 = '8012'x; inmdesc.30 = "inmtype" ; inmconv.30 = "x";
    inmkey.31 = '8018'x; inmdesc.31 = "inmlsize"; inmconv.31 = "d";

    inmkeys = 31

    inmdsnam_ = '0002'x
    inmdsorg_ = '003C'x
    inmrecfm_ = '0049'x

    inmutiln_ = '1028'x

    return

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
xgetb: Procedure
    parse arg file
    leng = charin(file,,1)
    flag = charin(file,,1)
    buff = flag || charin(file,,c2d(leng)-2)

    do  while '00'x = Bitand(flag,'40'x)
        leng = charin(file,,1)
        flag = charin(file,,1)
        buff = buff || charin(file,,c2d(leng)-2)
    end
    return buff

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
process_INMR01:
process_INMR02:
process_INMR03:
    parse arg inmrseq
    leng = length(buff)
    do while ( length(buff)  > 0 )
        next = getkey(buff)
        nfnd = 1
        select
            when keyn = inmdsnam_ then do
                dsnam =  _e2a(keyv.1)
                do  k = 2 to keyv.0
                    dsnam = dsnam || "." || _e2a(keyv.k)
                end
                /* dsnam = lower(dsnam) */
                call value type"."inmrseq".inmdsnam", dsnam
                list = strip(list) || " " || type"."inmrseq".inmdsnam"
                nfnd = 0
            end

            otherwise ,
                do  k = 1 to inmkeys
                    if  keyn = inmkey.k then do
                        nfnd = 0
                        knam = type"."inmrseq"."inmdesc.k
                        list = strip(list) || " " || knam
                        if  keyv.0 = 0 then ,
                            kval = ""
                        else,
                        if  inmconv.k = "d" then ,
                            kval = c2d(keyv.1)
                        else ,
                        if  inmconv.k = "x" then ,
                            kval = c2x(keyv.1)
                        else ,
                            kval = _e2a(keyv.1)
                        interpret knam "= '"kval"'"
                        leave
                    end
                end
        end
        if nfnd then ,
            call _log type "unsupported key" c2x(substr(buff, 3+1,16))

        buff = substr(buff,next)
    end

    if info then do
        call _log  copies("- ",30)
        call _log  type inmrseq leng
        do v = 1 to words(list)
            knam = word(list,v)
            kval = value(word(list,v))
            call _log  left(knam,20) || "=" kval
        end
    end
    return

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
process_INMRXX:
    if  info then do
        call _log  copies("- ",30)
        call _log  type
    end
    return

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
getkey: procedure expose keyn keyv.
    parse arg   buff
    parse var   buff ,
                keyn    +2 ,
                coun    +2 ,
                .
    coun = c2d(coun)
    keyv.0 = coun
    next = 5
    do  k = 1 to coun
        lenv  = c2d(substr(buff, next  ,2))
        keyv.k = substr(buff, next+2, lenv)
        next  = next + lenv + 2
    end
    return next

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
dsorg: procedure
    if  left(arg(1),2) = "02" then ,
        return "PO"
    if  left(arg(1),2) = "40" then ,
        return "PS"
    return "?"

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
recfm: procedure
    w = x2c(arg(1))
    if  bitand(w,'C000'x) = 'C000'x then ,
        return "?"
    if  bitand(w,'8000'x) = '8000'x then ,
        return "F"
    if  bitand(w,'4000'x) = '4000'x then ,
        return "V"
    return "?"

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ftype: procedure expose suff asis
    parse arg buf
    sigt =  "02c5e2c4"x ,
            "02e3e7e3"x ,
            "02d9d3c4"x ,
            "02c5d5c4"x ,
            "255044462d"x ,
            "504b0304"x ,
            "d0cf11e0a1b11ae1"x
    suft =  ".obj" ,
            ".obj" ,
            ".obj" ,
            ".obj" ,
            ".pdf" ,
            ".zip" ,
            ".doc"
    do  i = 1 to words(sigt)
        sig = word(sigt,i)
        len = length(sig)
        if  left(buf,len) = sig then do
            suff = word(suft,i)
            asis = 1
            return
        end
    end

    suff = ".txt"
    asis = 0

    return

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
::requires  "unxmit.cls"


the classes/external subroutines

Code:


/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*  Char/String Related                                                       */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
::routine _isnum public
  return (verify(arg(1),"0123456789") = 0 )

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
::routine _ishex public
  return ( verify(lower(arg(1)),'0123456789abcdef') = 0 )

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
::routine _strings public
    if  arg() \= 1 then
        return 0

    apos = "'"; quot = '"'; stop = 'ff'x;

    strv = strip(arg(1)) || stop

    coun = 0;
    do while ( strv \= stop)
        coun = coun + 1
        char = left(strv,1)
        if  char \= apos & char \= quot then ,
            char = " "

        next = min(_Pos(char,strv,2), ,
                   _Pos(stop,strv,2))

        if  char = " " then ,
            strv = strip(substr(strv,next))
        else
            strv = strip(substr(strv,next+1))

    end

    return coun

return 0

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
::routine _string public
    if  arg() \= 2 then
        return ""

    apos = "'"; quot = '"'; stop = 'ff'x;

    strv = strip(arg(1)) || stop

    coun = 0 ;
    do while ( strv \= stop)
        coun = coun + 1
        char = left(strv,1)
        if  char \= apos & char \= quot then ,
            char = " "

        next = min(_Pos(char,strv,2), ,
                   _Pos(stop,strv,2))

        if coun = arg(2) then leave

        if char = " " then ,
            strv = strip(substr(strv,next))
        else
            strv = strip(substr(strv,next+1))
    end

    if coun < arg(2) then ,
        return ""

    if  substr(strv,next,1) = char then ,
        return strip(left(strv,next))
    else ,
        return strip(left(strv,next-1))

return ""

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
::routine _pos public
    p = pos( arg(1), arg(2), arg(3))
    if  p > 0  then ,
        return p
    return 999999

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
::routine _plural public
    if arg(2) = 1 then ,
        return arg(1)
    else ,
        return arg(1) || "s"

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*  Console Related                                                           */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
::routine _log public
   if arg() = 1 then ,
       .output~lineout(left(.local~_self, 9) || "- " || strip(arg(1),"T"))
   else ,
      .output~lineout("")
   return 0

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
::routine _err public
   if  arg() = 1 then ,
       .error~lineout(left(.local~_self, 9) || "- " || strip(arg(1),"T"))
   else ,
       .error~lineout("")
   return 0

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
::routine _start public
    if  .local~_cpyr \= "" then ,
        call _log "Version :" .local~_vers '"'.local~_cpyr'"'
   call _log "Started :" time()
   call time "R"
   return

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
::routine _leave public

    parse value(time("E")) with secs "." usec

    ss = ( secs // 60 )
    mm = ( secs  % 60 ) // 60
    hh = ( ( secs  % 60 )  % 60 ) // 24
    dd = ( ( secs  % 60 )  % 60 )  % 24
    if  dd = 0 then ,
        elaps = hh _plural("hour",hh) mm _plural("minute",mm) ss _plural("second",ss)
    else ,
        elaps = dd _plural("day",dd) hh _plural("hour",hh) mm _plural("minute",mm) ss _plural("second",ss)
   call _log "Ended   :" time()  "Elapsed :" elaps
    return

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
::routine _pause public
   call _log "Press (ENTER) to continue"
   pull z
   return

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
::routine _cancel public
   call _log "- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -"
   call _log arg(1)
   call _log "- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -"
   exit

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
::routine _yesno public
   say left(.local~_self, 9) || "- " || strip(arg(1),"T")
   _repl = "z"
   do while ( pos(_repl,"y nxq ") = 0 )
      say copies(" ",12) || "(y/Y/[enter]) to continue"
      say copies(" ",12) || "(n/N/x/X) to exit"
      parse pull _repl
      _repl = lower(left(strip(_repl),1))
   end
   return translate(_repl,"11000","y nxq")

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*  File Related                                                              */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
::routine _exists public
    if  SysIsFile(arg(1)) then ,
        return 1
    if SysIsFileDirectory(arg(1)) then ,
         return 1
   return 0

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
::routine _isfile public
    if  SysIsFile(arg(1)) then ,
        return 1
    return 0

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
::routine _ispath public
   if  SysIsFileDirectory(arg(1)) then ,
        return 1
    return 0

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
::routine _open public
   if arg() < 2 then ,
      return 0
   if lower(arg(2)) = "r" then ,
      parms  = " open read "
   else ,
   if lower(arg(2)) = "rb" then ,
      parms  = " open read binary"
   else ,
    if   lower(arg(2)) = "w" then ,
      parms  = " open write"
   else ,
    if   lower(arg(2)) = "wr" then ,
      parms  = " open write replace"
   else ,
      return 0
   if arg() = 3 then do
      if \datatype(arg(3),"n") then ,
         return 0
      parms  = parms  || " reclenght " arg(3)
   end
   return ( stream(arg(1), "c", parms ) = "READY:" )

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
::routine _close public
   parms = " close"
   return ( stream(arg(1), "c", parms) = "READY:" )

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*  Environment Related                                                       */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
::routine _getenv public
   return VALUE(arg(1),,"ENVIRONMENT")

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

::routine _setenv public
   return VALUE(arg(1),arg(2),"ENVIRONMENT")

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

::routine _unsetenv public
   call VALUE arg(1), .NIL, "ENVIRONMENT"
   return 0

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*  Misc                                                                      */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
::routine _ls public
    Address "bash" "ls "arg(1)" | rxqueue"
    list = ""
    do i = 1 while queued() > 0
       parse pull data
       list = list data
    end
    return space(list)

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
::routine _hexdump public
    parse   arg buff
   head   = copies(" ",7)
   offs   = 1
   say head || ">>" || copies("1234567890",8) || "<<"
   do  while ( buff \= "" )
      parse var buff with 1 what 81 buff
      say     left(right(offs,6),7) || ">>" || _e2a(what) || "<<"
      what    = c2x(what)
      buf0    = ""
      buf1    = ""
      do   i = 1 to length(what) - 1 by 2
         buf0    = buf0 || substr(what, i    , 1 )
         buf1    = buf1 || substr(what, i + 1, 1 )
      end
      say     head || ">>" || buf0 || "<<"
      say     head || ">>" || buf1 || "<<"
      say
      offs += 80
   end
   return

/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
::routine _e2a public
                            /*0123456789abcdef*/
   return translate(arg(1), ,
               /*0*/    "................" || ,
               /*1*/    "................" || ,
               /*2*/    "................" || ,
               /*3*/    "................" || ,
               /*4*/    " ...........<(+." || ,
               /*5*/    "&.........!$*);." || ,
               /*6*/    "-/.........,%_>?" || ,
               /*7*/    "..........:#@" || "'" || '="' || ,
               /*8*/    ".abcdefghi......" || ,
               /*9*/    ".jklmnopqr......" || ,
               /*a*/    "..stuvwxyz......" || ,
               /*b*/    "..........[]...." || ,
               /*c*/    "{ABCDEFGHI......" || ,
               /*d*/    "}JKLMNOPQR......" || ,
               /*e*/    "\.STUVWXYZ......" || ,
               /*f*/    "0123456789......" )
                            /*0123456789abcdef*/


/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */


the only options that work right now are --dump --info --real

have a nice time,
play around and i will try to timely correct the errors

the usual test of recursively UNXMITTING all the CBT files
was successful
the .PDF, the .DOC and the .ZIP were correctly opened

cheers
Back to top
View user's profile Send private message
vasanthz

Global Moderator


Joined: 28 Aug 2007
Posts: 1742
Location: Tirupur, India

PostPosted: Tue Sep 11, 2012 11:38 pm
Reply with quote

Hello,
Appreciate your help Thanks, the code is quite intimidating, will attempt to understand it when I find time.

Regards,
Back to top
View user's profile Send private message
enrico-sorichetti

Superior Member


Joined: 14 Mar 2007
Posts: 10872
Location: italy

PostPosted: Tue Oct 23, 2012 10:18 pm
Reply with quote

an update is under way to UNPACK ISPF PACKED members
Back to top
View user's profile Send private message
thlucas

New User


Joined: 27 Dec 2012
Posts: 6
Location: United States

PostPosted: Fri Jan 04, 2013 6:02 am
Reply with quote

Here's where I found information about the various parts of an XMIT file.

TSO TRANSMIT data formats are documented in:
TSO/E Customization Guide, Chapter 37 Customizing TRANSMIT and RECEIVE, Format of Transmitted Data.

IEBCOPY Directory Format area is documented in:
DFP Using Datasets, "Chapter 27, Processing a Partitioned Data Set" section.

IEBCOPY COPYR1 area is documented in:
DFP utilities Guide, "Appendix B. Unload Partitioned Dataset Format" section.

IEBCOPY COPYR2 area is documented in:
DFP utilities Guide, "Appendix B. Unload Partitioned Dataset Format" section.

DEB is mapped by system macro SYS1.MACLIB(IEZDEB).
The DEBExtent01-16 fields are highly device dependent and are required to translate absolute DASD addresses (MBBCCHHR) in the member data records to relative addresses (TTR). For DASD devices, these areas are mapped by DSECT DEBDASD in SYS1.MACLIB(IEZDEB) macro.

The DEB control block is documented in
DFSMS DFP Advanced Services.
DEVTAB information is documented in:
DFSMS DFP System Data Administration.

PDS Program Data area is mapped by the IHAPDS macro, which is described in the "MVS Program Management Advanced Facilities" guide, Appendix E "Data Areas", paragraph "PDS directory entry format on entry to STOW".
Back to top
View user's profile Send private message
thlucas

New User


Joined: 27 Dec 2012
Posts: 6
Location: United States

PostPosted: Fri Jan 04, 2013 6:12 am
Reply with quote

I am developing a freeware application that allows data to be extracted from MVS TSO XMIT files. I call it the "MVS TSO XMIT Analyzer".

I wrote this program for fun, as well as to give back to the CBT Tape community. I found the CBT Tapes to be an invaluable resource over the years.

Here are a few more details.

Features

■ supports multiple files within the XMIT file.
■ supports Sequential, PDS, and PDS/E embedded content.
■ supports fixed-block, variable-blocked, and undefined record formats.
■ supports Message data contained within the XMIT file.
■ supports exporting of PDS and PDS/E member statistics for ISPF Source / Program data.
■ data can be extracted as-is (ie EBCDIC) or converted to Text (ie PC ASCII) format.
■ user-specified codepage conversion options to allow custom data translation.
■ supports easy viewing of embedded files - ie XMIT, PKZIP, PDF, MS Word, etc.
■ easy-to-use Graphical User-Interface.
■ drag and drop support, to allow easy extraction of source code to individual files.
■ underlying .NET Assembly API allows you to write your own programs to process XMIT files.

Requirements
■ Windows 32/64 bit Operating System.
■ Microsoft .NET v2.0 Framework.

More information / download can be found at the following link:
www.c-cubed.net/Products/MVSTSOXMITAnalyzer.aspx
Back to top
View user's profile Send private message
View previous topic :: :: View next topic  
Post new topic   Reply to topic View Bookmarks
All times are GMT + 6 Hours
Forum Index -> All Other Mainframe Topics Goto page 1, 2  Next

 


Similar Topics
Topic Forum Replies
No new posts How to split large record length file... DFSORT/ICETOOL 7
No new posts Extracting Variable decimal numbers f... DFSORT/ICETOOL 17
No new posts SFTP Issue - destination file record ... All Other Mainframe Topics 2
No new posts Access to non cataloged VSAM file JCL & VSAM 18
No new posts FINDREP - Only first record from give... DFSORT/ICETOOL 3
Search our Forums:

Back to Top