1 |
< |
# simply set the architecture variable based on uname |
2 |
< |
# |
3 |
< |
|
1 |
> |
############################################################### |
2 |
> |
# setarchitecture # |
3 |
> |
############################################################### |
4 |
> |
# modified : Fri Jul 12 13:55:16 2002 / SFA # |
5 |
> |
# params : none # |
6 |
> |
# : # |
7 |
> |
# : # |
8 |
> |
# : # |
9 |
> |
# function : Set the architecture variable. Use simple uname # |
10 |
> |
# : query for Sun: for Linux, alos try libc checking.# |
11 |
> |
# : # |
12 |
> |
# : # |
13 |
> |
############################################################### |
14 |
|
package setarchitecture; |
15 |
|
require 5.001; |
16 |
|
require Exporter; |
17 |
|
@ISA = qw(Exporter); |
18 |
|
@EXPORT = qw(setarch); |
19 |
|
|
20 |
< |
# unix systems |
21 |
< |
sub setarch { |
22 |
< |
$uname=`uname -a`; |
23 |
< |
($OSname, $hostname, $OSversion, @rest) = split / /, $uname; |
24 |
< |
# simply set to OS type and version |
25 |
< |
$ENV{SCRAM_ARCH}="${OSname}__${OSversion}"; |
26 |
< |
print "Setting Architecture to $ENV{SCRAM_ARCH}\n"; |
27 |
< |
} |
20 |
> |
# Currently, this is only used for UNIX systems. Not entirely sure what |
21 |
> |
# happens on Windows (most people tend to use CYGWIN). Eventually, this |
22 |
> |
# will need to be improved for non-UNIX architectures: |
23 |
> |
sub setarch |
24 |
> |
{ |
25 |
> |
my $uname=`uname -a`; |
26 |
> |
my ($OSname, $hostname, $OSversion, @rest) = split / /, $uname; |
27 |
> |
my $lddcmd="ldd /bin/ls"; |
28 |
> |
|
29 |
> |
# Retain only the first two version digits |
30 |
> |
# of os version from uname: |
31 |
> |
if ( $OSname =~ SunOS ) |
32 |
> |
{ |
33 |
> |
$OSversion =~ s/^(.\..)\..*/\1/; |
34 |
> |
} |
35 |
> |
# Linux: |
36 |
> |
elsif ( $OSname =~ Linux ) |
37 |
> |
{ |
38 |
> |
# Firstly we check for the kernel version. |
39 |
> |
$OSversion =~ s/^(.\..)\..*/\1/; |
40 |
> |
# Now, we also check for the libc version to confirm (or otherwise) |
41 |
> |
# the choice determined by the previous step: |
42 |
> |
# Open the ldd command as a pipe: |
43 |
> |
my $pid = open(LDD,"$lddcmd 2>&1 |"); |
44 |
> |
|
45 |
> |
# Check that we were able to fork: |
46 |
> |
if (defined($pid)) |
47 |
> |
{ |
48 |
> |
# Loop over lines of output: |
49 |
> |
while (<LDD>) |
50 |
> |
{ |
51 |
> |
chomp $_; |
52 |
> |
# Grab something that looks like "libc.*": |
53 |
> |
if (my ($libc) = ($_ =~ /\s+libc\.so.*\s.*\s(.*)\s.*/)) |
54 |
> |
{ |
55 |
> |
# Check if this libc thing is a soft link (it should be), then |
56 |
> |
# find out what the thingy is that the link points to: |
57 |
> |
if ( -l $libc && defined($value = readlink $libc)) |
58 |
> |
{ |
59 |
> |
# Extract the useful numeric info from this: |
60 |
> |
my ($libcmaj,$libcmin,$libcpatch) = ($value =~ /^libc-([0-9])\.([0-9])\.([0-9])\.so/); |
61 |
> |
|
62 |
> |
# Set the arch accordingly: |
63 |
> |
if ($libcmaj == 2 && $libcmin == 1 && $libcpatch >= 3) |
64 |
> |
{ |
65 |
> |
$ENV{SCRAM_ARCH}="Linux__2.2"; |
66 |
> |
} |
67 |
> |
|
68 |
> |
if ($libcmaj == 2 && $libcmin == 2 && $libcpatch >= 4) |
69 |
> |
{ |
70 |
> |
$ENV{SCRAM_ARCH}="Linux__2.4"; |
71 |
> |
} |
72 |
> |
} |
73 |
> |
# No need to check other lines: |
74 |
> |
last; |
75 |
> |
} |
76 |
> |
} |
77 |
> |
} |
78 |
> |
else |
79 |
> |
# Fork failed, so we must fall back to |
80 |
> |
# the normal mechanism to define the arch: |
81 |
> |
{ |
82 |
> |
$ENV{SCRAM_ARCH}="${OSname}__${OSversion}"; |
83 |
> |
} |
84 |
> |
} |
85 |
> |
else |
86 |
> |
{ |
87 |
> |
# At this point it looks like the platform is "other". |
88 |
> |
# Set SCRAM_ARCH anyway to the default: |
89 |
> |
$ENV{SCRAM_ARCH}="${OSname}__${OSversion}"; |
90 |
> |
} |
91 |
> |
|
92 |
> |
# Set arch flag to [OS type]__[OSversion] if not set by now: |
93 |
> |
if ( ! defined $ENV{SCRAM_ARCH} ) |
94 |
> |
{ |
95 |
> |
$ENV{SCRAM_ARCH}="${OSname}__${OSversion}"; |
96 |
> |
} |
97 |
> |
|
98 |
> |
return (0); |
99 |
> |
} |