$ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
$! ------------------ CUT HERE -----------------------
$!
$! This archive created by VMS_SHARE Version 7.1-002  17-JUl-1989
$!   On  8-SEP-1989 17:51:35.07   By user FAUCONNET 
$!
$! This VMS_SHARE Written by:
$!    Andy Harper, Kings College London UK
$!
$! Acknowledgements to:
$!    James Gray       - Original VMS_SHARE
$!    Michael Bednarek - Original Concept and implementation
$!
$! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER
$! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )
$!
$! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:
$!       1. VMS_SHARE.BUGS;3
$!       2. VMS_SHARE.COM;54
$!       3. VMS_SHARE.HLP;7
$!
$set="set"
$set symbol/scope=(nolocal,noglobal)
$f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID"))
$e="write sys$error  ""%UNPACK"", "
$w="write sys$output ""%UNPACK"", "
$ if f$trnlnm("SHARE_LOG") then $ w = "!"
$ if f$getsyi("version") .ges. "4.4" then $ goto START
$ e "-E-OLDVER, Must run at least VMS 4.4"
$ v=f$verify(v)
$ exit 44
$UNPACK: SUBROUTINE ! P1=filename, P2=checksum
$ if f$search(P1) .eqs. "" then $ goto file_absent
$ e "-W-EXISTS, File ''P1' exists. Skipped."
$ delete/nolog 'f'*
$ exit
$file_absent:
$ if f$parse(P1) .nes. "" then $ goto dirok
$ dn=f$parse(P1,,,"DIRECTORY")
$ w "-I-CREDIR, Creating directory ''dn'."
$ create/dir 'dn'
$ if $status then $ goto dirok
$ e "-E-CREDIRFAIL, Unable to create ''dn'. File skipped."
$ delete/nolog 'f'*
$ exit
$dirok:
$ w "-I-PROCESS, Processing file ''P1'."
$ define/user sys$output nl:
$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1'
PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET(
SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");
buff:=CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(buff))
;LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION(
BEGINNING_OF(buff));g:=0;LOOP EXITIF MARK(NONE)=END_OF(buff);x:=
ERASE_CHARACTER(1);IF g = 0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x=
"V" THEN APPEND_LINE;MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;
IF x="+" THEN g:=1;ERASE_LINE;ENDIF;ELSE IF x="-" THEN g:=0;ENDIF;ERASE_LINE;
ENDIF;ENDLOOP;p:="`";POSITION(BEGINNING_OF(buff));LOOP r:=SEARCH(p,FORWARD);
EXITIF r=0;POSITION(r);ERASE(r);COPY_TEXT(ASCII(INT(ERASE_CHARACTER(3))));
ENDLOOP;o:=GET_INFO(COMMAND_LINE,"output_file");WRITE_FILE(buff,o);
ENDPROCEDURE;Unpacker;EXIT;
$ delete/nolog 'f'*
$ CHECKSUM 'P1'
$ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT
$ e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ ENDSUBROUTINE
$START:
$ create/nolog 'f'
X`009`009V M S _ S H A R E   B U G   F I X E S
X
X    `009`009`009 Version 7.1-002
X
X
X
X
X1. INTRODUCTION
X
XThis document is an addendum to the main release notes for VMS_SHARE`032
Xdescribing all the bugs fixed since the last major release 7.1
X
X
X
X2. BUG FIX DESCRIPTIONS
X
X2.1 Verification
X
XVMS_SHARE now turns verification of the DCL code on or off based on the`032
Xdefinition of the logical name SHARE_VERIFY. Previously no attempt was made
V to`032
Xalter the verification setting. The environment is restored on exit.
X
XIf SHARE_VERIFY is defined as TRUE (or 1 or YES etc.) then verification is`0
V32
Xenabled. If defines as FALSE (or 0 or NO etc.) or is not defined at all,`032
Xverification is disabled.
X
XNote that this logical defines verification both for VMS_SHARE itself and fo
Vr`032
Xany unpack operations performed on the created archive.
X
XNote also that if the user has no READ access to the procedure (recommended)
V`032
Xthen verification is always disabled.
X
XThe .HLP file has been updated to include a reference to this logical and it
Vs`032
Xdefinitions.
X
X
X
X2.2 Symbol Redefinition
X
XVMS_SHARE now uses the SET SYMBOL command to insulate itself from any symbol
V`032
Xdefinitions made by the user. Both local and global definitions of any DCL
Xsymbols are ignored.  If VMS_SHARE exits normally then the original setting
V is`032
Xrestored. However, an abnormal exit may cause the new settings to be retaine
Vd.`032
XThis may cause confusion if a user is unaware of what has happened.
X
XPreviously any external symbol definitions matching commands used internally
V`032
Xto VMS_SHARE would cause unexpected actions and usually cause VMS_SHARE to`0
V32
Xfail.
X
X
X
X2.3 Spurious Rejection of certain files
X
XVMS_SHARE contains code to reject any attempt to include the output files in
V`032
Xthe packed archive on the grounds that packing an archive into itself is not
V`032
Xsensible. However the code for this check was faulty due to an undocumented`
V032
X'feature' of the f$integer lexical which returns 1 if a string starts with`0
V32
XT or Y (in other words, does a conversion from boolean to integer where T,Y
V =`032
X1 and F, N = 0). This caused some perfectly valid filenames to be rejected o
Vn
Xthe grounds that they had the same name as the output file.
X
XAs an example, if the output file is specified as 'V' then invalid input fil
Ves
Xwould be anything starting with this name followed by a number, such as 'V.1
V',
X'V.2' etc. The bug also caused files 'V.T' and 'V.Y' to be invalid.`032
X
XThe code has now been fixed by avoiding the use of f$integer until the strin
Vg`032
Xhas been checked with f$type to make sure it really is a number.
X
X
X
XAndy Harper
X17-JUL-1989
$ CALL UNPACK VMS_SHARE.BUGS;3 422992384
$ create/nolog 'f'
X$ v = 'f$verify(f$trnlnm("SHARE_VERIFY"))'
X$! Purpose:
X$!`009Package a series of files into a format that can be mailed across
X$!      most networks without damage.
X$!
X$! Parameters:
X$!`009P1 = a comma separated list of file specifications which are to be
X$!`009     packaged together.  Only files in or below the current`032
X$!`009     subdirectory are permitted.
X$!
X$!`009P2 = The name of an output share file. Any version number specified
X$!`009     here is ignored and the next highest version created. The file
X$!`009     may not appear in the input list.
X$!
X$! Privileges:
X$!`009None required
X$!
X$! Environment:
X$!`009Requires at least VMS 4.4 in order to use GOSUB
X$!
X$! Revision History:
X$!`0097.0`009Andy Harper`0099-May-1989`009Complete rewrite
X$!`0097.1`009Andy Harper`00915-Jun-1989`009Add file exclusion
X$!`0097.1-001`009Andy Harper`00929-JUN-1989`009Minor bug fixes
X$!`0097.1-002 Andy Harper`00917-JUL-1989`009Further minor bug fixes
X$
X$
X$! INSULATE USER FROM EXTERNAL SYMBOL DEFINITIONS
X$ set = "set"
X$ set symbol/scope=(nolocal,noglobal)
X$
X$
X$! DEFINE ESSENTIAL SYMBOLS
X$ temp = f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID")) - ";"
X$ em="write sys$error ""%"+f$parse(f$environment("PROCEDURE"),,,"NAME")+ """
V,"
X$ default = f$parse("") - ".;"
X$
X$ set noon
X$ on control_y then $ goto abort
X$
X$
X$! GET LIST OF FILES TO BE PACKAGED
X$get_filespec:
X$ if P1 .nes. "" then $ goto end_get_filespec
X$ read/prompt="Filespec : " sys$command P1
X$ goto get_filespec
X$end_get_filespec:
X$
X$
X$! GET NAME OF OUTPUT FILE
X$sharespec:
X$ if P2 .nes. "" then $ goto end_sharespec
X$ read/prompt="Share file : " sys$command P2
X$ goto sharespec
X$end_sharespec:
X$ P2 = f$parse(P2,,,,"SYNTAX_ONLY") - f$parse(P2,,,"VERSION")
X$ if f$parse(P2,,,"TYPE") .nes. "." then $ P2 = P2 + "_"
X$
X$
X$! PICK UP PARAMETERS FROM USER, VIA LOGICALS. SET NECESSARY DEFAULTS
X$ Real_Name = f$trnlnm("SHARE_REAL_NAME")
X$ if Real_Name .nes. "" then $ Real_Name = "(" + Real_Name + ")"
X$
X$ Max_Part_Size = f$integer(f$trnlnm("SHARE_PART_SIZE"))
X$ if Max_Part_Size .eq. 0 then $ Max_Part_Size = 30
X$ if Max_Part_Size .lt. 6 then $ Max_Part_Size = 6
X$
X$`032
X$ X_dir  = f$edit(f$trnlnm("SHARE_EXCLUDE_DIRS"), "UPCASE") + ","
X$ X_name = f$edit(f$trnlnm("SHARE_EXCLUDE_NAMES"),"UPCASE") + ","
X$ X_type = f$edit(f$trnlnm("SHARE_EXCLUDE_TYPES"),"UPCASE") + ",.DIR,"
X$
X$
X$! OPEN A FILE FOR PASSING PARAMETERS TO THE TPU CODE
X$ open/write/error=cantopen xx_share_params 'temp'
X$ write xx_share_params f$edit(f$getjpi("","USERNAME"),"TRIM")," ", Real_Nam
Ve
X$ write xx_share_params Max_Part_Size
X$ write xx_share_params P2
X$
X$
X$! INITIALIZE FOR SCANNING THE FILENAMES
X$ file_count = 0
X$ file_element = -1
X$
X$! GET NEXT ELEMENT FROM COMMA SEPARATED LIST OF WILDCARDED FILESPEC ELEMENT
VS
X$next_file_element:
X$ file_element = file_element + 1
X$ file = f$element(file_element,",",P1)
X$ if file .eqs. "," then $ goto no_more_files
X$
X$
X$! DO WE HAVE A FILE THAT MATCHES THIS SPECIFICATION???
X$ file_name = f$search(file)
X$ if file_name .eqs. "" then $ em "-W-FNF, ''file' not found. Ignored."
X$ if file_name .eqs. "" then $ goto next_file_element
X$
X$`032
X$! WE HAVE A VALID FILE SPEC SO GO DO SOME WORK ON IT.
X$fname:
X$ F_dir = f$parse(file_name,,,"DIRECTORY") +","
X$ F_name= f$parse(file_name,,,"NAME") + ","
X$ F_type= f$parse(file_name,,,"TYPE") + ","
X$ if file_name-f$parse(file_name,,,"VERSION") .nes. temp then $ -
X    if f$locate(F_dir,X_dir) .eq. f$length(X_dir) then $ -
X        if f$locate(F_name,X_name) .eq. f$length(X_name) then $ -
X            if f$locate(F_type,X_type) .eq. f$length(X_type) then $ -
X                gosub process_file
X$
X$
X$! LOCATE THE NEXT MATCHING FILENAME
X$ previous_file = file_name
X$ file_name = f$search(file)
X$ if file_name .nes. "" .and. file_name .nes. previous_file then $ goto fnam
Ve
X$ goto next_file_element
X$
X$
X$! NO MORE FILES, PROCESS THE LIST WE HAVE OBTAINED.
X$no_more_files:
X$ close xx_share_params
X$ if file_count .ne. 0 then $ goto dopacking
X$ em "-E-NOFILES, No files found."
X$ goto cleanup
X$
X$
X$
X$Process_File: ! file_name, P2 (sharefile), file_count, default
X$
X$! CHECK FILE IS WITHIN OR BELOW CURRENT SUBDIRECTORY, REMOVE LEADING STUFF
X$  x = file_name
X$  check = x - f$parse(x,,,"VERSION") - P2
X$  if f$type(check) .eqs. "INTEGER" then $ if check .gt. 0 then goto igsh
X$  x = x - (default-"`093")
X$  c = f$extract(0,1,x)
X$  if c .nes. "`093" .and. c .nes. "." then $ goto cantarchive
X$  x = "`091" + x - "`091`093"
X$
X$  file_count = file_count + 1
X$  em "-I-SELECTED, Selected file ''file_count' - ''x'"
X$  checksum 'x'
X$  write xx_share_params x, " ", checksum$checksum
X$  return
X$
X$igsh:
X$  em "-W-SHRNOTPACK, Share file part ''file_name' discovered. Not packaged!
V"
X$  return
X$
X$cantarchive:
X$ em "-E-NOTINTREE, ''file_name' not within/below current dir."
X$ goto cleanup
X$
X$cantopen:
X$ em "-E-NOPARFIL, Unable to open temporary parameter file ''temp'"
X$ goto reset_environment
X$
X$abort:
X$ em "-F-ABORT, Abort detected. Packing abandoned."
X$cleanup:
X$ if f$trnlnm("xx_share_params") .nes. "" then $ close xx_share_params
X$ if f$search(temp) .nes. "" then $ delete /nolog /noconfirm 'temp';*
X$reset_environment:
X$ v = f$verify(v)
X$ exit 44
X$
X$
X$! WEVE GOT A LIST OF FILES TO PACK SO LETS DO IT NOW!
X$dopacking:
X$ edit/tpu/nosec/nodis/com=sys$input 'temp'
X! +--------------------------------------------------------------------+
X! + FACILITY:                                                          +
X! +         VMS_SHARE                                                  +
X! +                                                                    +
X! + PURPOSE:                                                           +
X! +         To package a series of plain text files into a format that +
X! +         can be successfully mailed through most networks without   +
X! +         damage:                                                    +
X! +                                                                    +
X! +         Characters prone to translation by mailers/networks are    +
X! +         encoded into a form that will (hopefully) not be altered   +
X! +         but we cannot recover if they ARE altered despite the      +
X! +         encoding. A checksum is included so we can at least detect +
X! +         corruption.                                                +
X! +                                                                    +
X! + RESTRICTIONS:                                                      +
X! +         Text files only, NOT binary or executables                 +
X! +                                                                    +
X! +         No retransmit protocol with mailers, so cannot recover     +
X! +         from mangled mail files such as missing lines, character   +
X! +         translations etc.                                          +
X! +                                                                    +
X! + VERSION:                                                           +
X! +         7.0-001   Pack multiple files into single part             +
X! +         7.0-002   Produce multiple parts < Some maximum size       +
X! +         7.0-003   Deal with subdirectories on output               +
X! +         7.0-004   Output packed TPU code to unpack files           +
X! +         7.0-005   Quote troublesome characters & trailing blanks   +
X! +         7.0-006   Wrap long lines                                  +
X! +         7.1-001   Various bug fixes for release                    +
X! +         7.1-002   Further minor bug fixes                          +
X! +                                                                    +
X! +  AUTHOR:                                                           +
X! +         (C) ANDY HARPER, KINGS COLLEGE LONDON, UK     1989         +
X! +                                                                    +
X! +  CREDITS:                                                          +
X! +         James Gray for the first version of VMS_SHARE              +
X! +         Michael Bednarek for the original idea and prototype       +
X! +                                                                    +
X! +--------------------------------------------------------------------+
X!
X!
X`012
X! +--------------------------------------------------------------------+
X! + Initialisation routine to set up global constant values            +
X! +--------------------------------------------------------------------+
X
XPROCEDURE Init_Constants;
X
X   FAC_name       := "VMS_SHARE";`009! Facility name/version
X   FAC_vers       := "7.1-002  17-JUl-1989";
X   FAC_unpack     := "UNPACK";`009`009! Facility name of unpack code
X
X   DEBUG_state    := 0;`009`009`009! Turn debugging ON/OFF
X   Max_Line_Length:= 77;`009`009! Maximum length of coded/packed lines
X   Max_Parts      := 999;`009`009! Maximum number of parts supported
X
X   SPLIT_disallowed   := 0;`009`009! Flags for dealing with part breaks
X   SPLIT_permit_goto  := 1;
X   SPLIT_inhibit_goto := 2;
X
X   FAO_end_goto   := "$ GOTO PART!UL";`009! Format strings for part separato
Vrs
X   FAO_start_label:= "$PART!UL:";
X   FAO_end_part   := "+-+-+-+-+-+-+-+-  END  OF PART !UL +-+-+-+-+-+-+-+-";
X   FAO_start_part := "-+-+-+-+-+-+-+-+ START OF PART !UL -+-+-+-+-+-+-+-+";
X                     `032
X   TPU_Max_Record_Length := 960;`009! Max record length TPU supports
X
X   TPU_separators := "&(),=;>@";`009! Split packed TPU code on these
X
X   Quote_Flag := "`096";`009`009`009! Flag for escaping troublesome chars
X
X   Flag_Initial_Line      := "X";`009! Flag first line of a long line
X   Flag_Continuation_Line := "V";`009! Flag continuation lines.
X
XENDPROCEDURE;
X`012
X! +--------------------------------------------------------------------+
X! + Initialisation routine to set up tables                            +
X! +                                                                    +
X! + This routine sets up global tables that are used to perform various+
X! + conversions on the characters in the files:                        +
X! +                                                                    +
X! +    ASCII_CHARS:     A table of ascii characters, used for mapping  +
X! +                     characters into their 'escaped' form.          +
X! +                                                                    +
X! +    NON_PRINTABLES:  A table of characters which have no visible    +
X! +                     representation. Used for determining which     +
X! +                     characters to 'escape'.                        +
X! +                                                                    +
X! +    TROUBLE_CHARS:   Characters which may get randomly converted on +
X! +                     passing thru the network and which therefore   +
X! +                     will need 'escaping'.                          +
X! +                                                                    +
X! +--------------------------------------------------------------------+
X
XPROCEDURE Init_Tables
XLOCAL c;
X
X  c := 0;
X  ascii_chars    := "";`009`009`009! Table of ASCII characters
X  Non_Printables := "";`009`009`009! Table of non-printing chars
X
X  LOOP
X    EXITIF C > 255;
X    ascii_chars := ascii_chars + ASCII(c);
X
X    IF (c < 32) OR (c > 126)
X      THEN
X         Non_Printables := Non_Printables + ASCII(c);
X    ENDIF;
X    c:=c+1;
X  ENDLOOP;
X   `032
X  Trouble_chars :=`009`009`009! Troublesome characters
X                   ASCII(91)`009`009! Left square bracket
X                 + ASCII(93)`009`009! Right square bracket
X                 + ASCII(94)`009`009! Caret
X                 + ASCII(123)`009`009! Left curly bracket
X                 + ASCII(124)`009`009! Vertical bar
X                 + ASCII(125)`009`009! Right curly bracket
X                 + ASCII(126)`009`009! Tilde
X                ;
X
X  Funny_Chars := Non_Printables + Trouble_Chars + Quote_Flag;
X
XENDPROCEDURE;
X`012
X! +--------------------------------------------------------------------+
X! +                                                                    +
X! +  GENERAL UTILITY ROUTINES:                                         +
X! +                                                                    +
X! +     Inform(Xsev,Xident,Xtext);                                     +
X! +        Output error message in usual VMS format                    +
X! +                                                                    +
X! +     Size_Buffer(Xbuffer);                                          +
X! +        Returns the size in bytes of an arbitrary buffer. The       +
X! +        routine estimates the amount of disk space the buffer       +
X! +        would occupy if written to a file.  Ends of lines count as  +
X! +        three characters here. This is a slight overestimate in     +
X! +        practice but suffices.                                      +
X! +                                                                    +
X! +     Write_Part(Xbuffer,Part);                                      +
X! +        Writes an arbitrary buffer to a file. The current share file+
X! +        name is selected and the current 'part' number appended to  +
X! +        the filename (eg. X.SHARn)                                  +
X! +                                                                    +
X! +     Move_Info(FromBuf,ToBuf);                                      +
X! +        Shorthand for moving all info from one buffer to another    +
X! +                                                                    +
X! +     Copy_Line(Xstring);                                            +
X! +        Adds a string to the current buffer and follows it with a   +
X! +        new line character.                                         +
X! +                                                                    +
X! +     Reuse_Buffer(Xbuffer)                                          +
X! +        Erase buffer contents and position to it.                   +
X! +                                                                    +
X! +                                                                    +
X! +--------------------------------------------------------------------+
X
X
X
XPROCEDURE Inform(Xsev,xident,Xtext)
XLOCAL prefix;
X
X  prefix := "%" + FAC_name + "-" + Xsev + "-" + Xident;
X  MESSAGE( prefix + ", " + Xtext);
X
XENDPROCEDURE;
X
X
X `032
XPROCEDURE Size_Buffer(Xbuffer)
XLOCAL Size_Chars, Size_Lines;
X
X   Size_Chars := LENGTH(CREATE_RANGE(BEGINNING_OF(Xbuffer),END_OF(Xbuffer),N
VONE));
X   Size_Lines := GET_INFO(Xbuffer,"RECORD_COUNT");
X   RETURN( Size_Chars + 3 * Size_Lines );
X
XENDPROCEDURE;
X
X
X
XPROCEDURE Write_Part(Xbuffer,Part)
XLOCAL f,r;
X
XON_ERROR
X  Inform("E","FILWRERR", "Error writing part to file " + f);
XENDON_ERROR;
X
X   f := Share_File+STR(Part);
X   WRITE_FILE(Xbuffer,f);
X
X   IF DEBUG_state
X      THEN
X        r := GET_INFO(Xbuffer,"RECORD_COUNT");
X        Inform("I","DBGWRFIL",FAO("!UL line!%S written to !AS.",r,f));
X   ENDIF;
X
XENDPROCEDURE;
X
X
X
XPROCEDURE Move_Info(FromBuf, ToBuf)
X
X   POSITION(ToBuf);   MOVE_TEXT(FromBuf);
X
XENDPROCEDURE;
X
X
X
XPROCEDURE Copy_Line(Xstring)
X
X   COPY_TEXT(Xstring); SPLIT_LINE;
X
XENDPROCEDURE;
X
X
X
XPROCEDURE Reuse_Buffer(Xbuffer);
X
X   ERASE(Xbuffer);
X   POSITION(Xbuffer);
X
XENDPROCEDURE;
X`012
X! +--------------------------------------------------------------------+
X! + TPU CODE COMPRESSION ROUTINES                                      +
X! +                                                                    +
X! +    Pack_TPU(Xstring);                                              +
X! +       This routine takes a line of TPU code as a parameter and     +
X! +       adds it to the current buffer in a way that minimises        +
X! +       as much redundant information as possible to produce as few  +
X! +       lines as possible.  The compressed code will be added to the +
X! +       output file to perform file decoding/unpacking.              +
X! +                                                                    +
X! +--------------------------------------------------------------------+
X
X
XPROCEDURE Pack_TPU(Xstring)
XLOCAL s,c;
X
X  POSITION(END_OF(CURRENT_BUFFER));
X  MOVE_HORIZONTAL(-1);
X
X  s := Xstring;
X  EDIT(s,TRIM);
X  COPY_TEXT(s);
X
X  c := SUBSTR(s,LENGTH(s),1);
X  IF INDEX(TPU_separators,c) = 0
X    THEN
X      COPY_TEXT(" ");
X  ENDIF;
X
X  LOOP
X    EXITIF CURRENT_OFFSET < Max_Line_Length;
X    MOVE_HORIZONTAL(-1);
X    POSITION( SEARCH( ANY(TPU_separators),REVERSE) );
X  ENDLOOP;
X                       `032
X  IF LENGTH(CURRENT_LINE) > Max_Line_Length
X    THEN
X      MOVE_HORIZONTAL(1);`009! Split just past the separator character
X      SPLIT_LINE;
X  ENDIF;
X
X  IF DEBUG_state
X    THEN
X      Inform("I","DBGPCKTPUCUR","Current line is """ + CURRENT_LINE + """");
X      Inform("I","DBGPCKTPUNEW","New string is   """ + s + """");
X      Inform("I","DBGPCKTPULST","Last char is    """ + c + """");
X  ENDIF;
X
XENDPROCEDURE;
X`012
X! +--------------------------------------------------------------------+
X! + BUFFER ENCODING ROUTINES                                           +
X! +                                                                    +
X! +    Quote_Character;                                                +
X! +        Replaces the current character by an 'escape sequence'      +
X! +        consisting of a flag character followed by exactly 3 digits +
X! +        where the digits are the ASCII code of the character being  +
X! +        replaced.                                                   +
X! +                                                                    +
X! +        The intention is to change characters which may get altered +
X! +        in transit into something that is likely to pass thru       +
X! +        unchanged. Restoration is effected at the receiving end.    +
X! +                                                                    +
X! +    Quote_Buffer(Xbuffer,p);                                        +
X! +        This routine searches a buffer for a particular pattern     +
X! +        (Usually one of a series of specific characters) and        +
X! +        replaces the first character of that pattern by the 'escape'+
X! +        sequence. This is performed at each occurence of that       +
X! +        pattern in the buffer.                                      +
X! +                                                                    +
X! +    Wrap_Lines(Xbuffer, Max_Length);                                +
X! +        This routine wraps lines longer than a fixed size so that   +
X! +        all lines are less/equal to this size.  To allow rejoining  +
X! +        All lines are prefixed with a flag to indicate an initial   +
X! +        line or a continuation line.                                +
X! +                                                                    +
X! +        The intention here is to anticipate the actions of mailers  +
X! +        which have line limits and preempt their wrapping attempts  +
X! +        which would corrupt the data being transmitted. Doing it    +
X! +        this way, we have control over rejoining them.              +
X! +                                                                    +
X! +--------------------------------------------------------------------+
X
X
X
XPROCEDURE Quote_Character
X
X  COPY_TEXT(Quote_Flag+FAO("!3ZL",INDEX(ascii_chars,ERASE_CHARACTER(1))-1));
X
XENDPROCEDURE;
X`012
XPROCEDURE Quote_Buffer(Xbuffer, p)
XLOCAL r;
X
XON_ERROR
X  IF ERROR = TPU$_STRNOTFOUND THEN RETURN; ENDIF;
XENDON_ERROR;
X
X  POSITION( BEGINNING_OF(Xbuffer) );
X
X  LOOP
X    r := SEARCH(p, FORWARD, EXACT);
X    EXITIF r=0;
X    POSITION(r);
X
X    IF DEBUG_state
X      THEN
X        Inform("I","DBGQUOBEFORE", "Current_Line_before="""+CURRENT_LINE+"""
V");
X    ENDIF;
X
X    IF LENGTH(CURRENT_LINE)+3 > TPU_Max_Record_Length
X      THEN
X        Inform("W","TPULONGREC", "Line overlong, Quoting suppressed");
X        Inform("W","CURLINEIS",  """" + CURRENT_LINE + """");
X        MOVE_HORIZONTAL(-CURRENT_OFFSET);
X        MOVE_VERTICAL(1);
X      ELSE
X        Quote_Character;
X    ENDIF;
X
X    IF DEBUG_state
X      THEN
X        Inform("I","DBGQUOAFTER", "Current_Line_after ="""+CURRENT_LINE+""""
V);
X    ENDIF;
X
X  ENDLOOP;
X
XENDPROCEDURE;
X`012
XPROCEDURE Wrap_Lines(Xbuffer, Max_Length)
X
X  POSITION( BEGINNING_OF( Xbuffer ) );
X  LOOP
X    EXITIF MARK(NONE) = END_OF( CURRENT_BUFFER );
X
X    COPY_TEXT( Flag_Initial_Line );
X    LOOP
X      EXITIF LENGTH(CURRENT_LINE) <= Max_Length;
X `032
X      ! Find Last non-blank char on line
X      MOVE_HORIZONTAL(Max_Length-1);`032
X      LOOP
X        MOVE_HORIZONTAL(-1);
X        EXITIF (CURRENT_CHARACTER <> " ") OR (CURRENT_OFFSET < 2);
X      ENDLOOP;
X
X      IF DEBUG_state
X        THEN
X          Inform("I","DBGWRPSPLIT","Splitting Line """+CURRENT_LINE+"""");
X          Inform("I","DBGWRPCHAR", "Split char = """+CURRENT_CHARACTER+"""")
V;
X          Inform("I","DBGWRPOFF",  "Offset = " + STR(CURRENT_OFFSET));
X      ENDIF;
X
X      IF CURRENT_OFFSET < 2
X        THEN
X          MOVE_HORIZONTAL(Max_Length-5);
X          Quote_Character;
X        ELSE
X          MOVE_HORIZONTAL(1);
X      ENDIF;
X
X      ! Split line at last non-blank char or at max line length
X      SPLIT_LINE;
X      COPY_TEXT(Flag_Continuation_Line);
X    ENDLOOP;
X`032
X    ! Move to start of next genuine line
X    MOVE_HORIZONTAL(-1);
X    MOVE_VERTICAL(1);
X
X  ENDLOOP;
X
XENDPROCEDURE;
X`012
X! +--------------------------------------------------------------------+
X! + Routines to create headers and trailers for insertion in share file+
X! +--------------------------------------------------------------------+
X
X                                                 `032
XPROCEDURE Create_Prologue_Head(Xbuffer, Creator, Blocks, Start_File_List)
XLOCAL filecount,file,nextfile;
X
X  Reuse_Buffer(Xbuffer);
X
X  Copy_Line( "$ v='f$verify(f$trnlnm(""SHARE_VERIFY""))'");
X  Copy_Line( "$! ------------------ CUT HERE -----------------------");
X  Copy_Line( "$!" );
X  Copy_Line( "$! This archive created by " + FAC_name + " Version " + FAC_ve
Vrs);
X  Copy_Line( FAO("$!!   On !%D   By user !AS", 0, Creator) );
X  Copy_Line( "$!" );
X  Copy_Line( "$! This " + FAC_name + " Written by:");
X  Copy_Line( "$!    Andy Harper, Kings College London UK");
X  Copy_Line( "$!" );
X  Copy_Line( "$! Acknowledgements to:");
X  Copy_Line( "$!    James Gray       - Original VMS_SHARE");
X  Copy_Line( "$!    Michael Bednarek - Original Concept and implementation")
V;
X  Copy_Line( "$!");
X  Copy_Line( "$!+ THIS PACKAGE DISTRIBUTED IN 999 PARTS, TO KEEP EACH PART")
V;
X  Copy_Line( "$!  BELOW " + STR(Blocks) + " BLOCKS");
X  Copy_Line( "$!");
X  Copy_Line( "$! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER")
V;
X  Copy_Line( "$! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )");
X  Copy_Line( "$!");
X  Copy_Line( "$! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:");
X
X  filecount := 0;
X  nextfile := Start_File_List;
X  LOOP
X     POSITION(nextfile);
X     EXITIF MARK(NONE) = END_OF(CURRENT_BUFFER);
X
X     file := SUBSTR(CURRENT_LINE,1,INDEX(CURRENT_LINE," ")-1);
X     MOVE_VERTICAL(1);
X     nextfile := MARK(NONE);
X
X     POSITION(Xbuffer);
X     filecount := filecount + 1;
X     Copy_Line( FAO("$!!     !3UL. !AS", filecount, file));
X
X     IF DEBUG_state
X        THEN
X          Inform("I","DBGPROADFIL","Adding name """ + file + """ to prologue
V");
X     ENDIF;
X
X  ENDLOOP;
X  POSITION(Xbuffer);
X
X  Copy_Line( "$!");
X  Copy_Line( "$set=""set""");
X  Copy_Line( "$set symbol/scope=(nolocal,noglobal)");
X  Copy_Line( "$f=f$parse(""SHARE_TEMP"",""SYS$SCRATCH:.TMP_""+f$getjpi("""",
V""PID""))");
X  Copy_Line( "$e=""write sys$error  """"%"+FAC_unpack+""""", """);
X  Copy_Line( "$w=""write sys$output """"%"+FAC_unpack+""""", """);
X  Copy_Line( "$ if f$trnlnm(""SHARE_LOG"") then $ w = ""!""");
X  Copy_Line( "$ if f$getsyi(""version"") .ges. ""4.4"" then $ goto START");
X  Copy_Line( "$ e ""-E-OLDVER, Must run at least VMS 4.4""");
X  Copy_Line( "$ v=f$verify(v)");
X  Copy_Line( "$ exit 44");
X  Copy_Line( "$UNPACK: SUBROUTINE ! P1=filename, P2=checksum");
X  Copy_Line( "$ if f$search(P1) .eqs. """" then $ goto file_absent");
X  Copy_Line( "$ e ""-W-EXISTS, File ''P1' exists. Skipped.""");
X  Copy_Line( "$ delete/nolog 'f'*");
X  Copy_Line( "$ exit");
X  Copy_Line( "$file_absent:");
X  Copy_Line( "$ if f$parse(P1) .nes. """" then $ goto dirok");
X  Copy_Line( "$ dn=f$parse(P1,,,""DIRECTORY"")");
X  Copy_Line( "$ w ""-I-CREDIR, Creating directory ''dn'.""");
X  Copy_Line( "$ create/dir 'dn'");
X  Copy_Line( "$ if $status then $ goto dirok");
X  Copy_Line( "$ e ""-E-CREDIRFAIL, Unable to create ''dn'. File skipped.""")
V;
X  Copy_Line( "$ delete/nolog 'f'*");
X  Copy_Line( "$ exit");
X  Copy_Line( "$dirok:");
X  Copy_Line( "$ w ""-I-PROCESS, Processing file ''P1'.""");
X  COPY_TEXT( "$ define/user sys$output nl:");`009! suppress TPU 'lines read'
X
XENDPROCEDURE;
X
X
X
XPROCEDURE Create_Prologue_Unpacker(Xbuffer)
X
X  Reuse_Buffer(Xbuffer);
X
X  Copy_Line("$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1'");
X
X  Pack_TPU( "PROCEDURE Unpacker" );
X  Pack_TPU( "ON_ERROR" );`009`009`009`009! Trap SEARCH error
X  Pack_TPU( "ENDON_ERROR;" );
X
X  Pack_TPU( "SET(FACILITY_NAME,"""+FAC_unpack+""");" );`009! SETUP
X  Pack_TPU( "SET(SUCCESS,OFF);" );
X  Pack_TPU( "SET(INFORMATIONAL,OFF);" );
X  Pack_TPU( "f:=GET_INFO(COMMAND_LINE,""file_name"");" );
X  Pack_TPU( "buff:=CREATE_BUFFER(f,f);" );
X `032
X  Pack_TPU( "p:=SPAN("" "")@r&LINE_END;" );
X  Pack_TPU( "POSITION(BEGINNING_OF(buff));" );
X  Pack_TPU( "LOOP" );`009`009`009`009`009! Trailing blank removal
X  Pack_TPU( "   EXITIF SEARCH(p,FORWARD)=0;" );
X  Pack_TPU( "   POSITION(r);" );
X  Pack_TPU( "   ERASE(r);" );
X  Pack_TPU( "ENDLOOP;" );
X
X  Pack_TPU( "POSITION(BEGINNING_OF(buff));" );
X  Pack_TPU( "g:=0;" );
X  Pack_TPU( "LOOP" );`009`009`009`009`009! Unwrap lines
X  Pack_TPU( "  EXITIF MARK(NONE)=END_OF(buff);" );
X  Pack_TPU( "  x:=ERASE_CHARACTER(1);" );
X  Pack_TPU( "  IF g = 0 THEN" );
X  Pack_TPU( "    IF x=""X"" THEN MOVE_VERTICAL(1);ENDIF;" );
X  Pack_TPU( "    IF x=""V"" THEN APPEND_LINE;");
X  Pack_TPU( "      MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;"
V );
X  Pack_TPU( "    IF x=""+"" THEN g:=1;ERASE_LINE;ENDIF;" );
X  Pack_TPU( "  ELSE" );
X  Pack_TPU( "    IF x=""-"" THEN g:=0;ENDIF; ");
X  Pack_TPU( "    ERASE_LINE;" );
X  Pack_TPU( "  ENDIF;" );
X  Pack_TPU( "ENDLOOP;" );
X
X  Pack_TPU( "p:=""" + Quote_Flag + """;" );
X  Pack_TPU( "POSITION(BEGINNING_OF(buff));" );
X  Pack_TPU( "LOOP" );`009`009`009`009`009! Restore escaped chars
X  Pack_TPU( "  r:=SEARCH(p,FORWARD);" );
X  Pack_TPU( "  EXITIF r=0;" );
X  Pack_TPU( "  POSITION(r);" );
X  Pack_TPU( "  ERASE(r);" );
X  Pack_TPU( "  COPY_TEXT(ASCII(INT(ERASE_CHARACTER(3))));" );
X  Pack_TPU( "ENDLOOP;" );
X
X  Pack_TPU( "o:=GET_INFO(COMMAND_LINE,""output_file"");" );
X  Pack_TPU( "WRITE_FILE(buff,o);" );
X
X  Pack_TPU( "ENDPROCEDURE;" );
X
X  Pack_TPU( "Unpacker;");`009`009`009`009! procedure call
X  Pack_TPU( "EXIT;" );    SPLIT_LINE;`009`009`009! EXIT code
X
X  COPY_TEXT("$ delete/nolog 'f'*");
X
XENDPROCEDURE;
X`012
XPROCEDURE Create_Prologue_Trail(Xbuffer)
X
X  Reuse_Buffer(Xbuffer);
X
X  Copy_Line( "$ CHECKSUM 'P1'");
X  Copy_Line( "$ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT");
X  Copy_Line( "$ e ""-E-CHKSMFAIL, Checksum of ''P1' failed.""");
X  Copy_Line( "$ ENDSUBROUTINE");
X  COPY_TEXT( "$START:");
X
XENDPROCEDURE;
X
X
X
XPROCEDURE Create_File_Header(Xbuffer);
X
X  Reuse_Buffer(Xbuffer);
X  COPY_TEXT("$ create/nolog 'f'");
X
XENDPROCEDURE;
X
X
X
XPROCEDURE Create_File(Xbuffer, Filename)
XLOCAL r;
X
XON_ERROR
X  Inform("E","FILRDERR", "Error reading from file " + FileName);
XENDON_ERROR;
X
X  Reuse_Buffer(Xbuffer);
X  READ_FILE(FileName);
X
X  IF DEBUG_state
X    THEN
X      r := GET_INFO(Xbuffer,"RECORD_COUNT");
X      Inform("I","DBGRDFIL",FAO("!UL line!%S read from file !AS",r,FileName)
V);
X  ENDIF;
X
XENDPROCEDURE;
X
X
XPROCEDURE Create_File_Trailer(Xbuffer, Filename, Checksum);
X
X  Reuse_Buffer(Xbuffer);
X  COPY_TEXT("$ CALL UNPACK " + Filename + " " + Checksum);
X
XENDPROCEDURE;
X
X
XPROCEDURE Create_Epilogue(Xbuffer);
X
X  Reuse_Buffer(Xbuffer);
X  Copy_Line("$ v=f$verify(v)");
X  COPY_TEXT("$ EXIT");
X
XENDPROCEDURE;
X`012
X! +--------------------------------------------------------------------+
X! + PART SPLITTING ROUTINES                                            +
X! +                                                                    +
X! +    Find_Break(Xbuffer,Max_Size)                                    +
X! +       This routine uses a fast binary search algorithm to find the +
X! +       first line in the given buffer which straddles a given break +
X! +       point - I.E. where the size of the buffer up to and including+
X! +       that line would just go over the 'Max_Size' value (bytes).   +
X! +       This allows us to quickly determine where a buffer should be +
X! +       split when chopping up the info into several small parts.    +
X! +                                                                    +
X! +    Insert_Part_Separator(Part,Xendbuf,Xstartbuf,Split_status)      +
X! +       This routine is responsible for choosing the correct part    +
X! +       separator flag to insert at the beginning and end of parts.  +
X! +       Determination is controlled by two factors:-                 +
X! +                                                                    +
X! +         First by the 'split-status' parameter, which determines if +
X! +         a part break is permitted at this time (its not if, for    +
X! +         example, we are currently in the middle of the TPU code    +
X! +         which does the unpacking!) and, if it is, whether DCL      +
X! +         $GOTO's and labels are useable at the breaks.              +
X! +                                                                    +
X! +         Second, the type of part separator is determined by looking+
X! +         at the data in the buffer immediately around the break     +
X! +         point. If both start with '$' then we are splitting the    +
X! +         buffer at the DCL code which is part of the unpacking      +
X! +         control thus we can use $GOTO and a label.  If not, then   +
X! +         we are in the midst of user data and should use the        +
X! +         special flag lines                                         +
X! +                                                                    +
X! +    Add_to_part(Xbuffer,split-status)                               +
X! +       This takes a buffer of information and adds as much of it    +
X! +       as possible into the current part buffer, in order to fill   +
X! +       it to its maximum size.  The remainder of the buffer is      +
X! +       then copied into the part buffer in similar fashion, and     +
X! +       we repeat until the supply of information is exhausted. Each +
X! +       time the part buffer fills up it is flushed out to disk.     +
X! +       Part 1 is treated separately as the attention message at the +
X! +       head of the part needs to be updated later with the actual   +
X! +       number of parts created. We therefore keep it around until   +
X! +       the end in a separate buffer and flush it to disk at the end.+
X! +                                                                    +
X! +    Flush_buffer(Xbuffer,Part)                                      +
X! +       Flushes the specified buffer to disk if not empty. The name  +
X! +       of the file used is constructed from the original share      +
X! +       file template and the current part number.                   +
X! +                                                                    +
X! +--------------------------------------------------------------------+
X`012                                              `032
XPROCEDURE Find_Break(Xbuffer,Max_Size)
XLOCAL Low, High, Size, Line_Size, mb, New_Line, Cur_Line;
X
X  IF DEBUG_State
X    THEN
X      Inform("I","DBGFNDBRKMAX","Max free bytes =" + STR(Max_Size));
X  ENDIF;
X
X  Low      := 0;
X  High     := GET_INFO(Xbuffer,"record_count") - 1;
X  Cur_Line := 0;
X
X  mb := BEGINNING_OF(Xbuffer);
X  POSITION(mb);
X
X  ! Special case check to ensure at least one line fits in available space
X  IF mb <> END_OF(Xbuffer)
X     THEN
X        IF LENGTH(CURRENT_LINE)+3 > Max_Size THEN RETURN(0); ENDIF;
X  ENDIF;
X
X
X  LOOP
X
X     New_Line := (Low+High) / 2;
X     MOVE_VERTICAL(New_Line-Cur_Line);
X     Cur_Line := New_Line;
X
X     Size:=LENGTH(CREATE_RANGE(mb,MARK(NONE),NONE))+3*Cur_Line;
X     Line_Size := LENGTH(CURRENT_LINE) + 3;
X
X     IF DEBUG_state
X       THEN
X         Inform("I","DBGFNDBRKRNG",FAO("Search range = !UL-!UL",Low,High));
X         Inform("I","DBGFNDBRKCURL",FAO("(!UL) ""!AS""",Cur_line,CURRENT_LIN
VE));
X         Inform("I","DBGFNDBRKSIZE",FAO("Size=!UL, line=!UL",Size,Line_Size)
V);
X     ENDIF;
X
X     EXITIF (Size < Max_Size) AND (Size+Line_Size >= Max_Size);
X
X     IF Size < Max_Size
X       THEN
X         Low := Cur_Line + 1;
X       ELSE
X         High := Cur_Line - 1;
X     ENDIF;
X
X  ENDLOOP;
X
X  MOVE_HORIZONTAL(-1);
X  RETURN( CREATE_RANGE( mb, MARK(NONE), NONE ) );
X
XENDPROCEDURE;
X`012
XPROCEDURE Insert_Part_Separator(Part, Xendbuf, Xstartbuf, SPLIT_status)
XLOCAL c1,c2,end_text,start_text;
X
X   IF SPLIT_status = SPLIT_disallowed
X     THEN
X       Inform("F","CANTSPLIT","Part split tried where disallowed");
X       EXIT;
X   ENDIF;
X
X   POSITION( END_OF(Xendbuf) ); MOVE_VERTICAL(-1); c1 := CURRENT_CHARACTER;
X   POSITION( BEGINNING_OF(Xstartbuf) );            c2 := CURRENT_CHARACTER;
X
X   IF (c1 = "$") AND (c2 = "$") AND (SPLIT_status = SPLIT_permit_goto)
X      THEN`009`009`009! Executable DCL code insert GOTO/label pair
X         end_text  := FAO(FAO_end_goto, Part+1);
X         start_text:= FAO(FAO_start_label, Part+1);
X      ELSE`009`009`009! User data, insert recognizable separators
X         end_text  := FAO(FAO_end_part, Part);
X         start_text:= FAO(FAO_start_part, Part+1);
X   ENDIF;       `032
X
X   Copy_Line(start_text);      MOVE_VERTICAL(-1);
X   POSITION(END_OF(Xendbuf));  COPY_TEXT(end_text);
X
XENDPROCEDURE;
X`012
XPROCEDURE Add_To_Part(Xbuffer, SPLIT_status)
XLOCAL Size_Xbuffer, Size_part_buf;
X
X  LOOP
X
X    Size_Xbuffer  := Size_Buffer(Xbuffer);
X    Size_part_buf := Size_Buffer(part_buf);`032
X
X    IF DEBUG_state THEN
X       Inform( "I","DBGADPTMAX" ,FAO("     Max_bytes    = !UL",Max_Bytes));
X       Inform( "I","DBGADPTXSIZ",FAO("     Size xbuffer = !UL",Size_Xbuffer)
V);
X       Inform( "I","DBGADPTPSIZ",FAO("     Size part_buf= !UL",Size_part_buf
V));
X    ENDIF;
X
X    EXITIF Size_Xbuffer <= Max_Bytes-Size_part_buf-Reserved;
X
X    PartNo := PartNo + 1;
X    xbuf_range := Find_Break(Xbuffer,Max_Bytes-Size_part_buf-Reserved);
X    POSITION( END_OF(part_buf) );
X    IF xbuf_range <> 0`032
X      THEN
X        Move_Info(xbuf_range, part_buf);
X    ENDIF;
X    Insert_Part_Separator(PartNo, part_buf, Xbuffer, SPLIT_status);
X         `032
X    IF PartNo = 1
X       THEN
X          Move_Info(part_buf, pt1_buf);
X       ELSE
X          Write_Part(part_buf, PartNo);  ERASE(part_buf);
X    ENDIF;
X
X  ENDLOOP;
X
X  Move_Info(Xbuffer, part_buf);
X
XENDPROCEDURE;
X
X
X
XPROCEDURE Flush_Buffer(Xbuffer,Part)
X
X  IF Size_Buffer(Xbuffer) > 0
X     THEN
X        Write_Part(Xbuffer,Part);
X  ENDIF;
X
XENDPROCEDURE;
X`012
X! +--------------------------------------------------------------------+
X! +   MAIN PROGRAM                                                     +
X! +                                                                    +
X! +   This is the main control loop of the program, responsible for    +
X! +   picking up the parameters, creating the prologue and epilogue of +
X! +   the share file, setting up global constants and variables etc.   +
X! +                                                                    +
X! +   It also contains the main loop which goes around each of the     +
X! +   specified files to be packed into the share file.                +
X! +                                                                    +
X! +--------------------------------------------------------------------+
X
X
X
XInit_Constants;
XInit_Tables;
X
XSET(SUCCESS,OFF);`009`009! Suppress non-error messages
XSET(FACILITY_NAME, FAC_name);`009! identify ourself in errors
X
Xinfo_buf  := CREATE_BUFFER("`123info`125", GET_INFO(COMMAND_LINE, "FILE_NAME
V"));
Xpart_buf  := CREATE_BUFFER("`123part`125");
Xpt1_buf   := CREATE_BUFFER("`123part_1`125");
Xwork_buf  := CREATE_BUFFER("`123work`125");
X
X
X! PICK UP PARAMETERS FROM THE OUTSIDE WORLD
XPOSITION( info_buf);
XUsername   := CURRENT_LINE;      MOVE_VERTICAL(1);
XIF DEBUG_state
X  THEN
X    Inform("I","DBGPAR", "Params: Creator = """ + Username + """");
XENDIF;
X
XMax_Blocks:= INT(CURRENT_LINE); MOVE_VERTICAL(1);
XIF DEBUG_state
X  THEN
X    Inform("I","DBGPAR", "Params: Max_Blocks = " + STR(Max_Blocks));
XENDIF;
X
X
XShare_File:= CURRENT_LINE;      MOVE_VERTICAL(1);
XIF DEBUG_state
X  THEN
X    Inform("I","DBGPAR", "Params: Share_File = """ + Share_File + """");
XENDIF;
X`012
X! INITIALIZE STUFF TO GO THROUGH FILES
XStart_Of_Filenames := MARK(NONE);
XPartNo := 0;
XMax_Bytes := 512 * Max_Blocks;
X
X! Reserve space in the part buffers for 1 start and 1 end part + CR/LF chars
X! + a bit spare! They may not always be used but this is the worst case!
XReserved  := LENGTH(FAO(FAO_start_part,Max_Parts))
X           + LENGTH(FAO(FAO_end_part,  Max_Parts))
X           + 6;
X
X
X! CREATE THE INITIAL SHARE FILE HEADER
XCreate_Prologue_Head(work_buf, Username, Max_Blocks, Start_Of_Filenames);
XAdd_To_Part(work_buf,SPLIT_permit_goto);
X
XCreate_Prologue_Unpacker(work_buf);
XAdd_To_Part(work_buf,SPLIT_disallowed);
X
XCreate_Prologue_Trail(work_buf);
XAdd_To_Part(work_buf,SPLIT_permit_goto);
X
XPOSITION(Start_Of_Filenames);
X
X! LOOP AROUND, FILLING THE PART BUFFER WITH DATA FROM FILES
XLOOP
X   POSITION(info_buf);
X   EXITIF MARK(NONE) = END_OF(info_buf);
X
X   file_info := CURRENT_LINE;   MOVE_VERTICAL(1);
X   separator := INDEX(file_info,' ');
X   fname     := SUBSTR(file_info,1,separator-1);
X   chksum    := SUBSTR(file_info,separator+1,LENGTH(file_info)-separator);
X
X   IF DEBUG_state THEN
X      Inform("I","DBGPAR", "Params: filename = """ + fname + """");
X   ENDIF;
X
X   Create_File_Header(work_buf);
X   Add_To_Part(work_buf,SPLIT_permit_goto);
X
X   Create_File(work_buf,fname);
X   Quote_Buffer(work_buf, ANY(Funny_Chars));
X   Quote_Buffer(work_buf, " "&LINE_END);
X   Wrap_Lines(work_buf,Max_Line_Length);
X   Add_To_Part(work_buf,SPLIT_inhibit_goto);
X
X   Create_File_Trailer(work_buf,fname,chksum);
X   Add_To_Part(work_buf,SPLIT_permit_goto);
X
XENDLOOP;
X
XCreate_Epilogue(work_buf);
XAdd_To_Part(work_buf,SPLIT_permit_goto);
X
X
XPartNo := PartNo + 1;
XPOSITION(BEGINNING_OF(pt1_buf));
X
X
XIF PartNo > 1
X  THEN`009! Modify the inital message to state exact number of parts
X     POSITION(SEARCH( "$!+", FORWARD) );
X     POSITION( SEARCH( STR(Max_Parts), FORWARD) );
X     ERASE_CHARACTER(3);
X     COPY_TEXT( STR(PartNo) );
X
X  ELSE`009! Erase initial attention message as there's only 1 part!
X     MOVE_TEXT(part_buf);
X     POSITION(BEGINNING_OF(pt1_buf));
X     POSITION(SEARCH( "$!+", FORWARD) );
X     ERASE_LINE; ERASE_LINE; ERASE_LINE;
XENDIF;
X
XFlush_Buffer(part_buf, PartNo);
XFlush_Buffer(pt1_buf,  1);
X
XInform("I","NOOFPTS",FAO("Share file written in !UL part!%S",PartNo));
X
Xexit;
X$ delete /nolog /noconfirm 'temp';*
X$ v=f$verify(v)
$ CALL UNPACK VMS_SHARE.COM;54 1359781685
$ create/nolog 'f'
X1 VMS_SHARE
XPackage a series of files into a form suitable for mailing out across
Xthe network.`032
X
XFormat:
X     $ VMS_SHARE filespec sharefile
X2 Examples
X     $ VMS_SHARE *.for SOURCE
X          Package all the files ending in .FOR into the sharefile
X          'SOURCE'. Parts will be created called SOURCE.1, SOURCE.2 ...
X          etc.
X
X     $ VMS_SHARE `091...`093*.* SBDIR
X          Package all the files in all subdirectories below the
X          current one. The directory structure, relative to the current
X          directory, will be preserved and recreated at the unpacking
X          stage.
X2 Filespec
XA comma-separated list of wildcarded filename specifications. All files
Xwhich match the pattern(s) are packaged.`032
X
XThere are some restrictions:-
X     - The output share file name may not be included in the list.
X     - files ending in .DIR (normally directory files) are ignored.
X     - Files must exist in or below the current directory.
X
XA prompt is issued if no files are specified.
X2 Logical_Names
XSeveral logical names can be configured to control the operation of`032
XVMS_SHARE.
X3 SHARE_EXCLUDE_DIRS
XIf defined with a comma separated list of directory specifications, enclosed
Xin quotes, any file matching any of the listed directories will be excluded
Xfrom the packaging operation.`032
X
XWildcards are not permitted; all directories must be listed in full.
X3 SHARE_EXCLUDE_NAMES
XIf defined with a comma separated list of names, enclosed in quotes, any fil
Ve
Xwhose NAME part matches any of the listed names will be excluded from the
Xpackaging operation.`032
X
XWildcards are not permitted.
X3 SHARE_EXCLUDE_TYPES
XIf defined with a comma separated list of file types, enclosed in quotes, an
Vy
Xfile whose TYPE part matches any of the listed types will be excluded from t
Vhe
Xpackaging operation.`032
X
XWildcards are not permitted.
X3 SHARE_LOG
XIf defined with a logical value (YES/NO, TRUE/FALSE etc.) determines`032
Xwhether the unpacking stage produces informational messages about its`032
Xprogress. Error messages are always output.
X
XThe default is to produce the informational messages.
X3 SHARE_PART_SIZE
XIf defines, sets the maximum part size. The value is specified in blocks
Xand must be greater than 6. A zero value causes the default size to be
Xused otherwise a value less than 6 causes 6 to be used.`032
X
XThe default size is 30 blocks.
X3 SHARE_REAL_NAME
XDefines a string which is included at the head of the created share file`032
Xfollowing the username of the user who created it.  It is intended that
Xit will contain the real name of the user (For example, "FRED SMITH").`032
X3 SHARE_VERIFY
XIf defined with the value "TRUE" (or 1 or "YES" etc.) then
Xverification of the VMS_SHARE procedure is turned on. If defined with
X"FALSE" (or 0 or "NO" etc.) verifications is turned off.`032
X
XIf the logical is not defined at all, verification is off.
X
XNote that the user must have READ access to the procedure for
Xverification to be enabled.`032
X3 SHARE_TEMP
XDefines the name of a file to be used as a scratch file during the`032
Xpackaging operation.
X
XDefaults are taken from the name  SYS$SCRATCH:SHARE_TEMP.TMP_'pid' where`032
X'pid' is the current Process Identification number.
X2 Operational_Notes
XVMS_SHARE packages all the specified files into one or more parts having`032
Xa common filename prefix. The suffix will be the part number. Multiple`032
Xparts will be created if the total size of a part exceeds the specified`032
Xmaximum size (taken from the logical SHARE_PART_SIZE).
X
XEach part is encoded so that it can survive destruction when mailed`032
Xacross the network through unfriendly mailers which wrap lines,`032
Xtranspose characters etc. A checksum is included which can detect damage`032
Xat the receiving end.
X
XTo unpack, all parts must be concatenated in order and the whole`032
Xexecuted as a command procedure. It is preferable to be in an empty`032
Xscratch directory when doing this. If the parts have been received via`032
Xmail then it is NOT necessary to remove the mail headers between parts`032
Xbefore concatenating them.  The unpack code will ignore them if present.`032
XHowever, mail headers should be removed from the initial part.
X2 Sharefile
XThe name of the packed output file. This name will be suffixed by the`032
Xpart number even if there is only 1 part created.
X
XA prompt is issued if no sharefile name is specified.
$ CALL UNPACK VMS_SHARE.HLP;7 2547826
$ v=f$verify(v)
$ EXIT