src/Utilities/setarchitecture.pm

###############################################################
# setarchitecture                                             #
###############################################################
# modified : Fri Jul 12 13:55:16 2002 / SFA                   #
# params   : none                                             #
#          :                                                  #
#          :                                                  #
#          :                                                  #
# function : Set the architecture variable. Use simple uname  #
#          : query for Sun: for Linux, also try libc checking.#
#          :                                                  #
#          :                                                  #
###############################################################

BEGIN
   {
   print "Utilities::setarchitecture: I AM still used!!","\n";
   };

package setarchitecture;
require 5.001;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(setarch);

# Currently, this is only used for UNIX systems. Not entirely sure what
# happens on Windows (most people tend to use CYGWIN). Eventually, this
# will need to be improved for non-UNIX architectures:
sub setarch
   {
   my $uname=`uname -a`;
   my ($OSname, $hostname, $OSversion, @rest) = split / /, $uname;
      my $lddcmd="ldd /bin/ls";

   # Retain only the first two version digits
   # of os version from uname:
   if ( $OSname =~ SunOS )
      {
      $OSversion =~ s/^(.\..)\..*/\1/;
      }
   # Linux:
   elsif ( $OSname =~ Linux )
      {
      # Firstly we check for the kernel version.
      $OSversion =~ s/^(.\..)\..*/\1/;
      # Now, we also check for the libc version to confirm (or otherwise)
      # the choice determined by the previous step:
      # Open the ldd command as a pipe:
      my $pid = open(LDD,"$lddcmd 2>&1 |");

      # Check that we were able to fork:
      if (defined($pid))
         {
         # Loop over lines of output:
         while (<LDD>)
            {
            chomp $_;
            # Grab something that looks like "libc.*":
            if (my ($libc) = ($_ =~ /\s+libc\.so.*\s.*\s(.*)\s.*/))
               {
               # Check if this libc thing is a soft link (it should be), then
               # find out what the thingy is that the link points to:
               if ( -l $libc && defined($value = readlink $libc))
                  {
                  # Extract the useful numeric info from this:    
                  my ($libcmaj,$libcmin,$libcpatch) = ($value =~ /^libc-([0-9])\.([0-9])\.([0-9])\.so/);

                  # Set the arch accordingly:
                  if ($libcmaj == 2 && $libcmin == 1 && $libcpatch >= 3)
                     {
                     $ENV{SCRAM_ARCH}="Linux__2.2";
                     }
                  
                  if ($libcmaj == 2 && $libcmin == 2 && $libcpatch >= 4)
                     {
                     $ENV{SCRAM_ARCH}="Linux__2.4";
                     }
                  }
               # No need to check other lines:
               last;
               }
            }
         }
      else
         # Fork failed, so we must fall back to
         # the normal mechanism to define the arch:
         {
         $ENV{SCRAM_ARCH}="${OSname}__${OSversion}";
         }
      }
   else
      {
      # At this point it looks like the platform is "other". 
      # Set SCRAM_ARCH anyway to the default:
      $ENV{SCRAM_ARCH}="${OSname}__${OSversion}";
      }
   
   # Set arch flag to [OS type]__[OSversion] if not set by now:
   if ( ! defined $ENV{SCRAM_ARCH} )
      {
      $ENV{SCRAM_ARCH}="${OSname}__${OSversion}";
      }
   
   return (0);
   }
Revision:	1.10
Committed:	Wed Aug 10 17:27:32 2005 UTC (19 years, 9 months ago) by sashby
Content type:	text/plain
Branch:	MAIN
CVS Tags:	V1_0_3-p4, V1_0_3-p3, V1_0_3-p2, before110xmlBRmerge, V1_0_4p1, V1_0_3-p1, V1_0_3, V1_0_2, V1_0_2_p1
Branch point for:	v103_with_xml, v103_branch
Changes since 1.9:	+6 -0 lines
Log Message:	Starting to add POD documentation.
#	User	Rev	Content
1	sashby	1.7	###############################################################
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	sashby	1.9	# : query for Sun: for Linux, also try libc checking.#
11	sashby	1.7	# : #
12			# : #
13			###############################################################
14	sashby	1.10
15			BEGIN
16			{
17			print "Utilities::setarchitecture: I AM still used!!","\n";
18			};
19
20	williamc	1.1	package setarchitecture;
21	williamc	1.2	require 5.001;
22	williamc	1.1	require Exporter;
23			@ISA = qw(Exporter);
24			@EXPORT = qw(setarch);
25
26	sashby	1.7	# Currently, this is only used for UNIX systems. Not entirely sure what
27			# happens on Windows (most people tend to use CYGWIN). Eventually, this
28			# will need to be improved for non-UNIX architectures:
29			sub setarch
30			{
31			my $uname=`uname -a`;
32			my ($OSname, $hostname, $OSversion, @rest) = split / /, $uname;
33	sashby	1.8	my $lddcmd="ldd /bin/ls";
34	sashby	1.7
35	sashby	1.8	# Retain only the first two version digits
36			# of os version from uname:
37	sashby	1.7	if ( $OSname =~ SunOS )
38			{
39			$OSversion =~ s/^(.\..)\..*/\1/;
40			}
41	sashby	1.8	# Linux:
42			elsif ( $OSname =~ Linux )
43	sashby	1.7	{
44			# Firstly we check for the kernel version.
45			$OSversion =~ s/^(.\..)\..*/\1/;
46			# Now, we also check for the libc version to confirm (or otherwise)
47			# the choice determined by the previous step:
48			# Open the ldd command as a pipe:
49	sashby	1.8	my $pid = open(LDD,"$lddcmd 2>&1 \|");
50	sashby	1.7
51	sashby	1.8	# Check that we were able to fork:
52			if (defined($pid))
53			{
54			# Loop over lines of output:
55			while (<LDD>)
56			{
57			chomp $_;
58			# Grab something that looks like "libc.*":
59			if (my ($libc) = ($_ =~ /\s+libc\.so.\s.\s(.)\s./))
60			{
61			# Check if this libc thing is a soft link (it should be), then
62			# find out what the thingy is that the link points to:
63			if ( -l $libc && defined($value = readlink $libc))
64			{
65			# Extract the useful numeric info from this:
66			my ($libcmaj,$libcmin,$libcpatch) = ($value =~ /^libc-([0-9])\.([0-9])\.([0-9])\.so/);
67	sashby	1.7
68	sashby	1.8	# Set the arch accordingly:
69			if ($libcmaj == 2 && $libcmin == 1 && $libcpatch >= 3)
70			{
71			$ENV{SCRAM_ARCH}="Linux__2.2";
72			}
73
74			if ($libcmaj == 2 && $libcmin == 2 && $libcpatch >= 4)
75			{
76			$ENV{SCRAM_ARCH}="Linux__2.4";
77			}
78			}
79			# No need to check other lines:
80			last;
81			}
82			}
83			}
84			else
85			# Fork failed, so we must fall back to
86			# the normal mechanism to define the arch:
87			{
88			$ENV{SCRAM_ARCH}="${OSname}__${OSversion}";
89			}
90			}
91			else
92			{
93			# At this point it looks like the platform is "other".
94			# Set SCRAM_ARCH anyway to the default:
95			$ENV{SCRAM_ARCH}="${OSname}__${OSversion}";
96	sashby	1.7	}
97
98	sashby	1.8	# Set arch flag to [OS type]__[OSversion] if not set by now:
99	sashby	1.7	if ( ! defined $ENV{SCRAM_ARCH} )
100			{
101			$ENV{SCRAM_ARCH}="${OSname}__${OSversion}";
102			}
103
104			return (0);
105			}