|
1 #!perl |
|
2 # Copyright (c) 2003-2009 Nokia Corporation and/or its subsidiary(-ies). |
|
3 # All rights reserved. |
|
4 # This component and the accompanying materials are made available |
|
5 # under the terms of the License "Eclipse Public License v1.0" |
|
6 # which accompanies this distribution, and is available |
|
7 # at the URL "http://www.eclipse.org/legal/epl-v10.html". |
|
8 # |
|
9 # Initial Contributors: |
|
10 # Nokia Corporation - initial contribution. |
|
11 # |
|
12 # Contributors: |
|
13 # |
|
14 # Description: |
|
15 # |
|
16 # |
|
17 |
|
18 package CleanEnv; |
|
19 |
|
20 use strict; |
|
21 |
|
22 # |
|
23 # Globals. |
|
24 # |
|
25 |
|
26 my $reallyClean = 0; |
|
27 my $force = 0; |
|
28 my $verbose = 0; |
|
29 |
|
30 |
|
31 # |
|
32 # Public. |
|
33 # |
|
34 |
|
35 sub CleanEnv { |
|
36 my $iniData = shift; |
|
37 $reallyClean = shift; |
|
38 $force = shift; |
|
39 $verbose = shift; |
|
40 my $envDb = EnvDb->Open($iniData, $verbose); |
|
41 (my $overallStatus, undef, my $dirtyComps, my $unaccountedItems, my $duplicates) = $envDb->CheckEnv(1, $reallyClean, 1); |
|
42 |
|
43 if ($overallStatus == EnvDb::STATUS_CLEAN) { |
|
44 print "Environment already clean\n"; |
|
45 return 1; |
|
46 } |
|
47 else { |
|
48 my $cleaned = 1; |
|
49 if (scalar(@$unaccountedItems) > 0) { |
|
50 if (not $force or $verbose) { |
|
51 foreach my $line (@$unaccountedItems) { |
|
52 print "$line has unknown origin\n"; |
|
53 } |
|
54 } |
|
55 if (Query("\nDelete above file(s)? [y/n] ")) { |
|
56 foreach my $file (@$unaccountedItems) { |
|
57 if ($verbose) { print "Deleting $file...\n"; } |
|
58 unlink $file or print "Warning: Couldn't delete $file: $!\n" if (-f $file); |
|
59 RemoveDirIfEmpty($file) if (-d $file); |
|
60 |
|
61 (my $dir) = Utils::SplitFileName($file); |
|
62 RemoveDirIfEmpty($dir) if (-d $dir); |
|
63 } |
|
64 } |
|
65 else { |
|
66 $cleaned = 0; |
|
67 } |
|
68 } |
|
69 if (scalar(@$dirtyComps) > 0) { |
|
70 print "\n"; |
|
71 if (not $force or $verbose) { |
|
72 foreach my $comp (@$dirtyComps) { |
|
73 print "$comp->{comp} $comp->{ver} is dirty\n"; |
|
74 } |
|
75 } |
|
76 if (Query("\nRe-install the above component(s)? [y/n] ")) { |
|
77 foreach my $comp (@$dirtyComps) { |
|
78 $envDb->RefreshComponent($comp->{comp}); |
|
79 } |
|
80 } |
|
81 else { |
|
82 $cleaned = 0; |
|
83 } |
|
84 } |
|
85 if (scalar(@$duplicates) > 0) { |
|
86 print "\nThe following components are claiming the ownership of the same file:\n"; |
|
87 |
|
88 # Compile a hash of conflicting components indexed by file |
|
89 my %duplicateFiles; |
|
90 foreach my $dup (@$duplicates) { |
|
91 # Each list item contains the filename, plus only two conflicting components. |
|
92 my $file = shift @$dup; |
|
93 $duplicateFiles{$file} = [] if !exists $duplicateFiles{$file}; |
|
94 foreach my $comp (@$dup) { |
|
95 my $found = 0; |
|
96 foreach my $existingComp (@{$duplicateFiles{$file}}) { |
|
97 if ($existingComp eq $comp) { |
|
98 $found = 1; |
|
99 last; |
|
100 } |
|
101 } |
|
102 push @{$duplicateFiles{$file}}, $comp if !$found; |
|
103 } |
|
104 } |
|
105 |
|
106 foreach my $file (keys(%duplicateFiles)) { |
|
107 print join(", ", sort(@{$duplicateFiles{$file}})).": $file\n"; |
|
108 } |
|
109 print "\nCleanEnv cannot resolve these duplicates. To fix this, please remove one or\nmore of the conflicting components\n"; |
|
110 } |
|
111 return $cleaned; |
|
112 } |
|
113 } |
|
114 |
|
115 |
|
116 # |
|
117 # Private. |
|
118 # |
|
119 |
|
120 sub RemoveDirIfEmpty { |
|
121 my $dir = shift; |
|
122 if (DirEmpty($dir)) { |
|
123 rmdir $dir or print "Warning: Couldn't delete \"$dir\": $!\n"; |
|
124 $dir =~ s/\\$//; # Remove trailing backslash. |
|
125 (my $parentDir) = Utils::SplitFileName($dir); |
|
126 RemoveDirIfEmpty($parentDir); |
|
127 } |
|
128 } |
|
129 |
|
130 sub DirEmpty { |
|
131 my $dir = shift; |
|
132 return (scalar @{Utils::ReadDir($dir)} == 0); |
|
133 } |
|
134 |
|
135 sub Query { |
|
136 my $question = shift; |
|
137 return 1 if $force; |
|
138 print $question; |
|
139 my $response = lc <STDIN>; |
|
140 chomp $response; |
|
141 return ($response eq 'y')?1:0; |
|
142 } |
|
143 |
|
144 1; |
|
145 |
|
146 __END__ |
|
147 |
|
148 =head1 NAME |
|
149 |
|
150 CleanEnv.pm - Provides an interface for cleaning environments. |
|
151 |
|
152 =head1 INTERFACE |
|
153 |
|
154 =head2 CleanEnv |
|
155 |
|
156 Expects to be passed an C<IniData> reference, a flag indicating if a 'really clean' should be done, a flag indiacting of no user interaction (force) should be done, and a verbosity level. Cleans the environment accordingly. Returns true if the environment was cleaned (i.e. the user replied 'y' to all questions), false otherwise. |
|
157 |
|
158 =head1 KNOWN BUGS |
|
159 |
|
160 None. |
|
161 |
|
162 =head1 COPYRIGHT |
|
163 |
|
164 Copyright (c) 2003-2009 Nokia Corporation and/or its subsidiary(-ies). |
|
165 All rights reserved. |
|
166 This component and the accompanying materials are made available |
|
167 under the terms of the License "Eclipse Public License v1.0" |
|
168 which accompanies this distribution, and is available |
|
169 at the URL "http://www.eclipse.org/legal/epl-v10.html". |
|
170 |
|
171 Initial Contributors: |
|
172 Nokia Corporation - initial contribution. |
|
173 |
|
174 Contributors: |
|
175 |
|
176 Description: |
|
177 |
|
178 |
|
179 =cut |