"James_A._Gray.OsbuSouth"@XEROX.COM (05/27/88)
+-+-+-+ Beginning of part 2 +-+-+-+
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;
Xb_ascii := CREATE_BUFFER( "{ASCII}" );
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
Xb_dummy := CREATE_BUFFER( "{Share}", GET_INFO( COMMAND_LINE, "FILE_NAME" ) );
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( "{Packed}" );
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." ) );
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 ) | 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 !+
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( "{TPU}" );
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( ""{Part}"", GET_INFO( COMMAND_LINE,
X ""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( ""{Errors}"" );" ) );
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 );
X COPY_TEXT( b_file );
X DELETE( b_file );
X __copy_text( FAO( "$ GOSUB UNPACK_FILE" ) );
XENDLOOP;
XCOPY_TEXT( FAO( "$ EXIT" ) );
X
X!+
X! Compute the size of the packed buffer.
X!-
X
Xi_length := 0;
XPOSITION( BEGINNING_OF( b_packed ) );
XLOOP
X EXITIF MARK( NONE ) = END_OF( b_packed );
X i_line_length := LENGTH( CURRENT_LINE ) + 2;
X IF ( i_line_length - ( ( i_line_length / 2 ) * 2 ) ) <> 0
X THEN
X i_line_length := i_line_length + 1;
X ENDIF;
X i_length := i_length + i_line_length;
X MOVE_VERTICAL( 1 );
XENDLOOP;
X
X!+
X! Handle differently if only one part or more than one part will be written.
X!-
X
XIF i_length < i_max_part_bytes
XTHEN
X
X !+
X ! Set the number of parts and the name of the output file.
X !-
X
X i_parts := 1;
X SET( OUTPUT_FILE, b_packed, FAO( "!AS1_OF_1", s_output_file ) );
X
XELSE
X
X !+
X ! Since more than one part will be written, insert the ATTENTION message.
X !-
X
X POSITION( m_attention_text );
X MOVE_VERTICAL( 1 );
V __copy_text( FAO( "$!! ATTENTION: To keep each article below !UL block!%S (!U
XL byte!%S), this",
X i_max_part_blocks, i_max_part_bytes ) );
V __copy_text( FAO( "$!!!12* program has been transmitted in 999 parts. You sh
Xould" ) );
-+-+-+-+-+ End of part 2 +-+-+-+-+-