|
1 #!perl |
|
2 # Copyright (c) 2000-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 use strict; |
|
19 use FindBin; |
|
20 use lib "$FindBin::Bin"; |
|
21 use Getopt::Long; |
|
22 use IniData; |
|
23 use EnvDb; |
|
24 use CommandController; |
|
25 use DirHandle; |
|
26 use Utils; |
|
27 |
|
28 |
|
29 # Globals. |
|
30 # |
|
31 |
|
32 my $verbose = 0; |
|
33 my $iniData = IniData->New(); |
|
34 my $commandController = CommandController->New($iniData, 'SourceInfo'); |
|
35 my $envDb; |
|
36 my $file; |
|
37 my $comp; |
|
38 my $listindividualfiles; |
|
39 my $includeignores; |
|
40 my $includebinaries; |
|
41 my $summary; |
|
42 my $expandepoc32; |
|
43 my $countfiles; |
|
44 my $skipWarnings; |
|
45 |
|
46 $envDb = EnvDb->Open($iniData, $verbose); |
|
47 |
|
48 # |
|
49 # Main. |
|
50 # |
|
51 |
|
52 ProcessCommandLine(); |
|
53 SourceInfo(); |
|
54 |
|
55 # |
|
56 # Subs. |
|
57 # |
|
58 |
|
59 sub ProcessCommandLine { |
|
60 Getopt::Long::Configure ("bundling"); |
|
61 my $help; |
|
62 GetOptions('h' => \$help, 'v+' => \$verbose, 'f' => \$listindividualfiles, 'i' => \$includeignores, 'b' => \$includebinaries, 's' => \$summary, 'c' => \$countfiles, 'force' => \$skipWarnings); |
|
63 |
|
64 if ($help) { |
|
65 Usage(0); |
|
66 } |
|
67 |
|
68 if (!$ARGV[0]) { |
|
69 $comp = undef; # it already is, but let's be explicit... |
|
70 } else { |
|
71 if ($envDb->Version($ARGV[0])) { |
|
72 $comp = shift @ARGV; |
|
73 } else { |
|
74 $file = shift @ARGV; |
|
75 Utils::AbsoluteFileName(\$file); |
|
76 } |
|
77 } |
|
78 |
|
79 unless ($#ARGV == -1) { |
|
80 print "Error: Invalid arguments\n"; |
|
81 Usage(1); |
|
82 } |
|
83 } |
|
84 |
|
85 sub Usage { |
|
86 my $exitCode = shift; |
|
87 |
|
88 Utils::PrintDeathMessage($exitCode, "\nUsage: sourceinfo [options] [ component | file ] |
|
89 |
|
90 options: |
|
91 |
|
92 -h help |
|
93 -v verbose output (-vv very verbose) |
|
94 -f list individual files, not just directories |
|
95 -c count the files in each directory (can be slow) |
|
96 -b include binary files in report |
|
97 -i include 'ignored' files in report |
|
98 --force (deprecated) |
|
99 -s print summary report (don't specify a component or a file)\n"); |
|
100 } |
|
101 |
|
102 sub SourceInfo { |
|
103 $expandepoc32 = WorkOutWhetherExpandEpoc32(); |
|
104 if ($file) { |
|
105 die "Error: can't do summary report about a particular file.\n" if ($summary); |
|
106 DoFileReport($file); |
|
107 } elsif ($comp) { |
|
108 die "Error: can't do summary report about a particular component.\n" if ($summary); |
|
109 DoComponentReport($comp); |
|
110 } elsif ($summary) { |
|
111 DoSummaryReport(); |
|
112 } else { |
|
113 DoFullReport(); |
|
114 } |
|
115 } |
|
116 |
|
117 ############################################################################################## |
|
118 # Implementation notes |
|
119 # |
|
120 # This script is very complex. Here is a guide to what's going on. |
|
121 # First look at the main SourceInfo function, above. You'll see there's four different |
|
122 # types of report, corresponding to the four ways the command line can be used. (-s is |
|
123 # treated as its own type of report). |
|
124 # Each one of these creates and uses a similar set of objects in different ways. |
|
125 # |
|
126 # The objects used are: |
|
127 # SourceInfo::OwnerFinder::xxxx - these classes are factories for SourceInfo::Owners. |
|
128 # SourceInfo::Owner - these objects represent each way a directory or file can be owned. |
|
129 # A single component may produce many 'owners' - for example, |
|
130 # one for each of its binary files and one for each of the 'source' |
|
131 # items in its MRP. |
|
132 # SourceInfo::Item - this class is the heart of this script. It represents each item |
|
133 # on disk (whether a directory or file). It may contain a link |
|
134 # to one or more owners, if that directory or file is owned. |
|
135 # |
|
136 # Each of the reports work like this: |
|
137 # 1- build up (partial) tree of all the files/directories on disk made of SourceInfo::Items. |
|
138 # 2- create a load of SourceInfo::Owners. |
|
139 # 3- tell the owners to attach themselves to the relevant items in the tree of Items. |
|
140 # 4- tell the items to make themselves shown/hidden depending on various settings. |
|
141 # 5- gather the shown items into a list which can be made into a table. |
|
142 # |
|
143 # The only exception is the -s option, which doesn't really stick to this pattern for |
|
144 # stage 5. But it does for the rest. |
|
145 # |
|
146 # The different reports work on this in different ways. For example, if a component is |
|
147 # specified on the command line, OwnerFinders (and therefore owners) are only created for |
|
148 # that component. |
|
149 # |
|
150 # The tree created in Stage 1 starts out small. (In fact, it's just the root). It grows |
|
151 # items under many circumstances: |
|
152 # -- an owner item requests an item deep in the tree which hasn't been expanded that |
|
153 # far yet. |
|
154 # -- ExpandAll is called, corresponding to the -f option. |
|
155 # -- ExpandUnownedDirs is called, which will list all the items inside each directory |
|
156 # that isn't owned. This ensures that all unowned files and directories are listed |
|
157 # in the tree. |
|
158 # -- we're a sourceinfo <file> and we have to expand the tree to include the file. |
|
159 # |
|
160 # It's worth noting that the -b flag has two effects. Firstly, binary OwnerFinders |
|
161 # and Owners are not created. Secondly, (more importantly?) neither ExpandAll |
|
162 # nor ExpandUnownedDirs will do any expansion inside \epoc32. So you'll never |
|
163 # see items inside that tree, and 'binary' items outside that tree won't appear |
|
164 # either. (In fact, they'll be reported as having no owner). |
|
165 # \epoc32 is not included if -i is specified, either. |
|
166 # |
|
167 ############################################################################ |
|
168 |
|
169 sub WorkOutWhetherExpandEpoc32 { |
|
170 return 1 if $includebinaries && $includeignores; |
|
171 return 0; |
|
172 } |
|
173 |
|
174 # The four following methods are the different types of report that can |
|
175 # be done. |
|
176 |
|
177 sub DoFileReport { |
|
178 my $file = shift; |
|
179 |
|
180 print "Warning: \"$file\" is not a file and is not a component that is currently installed. The following report assumes it is a file which you could install with \"getsource\"\n" unless -e $file; |
|
181 |
|
182 my $owners = FindOwners(); # we have to create all possible owners |
|
183 my $root = new SourceInfo::Item("", undef); |
|
184 $root->FindItem($file, 1); # expand the tree to include our file |
|
185 |
|
186 print "Finding owned items\n" if $verbose; |
|
187 FindOwnedItems($owners, $root, 0); # mark the Items as having Owners |
|
188 |
|
189 my $items = $root->GetAll; |
|
190 $root->DecideVisibility; |
|
191 |
|
192 $iniData->TableFormatter->PrintTable(MakeTable($items), 1); |
|
193 } |
|
194 |
|
195 sub DoSummaryReport { |
|
196 my $root = CreateRoot(); |
|
197 $root->ExpandAll() if ($listindividualfiles); |
|
198 my $owners = FindOwners(); |
|
199 FindOwnedItems($owners, $root, 1); |
|
200 $root->ExpandUnownedDirs(); |
|
201 |
|
202 $root->DecideVisibility; |
|
203 |
|
204 my @noowners; |
|
205 my @multiowners; |
|
206 foreach my $item (@{$root->GetAllVisible}) { |
|
207 my $count = $item->NumOwners; |
|
208 if ($count == 0) { |
|
209 push @noowners, $item; |
|
210 } elsif ($count > 1) { |
|
211 push @multiowners, $item; |
|
212 } else { |
|
213 # This has exactly one ownership. Joy! |
|
214 } |
|
215 } |
|
216 |
|
217 print "Files/areas without ownership:\n"; |
|
218 foreach (@noowners) { |
|
219 print " ".$_->Path . "\n"; |
|
220 } |
|
221 |
|
222 print "Files/areas with multiple ownership:\n"; |
|
223 foreach (@multiowners) { |
|
224 print " ".$_->Path . "\n"; |
|
225 } |
|
226 } |
|
227 |
|
228 sub DoFullReport { |
|
229 print "Doing full report\n" if $verbose; |
|
230 my $root = CreateRoot(); |
|
231 $root->ExpandAll() if ($listindividualfiles); |
|
232 my $owners = FindOwners(); |
|
233 FindOwnedItems($owners, $root, 1); |
|
234 $root->ExpandUnownedDirs() unless $listindividualfiles; # might have already done it |
|
235 |
|
236 my $items = $root->GetAll; |
|
237 if ($listindividualfiles) { |
|
238 $root->ShowAll(); |
|
239 } else { |
|
240 $root->DecideVisibility(); |
|
241 } |
|
242 |
|
243 $iniData->TableFormatter->PrintTable(MakeTable($items), 1); |
|
244 } |
|
245 |
|
246 sub DoComponentReport { |
|
247 my $component = shift; |
|
248 |
|
249 my $root = CreateRoot(); |
|
250 my $owners = FindOwners($component); |
|
251 FindOwnedItems($owners, $root, 1); |
|
252 $root->ExpandOwnedDirs() if ($listindividualfiles); |
|
253 |
|
254 my $items = $root->GetAll; |
|
255 if ($listindividualfiles) { |
|
256 $root->ShowAll(); |
|
257 } else { |
|
258 $root->DecideVisibility(); |
|
259 } |
|
260 |
|
261 $iniData->TableFormatter->PrintTable(MakeTable($items), 1); |
|
262 } |
|
263 |
|
264 # The following global functions are used by all the above types of report. |
|
265 |
|
266 sub CreateRoot { |
|
267 return new SourceInfo::Item("",undef); |
|
268 } |
|
269 |
|
270 sub LimitRelevantOwners { |
|
271 my $ownername = shift; |
|
272 my $owners = shift; |
|
273 |
|
274 my @owners = grep { $_->Component =~ m/^\Q$ownername\E$/i } @$owners; |
|
275 return \@owners; |
|
276 } |
|
277 |
|
278 # This takes a load of Items and makes a nice table. Mostly, it |
|
279 # just tells each item to produce some relevant rows. |
|
280 |
|
281 sub MakeTable { |
|
282 my $items = shift; |
|
283 |
|
284 my @header = ( "Area" ); |
|
285 push @header, "Files" if $countfiles; |
|
286 push @header, ( "Component", "Element", "Status", "Notes" ); |
|
287 my @rows = (\@header); |
|
288 foreach my $item (sort { $a->Path cmp $b->Path } @$items) { |
|
289 next unless $item->{show}; |
|
290 push @rows, @{$item->MakeRows()}; |
|
291 } |
|
292 return \@rows; |
|
293 } |
|
294 |
|
295 # This tells each owner to attach itself to the right place |
|
296 # in the tree of Items. |
|
297 |
|
298 sub FindOwnedItems { |
|
299 my $owners = shift; |
|
300 my $root = shift; |
|
301 my $createnew = shift; |
|
302 |
|
303 foreach my $owner (@$owners) { |
|
304 $owner->FindOwnedItem($root, $createnew); |
|
305 } |
|
306 } |
|
307 |
|
308 # This produces all the Owner objects, by way of creating some |
|
309 # ephemeral OwnerFinder objects. This is the only place |
|
310 # OwnerFinders are used. |
|
311 |
|
312 sub FindOwners { |
|
313 my $component = shift; # may be undefined |
|
314 my @owners; |
|
315 |
|
316 my @ownerfinders = (new SourceInfo::OwnerFinder::Source); |
|
317 push @ownerfinders, new SourceInfo::OwnerFinder::Ignores if $includeignores; |
|
318 push @ownerfinders, new SourceInfo::OwnerFinder::Binaries if $includebinaries; |
|
319 |
|
320 @owners = map { @{ $_->FindOwners($component) } } @ownerfinders; |
|
321 |
|
322 return \@owners; |
|
323 } |
|
324 |
|
325 ########################################################################################## |
|
326 ########################################################################################## |
|
327 package SourceInfo::Item; |
|
328 |
|
329 sub new { |
|
330 my $class = shift; |
|
331 my $name = shift; |
|
332 my $parent = shift; |
|
333 my $status = shift; |
|
334 die "No name provided" unless (defined $name); |
|
335 return bless { |
|
336 name => $name, # '' if root. NOT '\' |
|
337 children => undef, |
|
338 parent => $parent, # undef if root |
|
339 category => undef, |
|
340 owners => [], # links to any Owner objects. |
|
341 fullpath => undef, |
|
342 status => $status, |
|
343 children => {}, # yes, there are circular references and the whole tree won't die until global cleanup |
|
344 show => 0 # whether to show in the results |
|
345 }, (ref $class || $class); |
|
346 } |
|
347 |
|
348 # Produce rows relevant to put into the results tables |
|
349 |
|
350 sub MakeRows { |
|
351 my $self = shift; |
|
352 |
|
353 my $owners = $self->Owners(); |
|
354 |
|
355 my @rows; |
|
356 foreach my $owner (@$owners) { # for each owner... |
|
357 push @rows, $self->MakeARow($owner); |
|
358 } |
|
359 if ($self->NumOwners == 0) { # or, if we don't have an owner :-( |
|
360 push @rows, $self->MakeARow(); |
|
361 } |
|
362 return \@rows; |
|
363 } |
|
364 |
|
365 sub MakeARow { |
|
366 my $self = shift; |
|
367 my $owner = shift; |
|
368 |
|
369 my @row = ($self->Path()); |
|
370 push @row, $self->NumFiles() if ($countfiles); |
|
371 if ($owner) { |
|
372 push @row, $owner->Component(); |
|
373 push @row, $owner->Element(); |
|
374 push @row, $self->Category() || $owner->Status() || "-"; |
|
375 } else { |
|
376 push @row, ("-", "-"); |
|
377 push @row, $self->Category() || "-"; |
|
378 } |
|
379 push @row, $self->Notes(); |
|
380 return \@row; |
|
381 } |
|
382 |
|
383 sub NumOwners { |
|
384 my $self = shift; |
|
385 return scalar @{$self->Owners()}; |
|
386 } |
|
387 |
|
388 # Will later be used for IPR category. |
|
389 # This currently isn't used. |
|
390 |
|
391 sub Category { |
|
392 my $self = shift; |
|
393 return undef; |
|
394 } |
|
395 |
|
396 # These two methods are alternatives for making some or all of the |
|
397 # items visible, depending on their ownership. |
|
398 |
|
399 sub ShowAll { |
|
400 my $self = shift; |
|
401 $self->{show} = 1; |
|
402 $self->ExecuteChildren(sub {$_->ShowAll}); |
|
403 } |
|
404 |
|
405 sub DecideVisibility { |
|
406 my $self = shift; |
|
407 print "Deciding visibility for ".$self->Path.". Is directory: ".$self->IsDirectory.", owners: ".@{$self->{owners}}.", children: ".%{$self->{children}}."\n" if $verbose > 3; |
|
408 if ( $self->IsFile() || @{$self->{owners}} || !%{$self->{children}} ) { |
|
409 $self->{show} = 1; |
|
410 } |
|
411 $self->ExecuteChildren(sub { $_->DecideVisibility } ); |
|
412 } |
|
413 |
|
414 sub NumFiles { |
|
415 my $self = shift; |
|
416 |
|
417 $self->ExpandAll; |
|
418 my $files = ($self->IsDirectory)?0:1; |
|
419 foreach (values %{$self->{children}}) { |
|
420 $files += $_->NumFiles; |
|
421 } |
|
422 |
|
423 return $files; |
|
424 } |
|
425 |
|
426 sub Notes { |
|
427 my $self = shift; |
|
428 my $numowners = $self->NumOwners; |
|
429 if ($numowners == 0) { |
|
430 return "NONE"; |
|
431 } elsif ($numowners > 1) { |
|
432 return "MULTIPLE"; |
|
433 } elsif ($self->Owners()->[0]->Type() eq "ignore") { |
|
434 return "IGNORED"; |
|
435 } |
|
436 } |
|
437 |
|
438 sub IsDirectory { |
|
439 my $self = shift; |
|
440 return -d ($self->Path || "\\"); |
|
441 } |
|
442 |
|
443 sub IsFile { |
|
444 my $self = shift; |
|
445 return -f ($self->Path || "\\"); |
|
446 } |
|
447 |
|
448 # Destructor. Not currently used - just in case we want to delete |
|
449 # a tree full of circular references. |
|
450 |
|
451 sub DeleteAll { |
|
452 my $self = shift; |
|
453 $self->{parent} = undef; |
|
454 $self->ExecuteChildren( sub { $_->DeleteAll } ); |
|
455 } |
|
456 |
|
457 # Returns a list of each item |
|
458 |
|
459 sub GetAll { |
|
460 my $self = shift; |
|
461 my @items = ($self); |
|
462 $self->ExecuteChildren(sub { push @items, @{$_->GetAll} } ); |
|
463 return \@items; |
|
464 } |
|
465 |
|
466 # Returns a list of each item that's visible |
|
467 |
|
468 sub GetAllVisible { |
|
469 my $self = shift; |
|
470 my @items = grep { $_->{show} } @{$self->GetAll}; |
|
471 return \@items; |
|
472 } |
|
473 |
|
474 sub ExpandAll { |
|
475 my $self = shift; |
|
476 print "." if $verbose; |
|
477 $self->FindChildren; |
|
478 $self->ExecuteChildren( sub { $_->ExpandAll } ); |
|
479 } |
|
480 |
|
481 # This expands any directories which don't have owners, but some |
|
482 # of the subdirectories are owned. |
|
483 |
|
484 sub ExpandUnownedDirs { |
|
485 my $self = shift; |
|
486 print "Expanding unowned for ".$self->Path."\n" if $verbose>1; |
|
487 return unless $self->IsDirectory; |
|
488 return if $self->NumOwners; |
|
489 # We also return if NONE of the children are owned, |
|
490 # i.e. we're a totally unowned directory. |
|
491 return unless $self->{childownersfound}; |
|
492 $self->FindChildren; |
|
493 $self->ExecuteChildren (sub { $_->ExpandUnownedDirs } ); |
|
494 } |
|
495 |
|
496 sub ExpandOwnedDirs { |
|
497 my $self = shift; |
|
498 |
|
499 $self->ExpandAll() if (@{$self->{owners}}); |
|
500 $self->ExecuteChildren (sub { $_->ExpandOwnedDirs } ); |
|
501 } |
|
502 |
|
503 # Recursively applies a function to each item |
|
504 |
|
505 sub ExecuteChildren { |
|
506 my $self = shift; |
|
507 my $sub = shift; |
|
508 &$sub($_) foreach (values %{$self->{children}}); |
|
509 } |
|
510 |
|
511 sub FindChildren { |
|
512 my $self = shift; |
|
513 print "Finding children for ".$self->Path."\n" if $verbose>1; |
|
514 return if defined $self->{foundchildren}; |
|
515 return if ($self->Path eq "\\epoc32" && !$expandepoc32); |
|
516 $self->{foundchildren} = 1; |
|
517 $self->ReadDir(); |
|
518 my %kids = map { (lc $_, new SourceInfo::Item($_, $self)) } @{$self->{dirlisting}}; |
|
519 print "Currently has these children: ".(join (', ', map { "$_->{name} ".$_->NumOwners } values %{$self->{children}}))."\n" if $verbose>2; |
|
520 $self->{children} ||= {}; |
|
521 $self->{children} = { %kids, %{$self->{children}} }; |
|
522 } |
|
523 |
|
524 sub NumChildren { |
|
525 my $self = shift; |
|
526 $self->ReadDir; |
|
527 return @{$self->{dirlisting}}; |
|
528 } |
|
529 |
|
530 sub ReadDir { |
|
531 my $self = shift; |
|
532 return if $self->{dirlisting}; |
|
533 $self->{dirlisting} = [] and return unless $self->IsDirectory(); |
|
534 print "Reading directory for ".$self->Path."\n" if $verbose > 1; |
|
535 my $dh = new DirHandle($self->Path() || "\\") or die "Couldn't open directory handle for \"".$self->Path()||"\\"."\" because $!"; |
|
536 $self->{dirlisting} = [ grep { ! m/^\./ } $dh->read ]; |
|
537 $dh = undef; # I know this is OBVIOUSLY going to happen at the end of this function but |
|
538 # I am getting strange out-of-file-descriptor errors. |
|
539 } |
|
540 |
|
541 sub Path { |
|
542 my $self = shift; |
|
543 unless (defined $self->{fullpath}) { |
|
544 if (defined $self->{parent}) { |
|
545 $self->{fullpath} = $self->{parent}->Path() . "\\" . $self->{name}; |
|
546 } else { |
|
547 $self->{fullpath} = $self->{name}; |
|
548 } |
|
549 } |
|
550 return $self->{fullpath}; |
|
551 } |
|
552 |
|
553 # This is used to find a particular item in the tree, |
|
554 # given a path. (It's used when searching for something |
|
555 # that is owned, for example). The 'createnew' flag |
|
556 # specifies whether it should create new files and directories |
|
557 # if necessary. |
|
558 |
|
559 sub FindItem { |
|
560 my $self = shift; |
|
561 my $path = shift; |
|
562 my $createnew = shift; |
|
563 |
|
564 print "Asked to find \"$path\"...\n" if ($verbose > 3); |
|
565 |
|
566 my @segments = split (/\\/, $path); |
|
567 unshift @segments, "" unless $segments[0] eq ""; # root segment has no name |
|
568 $self->FindItemBySegments($createnew, @segments); |
|
569 } |
|
570 |
|
571 sub FindItemBySegments { |
|
572 my ($self, $createnew, $firstseg, @othersegs) = @_; |
|
573 |
|
574 print "\n$self->{name} (path ".$self->Path().") (createnew $createnew):--\n" if ($verbose > 3); |
|
575 print "First segment $firstseg, others @othersegs\n" if ($verbose > 3); |
|
576 |
|
577 die "No path provided" unless defined $firstseg; |
|
578 |
|
579 if (lc $firstseg eq lc $self->{name}) { |
|
580 if (@othersegs) { |
|
581 foreach (values %{$self->{children}}) { |
|
582 my $found = $_->FindItemBySegments($createnew, @othersegs); |
|
583 return $found if $found; |
|
584 } |
|
585 return undef unless $createnew; |
|
586 return $self->CreateNewSegment(@othersegs); |
|
587 } else { |
|
588 return $self; |
|
589 } |
|
590 } else { |
|
591 return undef; |
|
592 } |
|
593 } |
|
594 |
|
595 sub CreateNewSegment { |
|
596 my ($self, $firstseg, @othersegs) = @_; |
|
597 print "Creating new segment for $firstseg (others @othersegs) within ".$self->Path."\n" if $verbose>1; |
|
598 |
|
599 my $kid = new SourceInfo::Item($firstseg, $self); |
|
600 $self->{children}->{lc $firstseg} = $kid; |
|
601 $self->{childownersfound} = 1; |
|
602 return $kid->FindItemBySegments(1, $firstseg, @othersegs); |
|
603 } |
|
604 |
|
605 sub Owners { |
|
606 my $self = shift; |
|
607 my @allowners = @{$self->{owners}}; |
|
608 return \@allowners unless ($self->{parent}); |
|
609 push @allowners, @{$self->{parent}->Owners}; |
|
610 return \@allowners; |
|
611 } |
|
612 |
|
613 sub AddOwner { |
|
614 my $self = shift; |
|
615 my $owner = shift; |
|
616 push @{$self->{owners}}, $owner; |
|
617 } |
|
618 |
|
619 ########################################################################################## |
|
620 ########################################################################################## |
|
621 package SourceInfo::Owner; |
|
622 |
|
623 sub new { |
|
624 my $class = shift; |
|
625 my $type = shift; |
|
626 my $component = shift; |
|
627 my $element = shift; |
|
628 my $status = shift; |
|
629 |
|
630 return bless { |
|
631 type => $type, # ignore, binary or source |
|
632 component => $component, |
|
633 element => $element, |
|
634 status => $status |
|
635 }, (ref $class || $class); |
|
636 } |
|
637 |
|
638 sub FindOwnedItem { |
|
639 my $self = shift; |
|
640 my $root = shift; |
|
641 my $createnew = shift; |
|
642 |
|
643 print "About to find the owned item for \"$self->{element}\" ($createnew)\n" if ($verbose > 3); |
|
644 my $item = $root->FindItem($self->{element}, $createnew); |
|
645 die "Failed to create new item" if (!$item && $createnew); |
|
646 $item->AddOwner($self) if $item; |
|
647 } |
|
648 |
|
649 sub Component { |
|
650 my $self = shift; |
|
651 return "-" if ($self->Type() eq "ignore"); |
|
652 return $self->{component}; |
|
653 } |
|
654 |
|
655 sub Element { |
|
656 my $self = shift; |
|
657 return "<binary>" if ($self->{type} eq "binary"); |
|
658 return "<ignore>" if ($self->Type() eq "ignore"); |
|
659 return $self->{element} || "-"; |
|
660 } |
|
661 |
|
662 sub Type { |
|
663 my $self = shift; |
|
664 return $self->{type}; |
|
665 } |
|
666 |
|
667 sub Status { |
|
668 my $self = shift; |
|
669 return $self->{status}; |
|
670 } |
|
671 |
|
672 ########################################################################################## |
|
673 ########################################################################################## |
|
674 package SourceInfo::OwnerFinder; |
|
675 |
|
676 sub new { |
|
677 my $class = shift; |
|
678 return bless {}, (ref $class || $class); |
|
679 } |
|
680 |
|
681 sub Components { |
|
682 my $self = shift; |
|
683 my $versionInfo = $envDb->VersionInfo(); |
|
684 return sort keys %$versionInfo; |
|
685 } |
|
686 |
|
687 package SourceInfo::OwnerFinder::Ignores; |
|
688 BEGIN { @SourceInfo::OwnerFinder::Ignores::ISA = qw(SourceInfo::OwnerFinder); }; |
|
689 |
|
690 sub FindOwners { |
|
691 my $self = shift; |
|
692 my @owners; |
|
693 # First, the ignored items |
|
694 print "Finding ignored binaries.\n" if $verbose; |
|
695 my $ignoreList = $iniData->BinariesToIgnore(); |
|
696 push (@$ignoreList, '\\epoc32\\relinfo\\*'); |
|
697 foreach my $ignore (@$ignoreList) { |
|
698 my @found = glob $ignore; |
|
699 if (@found) { |
|
700 push @owners, new SourceInfo::Owner("ignore", undef, $_, undef) foreach (@found); |
|
701 } elsif ($ignore =~ s/\\\*$//) { |
|
702 push @owners, new SourceInfo::Owner("ignore", undef, $ignore, undef); |
|
703 } |
|
704 } |
|
705 return \@owners; |
|
706 } |
|
707 |
|
708 package SourceInfo::OwnerFinder::Source; |
|
709 BEGIN { @SourceInfo::OwnerFinder::Source::ISA = qw(SourceInfo::OwnerFinder); }; |
|
710 |
|
711 sub FindOwners { |
|
712 my $self = shift; |
|
713 my $component = shift; |
|
714 print "Finding source directories owned.\n" if $verbose; |
|
715 my @owners; |
|
716 my @comps_to_examine; |
|
717 if ($component) { |
|
718 @comps_to_examine = ($component); |
|
719 } else { |
|
720 @comps_to_examine = $self->Components(); |
|
721 } |
|
722 |
|
723 foreach my $comp (@comps_to_examine) { |
|
724 eval { |
|
725 foreach my $element (keys %{$self->GetSourceInfo($comp)}) { |
|
726 |
|
727 if($iniData->HasMappings()){ |
|
728 $element = $iniData->PerformMapOnFileName($element); |
|
729 $element = Utils::RemoveSourceRoot($element); |
|
730 } |
|
731 |
|
732 push @owners, new SourceInfo::Owner("source", $comp, $element, undef); |
|
733 } |
|
734 }; |
|
735 if ($@) { |
|
736 print "Warning: could not find owner information for \"$comp\" because $@"; |
|
737 } |
|
738 } |
|
739 return \@owners; |
|
740 } |
|
741 |
|
742 sub GetSourceInfo { |
|
743 my $self = shift; |
|
744 my $comp = shift; |
|
745 my $ver = $envDb->Version($comp); |
|
746 my $relData = RelData->Open($iniData, $comp, $ver, $verbose); |
|
747 return $relData->SourceItems(); |
|
748 } |
|
749 |
|
750 package SourceInfo::OwnerFinder::Binaries; |
|
751 BEGIN { @SourceInfo::OwnerFinder::Binaries::ISA = qw(SourceInfo::OwnerFinder); }; |
|
752 |
|
753 sub FindOwners { |
|
754 my $self = shift; |
|
755 my $component = shift; |
|
756 my @owners; |
|
757 print "Finding binaries owned.\n" if $verbose; |
|
758 my @comps_to_examine; |
|
759 if ($component) { |
|
760 @comps_to_examine = ($component); |
|
761 } else { |
|
762 @comps_to_examine = $self->Components(); |
|
763 } |
|
764 foreach my $comp (@comps_to_examine) { |
|
765 my $bfowned = $envDb->ListBins($comp); |
|
766 shift @$bfowned; # get rid of the header row |
|
767 foreach my $binfile (@$bfowned) { |
|
768 my $file = $binfile->[0]; |
|
769 my $status = $binfile->[1]; |
|
770 push @owners, new SourceInfo::Owner("binary", $comp, $file, $status); |
|
771 } |
|
772 } |
|
773 return \@owners; |
|
774 } |
|
775 |
|
776 |
|
777 __END__ |
|
778 |
|
779 =head1 NAME |
|
780 |
|
781 SourceInfo - Displays information about the source code associated with components. |
|
782 |
|
783 =head1 SYNOPSIS |
|
784 |
|
785 sourceinfo [options] [any file | component] |
|
786 |
|
787 options: |
|
788 |
|
789 -h help |
|
790 -v verbose output (-vv very verbose) |
|
791 -f list individual files, not just directories |
|
792 -b include binary files |
|
793 -i include 'ignored' files |
|
794 -s print summary report (don't specify a component or a file) |
|
795 --force (deprecated) |
|
796 -c show a count of the files in each directory (and its subdirectories) -- can be slow |
|
797 |
|
798 =head1 DESCRIPTION |
|
799 |
|
800 If given a filename, prints information about what component(s) release the source directory(ies) containing that file. |
|
801 |
|
802 Area Files Component Element Status Notes |
|
803 \aardvark 6 aardvark \aardvark - |
|
804 \aardvark\aardvark.mrp 1 aardvark \aardvark - |
|
805 |
|
806 The confusing 'element' column lists what MRP 'source' statement owns that item of source code. |
|
807 |
|
808 If given a component name, prints information about what directories that component releases. |
|
809 |
|
810 Area Files Component Element Status Notes |
|
811 \aardvark 6 aardvark \aardvark - |
|
812 |
|
813 If no component name is specified, then a full report will be provided for each component. This will also report any files or directories that are not owned by any component, as well as any file or directories which are owned by more than one component. |
|
814 |
|
815 Area Files Component Element Status Notes |
|
816 \aardvark 6 aardvark \aardvark - |
|
817 \albatross 6 albatross \albatross - |
|
818 \anteater 6 anteater \anteater - |
|
819 \buffalo 6 buffalo \buffalo - |
|
820 |
|
821 If the -s flag is provided, then only the information about files/directories with zero or multiple ownership is shown. |
|
822 |
|
823 Files/areas without ownership: |
|
824 \prepenv-input.txt |
|
825 \reltools-tmp-cleanremote-conf.txt |
|
826 Files/areas with multiple ownership: |
|
827 |
|
828 The F<\epoc32> tree is not normally included in reports. Similarly, files owned as "binary" files by components aren't included in reports - so, if a component releases binary files outside of F<\epoc32> then they will be shown as having no ownership. |
|
829 |
|
830 For completeness, you can include binary ownership in the report using C<-b>. A similar option is C<-i>. This turns on the scanning of 'ignored' areas, such as F<\epoc32\wins\c>. |
|
831 |
|
832 The final option is C<-f>. If a directory is uniformly owned, then normally the files inside that directory will not be listed. Adding C<-f> prompts the tool to list every file. |
|
833 |
|
834 Note that the output of this may NOT be suitable for distributing to licensees, because it may include directory structures of bits of IPR they are not licensed to see. |
|
835 |
|
836 =head1 STATUS |
|
837 |
|
838 Supported. If you find a problem, please report it to us. |
|
839 |
|
840 =head1 KNOWN BUGS |
|
841 |
|
842 None, but this tool is still rather experimental so please treat the output with caution. |
|
843 |
|
844 =head1 COPYRIGHT |
|
845 |
|
846 Copyright (c) 2000-2009 Nokia Corporation and/or its subsidiary(-ies). |
|
847 All rights reserved. |
|
848 This component and the accompanying materials are made available |
|
849 under the terms of the License "Eclipse Public License v1.0" |
|
850 which accompanies this distribution, and is available |
|
851 at the URL "http://www.eclipse.org/legal/epl-v10.html". |
|
852 |
|
853 Initial Contributors: |
|
854 Nokia Corporation - initial contribution. |
|
855 |
|
856 Contributors: |
|
857 |
|
858 Description: |
|
859 |
|
860 |
|
861 =cut |
|
862 |