src/Utilities/Architecture.pm

#____________________________________________________________________ 
# File: Architecture.pm
#____________________________________________________________________ 
#  
# Author: Shaun Ashby <Shaun.Ashby@cern.ch>
# Update: 2003-10-23 17:20:41+0200
# Revision: $Id: Architecture.pm,v 1.2 2004/12/10 13:41:43 sashby Exp $ 
#
# Copyright: 2003 (C) Shaun Ashby
#
#--------------------------------------------------------------------
package Architecture;
require 5.004;
use Exporter;

@ISA=qw(Exporter);
@EXPORT_OK=qw( );

sub new()
   {
   ###############################################################
   # new()                                                       #
   ###############################################################
   # modified : Thu Oct 23 17:21:05 2003 / SFA                   #
   # params   :                                                  #
   #          :                                                  #
   # function :                                                  #
   #          :                                                  #
   ###############################################################
   my $proto=shift;
   my $class=ref($proto) || $proto;
   my $self={};
   
   bless $self,$class;
   
   $self->_initarch();

   return $self;
   }

sub arch()
   {
   my $self=shift;
   
   @_ ? $self->{arch} = shift
      : $self->{arch};
   }

sub system_arch_stem()
   {
   my $self=shift;
   
   @_ ? $self->{archstem} = shift
      : $self->{archstem};
   }

# A subroutine to determine the architecture. This
# is done by parsing the architecture map contained as
# data inside SCRAM_SITE.pm and looking for an appropriate
# match for our platform:
sub _initarch()
   {
   my $self=shift;
   $self->parse_architecture_map();
   return $self;
   }

# Parse the map data:
sub parse_architecture_map()
   {
   my $self=shift;
   my $matches={};
   
   require Installation::SCRAM_SITE;
   my $architectures = &Installation::SCRAM_SITE::read_architecture_map();
   
   while (my ($archstring,$archtest) = each %{$architectures})
      {
      my $rval = eval join(" ",@$archtest);
      
      if ($rval)
         {
         # Store the matched string:
         $matches->{$archstring}=1;
         
         if ((my $nkeys = keys %{$matches}) > 1)
            {
            print "\n";
            print "SCRAM: WARNING: more than one architecture definition in ","\n";
            print "       SCRAM_SITE matches current platform!","\n";
            print "Unable to set the architecture correctly!","\n";
            print "\n";
            exit(1);
            }
         
         # Store the match (only the *first* match in the case
         # of multiple matches):
         $self->arch($archstring);

         # Also take the arch stem from the arch string. E.g. for a string
         # "slc3_ia32_xxx", keep the "slc3_ia32" part:
         if (my ($sysname,$cpuarch) = ($archstring =~ /(.*?)\_(.*?)\_.*?$/))
            {
            my $stem = $sysname."_".$cpuarch;
            $self->system_arch_stem($stem);
            }
         else
            {
            # Just set the stem to be the same as the main arch string:
            $self->system_arch_stem($archstring);
            }
         }
      else
         {
         next;
         }
      }
   }

1;
Revision:	1.3
Committed:	Fri Jul 1 15:23:36 2005 UTC (19 years, 10 months ago) by sashby
Content type:	text/plain
Branch:	MAIN
Changes since 1.2:	+23 -1 lines
Log Message:	More work on GUI.
#	User	Rev	Content
1	sashby	1.2	#____________________________________________________________________
2			# File: Architecture.pm
3			#____________________________________________________________________
4			#
5			# Author: Shaun Ashby <Shaun.Ashby@cern.ch>
6			# Update: 2003-10-23 17:20:41+0200
7	sashby	1.3	# Revision: $Id: Architecture.pm,v 1.2 2004/12/10 13:41:43 sashby Exp $
8	williamc	1.1	#
9	sashby	1.2	# Copyright: 2003 (C) Shaun Ashby
10	williamc	1.1	#
11	sashby	1.2	#--------------------------------------------------------------------
12			package Architecture;
13			require 5.004;
14			use Exporter;
15
16			@ISA=qw(Exporter);
17			@EXPORT_OK=qw( );
18	williamc	1.1
19	sashby	1.2	sub new()
20			{
21			###############################################################
22			# new() #
23			###############################################################
24			# modified : Thu Oct 23 17:21:05 2003 / SFA #
25			# params : #
26			# : #
27			# function : #
28			# : #
29			###############################################################
30			my $proto=shift;
31			my $class=ref($proto) \|\| $proto;
32			my $self={};
33
34			bless $self,$class;
35
36			$self->_initarch();
37
38			return $self;
39			}
40
41			sub arch()
42			{
43			my $self=shift;
44
45			@_ ? $self->{arch} = shift
46			: $self->{arch};
47			}
48
49	sashby	1.3	sub system_arch_stem()
50			{
51			my $self=shift;
52
53			@_ ? $self->{archstem} = shift
54			: $self->{archstem};
55			}
56
57	sashby	1.2	# A subroutine to determine the architecture. This
58			# is done by parsing the architecture map contained as
59			# data inside SCRAM_SITE.pm and looking for an appropriate
60			# match for our platform:
61			sub _initarch()
62			{
63			my $self=shift;
64			$self->parse_architecture_map();
65			return $self;
66			}
67
68			# Parse the map data:
69			sub parse_architecture_map()
70			{
71			my $self=shift;
72			my $matches={};
73
74			require Installation::SCRAM_SITE;
75			my $architectures = &Installation::SCRAM_SITE::read_architecture_map();
76
77			while (my ($archstring,$archtest) = each %{$architectures})
78			{
79			my $rval = eval join(" ",@$archtest);
80
81			if ($rval)
82			{
83			# Store the matched string:
84			$matches->{$archstring}=1;
85
86			if ((my $nkeys = keys %{$matches}) > 1)
87			{
88			print "\n";
89			print "SCRAM: WARNING: more than one architecture definition in ","\n";
90			print " SCRAM_SITE matches current platform!","\n";
91			print "Unable to set the architecture correctly!","\n";
92			print "\n";
93			exit(1);
94			}
95	sashby	1.3
96	sashby	1.2	# Store the match (only the first match in the case
97			# of multiple matches):
98			$self->arch($archstring);
99	sashby	1.3
100			# Also take the arch stem from the arch string. E.g. for a string
101			# "slc3_ia32_xxx", keep the "slc3_ia32" part:
102			if (my ($sysname,$cpuarch) = ($archstring =~ /(.?)\_(.?)\_.*?$/))
103			{
104			my $stem = $sysname."_".$cpuarch;
105			$self->system_arch_stem($stem);
106			}
107			else
108			{
109			# Just set the stem to be the same as the main arch string:
110			$self->system_arch_stem($archstring);
111			}
112	sashby	1.2	}
113			else
114			{
115			next;
116			}
117			}
118			}
119	williamc	1.1
120	sashby	1.2	1;