/compiler/utils/fixlog.pp
Puppet | 174 lines | 162 code | 12 blank | 0 comment | 20 complexity | 5e1b8033caf3bbf6def2e44ccca69dc7 MD5 | raw file
Possible License(s): LGPL-2.0, LGPL-2.1, LGPL-3.0
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.