home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power Programming
/
powerprogramming1994.iso
/
progtool
/
filutl
/
toadshr1.arc
/
TOADSHR1.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1989-06-14
|
36KB
|
1,012 lines
PROGRAM ToadShar;
{ Toad Hall Shar v1.1 for Turbo Pascal v5.0
Other shars available for MS-DOS had no wildcard capability,
and I got BLOODY tired of typing in all those filenames!
This one's got wildcard capability (both for shar creation and extraction).
I've arbitrarily decided to force the world to accept the MS-DOS shar
file type of ".SHR" for a shar file type (when wildcard extracting)
(since we can't use the Unix ".shar" standard).
You don't like it? Recode it!
No, I don't know how to change it for Turbo Pascal v4.0.
Usage:
shar [-u] [file1]..[filen]
Where file1..filen can be up to 20 MS-DOS path\filenames
(wildcarded if you wish). (The 20 was arbitrary .. see MAXARGS.)
-u Unshar (extract) members from shar file(s).
Yes, the -u (any case) MUST be the first command line parameter!
shar filenames can be full DOS paths, with a default file
type of ".SHR" (added if required).
During shar creation:
The .SHR files produced will be simplistic (e.g., none of the fancy
Unix switches are available). However, they should be compatible
with Unix shars (provided you work around the line ending problem,
of course).
Shar-formatted output is to StdOut (e.g., via redirection at the
DOS command line). No check is made for an output file's existence
(naturally). Output is standard DOS text file (e.g., CR/LF line
endings).
No tests are made to filter out control characters, etc., and target
member files are treated as text files. I would NOT suggest using
this shar on anything but pure Ascii text files!
Any error msgs will go to StdOut (yep, the file you're creating!).
Sorry 'bout that .. don't wanna mess with a StdErr output routine
at this time. Maybe later.
During extraction:
You can wildcard the extracting. (E.g., if you have FOO1.SHR and
FOO2.SHR, just enter "TOADSHAR FOO*" and both files will be unshared.)
Existing files will NOT be overwritten! You'll get a warning message,
and shar will continue to work its way through the remaining shar file
members (if any).
No tests are made (to date) to replicate sed or sh errorchecking
(e.g., the simplistic character count).
Some sed/sh "echo" commands are echoed to StdOut during extraction.
I've tested TOADSHAR on Unix and MS-DOS .shar files created with various
switch settings .. seems to work ok.
This sucker isn't ALL it could be yet .. could use more file read/write
error trapping, more sophisticated sh-like testing (char counts,
file overwriting, etc.) .. but it'll do for now.
Credits:
Fancy dynamic arrays of FindFirst and FindNext SearchRecs,
thanks to a hack of:
"Linked list modules from LINKLIST.PAS"
Copyright (c) 1985 by Alan D. Hull
Boyer-Moore string searching (credits, source in POSBM.ASM)
Released to the public domain.
Constraints: Do NOT distribute without source and documentation.
Do NOT remove credits.
David P Kirschbaum
Toad Hall
kirsch@braggvax.ARPA
(or maybe kirsch%braggvax.ARPA@cacfs.army.mil)
(919) 868-3471 voice/data
v1.0 Original release
v1.1 Added:
new posBM and posCH POS() replacements.
StdErr message output.
}
{$B-} {shortcut Boolean logic}
{$D-} {No debug info}
{$F-} {No far calls}
{$L-} {No local symbol info}
{$R-} {No range checking}
{$S-} {No stack checking .. taking a chance on this one
for systems with VERY limited memory ..
You don't like it? Recompile it.}
{$V-} {Relaxed VAR string parm testing}
{ DEFINE Debug} {enable for some debug displays, file overwriting, etc.}
Uses Dos; {for the Find First/Find Next stuff}
TYPE
Str20 = STRING[20];
Str80 = STRING[80];
CONST
QUOTE = #39; {single-quotation mark/apostrophe char}
MAXARGS = 20; {change as you like}
VERSION = 'v1.1';
CRLF : ARRAY[1..2] OF CHAR = #$0D#$0A; {v1.1}
VAR
argv, argc : Byte;
Args : ARRAY[1..MAXARGS] {array of cmdline parms}
OF PathStr; {STRING[79]}
InFile : TEXT;
{
SearchRec, DirStr, NameStr, ExtStr are declared in the Dos unit.
As a reminder:
TYPE SearchRec = RECORD
fill : ARRAY[1..21] OF Byte;
attr : Byte;
time : longint;
size : longint;
Name : STRING[12];
END;
}
SrchRec : SearchRec;
Dir : DirStr; {STRING[79]}
Name: NameStr; {STRING[8]}
Ext : ExtStr; {STRING[4]}
CONST
{The shar file header (picked from a handy Unix speciman).
This array of array of chars is a kludge, I know .. but it was the
simplest/fastest way to collect one big hunk of characters for output.
Now if I wanted to add my block read/writes .. but then we wouldn't
have a nice neat TEXT file, would we?
}
(*
Hdr1 : ARRAY[1..26] OF CHAR = '# This is a shell archive.';
Hdr2 : ARRAY[1..53] OF CHAR =
'# Remove everything above and including the cut line.';
Hdr3 : ARRAY[1..43] OF CHAR =
'# Then run the rest of the file through sh.';
Hdr4 : ARRAY[1..57] OF CHAR =
'#----cut here-----cut here-----cut here-----cut here----#';
Hdr5 : ARRAY[1..9] OF CHAR = '#!/bin/sh';
Hdr6 : ARRAY[1..25] OF CHAR = '# shar: Shell Archiver';
Hdr7 : ARRAY[1..48] OF CHAR =
'# Run the following text with /bin/sh to create:';
*)
NR_HDRLINES = 4;
Hdr : ARRAY[1..NR_HDRLINES] OF Str80 =
(
'# This is a shell archive.'#$0D#$0A'# Remove everything above and including the cut ',
'line.'#$0D#$0A'# Then run the rest of the file through sh.'#$0D#$0A'#----cut here-----cut here',
'-----cut here-----cut here----#'#$0D#$0A'#!/bin/sh'#$0D#$0A'# shar: Shell Archiver',
#$0D#$0A'# Run the following text with /bin/sh to create:'#$0D#$0A
);
{Load our posBM and posCH modules}
{$F+}
{$L POSBM}
FUNCTION posBM(Pat,Str : STRING) : BYTE; EXTERNAL;
{$L POSCH}
FUNCTION posCH(Ch : CHAR; S : STRING) : BYTE; EXTERNAL;
{And our StdErr procedure}
{$L STDERR}
PROCEDURE Write_StdErr(S : STRING); EXTERNAL;
{$F-}
{
(Linked list modules from LINKLIST.PAS)
Copyright (c) 1985 by Alan D. Hull
TURBO LinkList modules and descriptions are hereby donated to
the public domain. They may be included in any other free
software without royalties to the author. TURBO LinkList
procedures, descriptions and/or declarations may not be
included in whole or in part in any program, function, or
package sold for commercial gain, without the express
permission of the author.
Thanks, Alan .. gee, 1985 .. sigh ..
}
TYPE
{ We don't really NEED the entire SearchRec saved (from a FindFirst
or FindNext) .. but I'm keeping it handy for now.
Actually, all we need is the Dir and SearchRec.Name (for opening
input files later).
}
SrchRecPtr = ^node;
node = RECORD { this is the linked list node }
flink,
blink : SrchRecPtr;
SrchRec : SearchRec; { map in a data record }
Dir : DirStr; {remember the directory also}
END;
VAR
head, tail, curr, Temp : SrchRecPtr;
PROCEDURE Allocate_Node( VAR node_ptr: SrchRecPtr);
{ Allocate a node of a doubly-linked list }
BEGIN
NEW (node_ptr); { get a new block of memory }
node_ptr^.flink := NIL; { make sure it doesn't point to }
node_ptr^.blink := NIL; { any other nodes yet. }
END;
PROCEDURE Add_After_Node (VAR head, tail, current, newp: SrchRecPtr);
{ Add the node to the linked list
head - A pointer to the first node in the linked list
tail - A pointer to the last node in the linked list
current - A pointer to the node in the list that the new node
is to be added after.
newp - A pointer to the node to be added to the linked list.
(Couldn't use NEW since it's a reserved word in Pascal)
}
VAR next: SrchRecPtr;
{ 1. The list is empty, head, tail, and current will point to newp.
2. We are adding past the end of the list. Redirect tail.
3. Adding at some point other that after the tail.
4. Point current to the new node.
}
BEGIN
IF (current = NIL) THEN BEGIN { 1 }
head := newp;
tail := newp;
END
ELSE BEGIN
IF (current = tail) THEN BEGIN { 2 }
current^.flink := newp;
newp^.blink := current;
newp^.flink := NIL;
tail := newp;
END
ELSE BEGIN { 3 }
next := current^.flink;
newp^.flink := next;
newp^.blink := current;
next^.blink := newp;
current^.flink := newp;
END
END;
current := newp; { 4 }
END; {Add_After_Node}
(*
{To remove a node: looks like this. We don't DO this .. just left
Alan's comments/code for your edification.
1. before removing the current node from list, we need to store the
pointer to the previous node, so that we can step "back" a node to
continue processing thru the list.
2. Restore the pointer from item 1 as the current node
}
curr := head;
IF curr <> NIL THEN BEGIN
temp := curr^.blink; { save pointer to prev. node }
Remove_Node (head, tail, curr);
curr := temp; { reassign to maintain continuity }
curr := curr^.flink;
{or} curr := temp^.flink;
END;
*)
{ ***** End of LINKLIST-related stuff ***** }
FUNCTION ItoS(i : INTEGER) : Str20;
VAR S : Str20;
BEGIN
STR(i,S);
ItoS := S;
END; {of ItoS}
PROCEDURE Usage;
BEGIN
Writeln('TOADSHAR public domain shar/unshar utility ', VERSION);
Writeln;
Writeln('Usage: shar [-u] [file1]..[filen] [>output.shr]');
Writeln;
Writeln('Where file1..filen can be up to 20 MS-DOS path\filenames');
Writeln('(wildcards permitted).');
Writeln('Output is to StdOut (e.g., redirectable).');
Writeln;
Writeln('-u Unshar (extract) members from shar file(s).');
Writeln(' Yes, the -u MUST be the first command line parameter!');
Writeln(' shar filenames can be full DOS paths,');
Writeln(' with a default file type of ".SHR" (added if required).');
Writeln(' Extracted file will NOT be written if a file of that name');
Writeln(' exists on the current drive:\directory.');
Writeln;
Writeln('Courtesy of David Kirschbaum, Toad Hall');
Halt(1);
END; {of Usage}
FUNCTION Uc (S : String) : String;
{v1.3 Returns S uppercased}
BEGIN
Inline(
$31/$C0/ { xor ax,ax}
$8A/$86/>S/ { mov al,>S[bp] ;snarf the length}
$09/$C0/ { or ax,ax ;0 length?}
$74/$18/ { jz Exit ;yep, exit}
$89/$C1/ { mov cx,ax ;loop counter}
$BA/$61/$20/ { mov dx,$2061 ;DL='a',DH=$20}
$31/$F6/ { xor si,si}
{L1:}
$46/ { inc si ;next char}
$36/ { SS:}
$8A/$82/>S/ { mov al,>S[bp][si] ;snarf the char}
$38/$D0/ { cmp al,dl}
$72/$05/ { jb S1 ;already uppercase}
$36/ { SS:}
$28/$B2/>S/ { sub >S[bp][si],dh ;uppercase it}
{S1:}
$E2/$EF); { loop L1}
{Exit:}
Uc := S; {return the function}
END; {of Uc}
PROCEDURE Strip(Ch : CHAR; VAR S : String);
{Strip any Ch chars from S}
VAR p : INTEGER;
BEGIN
Repeat
p := posCh(Ch,S); {v1.1 any there?}
IF p <> 0 THEN Delete(S,p,1); {yep, gobble them}
Until p = 0;
END; {of Strip}
FUNCTION Bracketed(S : String) : String;
{return string in brackets}
BEGIN
Bracketed := '[' + S + ']';
END; {of Bracketed}
PROCEDURE Get_Args;
{v1.3 process command line for all target filenames.
Move them into an array of PathStrs.
}
BEGIN
argc := ParamCount;
IF (argc = 0) {no parms at all}
OR (argc > MAXARGS) {or more than we can handle}
THEN Usage; {display help, die}
FOR argv := 1 TO argc DO
Args[argv] := Uc(ParamStr(argv)); {snarf parm, (uppercased)}
Args[SUCC(argc)] := ''; {double-insure no overruns}
END; {of Get_Args}
PROCEDURE Find_All;
{Work FindFirst/FindNext for each Arg name.
When FindFirst or FindNext fails, start on the next argv.
Remember, StdOut may be creating a file that meets the argument.
However .. since that StdOut file will (should?) be 0 size
(until DOS closes it) .. we can trap that easily enough.
Side-effect is: we won't be able to include any 0-sized files ..
but who wants to do that anyway?
}
VAR Ok : BOOLEAN;
PROCEDURE Make_Node;
BEGIN
IF SrchRec.size <> 0 THEN BEGIN {only for non-empty files.
This also stops us from
picking up the StdOut file!}
Allocate_Node(temp);
Temp^.Dir := Dir;
Temp^.SrchRec := SrchRec; {move in the whole search record}
Add_After_Node (head,tail,curr,Temp);
END;
END; {of Make_Node}
BEGIN {Find_All}
head := NIL; {init our filename pointer linked list}
tail := NIL;
curr := NIL;
temp := NIL;
FOR argv := 1 TO argc DO BEGIN {do all the args}
FSplit(Args[argv], Dir, Name, Ext); {split up the new name}
Findfirst(Args[argv], {full name}
READONLY OR ARCHIVE,
SrchRec);
IF DosError = 0 THEN BEGIN {FindFirst succeeded}
Make_Node; {save the FindFirst name}
Repeat
FindNext(SrchRec); {find any more}
Ok := (DosError = 0);
IF Ok THEN Make_Node; {save the FindNext name}
UNTIL NOT Ok; {until FindNext failed}
END; {if FindFirst succeeded}
END; {argv loop}
END; {of Find_All}
FUNCTION Exists (FName : PathStr) : BOOLEAN;
{Return TRUE if FName exists}
VAR F : FILE;
BEGIN
Assign(F,FName);
{$I-} Reset(F); {$I+}
IF IoResult = 0 THEN BEGIN {exists}
Exists := TRUE; {return function TRUE}
Close(F); {be neat}
END
ELSE Exists := FALSE; {return function FALSE}
END; {of Exists}
PROCEDURE Show_TargetNames;
VAR S : Str80;
BEGIN
Write_StdErr('shar: target files: '); {v1.1 A little informative..}
curr := head; {..wildcard info}
S := ''; {v1.1 clear output string}
WHILE curr <> NIL DO BEGIN
S := S + curr^.SrchRec.Name; {build a string of names}
curr := curr^.flink; {bump to next name}
IF LENGTH(S) > 60 THEN BEGIN {string's long enough...}
Write_StdErr(S + CRLF); {...so display the names}
S := ''; {...and clear the string}
END
ELSE IF curr <> NIL {isn't last name...}
THEN S := S + ', '; {..so separate names neatly}
END;
IF S <> '' THEN Write_StdErr(S + CRLF); {v1.1 display last partial string}
END; {of Show_TargetNames}
PROCEDURE UnShar;
{-u parm on cmdline. We may have filename(s)
or wildcards starting at Args[2].
Shift all args down one, expand wildcards, etc.
If no file type, use '.shr'.
If no Args[2], use '*.shr'
}
VAR
S : String;
OutFile : TEXT;
p,
line : word;
slen : BYTE Absolute S;
SharEof : BOOLEAN;
Ch : CHAR;
FUNCTION Word(S : String; p : INTEGER; Delim : CHAR) : Str20;
{Returns the next word starting at S[p],
and ending at the char Delim (or String end)
}
VAR Ch : CHAR;
BEGIN
Delete(S,1,PRED(p)); {gobble leading chars}
IF S = '' THEN BEGIN
Word := S; {Return function}
Exit;
END;
WHILE (LENGTH(S) > 0) {while we have a string}
AND (S[1] <= #$20) DO {and leading char is ctrl}
Delete(S,1,1); {gobble it (really after spaces
and tabs)}
p := posCH(Delim,S); {v1.1 find delimiter}
IF p = 0 THEN Word := S {no delimiter,
return remaining string}
ELSE Word := Copy(S,1,PRED(p)); {return up to but not including
delimiter}
END; {of Word}
PROCEDURE Die(Msg : String);
BEGIN
Write_StdErr('shar: ' + Msg
+ ' Line: ' + ItoS(line) + CRLF); {v1.1}
{$I-} Close(OutFile); {$I+} {in case not opened}
IF IoResult <> 0 THEN; {we don't care}
SharEof := TRUE; {post boolean}
END; {of Die}
PROCEDURE ReadLn_Eof;
{Halts us if we hit input file EOF}
BEGIN
S := ''; {insure S is cleared}
IF NOT SharEof THEN SharEof := Eof(InFile);
IF NOT SharEof THEN BEGIN
ReadLn(InFile,S);
Inc(line);
END;
END;
PROCEDURE Extract_Member;
{Extracts a single member (down to SHAR_EOF or whatever
We should be at a line that looks like this:
cat << \SHAR_EOF > test1.doc
or maybe 2 lines (if some switches like -s or -a were used):
echo shar: extracting test1.doc
sed 's/^XX//' << \SHAR_EOF > test1.doc
or sed 's/^X//' > unshar.c << '/'
or sed 's/^X//' > makeguide << 'EOF'
It's not LIKELY SHAR_EOF would change between members,
but we'll check every time anyway.
}
VAR
OutName : PathStr;
EofStr : STRING[20]; {for SHAR_EOF or whatever}
LeadChars : STRING[5]; {guessing as to min length}
leadlen : BYTE absolute LeadChars; {nr of leadchars}
DoOutPut,
Ok : BOOLEAN;
PROCEDURE Check_LeadChars;
{Extract_Member subroutine
In case some more switches were engaged,
and we get a line like this:
sed 's/^XX//' << \SHAR_EOF > test1.doc
or sed 's/^X//' > unshar.c << '/'
or sed 's/^X//' > makeguide << 'EOF'
}
VAR p1,p2 : INTEGER;
BEGIN
LeadChars := ''; {assume no leading chars}
IF Word(S,1,' ') <> 'sed' THEN Exit; {only sed does leading chars}
p1 := posBM('s/^',S); {v1.1}
IF p1 = 0 THEN Exit; {no leading chars}
Inc(p1,3); {bump past 's/^'}
p2 := posBM('//',S); {v1.1 find end of token}
IF p2 > p1 {gotta have at least 1}
THEN LeadChars := Copy (S,p1,p2-p1); {copy leading chars}
IF LeadChars = '' {last test}
THEN Die('s/ Leading char error'); {bad format, SharEof TRUE}
END; {of Check_LeadChars}
PROCEDURE Get_SharEof;
{Extract_Members subroutine.
Find the "\SHAR_EOF > ", save it.
Again, we're working a command line like:
cat << \SHAR_EOF > test1.doc
or sed 's/^XX//' << \SHAR_EOF > test1.doc
or sed 's/^X//' > unshar.c << '/'
or sed 's/^X//' > makeguide <<'EOF'
}
BEGIN
EofStr := ''; {clear it}
p := posBM('<<', S); {v1.1 find the SHAR_EOF token}
IF p <> 0 THEN BEGIN {ok, found it}
Inc(p,2); {skip past '<<'}
EofStr := Word(S,p,' '); {get next word}
IF EofStr <> '' THEN BEGIN {we got something!}
Case EofStr[1] OF
QUOTE : Ch := QUOTE; {extract between quotes}
'\' : Ch := ' '; {extract up to space}
ELSE Ch := #0; {an error}
END; {case}
IF Ch = #0 THEN EofStr := ''
ELSE EofStr := Word(EofStr,2,Ch); {extract word up to delimiter}
END;
END; {if SHAR_EOF Token}
IF EofStr = '' THEN Die('No SHAR_EOF'); {SharEof TRUE}
END; {of Get_SharEof}
PROCEDURE Get_OutName;
{Extracts output filename from cat or sed cmdline.
Again, we're working a command line like:
cat << \SHAR_EOF > test1.doc
or sed 's/^XX//' << \SHAR_EOF > test1.doc
or sed 's/^X//' > unshar.c << '/'
or sed 's/^X//' > makeguide << 'EOF'
Note: The name could be quoted!
v1.1 Warning msg output is to StdOut, but that's ok ..
User shouldn't be redirecting on UnSharing.
}
VAR
OutN1 : PathStr;
S1 : Str80;
BEGIN
OutName := ''; {clear it}
p := posCH('>', S); {v1.1 find the filename output char}
IF p < 3 Then BEGIN {should be deep in the cmdline}
Die('Format Error'); {SharEof TRUE}
Exit;
END;
OutName := Word(S,SUCC(p),' '); {Extract output filename}
Strip(QUOTE,OutName); {gobble any quotation marks}
Strip('"',OutName); {these too}
IF OutName <> '' THEN BEGIN {some rudimentary parsing}
OutName := Uc(OutName); {uppercase it now}
OutN1 := OutName; {fiddle local name}
IF OutN1[1] = '.' THEN BEGIN {Leading periods is bogus}
Write_StdErr('shar: WARNING! Replacing period in filename: '
+ Bracketed(OutN1) + CRLF); {v1.1}
OutN1[1] := '_'; {replace with something else}
END;
FSplit(OutN1, Dir, Name, Ext); {split up the new name}
IF Dir <> '' THEN BEGIN {better be empty!}
Write_StdErr('shar: WARNING! Ignoring Output name path: '
+ Bracketed(Dir) + CRLF); {v1.1}
END;
OutN1 := Name + Ext; {build new name after the split}
IF OutN1 <> OutName THEN BEGIN
Write_StdErr('shar: WARNING! Output name amended from '
+ Bracketed(OutName) + ' to ' + Bracketed(OutN1)
+ CRLF ); {v1.1}
OutName := OutN1;
END;
END; {hopefully it'll be legal}
IF OutName = '' {couldn't parse output filename}
THEN Die('Missing filename'); {SharEof TRUE}
END; {of Get_OutName}
PROCEDURE Process_Member;
{Extract_Member subroutine.
We're now reading the shar file's data.
Strip lead chars if necessary.
Stop at SHAR_EOF (in EofStr).
}
BEGIN
ReadLn_Eof; {start the read/write}
WHILE (NOT SharEof) {not physical EOF}
AND (S <> EofStr) {and not member SHAR_EOF}
DO BEGIN
IF leadlen <> 0 THEN BEGIN {we have leading chars}
IF COPY(S,1,leadlen) <> LeadChars {a fatal error}
THEN BEGIN
Die('Missing LeadChars: ' + Bracketed(S));
Exit; {quit now}
END;
Delete(S,1,leadlen); {gobble leading chars}
END;
IF DoOutPut {we're writing an output file}
THEN Writeln(OutFile,S); {write out the string}
ReadLn_Eof; {new S}
END; {wend}
{S = 'SHAR_EOF' or physical EOF}
END; {of Process_Member}
BEGIN {Extract_Member (UnShar subroutine)}
{We're now processing the first command lines for this member.}
Check_LeadChars; {check for just 'cat ' cmd or
maybe the more complicated
"sed 's/^XX//'" (lead chars).
Process accordingly.}
Get_SharEof; {Extract "\SHAR_EOF > " from cmdline
as EofStr.}
Get_OutName; {Extract '> filename' from cmdline
as OutName.}
IF SharEof THEN Exit; {failed during cmdline processing}
DoOutput := TRUE; {Assume we will output}
Write_StdErr(' Member: ' + OutName + CRLF); {v1.1 display member file}
{$IFNDEF Debug}
IF Exists(OutName) {no overwriting!}
THEN BEGIN
Die('File Exists: ' + Bracketed(OutName));
SharEof := FALSE; {but keep working the .shr file}
DoOutput := FALSE; {process, but no output}
END;
{$ENDIF}
IF DoOutPut THEN BEGIN {we're outputting a member}
Assign(OutFile,OutName); {so gotta create its file}
{$I-} ReWrite(OutFile); {$I+}
IF IoResult <> 0 {create failed somehow}
THEN BEGIN
Die('Create error: ' + Bracketed(OutName));
SharEof := FALSE; {but keep working the .shr file}
DoOutput := FALSE; {but no attempts to output}
END;
END;
Process_Member; {process the file down to SHAR_EOF}
{Done with this member. Current S should be SHAR_EOF}
IF DoOutPut THEN BEGIN
{$I-} Close(OutFile); {$I+} {just in case of a problem}
IF IoResult <> 0 THEN; {we don't care}
END;
END; {of Extract_Member}
PROCEDURE Sh;
{Crudely do what Sh does ..
" and blindly go where no man has dared before .. "
(for 'blindly', read 'ignorantly')
}
CONST
Sh_Words : STRING[46] =
'if then else fi test echo export cat sed exit ';
{Why this overwhelming urge to include "fee fi fo fum"?}
VAR
W : Str20;
IfFlag, {Not fully implemented yet..}
ThenFlag, {..but I didn't wanna write..}
ElseFlag : BOOLEAN; {..a full sh parser!}
BEGIN
IfFlag := FALSE;
ThenFlag := FALSE;
ElseFlag := FALSE;
WHILE NOT SharEof DO BEGIN
S[1] := #0; {physically clear first char}
S := ''; {clear the string}
While ( {a la c ...}
(S = '') {gobble blank lines}
OR (S[1] IN ['#',':']) {and sh comments}
)
AND NOT SharEof {but not physical EOF}
DO ReadLn_Eof; {work through header, junk}
IF SharEof THEN Exit; {physical EOF, done}
W := Word(S,1,' ') + ' '; {S's first word, plus a space}
{a reminder:
Sh_Words : STRING[46] =
'if then else fi test echo export cat sed exit ';
1 4 9 14 17 22 27 34 38 42
Above construct is tighter than an array of words and looping
through the array, testing for membership!
}
p := posBM( W , Sh_Words); {v1.1 is it a sh cmd?}
CASE p OF
0 : Write_StdErr('Unknown sh cmd: ' + Bracketed(S)
+ CRLF ); {v1.1}
1 : BEGIN {if} {only the ThenFlag matters...}
{stubbed IfFlag := TRUE; } {...for now}
ThenFlag := FALSE;
{stubbed ElseFlag := FALSE; }
END;
4 : BEGIN {then}
ThenFlag := TRUE;
{stubbed ElseFlag := FALSE; }
END;
9 : BEGIN {else}
{stubbed ElseFlag := TRUE; }
ThenFlag := FALSE;
END;
14 : BEGIN {fi}
{stubbed IfFlag := FALSE; }
ThenFlag := FALSE;
{stubbed ElseFlag := FALSE; }
END;
17,27 : ; {gobble test's, export's}
22 : BEGIN {echo}
IF NOT ThenFlag {All then's seem to be bad news ..}
THEN BEGIN {..and who wants to hear bad news?}
Delete(S,1,5); {gobble the 'echo '}
Write_StdErr(S + CRLF); {v1.1 Display string to StdErr}
END;
END;
34, {cat,}
38 : Extract_Member; {sed: write out the member}
42 : SharEof := TRUE; {exit: finished}
END; {case}
END; {While NOT SharEof}
END; {of Sh}
PROCEDURE Unshar_File;
VAR FName : PathStr;
BEGIN
FName := curr^.Dir + curr^.SrchRec.Name; {full filename}
Write_StdErr('shar: processing ' + FName + CRLF);
Assign(InFile, FName);
Reset(InFile); {open input file}
SharEof := FALSE; {init file Eof flag}
line := 0; {Init line counter}
{ First look for the header start. Could be text or other
junk from mailers, etc.}
Repeat
Readln_Eof
Until SharEof {hit physical .shr EOF}
OR ( (slen <> 0) AND (S[1] IN ['#',':']) ); {or we have a header line}
Sh; {process sh commands}
Close(InFile); {neaten up}
END; {of UnShar_File}
BEGIN {UnShar}
IF argc = 1 THEN BEGIN {just '-u', no names}
Args[1] := '*.SHR'; {default}
Args[2] := ''; {insure no overruns}
END
ELSE BEGIN {at least one target filename}
Dec(argc); {discard first arg ('-u')}
FOR argv := 1 TO argc DO {do argc-1 shifts}
Args[argv] := Args[SUCC(argv)]; {Shift all args down one}
Args[SUCC(argc)] := ''; {blank to insure no overruns}
FOR argv := 1 TO argc DO BEGIN {expand to .SHR if required}
IF posCH('.',Args[argv]) = 0 {v1.1 no file.typ separator}
THEN Args[argv] := Args[argv] + '.SHR'; {so force it}
END;
END;
Find_All; {create array of target files}
(*
Write_StdErr('target files: '); {v1.1 A little informative..}
curr := head; {..wildcard info}
S := ''; {v1.1 clear output string}
WHILE curr <> NIL DO BEGIN
S := S + curr^.SrchRec.Name; {build a string of names}
curr := curr^.flink; {bump to next name}
IF LENGTH(S) > 60 THEN BEGIN {string's long enough...}
Write_StdErr(S + CRLF); {...so display the names}
S := ''; {...and clear the string}
END
ELSE IF curr <> NIL {isn't last name...}
THEN S := S + ', '; {..so separate names neatly}
END;
IF S <> '' THEN Write_StdErr(S + CRLF); {v1.1 display last partial string}
*)
Show_TargetNames; {v1.1}
curr := head; {start with first filename}
WHILE curr <> NIL DO BEGIN
UnShar_File; {do them all}
curr := curr^.flink; {next file ptr}
END;
END; {of UnShar}
PROCEDURE Shar;
{We're creating a shar file to StdOut}
VAR
FName : PathStr;
S : String;
err : INTEGER;
PROCEDURE Write_Header;
{Output shar header and filenames}
VAR i : INTEGER;
BEGIN
(*
Writeln(Hdr1); {7 separate arrays of char ...}
Writeln(Hdr2); {... what a kludge ...}
Writeln(Hdr3);
Writeln(Hdr4);
Writeln(Hdr5);
Writeln(Hdr6);
Writeln(Hdr7);
*)
FOR i := 1 TO NR_HDRLINES DO
Write(Hdr[i]);
{ The rest of the header oughtta look like this:
# test1.doc
# test2.doc
# test3.doc
# This archive created: Mon Apr 17 11:30:47 1989
}
curr := head; {first filename}
WHILE curr <> NIL DO
WITH curr^ DO BEGIN
WriteLn( '#',^I,SrchRec.Name); {list them all, neatly}
curr := curr^.flink; {next filename}
END;
{I don't feel like hacking all the code it takes
to add the pretty date/time line .. YOU do it!
}
Writeln('# This archive created: Mon Apr 1 00:00:01 2001', {stubbed}
' by Joe Isuzu'); {put your name here!}
END; {of Write_Header}
BEGIN {Shar}
Find_All; {load dynamic array of wildcard
filenames}
Show_TargetNames; {v1.1}
Write_Header; {output the shar header}
curr := head; {start with first filename}
WHILE curr <> NIL DO BEGIN
FName := curr^.Dir + curr^.SrchRec.Name; {full filename}
Write_StdErr('shar: adding ' + FName + CRLF); {v1.1}
Assign(InFile, FName);
Reset(InFile); {open input file}
Writeln('cat << \SHAR_EOF > ' + curr^.SrchRec.Name); {'test1.doc'}
WHILE NOT Eof(InFile) DO BEGIN
{$I-} Readln(InFile,S);
IF IoResult <> 0 THEN BEGIN
Write_StdErr('Read error: ' + Bracketed(FName) + CRLF); {v1.1}
Close(InFile);
{$I+}
IF IoResult <> 0 THEN; {we don't care}
Exit; {die}
END;
Writeln(S); {let Turbo and DOS worry
about output errors}
END;
Writeln('SHAR_EOF');
{$I-} Close(InFile); {$I+} {close input file}
IF IoResult <> 0 THEN ; {we don't care}
curr := curr^.flink; {next file ptr}
END; {wend}
Writeln('# End of shell archive'); {neat ending}
Writeln('exit 0'); {even neater}
END; {of Shar}
BEGIN {Main}
Get_Args; {process cmdline args (may die)}
IF Args[1] = '-U' {He wants us to unshar something...}
THEN UnShar {...so do it}
Else Shar; {ok, shar everything}
END.