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.#
#          :                                                  #
#          :                                                  #
###############################################################
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
   {
   # Merge in fix from WIN32 branch:
   if ($^O =~ /(MSWin32|cygwin)/)
      {
      $ENV{SCRAM_ARCH}=$1;
      }
   #irm: ux part below
   else
      {
      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/;
         $ENV{SCRAM_ARCH}=$OSname."__".$OSversion; 
         }
      # 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";
                        }

                     if ($libcmaj == 2 && $libcmin == 3 && $libcpatch >= 2)
                        {
                        $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;
      }

   # Now translate this arch to something else if defined in arch.map:
   parse_map();
   
   return (0);
   }

# This subrtn parses an architecture map file found in config dir.
# The ides is to translate the architecture that scram determines automatically into
# some other string that will then become the recognised SCRAM_ARCH for the project:
sub parse_map()
   {
   my $configdir=$ENV{LOCALTOP}."/config"; # This is fine in most cases
   my $mapfile=$configdir."/arch.map";
   
   # Only swap archs in project areas:
   if ( defined $ENV{LOCALTOP} )
      {
      if ( -f $mapfile )
         {
         open(ARCHMAP,"< $mapfile") || die "Unable to open architecture map file: $!","\n";
         while (<ARCHMAP>)
            {
            my ($scram_arch,$req_arch) = ($_ =~ /^(.*)?->(.*)?/);
            print "SCRAM_ARCH ",$scram_arch," becomes ",$req_arch,"\n";
            }
         }
      }
   }
Revision:	1.9.2.1
Committed:	Fri Feb 27 15:34:56 2004 UTC (21 years, 2 months ago) by sashby
Content type:	text/plain
Branch:	SCRAM_V1_BRANCH
CVS Tags:	V1_pre0, SCRAM_V1, SCRAMV1_IMPORT
Branch point for:	V1_pre1
Changes since 1.9:	+93 -52 lines
Log Message:	First import of new SCRAM packages into CMS cvs repos.
#	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	williamc	1.1	package setarchitecture;
15	williamc	1.2	require 5.001;
16	williamc	1.1	require Exporter;
17			@ISA = qw(Exporter);
18			@EXPORT = qw(setarch);
19
20	sashby	1.7	# 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	sashby	1.9.2.1	# Merge in fix from WIN32 branch:
26			if ($^O =~ /(MSWin32\|cygwin)/)
27	sashby	1.7	{
28	sashby	1.9.2.1	$ENV{SCRAM_ARCH}=$1;
29	sashby	1.7	}
30	sashby	1.9.2.1	#irm: ux part below
31			else
32	sashby	1.7	{
33	sashby	1.9.2.1	my $uname=`uname -a`;
34			my ($OSname, $hostname, $OSversion, @rest) = split / /, $uname;
35			my $lddcmd="ldd /bin/ls";
36
37			# Retain only the first two version digits
38			# of os version from uname:
39			if ( $OSname =~ SunOS )
40			{
41			$OSversion =~ s/^(.\..)\..*/\1/;
42			$ENV{SCRAM_ARCH}=$OSname."__".$OSversion;
43			}
44			# Linux:
45			elsif ( $OSname =~ Linux )
46	sashby	1.8	{
47	sashby	1.9.2.1	# Firstly we check for the kernel version.
48			$OSversion =~ s/^(.\..)\..*/\1/;
49			# Now, we also check for the libc version to confirm (or otherwise)
50			# the choice determined by the previous step:
51			# Open the ldd command as a pipe:
52			my $pid = open(LDD,"$lddcmd 2>&1 \|");
53
54			# Check that we were able to fork:
55			if (defined($pid))
56	sashby	1.8	{
57	sashby	1.9.2.1	# Loop over lines of output:
58			while (<LDD>)
59	sashby	1.8	{
60	sashby	1.9.2.1	chomp $_;
61			# Grab something that looks like "libc.*":
62			if (my ($libc) = ($_ =~ /\s+libc\.so.\s.\s(.)\s./))
63	sashby	1.8	{
64	sashby	1.9.2.1	# Check if this libc thing is a soft link (it should be), then
65			# find out what the thingy is that the link points to:
66			if ( -l $libc && defined($value = readlink $libc))
67	sashby	1.8	{
68	sashby	1.9.2.1	# Extract the useful numeric info from this:
69			my ($libcmaj,$libcmin,$libcpatch) = ($value =~ /^libc-([0-9])\.([0-9])\.([0-9])\.so/);
70
71			# Set the arch accordingly:
72			if ($libcmaj == 2 && $libcmin == 1 && $libcpatch >= 3)
73			{
74			$ENV{SCRAM_ARCH}="Linux__2.2";
75			}
76
77			if ($libcmaj == 2 && $libcmin == 2 && $libcpatch >= 4)
78			{
79			$ENV{SCRAM_ARCH}="Linux__2.4";
80			}
81
82			if ($libcmaj == 2 && $libcmin == 3 && $libcpatch >= 2)
83			{
84			$ENV{SCRAM_ARCH}="Linux__2.4";
85			}
86
87	sashby	1.8	}
88	sashby	1.9.2.1	# No need to check other lines:
89			last;
90			}
91	sashby	1.8	}
92			}
93	sashby	1.9.2.1	else
94			# Fork failed, so we must fall back to
95			# the normal mechanism to define the arch:
96			{
97			$ENV{SCRAM_ARCH}=$OSname."__".$OSversion;
98			}
99	sashby	1.8	}
100			else
101			{
102	sashby	1.9.2.1	# At this point it looks like the platform is "other".
103			# Set SCRAM_ARCH anyway to the default:
104			$ENV{SCRAM_ARCH}=$OSname."__".$OSversion;
105	sashby	1.8	}
106			}
107			# Set arch flag to [OS type]__[OSversion] if not set by now:
108	sashby	1.7	if ( ! defined $ENV{SCRAM_ARCH} )
109			{
110	sashby	1.9.2.1	$ENV{SCRAM_ARCH}=$OSname."__".$OSversion;
111	sashby	1.7	}
112	sashby	1.9.2.1
113			# Now translate this arch to something else if defined in arch.map:
114			parse_map();
115	sashby	1.7
116			return (0);
117	sashby	1.9.2.1	}
118
119			# This subrtn parses an architecture map file found in config dir.
120			# The ides is to translate the architecture that scram determines automatically into
121			# some other string that will then become the recognised SCRAM_ARCH for the project:
122			sub parse_map()
123			{
124			my $configdir=$ENV{LOCALTOP}."/config"; # This is fine in most cases
125			my $mapfile=$configdir."/arch.map";
126
127			# Only swap archs in project areas:
128			if ( defined $ENV{LOCALTOP} )
129			{
130			if ( -f $mapfile )
131			{
132			open(ARCHMAP,"< $mapfile") \|\| die "Unable to open architecture map file: $!","\n";
133			while (<ARCHMAP>)
134			{
135			my ($scram_arch,$req_arch) = ($_ =~ /^(.)?->(.)?/);
136			print "SCRAM_ARCH ",$scram_arch," becomes ",$req_arch,"\n";
137			}
138			}
139			}
140	sashby	1.7	}