/compiler/utils/fixlog.pp

https://github.com/slibre/freepascal · Puppet · 174 lines · 162 code · 12 blank · 0 comment · 20 complexity · 5e1b8033caf3bbf6def2e44ccca69dc7 MD5 · raw file

  1. {
  2. Copyright (c) 1998-2002 by Peter Vreman
  3. Remove all revision logs from source files after X revisions or
  4. older than date X
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. program fixlog;
  12. {$mode objfpc}
  13. {$H+}
  14. uses
  15. sysutils;
  16. const
  17. bufsize = 32*1024;
  18. var
  19. maxrevs,myear,mmonth,mday : integer;
  20. procedure Date2Int(const date:string;var year,month,day:integer);
  21. begin
  22. year:=StrToInt(Copy(date,1,4));
  23. month:=StrToInt(Copy(date,6,2));
  24. day:=StrToInt(Copy(date,9,2));
  25. if (year=0) or (month=0) or (day=0) then
  26. begin
  27. writeln('wrong date "',date,'", use yyyy/mm/dd');
  28. halt(2);
  29. end;
  30. end;
  31. procedure dofile(const fn:string);
  32. var
  33. t,f : text;
  34. s : string;
  35. skip, truncated : boolean;
  36. year,month,day,
  37. found,revs,i : integer;
  38. fbuf,tbuf : pointer;
  39. begin
  40. getmem(fbuf,bufsize);
  41. getmem(tbuf,bufsize);
  42. write('processing ',fn,': ');
  43. assign(t,fn);
  44. assign(f,'fixlog.tmp');
  45. {$push}{$I-}
  46. reset(t);
  47. {$pop}
  48. if ioresult<>0 then
  49. begin
  50. writeln('error!');
  51. exit;
  52. end;
  53. rewrite(f);
  54. settextbuf(t,tbuf^,bufsize);
  55. settextbuf(f,fbuf^,bufsize);
  56. found:=0;
  57. revs:=0;
  58. skip:=false;
  59. truncated:=false;
  60. while not eof(t) do
  61. begin
  62. readln(t,s);
  63. case found of
  64. 0 :
  65. begin
  66. if pos('$Log: ',s)>0 then
  67. found:=1;
  68. skip:=false;
  69. writeln(f,s);
  70. end;
  71. 1 :
  72. begin
  73. i:=pos('Revision',s);
  74. if i>0 then
  75. begin
  76. inc(revs);
  77. if revs>maxrevs then
  78. begin
  79. skip:=true;
  80. truncated:=true;
  81. found:=2;
  82. end
  83. else
  84. begin
  85. inc(i,10);
  86. while (i<length(s)) and (s[i]<>' ') do
  87. inc(i);
  88. while (i<length(s)) and (s[i]=' ') do
  89. inc(i);
  90. if (i<length(s)) and (s[i] in ['0'..'9']) then
  91. begin
  92. Date2Int(Copy(s,i,10),year,month,day);
  93. if (year<Myear) or
  94. ((year=MYear) and (month<Mmonth)) or
  95. ((year=MYear) and (month=Mmonth) and (day<Mday)) then
  96. begin
  97. skip:=true;
  98. truncated:=true;
  99. found:=2;
  100. // write(year,'/',month,'/',day,' date');
  101. end;
  102. end;
  103. end;
  104. end
  105. else
  106. if pos('}',s)>0 then
  107. begin
  108. skip:=false;
  109. found:=0;
  110. end;
  111. if not skip then
  112. writeln(f,s);
  113. end;
  114. 2 :
  115. begin
  116. if pos('}',s)>0 then
  117. begin
  118. skip:=false;
  119. found:=0;
  120. end;
  121. if not skip then
  122. writeln(f,s);
  123. end;
  124. end;
  125. end;
  126. close(t);
  127. close(f);
  128. if revs=0 then
  129. writeln(' no log found')
  130. else
  131. if truncated then
  132. writeln(revs-1,' revisions')
  133. else
  134. writeln(revs,' revisions');
  135. erase(t);
  136. rename(f,fn);
  137. freemem(tbuf);
  138. freemem(fbuf);
  139. end;
  140. var
  141. dir : tsearchrec;
  142. i : integer;
  143. path : string;
  144. begin
  145. writeln('fixlog v1.01 (C) 1999-2002 Peter Vreman');
  146. if paramcount<3 then
  147. begin
  148. writeln('usage: fixlog <revisions> <yyyy-mm-dd> <files> [files]');
  149. halt(1);
  150. end;
  151. MaxRevs:=StrToInt(ParamStr(1));
  152. Date2Int(ParamStr(2),MYear,MMonth,MDay);
  153. for i:=3 to paramcount do
  154. begin
  155. path:=ExtractFilePath(paramstr(i));
  156. if findfirst(paramstr(i),faAnyFile,dir)=0 then
  157. repeat
  158. dofile(path+dir.name);
  159. until findnext(dir)<>0;
  160. findclose(dir);
  161. end;
  162. end.