fixlog.pp 3.9 KB

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