/compiler/utils/fixlog.pp

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