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 }