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.5.2.1 2006/05/15 15:20:45 sashby Exp $ 
#
# Copyright: 2003 (C) Shaun Ashby
#
#--------------------------------------------------------------------
package Architecture;

=head1 NAME
   
Architecture - Utilities to determine the architecture name.

=head1 SYNOPSIS

   if (! defined $self->{SCRAM_ARCH})
      {
      my $arch = Architecture->new();
      $self->architecture($a->arch());
      $self->system_architecture($a->system_arch_stem());
      $ENV{SCRAM_ARCH} = $self->architecture();
      }

=head1 DESCRIPTION

A mechanism to extract the current system architecture. The full arch
and system (short) arch strings can be returned in the application using
the methods in this package.

=head1 METHODS

=over
   
=cut
   
require 5.004;
use Exporter;

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

=item   C<new()>

Constructor for Architecture objects.

=cut

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;
   }

=item   C<arch()>

Method to set or return the architecture name.

=cut

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

=item   C<system_arch_stem()>

Method to set or return the system architecture name stem. The
architecture stem is the full architecture without any compiler dependence.
For example, the architecture B<slc3_ia32_gcc323> has a system architecture
name stem of B<slc3_ia32>.

=cut

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

=item   C<_initarch()>
   
A subroutine to determine the architecture. This
is done by parsing the architecture map contained as
data inside B<SCRAM_SITE.pm> and looking for an appropriate
match for our platform.

=cut
   
sub _initarch()
   {
   my $self=shift;
   $self->parse_architecture_map();
   return $self;
   }

=item   C<parse_architecture_map()>

Read the architecture map file defined in the site package B<SCRAM_SITE.pm>.
   
=cut
   
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;
         # Store the match. We take the first match then return:
         $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);
            }
         return;
         }
      else
         {
         next;
         }
      }
   }

1;

__END__

=back

=head1 AUTHOR/MAINTAINER

Shaun Ashby

=cut
Revision:	1.6
Committed:	Mon May 15 15:52:28 2006 UTC (18 years, 11 months ago) by sashby
Content type:	text/plain
Branch:	MAIN
CVS Tags:	V1_1_7, V1_1_6, V1_1_5, V1_1_4, V1_1_3, V1_1_2, V1_1_0_reltag8, V1_1_0_reltag7, V1_1_0_reltag6, V1_1_1, V1_1_0_reltag5, V1_1_0_reltag4, V1_1_0_reltag3, V1_1_0_reltag2, V1_1_0_reltag1, V1_1_0_reltag, V1_0_3-p4, V1_1_0_cand3, V1_1_0_cand2, V1_1_0_cand1, HEAD_SM_071214, forV1_1_0, v103_xml_071106, V1_0_3-p3, V1_0_3-p2, V1_1_0, v110p1, V110p6, V110p5, V110p4, V110p3, before110xmlBRmerge, V110p2, V110p1, V1_0_3-p1, V1_0_3
Branch point for:	forBinLess_SCRAM, HEAD_BRANCH_SM_071214, v200branch, v103_with_xml
Changes since 1.5:	+3 -15 lines
Log Message:	Improved parsing of arch map. First match returns.
#	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.6	# Revision: $Id: Architecture.pm,v 1.5.2.1 2006/05/15 15:20:45 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	sashby	1.4
14			=head1 NAME
15
16			Architecture - Utilities to determine the architecture name.
17
18			=head1 SYNOPSIS
19
20			if (! defined $self->{SCRAM_ARCH})
21			{
22			my $arch = Architecture->new();
23			$self->architecture($a->arch());
24			$self->system_architecture($a->system_arch_stem());
25			$ENV{SCRAM_ARCH} = $self->architecture();
26			}
27
28			=head1 DESCRIPTION
29
30			A mechanism to extract the current system architecture. The full arch
31			and system (short) arch strings can be returned in the application using
32			the methods in this package.
33
34			=head1 METHODS
35
36			=over
37
38			=cut
39
40	sashby	1.2	require 5.004;
41			use Exporter;
42
43			@ISA=qw(Exporter);
44			@EXPORT_OK=qw( );
45	williamc	1.1
46	sashby	1.4	=item C<new()>
47
48			Constructor for Architecture objects.
49
50			=cut
51
52	sashby	1.2	sub new()
53			{
54			###############################################################
55			# new() #
56			###############################################################
57			# modified : Thu Oct 23 17:21:05 2003 / SFA #
58			# params : #
59			# : #
60			# function : #
61			# : #
62			###############################################################
63			my $proto=shift;
64			my $class=ref($proto) \|\| $proto;
65			my $self={};
66
67			bless $self,$class;
68
69			$self->_initarch();
70
71			return $self;
72			}
73
74	sashby	1.4	=item C<arch()>
75
76			Method to set or return the architecture name.
77
78			=cut
79
80	sashby	1.2	sub arch()
81			{
82			my $self=shift;
83
84			@_ ? $self->{arch} = shift
85			: $self->{arch};
86			}
87
88	sashby	1.4	=item C<system_arch_stem()>
89
90			Method to set or return the system architecture name stem. The
91			architecture stem is the full architecture without any compiler dependence.
92			For example, the architecture B<slc3_ia32_gcc323> has a system architecture
93			name stem of B<slc3_ia32>.
94
95			=cut
96
97	sashby	1.3	sub system_arch_stem()
98			{
99			my $self=shift;
100
101			@_ ? $self->{archstem} = shift
102			: $self->{archstem};
103			}
104
105	sashby	1.4	=item C<_initarch()>
106
107			A subroutine to determine the architecture. This
108			is done by parsing the architecture map contained as
109			data inside B<SCRAM_SITE.pm> and looking for an appropriate
110			match for our platform.
111
112			=cut
113
114	sashby	1.2	sub _initarch()
115			{
116			my $self=shift;
117			$self->parse_architecture_map();
118			return $self;
119			}
120
121	sashby	1.4	=item C<parse_architecture_map()>
122
123			Read the architecture map file defined in the site package B<SCRAM_SITE.pm>.
124
125			=cut
126
127	sashby	1.2	sub parse_architecture_map()
128			{
129			my $self=shift;
130			my $matches={};
131
132			require Installation::SCRAM_SITE;
133			my $architectures = &Installation::SCRAM_SITE::read_architecture_map();
134
135			while (my ($archstring,$archtest) = each %{$architectures})
136			{
137			my $rval = eval join(" ",@$archtest);
138
139			if ($rval)
140			{
141			# Store the matched string:
142			$matches->{$archstring}=1;
143	sashby	1.6	# Store the match. We take the first match then return:
144	sashby	1.2	$self->arch($archstring);
145	sashby	1.3	# Also take the arch stem from the arch string. E.g. for a string
146			# "slc3_ia32_xxx", keep the "slc3_ia32" part:
147			if (my ($sysname,$cpuarch) = ($archstring =~ /(.?)\_(.?)\_.*?$/))
148			{
149			my $stem = $sysname."_".$cpuarch;
150			$self->system_arch_stem($stem);
151			}
152			else
153			{
154			# Just set the stem to be the same as the main arch string:
155			$self->system_arch_stem($archstring);
156			}
157	sashby	1.6	return;
158	sashby	1.2	}
159			else
160			{
161			next;
162			}
163			}
164			}
165	williamc	1.1
166	sashby	1.2	1;
167	sashby	1.4
168			__END__
169
170			=back
171
172			=head1 AUTHOR/MAINTAINER
173
174	sashby	1.5	Shaun Ashby
175	sashby	1.4
176			=cut