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