File: freefix.pl

package info (click to toggle)
gridengine 6.2-4
  • links: PTS, VCS
  • area: main
  • in suites: lenny
  • size: 51,532 kB
  • ctags: 51,172
  • sloc: ansic: 418,155; java: 37,080; sh: 22,593; jsp: 7,699; makefile: 5,292; csh: 4,244; xml: 2,901; cpp: 2,086; perl: 1,895; tcl: 1,188; lisp: 669; ruby: 642; yacc: 393; lex: 266
file content (142 lines) | stat: -rw-r--r-- 4,368 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
#!/usr/bin/perl

#########################################################################
# 
#  The Contents of this file are made available subject to the terms of
#  the Sun Industry Standards Source License Version 1.2
# 
#  Sun Microsystems Inc., March, 2001
# 
# 
#  Sun Industry Standards Source License Version 1.2
#  =================================================
#  The contents of this file are subject to the Sun Industry Standards
#  Source License Version 1.2 (the "License"); You may not use this file
#  except in compliance with the License. You may obtain a copy of the
#  License at http://gridengine.sunsource.net/Gridengine_SISSL_license.html
# 
#  Software provided under this License is provided on an "AS IS" basis,
#  WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING,
#  WITHOUT LIMITATION, WARRANTIES THAT THE SOFTWARE IS FREE OF DEFECTS,
#  MERCHANTABLE, FIT FOR A PARTICULAR PURPOSE, OR NON-INFRINGING.
#  See the License for the specific provisions governing your rights and
#  obligations concerning the Software.
# 
#   The Initial Developer of the Original Code is: Sun Microsystems, Inc.
# 
#   Copyright: 2001 by Sun Microsystems, Inc.
# 
#   All Rights Reserved.
# 
#########################################################################
#
# This script processes all .c files in the selected directory and makes
# sure that all calls to lFreeElem, lFreeList, lFreeWhat, lFreeWhere, and
# lFreeSortOrder assign the call result to the freed variable.  When the
# script finds a file that does not assign the result to the freed variable,
# it creates a new version of the file, called fix.file_name (where file_name
# is the name of the file being processed), in which these errors are corrected.
# if -commit is passed as an argument, instead of creating a new file to
# contain the changes, the script will overwrite the original.
#
# Syntax:
#    freefix.pl directory [-commit]
#
# Example:
#    freefix.pl gridengine/source -commit
#
#########################################################################

# Process args
if ((@ARGV < 1) || (@ARGV > 2) || ($ARGV[0] eq "") ||
    ((@ARGV == 2) && ($ARGV[1] ne "-commit"))) {
   print "Usage: freefix.pl directory_name [-commit]\n";
   exit 1;
}
elsif (@ARGV == 2) {
   $commit = 1;
}

# Global to tell if any changes were made
$changed = 0;

# Kick off the process
processDir ($ARGV[0]);

# If no changes were made, say so
if (!$changed) {
   print "No changes.\n";
}

# This routine recursively processes directories looking for .c files
sub processDir {
   my $dir = $_[0];
   my @files;

   opendir (DIR, $dir) || die ("Can't open directory $dir\n");
   (@files = readdir (DIR)) || die ("Can't read directory $dir\n");
   closedir (DIR) || die ("Can't close directory $dir\n");

   foreach $file (@files) {
      if ($file !~ /^\.\.?$/) {
         if ($file =~ /.c$/) {
            processFile ("$dir/$file");
         }
         elsif (-d "$dir/$file") {
            processDir ("$dir/$file");
         }
      }
   }
}

# This routine processes .c files to replace bad calls to lFree*
sub processFile {
   my $file = $_[0];
   # Flag to tell if we need to change the file or not
   my $printed = 0;

   open (FILE, "<$file");
   open (TMP, ">fix.$file");

   # First make sure there's something that needs to be fixed.
   while (<FILE>) {
      if ((/^\s*([a-zA-Z0-9]+\s*=\s*)?lFree(Elem|List|What|Where|SortOrder)\s*\(\s*[a-zA-Z0-9\->[\].*&]+\s*\)\s*;.*$/) &&
          ($1 eq "")) {
         print "Fixing $file";
         print " => $file.fix" if ($commit == 0);
         print "\n";
         $printed = 1;
         last;
      }
   }

   close (FILE);

   # Reopen the file, and this time make changes
   if ($printed) {
      open (FILE, "<$file");
      open (TMP, ">$file.fix");

      while (<FILE>) {
         if ((/^(\s*)(([a-zA-Z0-9]+\s*=\s*)?)(lFree(Elem|List|What|Where|SortOrder)(\s*\(\s*([a-zA-Z0-9\->[\].*&]+)\s*\))\s*;.*)$/) &&
             ($2 eq "")) {
            print TMP "$1$7 = $4\n";
         }
         else {
            print TMP;
         }
      }

      close (FILE);
      close (TMP);

      # if -commit was passed, replace the original with the tmp copy
      if ($commit) {
         unlink ("$file");
         rename ("$file.fix", "$file");
      }

      # Note that we made a change
      $changed = 1;
   }
}