From:	CSBVAX::MRGATE!RELAY-INFO-VAX@CRVAX.SRI.COM@SMTP 17-OCT-1988 10:08
To:	ARISIA::EVERHART
Subj:	VMS_SHARE 6.01A re-posting 2/3


Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Mon, 17 OCT 88 04:58:13 PDT
Received: from CUNYVM.CUNY.EDU by KL.SRI.COM with TCP; Mon, 17 Oct 88 04:54:20 PDT
Received: from UKACRL.BITNET by CUNYVM.CUNY.EDU (IBM VM SMTP R1.1) with BSMTP id 4694; Mon, 17 Oct 88 07:40:59 EDT
Received: from RL.IB by UKACRL.BITNET (Mailer X1.25) with BSMTP id 0378; Mon,
 17 Oct 88 11:27:31 BST
Received: from RL.IB by UK.AC.RL.IB (Mailer X1.25) with BSMTP id 0510; Mon, 17
          Oct 88 11:27:29 BS
Via:      UK.AC.KCL.CC.OAK; 17 OCT 88 11:27:09 BST
Date:     17-OCT-1988 11:28:11 GMT
From:     UDAA055%OAK.CC.KCL.AC.UK@CUNYVM.CUNY.EDU
To:       info-vax@KL.SRI.COM
Subject:  VMS_SHARE 6.01A re-posting 2/3
Sender:   Andy Harper, Kings College London <A.Harper%OAK.CC.KCL.AC.UK@CUNYVM.CUNY.EDU>

+-+-+-+ Beginning of part 2 +-+-+-+
Xping string.
X  EXITIF i_ascii = 255;`009`009`009`009! Highest ASCII decimal.
X  IF ( i_ascii < 32 ) OR ( i_ascii > 126 )
X  THEN
V    s_control := s_control + ASCII( i_ascii );`009! Construct the control chara
Xcters string.
X  ENDIF;
X  i_ascii := i_ascii + 1;
XENDLOOP;
X
X! because the network performs obscure translations on certain of the`032
X! printable characters, we add their ascii codes to the s-control string to
X! force them to be quoted, thus allowing them to survive the journey across
X! hostile systems.
X!
Xs_control := s_control + ASCII(  94 );`009`009! caret
Xs_control := s_control + ASCII( 123 );`009`009! Left brace
Xs_control := s_control + ASCII( 124 );`009`009! Vertical bar
Xs_control := s_control + ASCII( 125 );`009`009! Right Brace
Xs_control := s_control + ASCII( 126 );`009`009! Tilde
X
Xb_ascii := CREATE_BUFFER( "`123ASCII`125" );
XSET( NO_WRITE, b_ascii, ON );
XPOSITION( BEGINNING_OF( b_ascii ) );
VCOPY_TEXT( s_ascii );`009`009`009`009! Write string with all ASCII characters i
Xnto buffer.
Vpat_control := ANY( s_control );`009`009! Generate a pattern of all control cha
Xracters.
X
X!+
V! Read in the file containing the names of the files and their checksums.  Extr
Xact the username, the maximum part size,
X! the count of files to be processed and the name of the output (SHARE) file.
X!-
X
Vb_dummy := CREATE_BUFFER( "`123Share`125", GET_INFO( COMMAND_LINE, "FILE_NAME"
X) );
XSET( NO_WRITE, b_dummy, ON );
XPOSITION( BEGINNING_OF ( b_dummy ) );
X
Xs_user := __get_quoted_string;`009`009`009! USERNAME of creator.
X
Xi_max_part_blocks := INT( __get_quoted_string );
Xi_max_part_bytes := i_max_part_blocks * 512;`009! Maximum bytes in each part.
X
Xi_num_files := INT( __get_quoted_string );`009! Number of file to process.
X
Xs_share_file := __get_quoted_string;`009`009! Name of the output (SHARE) file.
Vs_output_file := s_share_file;`009`009`009! Internal name of the output (SHARE)
X file.
XIF FILE_PARSE( s_output_file, "", "", TYPE ) <> "."
XTHEN
X  s_output_file := s_output_file + "_";
XENDIF;
X
X!+
X! Create the buffer to hold all of the packed files concatinated together.
X!-
X
Xb_packed := CREATE_BUFFER( "`123Packed`125" );
X
X!+
V! Build the prolog for all parts.  This is not repeated in every part since it
Xis assumed that all parts will be
X! unpacked.  The rational for this is that a file may span more than one part.
X!-
X
XPOSITION( BEGINNING_OF( b_packed ) );
X__copy_text( FAO( "!22*. Cut between dotted lines and save. !21*." ) );
X__copy_text( FAO( "$!!!77*." ) );
V__copy_text( FAO( "$!! VAX/VMS archive file created by !AS !AS.", s_facility_na
Xme, s_facility_version ) );
X__copy_text( FAO( "$!!" ) );
V__copy_text( FAO( "$!! !AS was written by James Gray (Gray:OSBUSouth@Xerox.COM)
X from", s_facility_name ) );
V__copy_text( FAO( "$!! VMS_SHAR by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au
X)." ) );
X__copy_text( FAO( "$!!" ) );
V__copy_text( FAO( "$!! To unpack, simply save, concatinate all parts into one f
Xile and" ) );
X__copy_text( FAO( "$!! execute (@) that file." ) );
X__copy_text( FAO( "$!!" ) );
X__copy_text( FAO( "$!! This archive was created by user !AS", s_user ) );
X__copy_text( FAO( "$!! on !%D.", 0 ) );
X__copy_text( FAO( "$!!" ) );
XMOVE_VERTICAL( -1 );
Xm_attention_text := MARK( NONE );
XMOVE_VERTICAL( 1 );
V__copy_text( FAO( "$!! It contains the following !UL file!%S:", i_num_files ) )
X;
X
X!+
V! Read in all of the input files into separate buffers and do all fixup to each
X file as necessary.
X!-
X
Xi_file_num := 0;
XLOOP
X
X  !+
X  ! Extract the file name of the next file.
X  !-
X
X  i_file_num := i_file_num + 1;
X  EXITIF i_file_num > i_num_files;
X  POSITION( BEGINNING_OF( b_dummy ) );
X  MOVE_VERTICAL( i_file_num );
X  s_file_spec := __get_quoted_string;
X
X  !+
X  ! Add the file name to the list of files in the preamble of the first part.
X  !-
X
V  s_file_name := FILE_PARSE( s_file_spec, "", "", NAME ) + FILE_PARSE( s_file_s
Xpec, "", "", TYPE );
X  POSITION( b_packed );
X  __copy_text( FAO( "$!!!8* !AS", s_file_name ) );
X
X  !+
X  ! Read in the next file.
X  !-
X
X  b_file := CREATE_BUFFER( s_file_spec, s_file_spec );
X  SET( NO_WRITE, b_file, ON );
X
X  !+
X  ! Quote all of the quote characters, i.e. `` becomes ````.
X  !-
X
X  POSITION( BEGINNING_OF ( b_file ) );
X  pat_quote := s_quoting_char & ( ARB( 1 ) `124 LINE_END );
X`009`009`009`009`009`009! Pattern for quotes
X  ! This pattern may seem elaborate, but it allows positioning AFTER the quote,
X  ! so we don't have to skip it.
X  LOOP
X    r_x := SEARCH( pat_quote, FORWARD, EXACT );`009! First, quote all quotes.
X    EXITIF r_x = 0;`009`009`009`009! No (more) quotes.
X    POSITION( END_OF( r_x ) );`009`009`009! POSITION after the quote,
X    COPY_TEXT( s_quoting_char );`009`009! insert another quote,
X  ENDLOOP;
X
X
X  !+
X  ! Locate lines which have a trailing blank and quote the final blank to
X  ! ensure that unsympathetic systems dont delete them (they might be`032
X  ! important sometimes!).
X  !`009`009`009`009`009Andy Harper, Oct 12, 1988
X  !-
X
X  pat_trail := " " & LINE_END;`009`009! Pattern to Find Trailing Blanks
X
X  POSITION(BEGINNING_OF(b_file));
X  LOOP
X    r_x := SEARCH( pat_trail, FORWARD, EXACT);
X    EXITIF r_x = 0;
X    POSITION( r_x );
X    ERASE_CHARACTER( 1 );
X    COPY_TEXT("``032");`009`009`009! Replace blank by quoted version
X  ENDLOOP;
X
X
X `032
X  !+
V  ! Quote all control characters by replacing them with a quote character follo
Xwed by the decimal value
X  ! of the character.
X  !-
X
X  POSITION( BEGINNING_OF( b_file ) );
X  LOOP
X    r_x := SEARCH( pat_control, FORWARD, EXACT );
X    EXITIF r_x = 0;`009`009`009`009! No (more) control characters.
X    POSITION( r_x );`009`009`009`009! POSITION on the control character.
V    r_x := ERASE_CHARACTER( 1 );`009`009! Delete and remember the control chara
Xcter.
X    POSITION( BEGINNING_OF( b_ascii ) );`009! Map the control character to its
X    POSITION( SEARCH( r_x, FORWARD, EXACT ) );`009! decimal equivalent.
X    i_x := CURRENT_OFFSET;
V    POSITION( b_file );`009`009`009`009! Back to our buffer where the quoted de
Xcimal ASCII value is written.
X    COPY_TEXT( s_quoting_char + FAO( "!3ZL", i_x ) );
X  ENDLOOP;
X
X  !+
V  ! Break all lines longer than i_max_line into lines less than or equal to i_m
Xax_line.
X  !-
X
X  POSITION( BEGINNING_OF( b_file ) );
X  LOOP`009`009`009`009`009`009! Third, all lines longer than i_max_line
X    IF LENGTH( CURRENT_LINE ) > i_max_line THEN`009! characters are
X      COPY_TEXT( s_long_line );`009`009`009! prepended with a "V"
X      MOVE_HORIZONTAL( i_max_line );`009`009! and
X      SPLIT_LINE;`009`009`009`009! split.
X    ELSE`009`009`009`009`009! Shorter line.
X      COPY_TEXT( s_short_line );`009`009! Prepended with a "X".
X      MOVE_HORIZONTAL( -1 );`009`009`009! Reposition to beginning of line.
X      MOVE_VERTICAL( 1 );`009`009`009! Advance to the next line.
X    ENDIF;
X    EXITIF MARK( NONE ) = END_OF( b_file );
X  ENDLOOP;
XENDLOOP;
X!+
X! Create a buffer to hold the
X!-
Xb_tpu := CREATE_BUFFER( "`123TPU`125" );
X
X!+
V! Append the code that will be used to unpack the files.  Note that the TPU cod
Xe will be compressed.
X!-
X
XPOSITION( b_packed );
X__copy_text( FAO( "$!!" ) );
X__copy_text( FAO( "$!!!78*=" ) );
X  !+
X  ! Set up and check environment.
X  !-
X__copy_text( FAO( "$ SET SYMBOL/SCOPE=( NOLOCAL, NOGLOBAL )" ) );
X__copy_text( FAO( "$ VERSION = F$GETSYI( ""VERSION"" )" ) );
X__copy_text( FAO( "$ IF VERSION .GES ""V4.4"" THEN GOTO VERSION_OK" ) );
V__copy_text( FAO( "$ WRITE SYS$OUTPUT ""You are running VMS ''VERSION'; "", -"
X) );
V__copy_text( FAO( "    ""!AS !AS requires VMS V4.4 or higher.""", s_facility_na
Xme, s_facility_version ) );
X__copy_text( FAO( "$ EXIT 44 ! SS$_ABORT" ) );
X__copy_text( FAO( "$VERSION_OK:" ) );
X__copy_text( FAO( "$ GOTO START" ) );
X__copy_text( FAO( "$!" ) );
X  !+
X  ! Start of routine that unpacks a file.
X  !-
X__copy_text( FAO( "$UNPACK_FILE:" ) );
X__copy_text( FAO( "$ WRITE SYS$OUTPUT ""Creating ''FILE_IS'""" ) );
X__copy_text( FAO( "$ DEFINE/USER_MODE SYS$OUTPUT NL:" ) );
V__copy_text( FAO( "$ EDIT/TPU/COMMAND=SYS$INPUT/NODISPLAY/OUTPUT='FILE_IS'/NOSE
XCTION -" ) );
X__copy_text( FAO( "    VMS_SHARE_DUMMY.DUMMY" ) );
X  !+
X  ! Set up buffers used during unpacking.
X  !-
V__pack_text( FAO( "b_part := CREATE_BUFFER( ""`123Part`125"", GET_INFO( COMMAND
X_LINE, ""file_name"" ) );" ) );
V__pack_text( FAO( "s_file_spec := GET_INFO( COMMAND_LINE, ""output_file"" );" )
X );
X__pack_text( FAO( "SET( OUTPUT_FILE, b_part, s_file_spec );" ) );
X__pack_text( FAO( "b_errors := CREATE_BUFFER( ""`123Errors`125"" );" ) );
X  !+
X  ! Initialize variables.
X  !-
X__pack_text( FAO( "i_errors := 0;" ) );
V__pack_text( FAO( "pat_beg_1 := ANCHOR & ""!AS"";", SUBSTR( s_part_begin, 2, 16
X ) ) );
V__pack_text( FAO( "pat_beg_2 := LINE_BEGIN & ""!AS"";", SUBSTR( s_part_begin, 1
X, 17 ) ) );
V__pack_text( FAO( "pat_end := ANCHOR & ""!AS"";", SUBSTR( s_part_end, 2, 13 ) )
X );
X  !+
V  ! Concatinates long lines that are preceeded by a V, removes all X's from oth
Xer lines and
X  ! removes end of part/beginning or part lines inclusive.
X  !-
X__pack_text( FAO( "POSITION( BEGINNING_OF( b_part ) );" ) );
X__pack_text( FAO( "i_append_line := 0;" ) );
X__pack_text( FAO( "LOOP" ) );
X__pack_text( FAO( "  EXITIF MARK( NONE ) = END_OF( b_part );" ) );
X__pack_text( FAO( "  s_x := ERASE_CHARACTER( 1 );" ) );
X__pack_text( FAO( "  IF s_x = ""!AS""", SUBSTR( s_part_begin, 1, 1 ) ) );
X__pack_text( FAO( "  THEN" ) );
X__pack_text( FAO( "    r_skip := SEARCH( pat_beg_1, FORWARD, EXACT );" ) );
X__pack_text( FAO( "    IF r_skip <> 0" ) );
X__pack_text( FAO( "    THEN" ) );
X__pack_text( FAO( "      s_x := """";" ) );
X__pack_text( FAO( "      MOVE_HORIZONTAL( -CURRENT_OFFSET );" ) );
X__pack_text( FAO( "      ERASE_LINE;" ) );
X__pack_text( FAO( "    ENDIF;" ) );
X__pack_text( FAO( "  ENDIF;" ) );
X__pack_text( FAO( "  IF s_x = ""!AS""", SUBSTR( s_part_end, 1, 1 ) ) );
X__pack_text( FAO( "  THEN" ) );
X__pack_text( FAO( "    r_skip := SEARCH( pat_end, FORWARD, EXACT );" ) );
X__pack_text( FAO( "    IF r_skip <> 0" ) );
X__pack_text( FAO( "    THEN" ) );
X__pack_text( FAO( "      s_x := """";" ) );
X__pack_text( FAO( "      MOVE_HORIZONTAL( -CURRENT_OFFSET );" ) );
X__pack_text( FAO( "      m_skip := MARK( NONE );" ) );
X__pack_text( FAO( "      r_skip := SEARCH( pat_beg_2, FORWARD, EXACT );" ) );
X__pack_text( FAO( "      IF r_skip <> 0" ) );
X__pack_text( FAO( "      THEN" ) );
X__pack_text( FAO( "        POSITION( END_OF( r_skip ) );" ) );
X__pack_text( FAO( "        MOVE_HORIZONTAL( -CURRENT_OFFSET );" ) );
X__pack_text( FAO( "        MOVE_VERTICAL( 1 );" ) );
X__pack_text( FAO( "        MOVE_HORIZONTAL( -1 );" ) );
X__pack_text( FAO( "      ELSE" ) );
X__pack_text( FAO( "        POSITION( END_OF( b_part ) );" ) );
X__pack_text( FAO( "      ENDIF;" ) );
V__pack_text( FAO( "      ERASE( CREATE_RANGE( m_skip, MARK( NONE ), NONE ) );"
X) );
X__pack_text( FAO( "    ENDIF;" ) );
X__pack_text( FAO( "  ENDIF;" ) );
X__pack_text( FAO( "  IF s_x = ""!AS""", s_long_line ) );
X__pack_text( FAO( "  THEN" ) );
X__pack_text( FAO( "    s_x := """";" ) );
X__pack_text( FAO( "    IF i_append_line <> 0" ) );
X__pack_text( FAO( "    THEN" ) );
X__pack_text( FAO( "      APPEND_LINE;" ) );
X__pack_text( FAO( "      MOVE_HORIZONTAL( -CURRENT_OFFSET );" ) );
X__pack_text( FAO( "    ENDIF;" ) );
X__pack_text( FAO( "    i_append_line := 1;" ) );
X__pack_text( FAO( "    MOVE_VERTICAL( 1 );" ) );
X__pack_text( FAO( "  ENDIF;" ) );
X__pack_text( FAO( "  IF s_x = ""!AS""", s_short_line ) );
X__pack_text( FAO( "  THEN" ) );
X__pack_text( FAO( "    s_x := """";" ) );
X__pack_text( FAO( "    IF i_append_line <> 0" ) );
X__pack_text( FAO( "    THEN" ) );
X__pack_text( FAO( "      APPEND_LINE;" ) );
X__pack_text( FAO( "      MOVE_HORIZONTAL( -CURRENT_OFFSET );" ) );
X__pack_text( FAO( "    ENDIF;" ) );
X__pack_text( FAO( "    i_append_line := 0;" ) );
X__pack_text( FAO( "    MOVE_VERTICAL( 1 );" ) );
X__pack_text( FAO( "  ENDIF;" ) );
X__pack_text( FAO( "  IF s_x <> """"" ) );
X__pack_text( FAO( "  THEN" ) );
X__pack_text( FAO( "    i_errors := i_errors + 1;" ) );
X__pack_text( FAO( "    s_text := CURRENT_LINE;" ) );
X__pack_text( FAO( "    POSITION( b_errors );" ) );
V__pack_text( FAO( "    COPY_TEXT( ""The following line could not be unpacked pr
Xoperly:"" );" ) );
X__pack_text( FAO( "    SPLIT_LINE;" ) );
X__pack_text( FAO( "    COPY_TEXT( s_x );" ) );
X__pack_text( FAO( "    COPY_TEXT( s_text );" ) );
X__pack_text( FAO( "    POSITION( b_part );" ) );
X__pack_text( FAO( "    MOVE_VERTICAL( 1 );" ) );
X__pack_text( FAO( "  ENDIF;" ) );
X__pack_text( FAO( "ENDLOOP;" ) );
X  !+
X  ! Unquotes all quoted characters.
X  !-
X__pack_text( FAO( "POSITION( BEGINNING_OF( b_part ) );" ) );
X__pack_text( FAO( "LOOP" ) );
V__pack_text( FAO( "  r_x := SEARCH( ""!AS"", FORWARD, EXACT );", s_quoting_char
X ) );
X__pack_text( FAO( "  EXITIF r_x = 0;" ) );
X__pack_text( FAO( "  POSITION( r_x );" ) );
X__pack_text( FAO( "  ERASE_CHARACTER( 1 );" ) );
X__pack_text( FAO( "  IF CURRENT_CHARACTER = ""!AS""", s_quoting_char ) );
X__pack_text( FAO( "  THEN" ) );
X__pack_text( FAO( "    MOVE_HORIZONTAL( 1 );" ) );
X__pack_text( FAO( "  ELSE" ) );
X__pack_text( FAO( "    COPY_TEXT( ASCII( INT( ERASE_CHARACTER( 3 ) ) ) );" ) );
X__pack_text( FAO( "  ENDIF;" ) );
X__pack_text( FAO( "ENDLOOP;" ) );
X__pack_text( FAO( "IF i_errors = 0" ) );
X__pack_text( FAO( "THEN" ) );
X__pack_text( FAO( "  SET( NO_WRITE, b_errors, ON );" ) );
X__pack_text( FAO( "ELSE" ) );
X__pack_text( FAO( "  POSITION( BEGINNING_OF( b_errors ) );" ) );
V__pack_text( FAO( "  COPY_TEXT( FAO( ""The following !!UL errors were detected
Xwhile unpacking !!AS""," ) );
X__pack_text( FAO( "    i_errors, s_file_spec ) );" ) );
X__pack_text( FAO( "  SPLIT_LINE;" ) );
X__pack_text( FAO( "  SET( OUTPUT_FILE, b_errors, ""SYS$COMMAND"" );" ) );
X__pack_text( FAO( "ENDIF;" ) );
X__pack_text( FAO( "EXIT;" ) );
XSPLIT_LINE;
X__copy_text( FAO( "$ DELETE VMS_SHARE_DUMMY.DUMMY;*" ) );
X__copy_text( FAO( "$ CHECKSUM 'FILE_IS" ) );
X__copy_text( FAO( "$ WRITE SYS$OUTPUT "" CHECKSUM "", -" ) );
V__copy_text( FAO( "  F$ELEMENT( CHECKSUM_IS .EQ. CHECKSUM$CHECKSUM, "","", ""fa
Xiled!!,passed."" )" ) );
X__copy_text( FAO( "$ RETURN" ) );
X  !+
X  ! End of routine that unpacks a file.
X  !-
X__copy_text( FAO( "$!" ) );
X__copy_text( FAO( "$START:" ) );
X
X!+
X! Loop through the buffers appending each file to the common share file.
X!-
X
Xi_file_num := 0;
XLOOP
X  i_file_num := i_file_num + 1;
X  EXITIF i_file_num > i_num_files;
X  POSITION( BEGINNING_OF( b_dummy ) );
X  MOVE_VERTICAL( i_file_num );
X  s_file_spec := __get_quoted_string;
X  s_checksum := __get_quoted_string;
V  s_file_name := FILE_PARSE( s_file_spec, "", "", NAME ) + FILE_PARSE( s_file_s
Xpec, "", "", TYPE );
X  POSITION( b_packed );
X  __copy_text( FAO( "$ FILE_IS = ""!AS""", s_file_name ) );
X  __copy_text( FAO( "$ CHECKSUM_IS = !AS", s_checksum ) );
X  __copy_text( FAO( "$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY" ) );
X  b_file := __find_buffer( s_file_spec );
-+-+-+-+-+ End of part 2 +-+-+-+-+-

