xref: /AOO41X/main/solenv/bin/modules/CreatePDBRelocators.pm (revision 9780544fa6b4c85f7d9b48452f58c7da854fc9a5) 
1#**************************************************************
2#
3#  Licensed to the Apache Software Foundation (ASF) under one
4#  or more contributor license agreements.  See the NOTICE file
5#  distributed with this work for additional information
6#  regarding copyright ownership.  The ASF licenses this file
7#  to you under the Apache License, Version 2.0 (the
8#  "License"); you may not use this file except in compliance
9#  with the License.  You may obtain a copy of the License at
10#
11#    http://www.apache.org/licenses/LICENSE-2.0
12#
13#  Unless required by applicable law or agreed to in writing,
14#  software distributed under the License is distributed on an
15#  "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
16#  KIND, either express or implied.  See the License for the
17#  specific language governing permissions and limitations
18#  under the License.
19#
20#**************************************************************
21
22
23
24#*************************************************************************
25#
26# createPDBRelocators - create for pdb relocator files
27#                       PDB relocator files are used to find debug infos
28#                       for analysis of creash reports
29#
30# usage: create_pdb_relocators($inpath, $milestoneext, $pre);
31#
32#*************************************************************************
33
34package CreatePDBRelocators;
35
36use strict;
37use File::Basename;
38use SourceConfig;
39
40sub new
41{
42    my $Object = shift;
43    my $solarversion = shift;
44    my $workdir;
45    my $relworkdir;
46    my $self = {};
47    my @basedirs;
48    my @repos;
49
50    if (!defined ($solarversion)) {
51        $solarversion = $ENV{SOLARVERSION};
52    }
53    if ( !$solarversion ) {
54        print STDERR "can't determine SOLARVERSION.\n";
55        exit (1);
56    }
57
58    $self->{SOLARVERSION} = $solarversion;
59
60    $workdir = $ENV{WORKDIR};
61    if ( !$workdir ) {
62        print STDERR "can't determine WORKDIR.\n";
63        exit (1);
64    }
65
66    if ( $workdir =~ /^$solarversion/ ) {
67        $relworkdir = $workdir;
68        $relworkdir =~ s/^$solarversion\///;
69    } else {
70        print STDERR "ERROR: workdir outside $solarversion unsupported\n";
71        exit (2);
72    }
73    my $SourceConfigObj = SourceConfig->new();
74    @repos = $SourceConfigObj->get_repositories();
75    if ( defined $ENV{UPDMINOREXT} ) {
76        foreach my $onedir ( @repos ) {
77            push( @basedirs, $onedir.$ENV{UPDMINOREXT} );
78        }
79    }
80    # basdirs is repositories (dmake) + workdir (gnu make)
81    push(@basedirs, $relworkdir);
82    if (!scalar @basedirs) {
83        print STDERR "no basedir and no working directory found.\n";
84        exit (2);
85    }
86    $self->{BASEDIRS} = \@basedirs;
87    bless($self, $Object);
88    return $self;
89}
90
91sub create_pdb_relocators
92{
93    my $self = shift;
94    my $inpath   = shift;
95    my $milestoneext    = shift;
96    my $pre      = shift;
97
98    my $solarversion = $self->{SOLARVERSION};
99    my $root_dir = "$solarversion/$inpath";
100
101    # sanitize path
102    $root_dir =~ s/\\/\//g;
103    my $o =~ s/\\/\//g;
104    my $premilestoneext = $milestoneext;
105    if ( $pre ne "" ) {
106        $premilestoneext = ~ s/^\.//;
107        $premilestoneext = ".pre$premilestoneext";
108    }
109    my $pdb_dir = $root_dir . "/pdb$premilestoneext";
110    my $pdb_so_dir = $root_dir . "/pdb$premilestoneext/so";
111
112    # create pdb directories if necessary
113    if ( ! -d $pdb_dir ) {
114        if ( !mkdir($pdb_dir, 0775) ) {
115            print STDERR "can't create directory '$pdb_dir'\n";
116                return undef;
117        }
118    }
119    if ( ! -d $pdb_so_dir ) {
120        if ( !mkdir($pdb_so_dir, 0775) ) {
121            print STDERR "can't create directory '$pdb_so_dir'\n";
122                return undef;
123        }
124    }
125
126    # collect files
127    foreach my $basedir (@{$self->{BASEDIRS}}) {
128        my @pdb_files;
129        my $o = $self->{SOLARVERSION} . "/$basedir";
130        $basedir =~ s/(.*?)\.(.*)/$1/;
131        $self->collect_files( $o, $inpath, \@pdb_files);
132
133        foreach (@pdb_files) {
134            my $relocator = basename($_) . ".location";
135            /$o\/(.*)/i;
136
137            my $src_location = $1;
138
139            my $location = "";
140            my $target = "";
141            if ( $src_location =~ /\/so\// )
142            {
143                $location = "../../../$basedir$milestoneext/" . $src_location;
144                $target = "$pdb_dir/so/$relocator";
145            }
146            else
147            {
148                $location = "../../$basedir$milestoneext/" . $src_location;
149                $target = "$pdb_dir/$relocator";
150            }
151
152            if ( !open(RELOCATOR, ">$target") ) {
153                print STDERR "can't write file '$target'\n";
154                return undef;
155            }
156            print RELOCATOR "$location\n";
157            close(RELOCATOR);
158        }
159    }
160    return 1;
161}
162
163sub collect_files_from_all_basedirs
164{
165    my $self = shift;
166    my ($platform, $filesref) = @_;
167    my $basedir;
168    my $ret;
169    foreach $basedir (@{$self->{BASEDIRS}}) {
170        my $srcdir = $self->{SOLARVERSION} . "/$basedir";
171        $ret |= $self->collect_files ($srcdir, $platform, $filesref);
172    }
173    return $ret;
174}
175
176sub collect_files
177{
178    my $self = shift;
179    my ($srcdir, $platform, $filesref) = @_;
180    my $template = "$srcdir/*/$platform";
181    my $template2 = "$srcdir/LinkTarget";
182    if ( $ENV{GUI} eq "WNT" ) {
183        # collect all pdb files on o:
184        # regular glob does not work with two wildcard on WNT
185        my @bin    = glob("$template/bin/*.pdb");
186        my @bin_so = glob("$template/bin/so/*.pdb");
187        my @workdir = glob("$template2/*/*.pdb");
188        # we are only interested in pdb files which are accompanied by
189        # .exe or .dll which the same name
190        foreach (@bin, @bin_so, @workdir) {
191            my $dir  = dirname($_);
192            my $base = basename($_, ".pdb");
193            my $exe = "$dir/$base.exe";
194            my $dll = "$dir/$base.dll";
195            if ( -e $exe || -e $dll ) {
196                push(@$filesref, $_);
197            }
198        }
199    }
200    else {
201        # collect all shared libraries on o:
202        my @lib = glob("$template/lib/*.so*");
203        my @workdir_lib = glob("$template2/Library/*.so*");
204        my @lib_so = glob("$template/lib/so/*.so*");
205        my @mac_lib = glob("$template/lib/*.dylib*");
206        my @mac_workdir_lib = glob("$template2/Library/*.dylib*");
207        my @mac_lib_so = glob("$template/lib/so/*.dylib*");
208        # collect all binary executables on o:
209        my @bin = $self->find_binary_execs("$template/bin");
210        my @workdir_bin = $self->find_binary_execs("$template2/Executable");
211        my @bin_so = $self->find_binary_execs("$template/bin/so");
212        push(@$filesref, (@lib, @lib_so, @workdir_lib, @mac_lib, @mac_workdir_lib, @mac_lib_so, @bin, @workdir_bin, @bin_so));
213    }
214    return 1;
215}
216
217sub find_binary_execs
218{
219    my $self = shift;
220    my $path = shift;
221    my @files = glob("$path/*");
222    my @execs = grep(-x $_, @files);
223    my @elf_files = grep(`file $_` =~ /ELF/, @execs);
224    my @MachO_files = grep(`file $_` =~ /Mach\-O/, @execs);
225    return ( @elf_files, @MachO_files );
226}
227
2281; # required
229
230