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