home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format 101 / af101sub.adf / DoVer.LZX / DoVer / src / DoVer.mod < prev    next >
Encoding:
Text File  |  1997-06-27  |  13.6 KB  |  473 lines
  1. (*
  2. (* :Program.    DoVer.mod
  3. ** :Contents.   search $VER and copy them to filecomment
  4. ** :Author.     Bert Jahn
  5. ** :EMail.      jah@fh-zwickau.de
  6. ** :Address.    Franz-Liszt-Straße 16, Rudolstadt, 07404, Germany
  7. ** :History.    V0.1 24.01.95 Beta
  8. **              V1.0 06.03.95
  9. **              V1.1 13.11.95 minor changes
  10. **                   26.11.95 changes in GetResidentID.asm
  11. **                   released on aminet
  12. **                   16.12.95 added PREPEND,APPEND
  13. **              V1.2 released on aminet
  14. **                   23.12.95 added CONVERTDATE
  15. **              V1.3 released on aminet
  16. **                   07.03.96 added SHORT
  17. **              V1.4 released on aminet
  18. **                   15.09.96 complete new parsing of version string
  19. **                            new option FMT/K to set version format from commandline
  20. **                            option SHORT removed because now obsolete
  21. **                            searchloop optimized a bit
  22. **                   17.09.96 CONVERTDATE removed, it's now automatically done if FMT is specified
  23. **              V1.5 released on aminet
  24. **                   28.09.96 min length for formats ("FMT=") added
  25. **                            added multiple files as argument ("FILE/A/M")
  26. **              V1.6 released on aminet
  27. **                   14.06.97 month as string compare is now case insensitive
  28. **              V1.7 released on aminet
  29. **                   27.06.97 selectable fillchar implemented
  30. **              V1.8 released on aminet
  31. ** :Copyright.  Public Domain
  32. ** :Language.   Oberon
  33. ** :Translator. Amiga Oberon 3.11 (Includes 40.15)
  34. *)
  35. *)
  36.  
  37. (* $ClearVars+ *) (* important; all other switches should turned off *)
  38.  
  39. MODULE DoVer;
  40.  
  41. IMPORT
  42.   SYS  := SYSTEM,
  43.   d    := Dos,
  44.   ds   := DosSupport,
  45.   e    := Exec,
  46.   str  := Strings,
  47.   xfd  := XFDmaster,
  48.   xfds := XFDsupport;
  49.  
  50. CONST
  51.   version  = "$VER: DoVer V1.8 (27.06.97) by Bert Jahn";
  52.   template = "FILE/A/M,FMT/K,DEFAULT/K,FORCE/S,APPEND/S,PREPEND/S,QUIET/S,NOCOMM/S";
  53.  
  54. TYPE
  55.   Args = STRUCT (dummy: d.ArgsStruct)
  56.     file    : d.ArgStringArray;  (* Files to scan *)
  57.     fmt     : d.ArgString;  (* version format *)
  58.     default : d.ArgString;  (* default string for SetComment *)
  59.     force   : d.ArgBool;    (* overwrite old comment *)
  60.     append  : d.ArgBool;    (* append ver onto end of any exist filenote *)
  61.     prepend : d.ArgBool;    (* add ver onto start of any exist filenote *)
  62.     quiet   : d.ArgBool;    (* be quiet, only errmsg output *)
  63.     nocomm  : d.ArgBool;    (* don't set comment *)
  64.   END;
  65.  
  66. VAR
  67.   rd      : d.RDArgsPtr;       (* for ReadArgs *)
  68.   args    : Args;
  69.   buffer  : ARRAY 256 OF CHAR; (* the comment *)
  70.   f       : xfds.FileDescr;
  71.   fileadr : e.LSTRPTR;
  72.   i       : INTEGER;
  73.  
  74.  
  75.  
  76. (* copy string filtered to arrayofchar *)
  77. (*  src     sourcestring
  78.     dest    space for deststring; LEN(dest) must valid ! *)
  79. PROCEDURE ParseString(src: e.LSTRPTR; VAR dest: ARRAY OF CHAR);
  80. VAR
  81.   s,d,e,z : LONGINT;
  82.   name,ver,date,ext : ARRAY 128 OF CHAR;
  83.   day,mon,year,t : INTEGER;
  84.   c : CHAR;
  85.   fc : CHAR;    (* fillchar *)
  86. TYPE
  87.   MonthType = ARRAY 12 OF ARRAY 4 OF CHAR;
  88. CONST
  89.   month  = MonthType ("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"); (* english *)
  90.   monthg = MonthType ("JAN","FEB","MÄR","APR","MAI","JUN","JUL","AUG","SEP","OKT","NOV","DEZ"); (* german *)
  91.  
  92.   (* transform string(date) to integer, returns endpos of int *)
  93.   PROCEDURE Str2Int(VAR x: INTEGER):BOOLEAN;
  94.   BEGIN
  95.     x := 0;
  96.     LOOP
  97.       c := date[s];
  98.       IF (c>='0') & (c<='9') THEN
  99.         x := 10 * x + ORD(c) - ORD('0');
  100.         INC(s);
  101.       ELSE
  102.         IF x=0 THEN
  103.           RETURN FALSE;
  104.         ELSE
  105.           RETURN TRUE;
  106.         END;
  107.       END;
  108.     END;
  109.   END Str2Int;
  110.  
  111.   (* append one character to dest[], returns true if buffer is full *)
  112.   PROCEDURE CatChar(ch: CHAR): BOOLEAN;
  113.   BEGIN
  114.     IF d >= LEN(dest)-1 THEN
  115.       IF e # 0 THEN          (* buffer full -> seems it's a text file *)
  116.         d := e;              (* use earlier LF for terminating *)
  117.       ELSE
  118.         d := LEN(dest)-1
  119.       END;
  120.       RETURN TRUE;
  121.     ELSE
  122.       IF (d#0) OR (ch#' ') THEN (* to overread the first space *)
  123.         dest[d] := ch;
  124.         INC(d);
  125.       END;
  126.       RETURN FALSE;
  127.     END;
  128.   END CatChar;
  129.  
  130.   (* append an integer value as ascii to string *)
  131.   PROCEDURE AppendInt(VAR s:ARRAY OF CHAR; i:INTEGER; min:LONGINT);
  132.   VAR
  133.     b : ARRAY 5 OF INTEGER; (* max 5 digits ! *)
  134.     c : INTEGER;
  135.   BEGIN
  136.     c := 0;
  137.     REPEAT
  138.       b[c] := i MOD 10;
  139.       i := i DIV 10;
  140.       INC(c);
  141.     UNTIL i = 0;
  142.     WHILE min>c DO          (* prepend SPACE's if required *)
  143.       str.AppendChar(s,' ');
  144.       DEC(min);
  145.     END;
  146.     REPEAT
  147.       DEC(c);
  148.       str.AppendChar(s,CHR(ORD('0')+b[c]));
  149.     UNTIL c = 0;
  150.   END AppendInt;
  151.  
  152.   (* append string to string with minimum length *)
  153.   PROCEDURE AppendStr(VAR s1:ARRAY OF CHAR; VAR s2:ARRAY OF CHAR; min:LONGINT);
  154.   VAR
  155.     l : LONGINT;
  156.   BEGIN
  157.     l := str.Length(s2);
  158.     WHILE min>l DO
  159.       str.AppendChar(s1,fc);
  160.       DEC(min);
  161.     END;
  162.     str.Append(s1,s2);
  163.   END AppendStr;
  164.  
  165.  
  166. BEGIN
  167.   (* first remove all control codes and find end of string *)
  168.   LOOP
  169.     CASE src[s] OF
  170.       0X        : EXIT;                             (* end reached *)
  171.     | 1X .. 8X  : ;                                 (* ignore *)
  172.     | 9X        : IF CatChar(' ') THEN EXIT END;    (* tabulator -> space *)
  173.     | 0AX       : IF CatChar(' ') THEN EXIT END; IF (e = 0) THEN e := d; END; (* save pos of LF terminating *)
  174.     | 0BX..1FX  : ;                                 (* ignore *)
  175.     | 0A0X      : IF CatChar(' ') THEN EXIT END;    (* whitespace -> space *)
  176.       ELSE        IF CatChar(src[s]) THEN EXIT END; (* copy *)
  177.     END;
  178.     INC(s);
  179.   END;
  180.   dest[d] := 0X;  (* terminate buffer *)
  181.  
  182.   (* check for users format *)
  183.   IF args.fmt = NIL THEN RETURN END;
  184.  
  185.   (* now split the string off *)
  186.   s:=0;
  187.   (* get name *)
  188.   d:=0;
  189.   WHILE ( (d<LEN(name)-1) AND (dest[s]#0X) AND (dest[s]#' ') ) DO
  190.     name[d]:=dest[s];
  191.     INC(d); INC(s);
  192.   END;
  193.   name[d]:=0X;
  194.   (* get version *)
  195.   WHILE ( (dest[s]=' ') OR (dest[s]='v') OR (dest[s]='V') ) DO INC(s); END;
  196.   d:=0;
  197.   WHILE ( (d<LEN(ver)-1) AND (dest[s]#0X) AND (dest[s]#' ') ) DO
  198.     ver[d]:=dest[s];
  199.     INC(d); INC(s);
  200.   END;
  201.   ver[d]:=0X;
  202.   (* get date *)
  203.   WHILE dest[s]=' ' DO INC(s); END;
  204.   d:=0;
  205.   WHILE ( (d<LEN(date)-1) AND (dest[s]#0X) AND ~((date[0]='(') AND (date[d-1]=')')) AND ~((date[0]#'(') AND (dest[s]=' ')) ) DO
  206.     date[d]:=dest[s];
  207.     INC(d); INC(s);
  208.   END;
  209.   date[d]:=0X;
  210.   (* get extra *)
  211.   WHILE dest[s]=' ' DO INC(s); END;
  212.   d:=0;
  213.   WHILE ( (d<LEN(ext)-1) AND (dest[s]#0X) ) DO
  214.     ext[d]:=dest[s];
  215.     INC(d); INC(s);
  216.   END;
  217.   ext[d]:=0X;
  218.  
  219.   (* decode the datestamp *)
  220.   s := 0;
  221.   WHILE (date[s]='(') OR (date[s]=' ') DO INC(s); END;
  222.   IF ~ Str2Int(day) THEN
  223.     (* Dec  1 1992 *)
  224.     t := 0;
  225.     WHILE t<12 DO
  226.       IF (date[s]=month[t][0]) AND (date[s+1]=month[t][1]) AND (date[s+2]=month[t][2]) THEN mon:=t+1; END;
  227.       INC(t);
  228.     END;
  229.     IF mon # 0 THEN
  230.       WHILE (date[s]#0X) AND ((date[s]<'0') OR (date[s]>'9')) DO INC(s); END;
  231.       IF Str2Int(day) THEN END;
  232.       IF date[s]=' ' THEN INC(s); END;
  233.     END;
  234.   ELSE
  235.     (* 1.12.92 *)
  236.     IF date[s]#0X THEN INC(s) END;
  237.     IF ~ Str2Int(mon) THEN
  238.       (* 1-Dec-92 *)
  239.       t := 0;
  240.       WHILE t<12 DO
  241.         IF (CAP(date[s])=month[t][0]) AND (CAP(date[s+1])=CAP(month[t][1])) AND (CAP(date[s+2])=CAP(month[t][2])) THEN mon:=t+1; END;
  242.         INC(t);
  243.       END;
  244.       IF mon = 0 THEN
  245.         (* 1-Dez-92 german *)
  246.         t := 0;
  247.         WHILE t<12 DO
  248.           IF (str.CapIntl(date[s])=monthg[t][0]) AND (str.CapIntl(date[s+1])=monthg[t][1]) AND (str.CapIntl(date[s+2])=monthg[t][2]) THEN mon:=t+1; END;
  249.           INC(t);
  250.         END;
  251.       END;
  252.     END;
  253.     WHILE (date[s]#0X) AND ((date[s]<'0') OR (date[s]>'9')) DO INC(s); END;
  254.   END;
  255.   IF (day # 0 ) AND (mon # 0) THEN
  256.     IF Str2Int(year) THEN
  257.       IF day > 31 THEN t:=day;day:=year;year:=t; END; (* swap day - year *)
  258.       IF year > 99 THEN DEC(year,1900); END;  (* 1992 *)
  259.       IF year > 99 THEN DEC(year,100); END;   (* 2010 *)
  260.     END;
  261.   END;
  262.  
  263.   IF (ver[0]>='0') AND (ver[0]<='9') AND (day>0) AND (day<=31)  AND (mon>0) AND (mon<=12) AND (year<100) THEN
  264.     (* build final version string *)
  265.     dest[0] := 0X;
  266.     t := 0;
  267.     WHILE args.fmt^[t] # 0X DO
  268.       IF args.fmt^[t] = '%' THEN
  269.         c := args.fmt^[t+1];
  270.         IF (c='0') THEN fc:=c; ELSE fc:=' '; END;
  271.         s := 0;
  272.         WHILE (c>='0') AND (c<='9') DO
  273.           s := 10 * s + ORD(c) - ORD('0');
  274.           INC(t);
  275.           c := args.fmt^[t+1];
  276.         END;
  277.         CASE args.fmt^[t+1] OF
  278.           'n' : AppendStr(dest,name,s);
  279.         | 'v' : AppendStr(dest,ver,s);
  280.         | 'd' : AppendInt(dest,day,s);
  281.         | 'm' : AppendInt(dest,mon,s);
  282.         | 'M' : AppendStr(dest,month[mon-1],s);
  283.         | 'y' : AppendInt(dest,year,s);
  284.         | 'Y' : IF year >= 78 THEN
  285.                   AppendInt(dest,year+1900,s);
  286.                 ELSE
  287.                   AppendInt(dest,year+2000,s);
  288.                 END;
  289.         | 'e' : AppendStr(dest,ext,s);
  290.         | '%' : str.AppendChar(dest,'%');
  291.         | 0X  : DEC(t);
  292.           ELSE ;
  293.         END;
  294.         INC(t);
  295.       ELSE
  296.         str.AppendChar(dest,args.fmt^[t]);
  297.       END;
  298.       INC(t);
  299.     END;
  300.   END;
  301.  
  302. END ParseString;
  303.  
  304.  
  305.  
  306. (* relocate the file if possible and search for resident structure *)
  307. PROCEDURE CheckResident(VAR src: ARRAY OF CHAR; srclen: LONGINT; VAR dest: ARRAY OF CHAR): BOOLEAN;
  308. VAR
  309.   str  : e.LSTRPTR;
  310.   bptr : e.BPTR;
  311.   ret  : BOOLEAN;
  312.   xerr : e.UWORD;
  313.  
  314.   (* Sorry, I failed to write this in Oberon ! *)
  315.   (* searchs for resident structure and return address of idstring if found *)
  316.   (* see GetResidentID.asm for source *)
  317.   PROCEDURE GetResidentID {"_GetResidentID"} (segment {8}:e.BPTR): e.APTR;
  318.   (* $JOIN GetResidentID.o *)
  319.  
  320. BEGIN
  321.   (* $IFNOT ClearVars *) ret := FALSE; (* $END *)
  322.   IF (srclen >= 3) & (src[3] = 0F3X) THEN     (* is't an executable ? *)
  323.     IF xfd.base # NIL THEN
  324.       xerr := xfd.Relocate(srclen,xfd.relDefault,SYS.ADR(src),bptr);
  325.       IF xerr # xfd.errOk THEN
  326.         d.PrintF("relocating error: %s\n",xfd.GetErrorText(xerr));
  327.       ELSE
  328.         str := GetResidentID(bptr);
  329.         IF str # NIL THEN
  330.           ParseString(str,dest);   (* no sizecheck because possible string outside first segment ... *)
  331.           ret := TRUE;
  332.         END;
  333.         d.UnLoadSeg(bptr);
  334.       END
  335.     END;
  336.   END;
  337.   RETURN ret;
  338. END CheckResident;
  339.  
  340.  
  341.  
  342. (* search the VerString in "src" and copy them to "dest" if found *)
  343. (* "srclen" is used instead of LEN(src) so "src" can be "e.LSTRPTR^" or "e.APTR^" *)
  344. PROCEDURE CheckVerStr(VAR src: ARRAY OF CHAR; srclen: LONGINT; VAR dest: ARRAY OF CHAR): BOOLEAN;
  345. VAR
  346.   ret : BOOLEAN;   (* RETURN Code *)
  347.   a   : LONGINT;   (* offsets in array *)
  348. BEGIN
  349.   (* $IFNOT ClearVars *) ret := FALSE; a := 0; (* $END *)
  350.   DEC(srclen,6);  (* opt *)
  351.   WHILE (~ ret) & (a < srclen) DO
  352.     IF src[a]="$" THEN
  353.       INC(a);
  354.       IF (src[a]="V") OR (src[a]="v") THEN
  355.         INC(a);
  356.         IF (src[a]="E") OR (src[a]="e") THEN
  357.           INC(a);
  358.           IF (src[a]="R") OR (src[a]="r") THEN
  359.             INC(a);
  360.             IF (src[a]=":") THEN ret := TRUE; END;
  361.           END
  362.         END
  363.       END
  364.     ELSE
  365.       INC(a);
  366.     END;
  367.   END;
  368.   IF ret THEN
  369.     INC(a);
  370.     ParseString(SYS.ADR(src[a]),dest);
  371.   END;
  372.   RETURN ret;
  373. END CheckVerStr;
  374.  
  375.  
  376.  
  377. (* set the file comment *)
  378. PROCEDURE SetComment(VAR comment: ARRAY OF CHAR);
  379. VAR
  380.   lock : d.FileLockPtr;
  381.   fib  : d.FileInfoBlockPtr;
  382.   set  : BOOLEAN;
  383.   cmt  : ARRAY 79 OF CHAR;
  384. BEGIN
  385.   IF args.nocomm = 0 THEN
  386.     (* $IFNOT ClearVars *) set := FALSE; (* $END *)
  387.     cmt[0] := 0X; str.Append(cmt,comment);
  388.     IF args.force # 0 THEN
  389.       set := TRUE;
  390.     ELSE
  391.       lock := d.Lock(args.file[i]^,d.accessRead);
  392.       IF lock = NIL THEN
  393.         ds.PrintFault;
  394.       ELSE
  395.         NEW(fib);
  396.         IF fib = NIL THEN
  397.           ds.PrintMemErr;
  398.         ELSE
  399.           IF ~ d.Examine(lock,fib^) THEN
  400.             ds.PrintFault;
  401.           ELSE
  402.             IF args.append # 0 THEN
  403.               cmt[0] := 0X; str.Append(cmt,fib.comment);
  404.               str.Append(cmt," ");
  405.               str.Append(cmt,comment);
  406.               set:=TRUE;
  407.             ELSIF args.prepend #0 THEN
  408.               str.Append(cmt," ");
  409.               str.Append(cmt,fib.comment); set:=TRUE;
  410.             ELSIF fib.comment[0] = 0X THEN
  411.               set := TRUE;
  412.             END;
  413.           END;
  414.           DISPOSE(fib);
  415.         END;
  416.         d.UnLock(lock);
  417.       END
  418.     END;
  419.     IF set THEN
  420.       IF ~ d.SetComment(args.file[i]^,cmt) THEN ds.PrintFault; END;
  421.     END
  422.   END
  423. END SetComment;
  424.  
  425.  
  426.  
  427. PROCEDURE PrintMsg(str: e.LSTRPTR);
  428. BEGIN
  429.   IF args.quiet = 0 THEN
  430.     d.PrintF("%s\t- %s\n",args.file[i],str);
  431.   END
  432. END PrintMsg;
  433.  
  434.  
  435.  
  436. (* main *)
  437. BEGIN
  438.   SYS.SETREG(8,SYS.ADR(version));    (* that the version string will linked *)
  439.   IF d.base.lib.version < 37 THEN
  440.     HALT(20);
  441.   ELSE
  442.     rd := d.ReadArgs(template,args,NIL);
  443.     IF rd = NIL THEN
  444.       ds.PrintFault;
  445.     ELSE
  446.       IF args.force + args.append + args.prepend < -1  THEN   (* it's not fine but works *)
  447.         d.PrintF("only one of FORCE APPEND PREPEND can specified\n");
  448.       ELSE
  449.         WHILE args.file[i] # NIL DO
  450.           f.name := args.file[i];
  451.           f.passwd := NIL;               (* no passwd support *)
  452.           IF xfds.LoadFile(f) THEN
  453.             fileadr := f.address;
  454.             IF CheckVerStr(fileadr^,f.size,buffer) OR CheckResident(fileadr^,f.size,buffer) THEN
  455.               PrintMsg(SYS.ADR(buffer));
  456.               SetComment(buffer);
  457.             ELSE
  458.               PrintMsg(SYS.ADR("No VersionString found"));
  459.               IF args.default # NIL THEN
  460.                 SetComment(args.default^);
  461.               END
  462.             END;
  463.             xfds.UnLoadFile(f);
  464.           END;
  465.           INC(i);
  466.         END;
  467.       END;
  468.       d.FreeArgs(rd);
  469.     END
  470.   END
  471. END DoVer.
  472.  
  473.