fixlog.pp 4.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194
  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, truncated : 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. truncated:=false;
  61. while not eof(t) do
  62. begin
  63. readln(t,s);
  64. case found of
  65. 0 :
  66. begin
  67. if pos('$Log: ',s)>0 then
  68. found:=1;
  69. skip:=false;
  70. writeln(f,s);
  71. end;
  72. 1 :
  73. begin
  74. i:=pos('Revision',s);
  75. if i>0 then
  76. begin
  77. inc(revs);
  78. if revs>maxrevs then
  79. begin
  80. skip:=true;
  81. truncated:=true;
  82. found:=2;
  83. end
  84. else
  85. begin
  86. inc(i,10);
  87. while (i<length(s)) and (s[i]<>' ') do
  88. inc(i);
  89. while (i<length(s)) and (s[i]=' ') do
  90. inc(i);
  91. if (i<length(s)) and (s[i] in ['0'..'9']) then
  92. begin
  93. Date2Int(Copy(s,i,10),year,month,day);
  94. if (year<Myear) or
  95. ((year=MYear) and (month<Mmonth)) or
  96. ((year=MYear) and (month=Mmonth) and (day<Mday)) then
  97. begin
  98. skip:=true;
  99. truncated:=true;
  100. found:=2;
  101. // write(year,'/',month,'/',day,' date');
  102. end;
  103. end;
  104. end;
  105. end
  106. else
  107. if pos('}',s)>0 then
  108. begin
  109. skip:=false;
  110. found:=0;
  111. end;
  112. if not skip then
  113. writeln(f,s);
  114. end;
  115. 2 :
  116. begin
  117. if pos('}',s)>0 then
  118. begin
  119. skip:=false;
  120. found:=0;
  121. end;
  122. if not skip then
  123. writeln(f,s);
  124. end;
  125. end;
  126. end;
  127. close(t);
  128. close(f);
  129. if revs=0 then
  130. writeln(' no log found')
  131. else
  132. if truncated then
  133. writeln(revs-1,' revisions')
  134. else
  135. writeln(revs,' revisions');
  136. erase(t);
  137. rename(f,fn);
  138. freemem(tbuf);
  139. freemem(fbuf);
  140. end;
  141. var
  142. dir : tsearchrec;
  143. i : integer;
  144. begin
  145. writeln('fixlog v1.00 (C) 1999-2000 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. if findfirst(paramstr(i),faAnyFile,dir)=0 then
  156. repeat
  157. dofile(dir.name);
  158. until findnext(dir)<>0;
  159. findclose(dir);
  160. end;
  161. end.
  162. {
  163. $Log$
  164. Revision 1.3 2001-03-05 21:44:16 peter
  165. * small diffs from Sergey applied
  166. Revision 1.1 2000/07/13 06:30:14 michael
  167. + Initial import
  168. Revision 1.4 2000/02/09 13:08:27 peter
  169. * usage shows yyyy-mm-dd
  170. Revision 1.3 2000/01/08 13:52:02 peter
  171. * max date added
  172. Revision 1.2 2000/01/07 01:15:00 peter
  173. * updated copyright to 2000
  174. Revision 1.1 1999/10/06 06:29:03 peter
  175. * new tool
  176. }