Home | History | Annotate | Download | only in Scripts 
      1 #!/usr/bin/perl -w
      2 
      3 # Copyright (C) 2008 Apple Inc. All Rights Reserved.
      4 #
      5 # Redistribution and use in source and binary forms, with or without
      6 # modification, are permitted provided that the following conditions
      7 # are met:
      8 # 1. Redistributions of source code must retain the above copyright
      9 #    notice, this list of conditions and the following disclaimer.
     10 # 2. Redistributions in binary form must reproduce the above copyright
     11 #    notice, this list of conditions and the following disclaimer in the
     12 #    documentation and/or other materials provided with the distribution.
     13 #
     14 # THIS SOFTWARE IS PROVIDED BY APPLE INC. ``AS IS'' AND ANY
     15 # EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
     16 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
     17 # PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL APPLE INC. OR
     18 # CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
     19 # EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
     20 # PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
     21 # PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY
     22 # OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
     23 # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
     24 # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
     25 
     26 use strict;
     27 use File::Basename;
     28 
     29 sub printDependencyTree($);
     30 
     31 my $basename = basename($0);
     32 @ARGV or die "Usage: $basename sln1 [sln2 sln3...]";
     33 
     34 foreach my $sln (@ARGV) {
     35     printDependencyTree($sln);
     36 }
     37 
     38 exit;
     39 
     40 sub printDependencyTree($)
     41 {
     42     my ($sln) = @_;
     43 
     44     unless (-f $sln) {
     45         warn "Warning: Can't find $sln; skipping\n";
     46         return;
     47     }
     48 
     49     unless (open SLN, "<", $sln) {
     50         warn "Warning: Can't open $sln; skipping\n";
     51         return;
     52     }
     53 
     54     my %projectsByUUID = ();
     55     my $currentProject;
     56 
     57     my $state = "initial";
     58     foreach my $line (<SLN>) {
     59         if ($state eq "initial") {
     60             if ($line =~ /^Project\([^\)]+\) = "([^"]+)", "[^"]+", "([^"]+)"\r?$/) {
     61                 my $name = $1;
     62                 my $uuid = $2;
     63                 if (exists $projectsByUUID{$uuid}) {
     64                     warn "Warning: Project $name appears more than once in $sln; using first definition\n";
     65                     next;
     66                 }
     67                 $currentProject = {
     68                     name => $name,
     69                     uuid => $uuid,
     70                     dependencies => {},
     71                 };
     72                 $projectsByUUID{$uuid} = $currentProject;
     73 
     74                 $state = "inProject";
     75             }
     76 
     77             next;
     78         }
     79 
     80         if ($state eq "inProject") {
     81             defined($currentProject) or die;
     82 
     83             if ($line =~ /^\s*ProjectSection\(ProjectDependencies\) = postProject\r?$/) {
     84                 $state = "inDependencies";
     85             } elsif ($line =~ /^EndProject\r?$/) {
     86                 $currentProject = undef;
     87                 $state = "initial";
     88             }
     89 
     90             next;
     91         }
     92 
     93         if ($state eq "inDependencies") {
     94             defined($currentProject) or die;
     95 
     96             if ($line =~ /^\s*({[^}]+}) = ({[^}]+})\r?$/) {
     97                 my $uuid1 = $1;
     98                 my $uuid2 = $2;
     99                 if (exists $currentProject->{dependencies}->{$uuid1}) {
    100                     warn "Warning: UUID $uuid1 listed more than once as dependency of project ", $currentProject->{name}, "\n";
    101                     next;
    102                 }
    103 
    104                 $uuid1 eq $uuid2 or warn "Warning: UUIDs in depedency section of project ", $currentProject->{name}, " don't match: $uuid1 $uuid2; using first UUID\n";
    105 
    106                 $currentProject->{dependencies}->{$uuid1} = 1;
    107             } elsif ($line =~ /^\s*EndProjectSection\r?$/) {
    108                 $state = "inProject";
    109             }
    110 
    111             next;
    112         }
    113     }
    114 
    115     close SLN or warn "Warning: Can't close $sln\n";
    116 
    117     my %projectsNotDependedUpon = %projectsByUUID;
    118     CANDIDATE: foreach my $candidateUUID (keys %projectsByUUID) {
    119         foreach my $projectUUID (keys %projectsByUUID) {
    120             next if $candidateUUID eq $projectUUID;
    121             foreach my $dependencyUUID (keys %{$projectsByUUID{$projectUUID}->{dependencies}}) {
    122                 if ($candidateUUID eq $dependencyUUID) {
    123                     delete $projectsNotDependedUpon{$candidateUUID};
    124                     next CANDIDATE;
    125                 }
    126             }
    127         }
    128     }
    129 
    130     foreach my $project (values %projectsNotDependedUpon) {
    131         printProjectAndDependencies($project, 0, \%projectsByUUID);
    132     }
    133 }
    134 
    135 sub printProjectAndDependencies
    136 {
    137     my ($project, $indentLevel, $projectsByUUID) = @_;
    138 
    139     print " " x $indentLevel, $project->{name}, "\n";
    140     foreach my $dependencyUUID (keys %{$project->{dependencies}}) {
    141         printProjectAndDependencies($projectsByUUID->{$dependencyUUID}, $indentLevel + 1, $projectsByUUID);
    142     }
    143 }
    144