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.4 2005/08/05 16:44:26 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;
         
         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;

__END__

=back

=head1 AUTHOR/MAINTAINER

Shaun Ashby

=cut
Revision:	1.5
Committed:	Wed Aug 17 11:11:48 2005 UTC (19 years, 8 months ago) by sashby
Content type:	text/plain
Branch:	MAIN
CVS Tags:	V1_0_2, V1_0_2_p1
Branch point for:	v103_branch
Changes since 1.4:	+2 -2 lines
Log Message:	Added more POD doc.
#	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.5	# Revision: $Id: Architecture.pm,v 1.4 2005/08/05 16:44:26 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
144			if ((my $nkeys = keys %{$matches}) > 1)
145			{
146			print "\n";
147			print "SCRAM: WARNING: more than one architecture definition in ","\n";
148			print " SCRAM_SITE matches current platform!","\n";
149			print "Unable to set the architecture correctly!","\n";
150			print "\n";
151			exit(1);
152			}
153	sashby	1.3
154	sashby	1.2	# Store the match (only the first match in the case
155			# of multiple matches):
156			$self->arch($archstring);
157	sashby	1.3
158			# Also take the arch stem from the arch string. E.g. for a string
159			# "slc3_ia32_xxx", keep the "slc3_ia32" part:
160			if (my ($sysname,$cpuarch) = ($archstring =~ /(.?)\_(.?)\_.*?$/))
161			{
162			my $stem = $sysname."_".$cpuarch;
163			$self->system_arch_stem($stem);
164			}
165			else
166			{
167			# Just set the stem to be the same as the main arch string:
168			$self->system_arch_stem($archstring);
169			}
170	sashby	1.2	}
171			else
172			{
173			next;
174			}
175			}
176			}
177	williamc	1.1
178	sashby	1.2	1;
179	sashby	1.4
180			__END__
181
182			=back
183
184			=head1 AUTHOR/MAINTAINER
185
186	sashby	1.5	Shaun Ashby
187	sashby	1.4
188			=cut