Commit | Line | Data |
---|---|---|
9f8e26f4 C |
1 | # Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen |
2 | # Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix | |
3 | # This file is part of Coccinelle. | |
4 | # | |
5 | # Coccinelle is free software: you can redistribute it and/or modify | |
6 | # it under the terms of the GNU General Public License as published by | |
7 | # the Free Software Foundation, according to version 2 of the License. | |
8 | # | |
9 | # Coccinelle is distributed in the hope that it will be useful, | |
10 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
11 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
12 | # GNU General Public License for more details. | |
13 | # | |
14 | # You should have received a copy of the GNU General Public License | |
15 | # along with Coccinelle. If not, see <http://www.gnu.org/licenses/>. | |
16 | # | |
17 | # The authors reserve the right to distribute this or future versions of | |
18 | # Coccinelle under other licenses. | |
19 | ||
20 | ||
34e49164 C |
21 | #!/usr/bin/perl |
22 | # | |
23 | # ARGV: 0 = replacement text, 1 = file w. list of files | |
24 | # | |
25 | ||
26 | $debug = 0; | |
27 | $retain = 1; # 1 = retain old status | |
28 | ||
29 | #---------------------------------------------------------------------- | |
30 | $header = 0; # 0 = not seen header yet; 1 = seen beginning; 2 = seen end | |
31 | ||
32 | $currentfile = ""; | |
33 | $currentstatus = ""; | |
34 | $oldstatus = ""; | |
35 | @files = (); | |
36 | ||
37 | # Get replacement text | |
38 | $replace = shift; | |
39 | ||
40 | # Get files of interest | |
41 | open(FILES,shift); | |
42 | @files = <FILES>; | |
43 | close(FILES); | |
44 | ||
45 | # Remove file name suffixes | |
46 | foreach $_ (@files) { | |
47 | s/^([^.]+)\..+$/\1/; | |
48 | chop; | |
49 | print "--> added [$_]\n" if $debug; | |
50 | } | |
51 | ||
52 | # Process std. input | |
53 | while(<>) { | |
54 | ||
55 | # Find an ignore header | |
56 | if(/^-+$/) { | |
57 | $header = $header + 1; | |
58 | } | |
59 | ||
60 | # | |
61 | if($header > 1) { | |
62 | ||
63 | # Filename | |
64 | if(/^([0-9a-zA-Z_-]+)\.c\s*$/) { | |
65 | $currentfile = $1; | |
66 | $currentstatus = ""; | |
67 | print "--> currentfile: [$currentfile]\n" if $debug; | |
68 | } | |
69 | ||
70 | # Status code | |
71 | if(/^(\s+\*\s+)\[status\]([ \t\f]*)(\S*)$/) { | |
72 | $currentstatus = $3; | |
73 | ||
74 | print "--> $currentfile [$currentstatus]\n" if $debug; | |
75 | ||
76 | if(grep {/^$currentfile$/} @files) { | |
77 | s/^(\s+\*\s+\[status\])[ \t\f]*(.*)$/\1 $replace/; | |
78 | print "==>" if $debug; | |
79 | ||
80 | if($retain && ($currentstatus ne "")) { | |
81 | $oldstatus = " * [old-status] $currentstatus\n"; | |
82 | } | |
83 | } | |
84 | ||
85 | $currentfile =""; | |
86 | ||
87 | } | |
88 | ||
89 | } | |
90 | ||
91 | # | |
92 | print "$_"; | |
93 | ||
94 | if($oldstatus ne "") { | |
95 | print $oldstatus; | |
96 | $oldstatus = ""; | |
97 | } | |
98 | ||
99 | } |