From:	CSBVAX::CSBVAX::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 10-FEB-1989 07:16
To:	MRGATE::"ARISIA::EVERHART"
Subj:	VMS_SHARE (Version 6.10) 3/4


Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Thu,  9 FEB 89 11:20:55 PDT
Received: from CUNYVM.CUNY.EDU by KL.SRI.COM with TCP; Thu, 9 Feb 89 11:07:05 PST
Received: from UKACRL.BITNET by CUNYVM.CUNY.EDU (IBM VM SMTP R1.1) with BSMTP id 8542; Thu, 09 Feb 89 14:05:56 EST
Received: from RL.IB by UKACRL.BITNET (Mailer X1.25) with BSMTP id 5895; Wed,
 08 Feb 89 13:37:22 GMT
Received: from RL.IB by UK.AC.RL.IB (Mailer X1.25) with BSMTP id 5761; Wed, 08
          Feb 89 13:37:21 GM
Via:      UK.AC.KCL.CC.OAK;  8 FEB 89 13:37:06 GMT
Date:     8-FEB-1989 13:36:36 GMT
From:     UDAA055%OAK.CC.KCL.AC.UK@CUNYVM.CUNY.EDU
To:       info-vax@KL.SRI.COM
Subject:  VMS_SHARE (Version 6.10) 3/4
Sender:   JANET "UDAA055@UK.AC.KCL.CC.OAK" <UDAA055%OAK.CC.KCL.AC.UK@CUNYVM.CUNY.EDU>
Mailer:   Janet_Mailshr V3.3 (14-Dec-1988)

+-+-+-+ Beginning of part 3 +-+-+-+
X      SPLIT_LINE;
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( bb_file );
X  ENDLOOP;
X
XENDPROCEDURE;
X
X
X
X
X!+
V! Build the prolog for all parts.  This is not repeated in every part since`0
X32
X! it is assumed that all parts will be unpacked.  The rationale for this is
X! that a file may span more than one part.
X!-
XPROCEDURE WRITE_SHARE_PROLOG( buff )
X
X   POSITION( BEGINNING_OF( buff) );
V   __copy_text( FAO( "$!! !19*. Cut between dotted lines and save. !19*." ) )
X;
X   __copy_text( FAO( "$!!!75*." ) );
V   __copy_text( FAO( "$!! VAX/VMS archive file created by !AS !AS.", s_facili
Xty_name, s_facility_version ) );
X   __copy_text( FAO( "$!!" ) );
V   __copy_text( FAO( "$!! !AS was written by James Gray (Gray:OSBUSouth@Xerox
X.COM) from", s_facility_name ) );
V   __copy_text( FAO( "$!! VMS_SHAR by Michael Bednarek (U3369429@ucsvc.dn.mu.
Xoz.au)." ) );
X   __copy_text( FAO( "$!!" ) );
V   __copy_text( FAO( "$!! To unpack, simply save, concatinate all parts into
X one file 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( "$!!" ) );
X
X   MOVE_VERTICAL( -1 );
X   m_attention_text := MARK( NONE );
X   MOVE_VERTICAL( 1 );
X
V   __copy_text( FAO( "$!! It contains the following !UL file!%S:", i_num_file
Xs ) );
X
X   MOVE_VERTICAL( -1 );
X   m_note_filename  := MARK( NONE );
X   MOVE_VERTICAL( 1 );
X
XENDPROCEDURE;
X
X
X
X
X
X
X!+
X! Append the code that will be used to unpack the files.  Note that the TPU
X! code will be compressed.
X!-
XPROCEDURE WRITE_SHARE_UNPACK( buff );
X
X   POSITION( buff );
X   __copy_text( "$!" );
X   __copy_text( FAO( "$!!!76*=" ) );
X
X
X   !+
X   ! Code to set up and check environment.
X   !-
X   __copy_text( "$ SET SYMBOL/SCOPE=( NOLOCAL, NOGLOBAL )" );
X   __copy_text( "$ VERSION = F$GETSYI( ""VERSION"" )" );
X   __copy_text( "$ IF VERSION .GES ""V4.4"" THEN GOTO VERSION_OK" );
V   __copy_text( "$ WRITE SYS$OUTPUT ""You are running VMS ''VERSION'; "", -"
X );
V   __copy_text( FAO( "    ""!AS !AS requires VMS V4.4 or higher.""", s_facili
Xty_name, s_facility_version ) );
X   __copy_text( "$ EXIT 44 ! SS$_ABORT" );
X   __copy_text( "$VERSION_OK:" );
X   __copy_text( "$ GOTO START" );
X   __copy_text( "$!" );
X
X
X   !+
X   ! Start of routine that unpacks a file.
X   !-
X   __copy_text( "$UNPACK_FILE:" );
X   __copy_text( "$ WRITE SYS$OUTPUT ""Creating ''FILE_IS'""" );
X   __copy_text( "$ DEFINE/USER_MODE SYS$OUTPUT NL:" );
V   __copy_text( "$ EDIT/TPU/COMMAND=SYS$INPUT/NODISPLAY/OUTPUT='FILE_IS'/NOSE
XCTION -" );
X   __copy_text( "    VMS_SHARE_DUMMY.DUMMY" );
X
X
X   !+
X   ! Set up buffers used during unpacking.
X   !-
V   __pack_text( "b_part := CREATE_BUFFER( ""`123Part`125"", GET_INFO( COMMAND
X_LINE, ""file_name"" ) );" );
V   __pack_text( "s_file_spec := GET_INFO( COMMAND_LINE, ""output_file"" );" )
X;
X   __pack_text( "SET( OUTPUT_FILE, b_part, s_file_spec );" );
X   __pack_text( "b_errors := CREATE_BUFFER( ""`123Errors`125"" );" );
X
X
X   !+
X   ! Initialize variables.
X   !-
X   __pack_text( "i_errors := 0;" );
V   __pack_text( FAO( "pat_beg_1 := ANCHOR & ""!AS"";", SUBSTR( s_part_begin,
X 2, 16 ) ) );
V   __pack_text( FAO( "pat_beg_2 := LINE_BEGIN & ""!AS"";", SUBSTR( s_part_beg
Xin, 1, 17 ) ) );
V   __pack_text( FAO( "pat_end := ANCHOR & ""!AS"";", SUBSTR( s_part_end, 2, 1
X3 ) ) );
X
X
X
X   !+
X   ! Insert code to strip trailing blanks as they will be superfluous
X   ! (and wrong!)
X   !-
X   __pack_text( "POSITION( BEGINNING_OF( b_part ) );" );
X   __pack_text( "LOOP" );
V   __pack_text( "  EXITIF SEARCH( SPAN( ' ' )@r_trail & LINE_END, FORWARD) =
X 0;" );
X   __pack_text( "  POSITION( r_trail );" );
X   __pack_text( "  ERASE( r_trail );" );
X   __pack_text( "ENDLOOP;" );
X
X
X
X   !+
X   ! Set up to scan the buffer and do the following:
X   !   o Remove start of line marker characters
X   !   o Recombine split lines
V   !   o Ignore begin/end part markers and garbage (eg mail headers) in betwe
Xen.
X   !-
X   __pack_text( "POSITION( BEGINNING_OF( b_part ) );" );
X   __pack_text( "i_append_line := 0;" );
X   __pack_text( "LOOP" );
X   __pack_text( "  EXITIF MARK( NONE ) = END_OF( b_part );" );
X
X
X
X   !+
X   ! Insert code to remove and examine the start of line marker character
X   !-
X   __pack_text( "  s_x := ERASE_CHARACTER( 1 );" );
X
X
X   !+
X   ! Insert code to find the start of the part
X   !-
X   __pack_text( "  IF s_x = '" + SUBSTR( s_part_begin, 1, 1 ) + "' THEN" );
X   __pack_text( "    r_skip := SEARCH( pat_beg_1, FORWARD, EXACT );" );
X   __pack_text( "    IF r_skip <> 0 THEN" );
X   __pack_text( "      s_x := '';" );
X   __pack_text( "      MOVE_HORIZONTAL( -CURRENT_OFFSET );" );
X   __pack_text( "      ERASE_LINE;" );
X   __pack_text( "    ENDIF;" );
X   __pack_text( "  ENDIF;" );
X
X
X   !+
V   ! Insert code to deal with the end of a part (ie skip garbage between part
Xs)
X   !-
X   __pack_text( "  IF s_x = '" + SUBSTR( s_part_end, 1, 1 ) + "' THEN" );
X   __pack_text( "    r_skip := SEARCH( pat_end, FORWARD, EXACT );" );
X   __pack_text( "    IF r_skip <> 0 THEN" );
X   __pack_text( "      s_x := '';" );
X   __pack_text( "      MOVE_HORIZONTAL( -CURRENT_OFFSET );" );
X   __pack_text( "      m_skip := MARK( NONE );" );
X   __pack_text( "      r_skip := SEARCH( pat_beg_2, FORWARD, EXACT );" );
X   __pack_text( "      IF r_skip <> 0 THEN" );
X   __pack_text( "        POSITION( END_OF( r_skip ) );" );
X   __pack_text( "        MOVE_HORIZONTAL( -CURRENT_OFFSET );" );
X   __pack_text( "        MOVE_VERTICAL( 1 );" );
X   __pack_text( "        MOVE_HORIZONTAL( -1 );" );
X   __pack_text( "      ELSE" );
X   __pack_text( "        POSITION( END_OF( b_part ) );" );
X   __pack_text( "      ENDIF;" );
V   __pack_text( "      ERASE( CREATE_RANGE( m_skip, MARK( NONE ), NONE ) );"
X );
X   __pack_text( "    ENDIF;" );
X   __pack_text( "  ENDIF;" );
X
X
X   !+
X   ! insert code to deal with a line flagged as continued on next line
X   !-
X   __pack_text( "  IF s_x = '" + s_long_line + "' THEN" );
X   __pack_text( "    s_x := '';" );
X   __pack_text( "    IF i_append_line <> 0 THEN" );
X   __pack_text( "      APPEND_LINE;" );
X   __pack_text( "      MOVE_HORIZONTAL( -CURRENT_OFFSET );" );
X   __pack_text( "    ENDIF;" );
X   __pack_text( "    i_append_line := 1;" );
X   __pack_text( "    MOVE_VERTICAL( 1 );" );
X   __pack_text( "  ENDIF;" );
X
X
X   !+
V   ! insert code to deal with a line flagged as non continued (or the last pa
Xrt
X   ! of a continued line.
X   !-
X   __pack_text( "  IF s_x = '" + s_short_line + "' THEN" );
X   __pack_text( "    s_x := '';" );
X   __pack_text( "    IF i_append_line <> 0 THEN" );
X   __pack_text( "      APPEND_LINE;" );
X   __pack_text( "      MOVE_HORIZONTAL( -CURRENT_OFFSET );" );
X   __pack_text( "    ENDIF;" );
X   __pack_text( "    i_append_line := 0;" );
X   __pack_text( "    MOVE_VERTICAL( 1 );" );
X   __pack_text( "  ENDIF;" );
X
X
X
X   !+
X   ! insert code to deal with any other line, which must be an error case
X   !-
X   __pack_text( "  IF s_x <> '' THEN" );
X   __pack_text( "    i_errors := i_errors + 1;" );
X   __pack_text( "    s_text := CURRENT_LINE;" );
X   __pack_text( "    POSITION( b_errors );" );
V   __pack_text( "    COPY_TEXT( ""The following line could not be unpacked pr
Xoperly:"" );" );
X   __pack_text( "    SPLIT_LINE;" );
X   __pack_text( "    COPY_TEXT( s_x );" );
X   __pack_text( "    COPY_TEXT( s_text );" );
X   __pack_text( "    POSITION( b_part );" );
X   __pack_text( "    MOVE_VERTICAL( 1 );" );
X   __pack_text( "  ENDIF;" );
X   __pack_text( "ENDLOOP;" );
X
X
X   !+
X   ! Insert code to restore escaped characters to their real selves.
X   !-
X   __pack_text( "POSITION( BEGINNING_OF( b_part ) );" );
X   __pack_text( "LOOP" );
V   __pack_text( "  r_x := SEARCH( """ + s_quoting_char + """, FORWARD, EXACT
X );" );
X   __pack_text( "  EXITIF r_x = 0;" );
X   __pack_text( "  POSITION( r_x );" );
X   __pack_text( "  ERASE_CHARACTER( 1 );" );
X   __pack_text( "  COPY_TEXT( ASCII( INT( ERASE_CHARACTER( 3 ) ) ) );" );
X   __pack_text( "ENDLOOP;" );
X
X
X   !+
X   ! Insert code to summarise all errors encountered.
X   !-
X   __pack_text( "IF i_errors = 0 THEN" );
X   __pack_text( "  SET( NO_WRITE, b_errors, ON );" );
X   __pack_text( "ELSE" );
X   __pack_text( "  POSITION( BEGINNING_OF( b_errors ) );" );
V   __pack_text( "  COPY_TEXT( FAO( ""The following !UL errors were detected w
Xhile unpacking !AS""," );
X   __pack_text( "    i_errors, s_file_spec ) );" );
X   __pack_text( "  SPLIT_LINE;" );
X   __pack_text( "  SET( OUTPUT_FILE, b_errors, ""SYS$COMMAND"" );" );
X   __pack_text( "ENDIF;" );
X   __pack_text( "EXIT;" );
X
X
X   !+
X   ! Terminate the packed TPU code properly
X   !-
X   SPLIT_LINE;
X
X
X   !+
X   ! Add the DCL needed to checksum and tidy up.
X   !-
X   __copy_text( "$ DELETE VMS_SHARE_DUMMY.DUMMY;*" );
X   __copy_text( "$ CHECKSUM 'FILE_IS" );
X   __copy_text( "$ WRITE SYS$OUTPUT "" CHECKSUM "", -" );
V   __copy_text( "  F$ELEMENT( CHECKSUM_IS .EQ. CHECKSUM$CHECKSUM, "","", ""fa
Xiled!!,passed."" )" );
X   __copy_text( "$ RETURN" );
X
X
X   !+
X   ! End of routine that unpacks a file.
X   !-
X   __copy_text( "$!" );
X   __pack_text( "$START:" );
X
XENDPROCEDURE;
X
X
X!+
X! Insert an attention mark at the beginning of the packed file if there
X! are several parts in the set.
X!
X! On completion, the previous position is restored.
X!-
VPROCEDURE WRITE_SHARE_ATTENTION( m_position, ii_max_part_blocks, ii_max_part_
Xbytes )
XLOCAL prevposition;
X
X  prevposition := MARK(NONE);
X  POSITION( m_position );
X  MOVE_VERTICAL( 1 );
X
V  __copy_text( FAO( "$!! ATTENTION: To keep each article below !UL block!%S (
X!UL byte!%S), this",
X    ii_max_part_blocks, ii_max_part_bytes ) );
V  __copy_text( FAO( "$!!!12* program has been transmitted in 999 parts.  You
X should" ) );
V  __copy_text( FAO( "$!!!12* concatenate ALL parts to ONE file and execute (@
X) that file." ) );
X  __copy_text( "$!" );
X
X  POSITION( prevposition );
X
XENDPROCEDURE;
X
X
X
X
X
X!+----------------------------------------------
X!      MAIN CODE STARTS HERE
X!+----------------------------------------------
X
Xi_max_line := 77;`009`009`009`009! Maximum length of output line.
Vpat_separator := ANY( "&(),:;<" );`009`009! Pattern used to pack TPU commands
X.
Xs_blank := " ";`009`009`009`009`009! ASCII blank character.
Xs_facility_name := "VMS_SHARE";`009`009`009! Facility name.
Xs_facility_version := "V06.10 7-FEB-1989";`009! Facility version number.
Xs_long_line := "V";`009`009`009`009! Long line prefix character.
Xs_quote := '"';`009`009`009`009`009! An ASCII quote character.
Xs_quoting_char := "`096";`009`009`009`009! 'Escape' character.
Xs_short_line := "X";`009`009`009`009! Short line prefix character.
X!+
X! NOTE: The format of the following four strings is such that this routine
X!       will always work for up to 999 parts.
X!-
Xs_part_begin := "+-+-+-+ Beginning of part !UL +-+-+-+";
Xs_part_end   := "-+-+-+-+-+ End of part !UL +-+-+-+-+-";
Xs_part_goto  := "$ GOTO PART!UL";
Xs_part_label := "$PART!UL:";
X
XINIT_ASCII;
X
X
X
X!+
X! Read in the file containing the names of the files and their checksums.
X! Extract the username, the maximum part size, the count of files to be
X! processed and the name of the output (SHARE) file.
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
Vs_share_file := __get_quoted_string;`009`009! Name of the output (SHARE) file
X.
Vs_output_file := s_share_file;`009`009`009! Internal name of the output (SHAR
XE) file.
XIF FILE_PARSE( s_output_file, "", "", TYPE ) <> "."
XTHEN
X  s_output_file := s_output_file + "_";
XENDIF;
X
X
X
X!+
X!  Create and initialize a buffer to hold the created SHARE file
X!-
Xb_packed := CREATE_BUFFER( "`123Packed`125" );
XWRITE_SHARE_PROLOG( b_packed );
XWRITE_SHARE_UNPACK( b_packed );
X
X
X!+
X! Loop through the files appending each file to the common share file.
X!-
Xi_file_num := 0;
XLOOP
X  i_file_num := i_file_num + 1;
X  EXITIF i_file_num > i_num_files;
X
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
X_spec, "", "", TYPE );
X
X  POSITION( m_note_filename );
X  MOVE_VERTICAL( i_file_num );
X  __copy_text( "$!        " + s_file_name );
X
X  b_file := CREATE_BUFFER( s_file_spec, s_file_spec );
X  SET( NO_WRITE, b_file, ON );
X  QUOTE_BUFFER( b_file, s_quoting_char );`009! Escape the escape character
X  QUOTE_BUFFER( b_file, pat_control );`009`009! Escape control chars
X  QUOTE_BUFFER( b_file, " "&LINE_END );`009`009! Escape trailing blanks
X  WRAP_AND_PREFIX_LINES( b_file);`009`009! Do line wrapping etc.
X
X  POSITION( END_OF( b_packed ) );
X  __copy_text( "$ FILE_IS = """ + s_file_name + """" );
X  __copy_text( "$ CHECKSUM_IS = " +  s_checksum );
X  __copy_text( "$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY" );
X  COPY_TEXT( b_file );
X  DELETE( b_file );
X
X  __copy_text( "$ GOSUB UNPACK_FILE" );
X
XENDLOOP;
XCOPY_TEXT( "$ EXIT" );
X
X
X!+
X! Compute the size of the packed buffer.
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!+
X! Handle differently if only one part or more than one part will be written.
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  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  !+
V  WRITE_SHARE_ATTENTION( m_attention_text, i_max_part_blocks, i_max_part_byte
Xs );
X
X
V  ! Skip the first part for now since the number of parts will have to be cor
Xrected later.
X  !-
X  POSITION( BEGINNING_OF( b_packed ) );
X  __find_part_end;
X  MOVE_HORIZONTAL( -(CURRENT_OFFSET + 1) );
X
X
X  !+
-+-+-+-+-+ End of part 3 +-+-+-+-+-

