home *** CD-ROM | disk | FTP | other *** search
/ ftp.cc.umanitoba.ca software / ftp.cc.umanitoba.ca-software-.zip / ftp.cc.umanitoba.ca-software- / mac_network / Comet.3.0.8.sit.bin / ibm-host-software / UPLOAD.EXEC < prev    next >
Text File  |  1988-05-24  |  5KB  |  133 lines
  1. /*
  2. Use this exec to transfer IBM PC or Mac files to CMS via FT3270 or FTC19.
  3.  
  4. SYNTAX:    UPLOAD <">micro_filespec<"> <fn|* <ft|* <fm>>> <( options <)>>
  5.                   options are:  <REPlace> <BINary|TEXt> <lrecl>
  6. Notes:
  7.    1) Micro_filespec must be enclosed in double quotes if it contains blanks.
  8.    2) CMS fn & ft default to first & second parts of micro_filespec
  9.       respectively. CMS fm defaults to 'A'.
  10.    3) Three options are checked for. Invalid words are ignored.
  11.    4) REPLACE means the CMS file will be replaced with the transferred one. The
  12.       default is to return an error if a CMS file of that name already exists.
  13.    5) BINARY means that a binary translation will take place with no ASCII/
  14.       ebcdic translation and no special attention paid to local CR/LF's.
  15.    6) The TEXT option means that the program will perform the ebcdic/ASCII
  16.       translation and cut loose a record when a local line feed character is
  17.       encountered.
  18.    7) The default is to let the micro decide whether to make the transfer TEXT
  19.       or BINARY and so inform the CMS program.
  20.    8) A number less than 65536 may be specified to indicate the creation of a
  21.       CMS file of fixed record length. If it is not specified then a file of
  22.       variable length records is created.
  23.  
  24. */
  25. address 'COMMAND'
  26. /* modified for mac to preserve slash marks kevin 11/3/87 */
  27. /* 5-5-88 Rich K split path/name based on forward or backslashes */
  28. /* 5-13-88 RICH K. FIX BUG WHEN RDR FILE ARRIVES SPOOLED TO CURRENT */
  29. /*                 READER SETTING */
  30. /* 5-24-88 Rich K. Add test for disk not in write mode */
  31.  
  32. /* Parse the arguments and build the CMS FN FT FM if necessary */
  33.  
  34. parse arg parms '(' opts ')'
  35. if parms = '' | parms = '?' then signal help
  36.  
  37. /* Split the micro filespec from the CMS FN FT FM.  The filespec may
  38.    be surrounded by quotes to remove ambiguity. */
  39.  
  40. QuotePos = pos( '"', parms )           /* quotes in the filespec? */
  41. select
  42.   when QuotePos = 0 then parse var parms FSpec FN FT FM . /* none */
  43.   when QuotePos = 1                    /* starts with a quote */
  44.   then do
  45.     if pos( '"', parms, 2 ) = 0 then signal help /* mismatched quotes */
  46.     parse var parms '"' FSpec '"' FN FT FM .
  47.     end
  48.   otherwise signal help                /* quote in the middle */
  49.   end
  50.  
  51. if length( FM ) > 2 then signal help   /* invalid filemode */
  52. /* FSpec = translate( FSpec, '\', '/' )   translate slash to backslash */
  53.  
  54. /* Try to build a reasonable default CMS FN FT FM from the filespec
  55.    in case they are not specified */
  56.  
  57. NamePos = max( lastpos( ':', FSpec ), lastpos( '\', FSpec ) )
  58. NamePos = max( NamePos, lastpos( '/', FSpec ) )
  59. MicroName = substr( FSpec, NamePos + 1 )     /* strip path, if any */
  60. MicroName = translate( MicroName, '.', ' ' ) /* convert blanks to .s */
  61. parse var MicroName MicroFN '.' MicroFT      /* split name & exten */
  62. MicroFT = strip( MicroFT, 'BOTH', '.' )      /* strip multiple spaces */
  63. if MicroFT = '' then MicroFT = 'UPLOADED'    /* default FT */
  64.  
  65. if FN = '' | FN = '*' | FN = '=' then FN = MicroFN
  66. if FT = '' | FT = '*' | FT = '=' then FT = MicroFT
  67. if FM = '' | FM = '*' | FM = '=' then FM = 'A'
  68.  
  69. /* make sure disk is read/write since FT3270 module does not check */
  70.  
  71. Upper FM
  72. 'STATEW * * ' FM
  73. If rc <> 0 Then Do
  74.    say "Error: disk '"FM"' is not accessible in write mode"
  75.    exit
  76.    End
  77.  
  78. /* Parse the options string */
  79.  
  80. rep   = 'N'                            /* set default flags */
  81. bin   = 'D'
  82. LRecl = ''
  83.  
  84. do while( opts ^= '' )
  85.   parse upper var opts opt opts        /* get the next option word */
  86.  
  87.   select
  88.     when datatype( opt, 'WHOLE' )    then LRecl = opt /* LRecl */
  89.     when abbrev( 'REPLACE', opt, 3 ) then rep = 'R'   /* REPlace */
  90.     when abbrev( 'BINARY',  opt, 3 ) then bin = 'B'   /* BINary */
  91.     when abbrev( 'TEXT',    opt, 3 ) then bin = 'T'   /* TEXt */
  92.     otherwise do
  93.       say "Invalid option: '"opt"'";  exit 1
  94.       end
  95.     end                                /* end select */
  96.   end                                  /* end do */
  97.  
  98. ConByte = 'U' || bin || rep || LRecl   /* generate the control byte */
  99.  
  100. /* Remember whether messages etc. were on or off */
  101.  
  102. 'CPSTACK LIFO QUERY SET'
  103. pull . ; pull . ; pull .
  104. pull 'IMSG' imsg ',' .
  105. pull . ; pull .
  106. pull 'MSG' msg ',' . 'WNG' wng ',' .
  107.  
  108. 'CPSTACK Q C'                               /* CHECK READER SETTING */
  109. pull 'RDR' rdrnum 'CL' rdrcl rdrcont rdrhold rdreof rdrready
  110. 'CP NOTREADY C'
  111.  
  112. /* Run the program; check rc; restore msg processing; & exit */
  113.  
  114. FN = translate( FN )  /* make sure CMS filespec is in upper case */
  115. FT = translate( FT )
  116. FM = translate( FM )
  117.  
  118. 'FT3270 "'FSPEC'"' CONBYTE FN FT FM  /* PERFORM THE UPLOAD */
  119. rrc = rc
  120. 'CP SET MSG'  msg
  121. 'CP SET WNG'  wng
  122. 'CP SET IMSG' imsg
  123. if rdrready = 'READY' then 'CP READY C'
  124. exit rrc
  125.  
  126. /* Help screen -- Show the comments at the front of this file */
  127.  
  128. Help:
  129.   'VMFCLEAR'
  130.   do i = 2 while( sourceline( i ) ^= '*/' )
  131.      say sourceline( i )
  132.      end
  133.