(*
(* :Program.    DoVer.mod
** :Contents.   search $VER and copy them to filecomment
** :Author.     Bert Jahn
** :EMail.      jah@pub.th-zwickau.de
** :Address.    Franz-Liszt-Straße 16, Rudolstadt, 07404, Germany
** :History.    V0.1 24.01.95 Beta
**              V1.0 06.03.95
**              V1.1 13.11.95 minor changes
**                   26.11.95 changes in GetResidentID.asm
**                   released on aminet
**                   16.12.95 added PREPEND,APPEND
**              V1.2 released on aminet
**                   23.12.95 added CONVERTDATE
**              V1.3 released on aminet
** :Copyright.  Public Domain
** :Language.   Oberon
** :Translator. Amiga Oberon 3.11 (Includes 40.15)
*)
*)

(* $ClearVars+ *) (* saves some bytes; all other switches should turned off *)

MODULE DoVer;

IMPORT
  SYS  := SYSTEM,
  d    := Dos,
  ds   := DosSupport,
  e    := Exec,
  str  := Strings,
  xfd  := XFDmaster,
  xfds := XFDsupport;

CONST
  version  = "$VER: DoVer V1.3 (25-Dec-95) by Bert Jahn";
  template = "FILE/A,DEFAULT/K,FORCE/S,APPEND/S,PREPEND/S,CONVERTDATE/S,QUIET/S,NOCOMM/S";

TYPE
  Args = STRUCT (dummy: d.ArgsStruct)
    file    : d.ArgString;  (* File to scan *)
    default : d.ArgString;  (* default string for SetComment *)
    force   : d.ArgBool;    (* overwrite old comment *)
    append  : d.ArgBool;    (* append ver onto end of any exist filenote *)
    prepend : d.ArgBool;    (* add ver onto start of any exist filenote *)
    date    : d.ArgBool;    (* try to convert datestamp *)
    quiet   : d.ArgBool;    (* be quiet, only errmsg output *)
    nocomm  : d.ArgBool;    (* don't set comment *)
  END;

VAR
  rd      : d.RDArgsPtr;       (* for ReadArgs *)
  args    : Args;
  buffer  : ARRAY 256 OF CHAR; (* the comment *)
  f       : xfds.FileDescr;
  fileadr : e.LSTRPTR;



(* copy string filtered to arrayofchar *)
(*  src     sourcestring
    dest    space for deststring; LEN(dest) must valid ! *)
PROCEDURE ParseString(src: e.LSTRPTR; VAR dest: ARRAY OF CHAR);
VAR
  s,d,c,i,z : LONGINT;
TYPE
  MonthType = ARRAY 12 OF ARRAY 4 OF CHAR;
CONST
  month = MonthType ("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec");

  (* transform string to integer, returns endpos of int *)
  PROCEDURE Str2Int(pos: LONGINT; VAR x: LONGINT):LONGINT;
  VAR
    c : CHAR;
  BEGIN
    x := 0;
    LOOP
      c := src[pos];
      IF (c>='0') & (c<='9') THEN
        x := 10 * x + ORD(c) - ORD('0');
        INC(pos);
      ELSE
        RETURN pos;
      END;
    END;
  END Str2Int;

  (* check for end of destination buffer *)
  PROCEDURE CheckDest(): BOOLEAN;
  BEGIN
    IF d >= LEN(dest)-1 THEN
      IF c # 0 THEN          (* buffer full -> seems it's a text file *)
        d := c;              (* use earlier LF for terminating *)
      ELSE
        d := LEN(dest)-1
      END;
      RETURN TRUE;
    END;
    RETURN FALSE;
  END CheckDest;

  (* copy one character from src[] to dest[], returns true if buffer is full *)
  PROCEDURE CopyChar(): BOOLEAN;
  BEGIN
    dest[d] := src[s]; INC(s); INC(d);
    RETURN CheckDest();
  END CopyChar;

BEGIN
  (* $IFNOT ClearVars *) s:=0; d:=0; c:=0; (* $END *)
  LOOP
    CASE src[s] OF
      0X        : EXIT;        (* end reached *)
    | 1X .. 9X  : INC(s);
    | 0AX       : INC(s); IF (c = 0) THEN c := d; END; (* save pos of LF terminating *)
    | 0BX..1FX  : INC(s);
    | '('       : IF CopyChar() THEN EXIT END;
                  IF args.date # 0 THEN
                    z := Str2Int(s,i);
                    IF i # 0 THEN
                      WHILE z >= s DO
                        IF CopyChar() THEN EXIT END;
                      END;
                      z := Str2Int(s,i);
                      IF (i > 0) & (i < 13) THEN
                        s := z;                       (* skip month *)
                        dest[d] := 0X;                (* needed for Append *)
                        str.Append(dest,month[i-1]);
                        INC(d,3);
                        IF CheckDest() THEN EXIT END;
                      END;
                    END;
                  END;
      ELSE        IF CopyChar() THEN EXIT END
    END;
  END;
  dest[d] := 0X;               (* terminate buffer *)
END ParseString;



(* relocate the file if possible and search for resident structure *)
PROCEDURE CheckResident(VAR src: ARRAY OF CHAR; srclen: LONGINT; VAR dest: ARRAY OF CHAR): BOOLEAN;
VAR
  str  : e.LSTRPTR;
  bptr : e.BPTR;
  ret  : BOOLEAN;
  xerr : e.UWORD;

  (* Sorry, I failed to write this in Oberon ! *)
  (* searchs for resident structure and return address of idstring if found *)
  (* see GetResidentID.asm for source *)
  PROCEDURE GetResidentID {"_GetResidentID"} (segment {8}:e.BPTR): e.APTR;
  (* $JOIN GetResidentID.o *)

BEGIN
  (* $IFNOT ClearVars *) ret := FALSE; (* $END *)
  IF (srclen >= 3) & (src[3] = 0F3X) THEN     (* is't an executable ? *)
    IF xfd.base # NIL THEN
      xerr := xfd.Relocate(srclen,xfd.relDefault,SYS.ADR(src),bptr);
      IF xerr # xfd.errOk THEN
        d.PrintF("relocating error: %s\n",xfd.GetErrorText(xerr));
      ELSE
        str := GetResidentID(bptr);
        IF str # NIL THEN
          ParseString(str,dest);   (* no sizecheck because possible string outside first segment ... *)
          ret := TRUE;
        END;
        d.UnLoadSeg(bptr);
      END
    END;
  END;
  RETURN ret;
END CheckResident;



(* search the VerString in "src" and copy them to "dest" if found *)
(* "srclen" is used instead of LEN(src) so "src" can be "e.LSTRPTR^" or "e.APTR^" *)
PROCEDURE CheckVerStr(VAR src: ARRAY OF CHAR; srclen: LONGINT; VAR dest: ARRAY OF CHAR): BOOLEAN;
VAR
  ret : BOOLEAN;   (* RETURN Code *)
  a   : LONGINT;   (* offsets in array *)
BEGIN
  (* $IFNOT ClearVars *) ret := FALSE; a := 0; (* $END *)
  WHILE (~ ret) & (a < srclen-6) DO
    IF src[a]="$" THEN
      INC(a);
      IF (src[a]="V") OR (src[a]="v") THEN
        INC(a);
        IF (src[a]="E") OR (src[a]="e") THEN
          INC(a);
          IF (src[a]="R") OR (src[a]="r") THEN
            INC(a);
            IF (src[a]=":") THEN ret := TRUE; END;
          END
        END
      END
    ELSE
      INC(a);
    END;
  END;
  IF ret THEN
    INC(a);
    WHILE src[a] <= " " DO INC(a) END;    (* overead first SPACE/ControlCodes *)
    ParseString(SYS.ADR(src[a]),dest);
  END;
  RETURN ret;
END CheckVerStr;



(* set the file comment *)
PROCEDURE SetComment(VAR comment: ARRAY OF CHAR);
VAR
  lock : d.FileLockPtr;
  fib  : d.FileInfoBlockPtr;
  set  : BOOLEAN;
  cmt  : ARRAY 79 OF CHAR;
BEGIN
  IF args.nocomm = 0 THEN
    (* $IFNOT ClearVars *) set := FALSE; (* $END *)
    cmt[0] := 0X; str.Append(cmt,comment);
    IF args.force # 0 THEN
      set := TRUE;
    ELSE
      lock := d.Lock(args.file^,d.accessRead);
      IF lock = NIL THEN
        ds.PrintFault;
      ELSE
        NEW(fib);
        IF fib = NIL THEN
          ds.PrintMemErr;
        ELSE
          IF ~ d.Examine(lock,fib^) THEN
            ds.PrintFault;
          ELSE
            IF args.append # 0 THEN
              cmt[0] := 0X; str.Append(cmt,fib.comment);
              str.Append(cmt," ");
              str.Append(cmt,comment);
              set:=TRUE;
            ELSIF args.prepend #0 THEN
              str.Append(cmt," ");
              str.Append(cmt,fib.comment); set:=TRUE;
            ELSIF fib.comment[0] = 0X THEN
              set := TRUE;
            END;
          END;
          DISPOSE(fib);
        END;
        d.UnLock(lock);
      END
    END;
    IF set THEN
      IF ~ d.SetComment(args.file^,cmt) THEN ds.PrintFault; END;
    END
  END
END SetComment;



PROCEDURE PrintMsg(str: e.LSTRPTR);
BEGIN
  IF args.quiet = 0 THEN
    d.PrintF("%s\t- %s\n",args.file,str);
  END
END PrintMsg;



(* main *)
BEGIN
  SYS.SETREG(8,SYS.ADR(version));    (* that the version string will linked *)
  IF d.base.lib.version < 37 THEN
    HALT(20);
  ELSE
    rd := d.ReadArgs(template,args,NIL);
    IF rd = NIL THEN
      ds.PrintFault;
    ELSE
      IF args.force + args.append + args.prepend < -1  THEN   (* it's not fine but works *)
        d.PrintF("only one of FORCE APPEND PREPEND can specified\n");
      ELSE
        f.name := args.file;
        f.passwd := NIL;               (* no passwd support *)
        IF xfds.LoadFile(f) THEN
          fileadr := f.address;
          IF CheckVerStr(fileadr^,f.size,buffer) OR CheckResident(fileadr^,f.size,buffer) THEN
            PrintMsg(SYS.ADR(buffer));
            SetComment(buffer);
          ELSE
            PrintMsg(SYS.ADR("No VersionString found"));
            IF args.default # NIL THEN
              SetComment(args.default^);
            END
          END;
          xfds.UnLoadFile(f);
        END
      END;
      d.FreeArgs(rd);
    END
  END
END DoVer.