1#*************************************************************************
2#
3# DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
4#
5# Copyright 2000, 2010 Oracle and/or its affiliates.
6#
7# OpenOffice.org - a multi-platform office productivity suite
8#
9# This file is part of OpenOffice.org.
10#
11# OpenOffice.org is free software: you can redistribute it and/or modify
12# it under the terms of the GNU Lesser General Public License version 3
13# only, as published by the Free Software Foundation.
14#
15# OpenOffice.org is distributed in the hope that it will be useful,
16# but WITHOUT ANY WARRANTY; without even the implied warranty of
17# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18# GNU Lesser General Public License version 3 for more details
19# (a copy is included in the LICENSE file that accompanied this code).
20#
21# You should have received a copy of the GNU Lesser General Public License
22# version 3 along with OpenOffice.org.  If not, see
23# <http://www.openoffice.org/license.html>
24# for a copy of the LGPLv3 License.
25#
26#*************************************************************************
27
28#*************************************************************************
29#
30# createPDBRelocators - create for pdb relocator files
31#                       PDB relocator files are used to find debug infos
32#                       for analysis of creash reports
33#
34# usage: create_pdb_relocators($inpath, $milestoneext, $pre);
35#
36#*************************************************************************
37
38package CreatePDBRelocators;
39
40use strict;
41use File::Basename;
42use SourceConfig;
43
44sub new
45{
46    my $Object = shift;
47    my $solarversion = shift;
48    my $workdir;
49    my $relworkdir;
50    my $self = {};
51    my @basedirs;
52    my @repos;
53
54    if (!defined ($solarversion)) {
55        $solarversion = $ENV{SOLARVERSION};
56    }
57    if ( !$solarversion ) {
58	    print STDERR "can't determine SOLARVERSION.\n";
59        exit (1);
60    }
61
62    $self->{SOLARVERSION} = $solarversion;
63
64    $workdir = $ENV{WORKDIR};
65    if ( !$workdir ) {
66	    print STDERR "can't determine WORKDIR.\n";
67        exit (1);
68    }
69
70    if ( $workdir =~ /^$solarversion/ ) {
71        $relworkdir = $workdir;
72        $relworkdir =~ s/^$solarversion\///;
73    } else {
74        print STDERR "ERROR: workdir outside $solarversion unsupported\n";
75        exit (2);
76    }
77    my $SourceConfigObj = SourceConfig->new();
78    @repos = $SourceConfigObj->get_repositories();
79    if ( defined $ENV{UPDMINOREXT} ) {
80        foreach my $onedir ( @repos ) {
81            push( @basedirs, $onedir.$ENV{UPDMINOREXT} );
82        }
83    }
84    # basdirs is repositories (dmake) + workdir (gnu make)
85    push(@basedirs, $relworkdir);
86    if (!scalar @basedirs) {
87        print STDERR "no basedir and no working directory found.\n";
88        exit (2);
89    }
90    $self->{BASEDIRS} = \@basedirs;
91    bless($self, $Object);
92    return $self;
93}
94
95sub create_pdb_relocators
96{
97    my $self = shift;
98    my $inpath   = shift;
99    my $milestoneext    = shift;
100    my $pre      = shift;
101
102    my $solarversion = $self->{SOLARVERSION};
103    my $root_dir = "$solarversion/$inpath";
104
105    # sanitize path
106    $root_dir =~ s/\\/\//g;
107    my $o =~ s/\\/\//g;
108	my $premilestoneext = $milestoneext;
109	if ( $pre ne "" ) {
110		$premilestoneext = ~ s/^\.//;
111		$premilestoneext = ".pre$premilestoneext";
112	}
113	my $pdb_dir = $root_dir . "/pdb$premilestoneext";
114	my $pdb_so_dir = $root_dir . "/pdb$premilestoneext/so";
115
116    # create pdb directories if necessary
117    if ( ! -d $pdb_dir ) {
118	    if ( !mkdir($pdb_dir, 0775) ) {
119		    print STDERR "can't create directory '$pdb_dir'\n";
120                return undef;
121        }
122    }
123    if ( ! -d $pdb_so_dir ) {
124	    if ( !mkdir($pdb_so_dir, 0775) ) {
125		    print STDERR "can't create directory '$pdb_so_dir'\n";
126                return undef;
127        }
128    }
129
130    # collect files
131    foreach my $basedir (@{$self->{BASEDIRS}}) {
132        my @pdb_files;
133        my $o = $self->{SOLARVERSION} . "/$basedir";
134        $basedir =~ s/(.*?)\.(.*)/$1/;
135		$self->collect_files( $o, $inpath, \@pdb_files);
136
137		foreach (@pdb_files) {
138			my $relocator = basename($_) . ".location";
139			/$o\/(.*)/i;
140
141			my $src_location = $1;
142
143			my $location = "";
144			my $target = "";
145			if ( $src_location =~ /\/so\// )
146			{
147				$location = "../../../$basedir$milestoneext/" . $src_location;
148				$target = "$pdb_dir/so/$relocator";
149			}
150			else
151			{
152				$location = "../../$basedir$milestoneext/" . $src_location;
153				$target = "$pdb_dir/$relocator";
154			}
155
156			if ( !open(RELOCATOR, ">$target") ) {
157				print STDERR "can't write file '$target'\n";
158				return undef;
159			}
160			print RELOCATOR "$location\n";
161			close(RELOCATOR);
162		}
163    }
164    return 1;
165}
166
167sub collect_files_from_all_basedirs
168{
169	my $self = shift;
170	my ($platform, $filesref) = @_;
171	my $basedir;
172	my $ret;
173	foreach $basedir (@{$self->{BASEDIRS}}) {
174		my $srcdir = $self->{SOLARVERSION} . "/$basedir";
175		$ret |= $self->collect_files ($srcdir, $platform, $filesref);
176	}
177	return $ret;
178}
179
180sub collect_files
181{
182    my $self = shift;
183    my ($srcdir, $platform, $filesref) = @_;
184    my $template = "$srcdir/*/$platform";
185    my $template2 = "$srcdir/LinkTarget";
186	if ( $ENV{GUI} eq "WNT" ) {
187        # collect all pdb files on o:
188        # regular glob does not work with two wildcard on WNT
189        my @bin    = glob("$template/bin/*.pdb");
190        my @bin_so = glob("$template/bin/so/*.pdb");
191        my @workdir = glob("$template2/*/*.pdb");
192        # we are only interested in pdb files which are accompanied by
193        # .exe or .dll which the same name
194        foreach (@bin, @bin_so, @workdir) {
195            my $dir  = dirname($_);
196            my $base = basename($_, ".pdb");
197            my $exe = "$dir/$base.exe";
198            my $dll = "$dir/$base.dll";
199            if ( -e $exe || -e $dll ) {
200                push(@$filesref, $_);
201            }
202        }
203    }
204    else {
205        # collect all shared libraries on o:
206        my @lib = glob("$template/lib/*.so*");
207        my @workdir_lib = glob("$template2/Library/*.so*");
208        my @lib_so = glob("$template/lib/so/*.so*");
209        my @mac_lib = glob("$template/lib/*.dylib*");
210        my @mac_workdir_lib = glob("$template2/Library/*.dylib*");
211        my @mac_lib_so = glob("$template/lib/so/*.dylib*");
212        # collect all binary executables on o:
213        my @bin = $self->find_binary_execs("$template/bin");
214        my @workdir_bin = $self->find_binary_execs("$template2/Executable");
215        my @bin_so = $self->find_binary_execs("$template/bin/so");
216        push(@$filesref, (@lib, @lib_so, @workdir_lib, @mac_lib, @mac_workdir_lib, @mac_lib_so, @bin, @workdir_bin, @bin_so));
217    }
218    return 1;
219}
220
221sub find_binary_execs
222{
223    my $self = shift;
224    my $path = shift;
225    my @files = glob("$path/*");
226    my @execs = grep(-x $_, @files);
227    my @elf_files = grep(`file $_` =~ /ELF/, @execs);
228    my @MachO_files = grep(`file $_` =~ /Mach\-O/, @execs);
229    return ( @elf_files, @MachO_files );
230}
231
2321; # required
233
234