xref: /illumos-gate/usr/src/cmd/perl/contrib/Sun/Solaris/Lgrp/Lgrp.pm (revision 968633ad8faee931821fd6b656eb0d96d4b186c0)
1#
2# CDDL HEADER START
3#
4# The contents of this file are subject to the terms of the
5# Common Development and Distribution License (the "License").
6# You may not use this file except in compliance with the License.
7#
8# You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
9# or http://www.opensolaris.org/os/licensing.
10# See the License for the specific language governing permissions
11# and limitations under the License.
12#
13# When distributing Covered Code, include this CDDL HEADER in each
14# file and include the License file at usr/src/OPENSOLARIS.LICENSE.
15# If applicable, add the following below this CDDL HEADER, with the
16# fields enclosed by brackets "[]" replaced with your own identifying
17# information: Portions Copyright [yyyy] [name of copyright owner]
18#
19# CDDL HEADER END
20#
21
22#
23# Copyright 2006 Sun Microsystems, Inc.  All rights reserved.
24# Use is subject to license terms.
25#
26
27#
28# Lgrp.pm provides procedural and object-oriented interface to the Solaris
29# liblgrp(3LIB) library.
30#
31
32
33require 5.6.1;
34use strict;
35use warnings;
36use Carp;
37
38package Sun::Solaris::Lgrp;
39
40our $VERSION = '1.1';
41use XSLoader;
42XSLoader::load(__PACKAGE__, $VERSION);
43
44require Exporter;
45
46our @ISA = qw(Exporter);
47
48our (@EXPORT_OK, %EXPORT_TAGS);
49
50# Things to export
51my @lgrp_constants = qw(LGRP_AFF_NONE LGRP_AFF_STRONG LGRP_AFF_WEAK
52			LGRP_CONTENT_DIRECT LGRP_CONTENT_HIERARCHY
53			LGRP_MEM_SZ_FREE LGRP_MEM_SZ_INSTALLED LGRP_VER_CURRENT
54			LGRP_VER_NONE LGRP_VIEW_CALLER
55			LGRP_VIEW_OS LGRP_NONE
56			LGRP_RSRC_CPU LGRP_RSRC_MEM
57			LGRP_CONTENT_ALL LGRP_LAT_CPU_TO_MEM
58);
59
60my @proc_constants = qw(P_PID P_LWPID P_MYID);
61
62my @constants = (@lgrp_constants, @proc_constants);
63
64my @functions = qw(lgrp_affinity_get lgrp_affinity_set
65		   lgrp_children lgrp_cookie_stale lgrp_cpus lgrp_fini
66		   lgrp_home lgrp_init lgrp_latency lgrp_latency_cookie
67		   lgrp_mem_size lgrp_nlgrps lgrp_parents
68		   lgrp_root lgrp_version lgrp_view lgrp_resources
69		   lgrp_isleaf lgrp_lgrps lgrp_leaves);
70
71my @all = (@constants, @functions);
72
73# Define symbolic names for various subsets of export lists
74%EXPORT_TAGS = ('CONSTANTS' => \@constants,
75		'LGRP_CONSTANTS' => \@lgrp_constants,
76		'PROC_CONSTANTS' => \@proc_constants,
77		'FUNCTIONS' => \@functions,
78		'ALL' => \@all);
79
80# Define things that are ok ot export.
81@EXPORT_OK = ( @{ $EXPORT_TAGS{'ALL'} } );
82
83#
84# _usage(): print error message and terminate the program.
85#
86sub _usage
87{
88	my $msg = shift;
89	Carp::croak "Usage: Sun::Solaris::Lgrp::$msg";
90}
91
92#
93# lgrp_isleaf($cookie, $lgrp)
94#   Returns T if lgrp is leaf, F otherwise.
95#
96sub lgrp_isleaf
97{
98	scalar @_ == 2 or _usage "lgrp_isleaf(cookie, lgrp)";
99	return (!lgrp_children(shift, shift));
100}
101
102#
103# lgrp_lgrps($cookie, [$lgrp])
104#   Returns: list of lgrps in a subtree starting from $lgrp.
105# 	     If $root is not specified, use lgrp_root.
106# 	     undef on failure.
107sub lgrp_lgrps
108{
109	scalar @_ > 0 or _usage("lgrp_lgrps(cookie, [lgrp])");
110	my $cookie = shift;
111	my $root = shift;
112	$root = lgrp_root($cookie) unless defined $root;
113	return unless defined $root;
114	my @children = lgrp_children($cookie, $root);
115	my @result;
116
117	#
118	# Concatenate root with subtrees for every children. Every subtree is
119	# obtained by calling lgrp_lgrps recursively with each of the children
120	# as the argument.
121	#
122	@result = @children ?
123	  ($root, map {lgrp_lgrps($cookie, $_)} @children) :
124	    ($root);
125	return (wantarray ? @result : scalar @result);
126}
127
128#
129# lgrp_leaves($cookie, [$lgrp])
130#   Returns: list of leaves in the hierarchy starting from $lgrp.
131# 	     If $lgrp is not specified, use lgrp_root.
132# 	     undef on failure.
133#
134sub lgrp_leaves
135{
136	scalar @_ > 0 or _usage("lgrp_leaves(cookie, [lgrp])");
137	my $cookie = shift;
138	my $root = shift;
139	$root = lgrp_root($cookie) unless defined $root;
140	return unless defined $root;
141	my @result = grep {
142		lgrp_isleaf($cookie, $_)
143	} lgrp_lgrps($cookie, $root);
144	return (wantarray ? @result : scalar @result);
145}
146
147######################################################################
148# Object-Oriented interface.
149######################################################################
150
151#
152# cookie: extract cookie from the argument.
153# If the argument is scalar, it is the cookie itself, otherwise it is the
154# reference to the object and the cookie value is in $self->{COOKIE}.
155#
156sub cookie
157{
158	my $self = shift;
159	return ((ref $self) ? $self->{COOKIE} : $self);
160}
161
162#
163# new: The object constructor
164#
165sub new
166{
167	my $class = shift;
168	my ($self, $view);
169	$view = shift;
170	$self->{COOKIE} = ($view ? lgrp_init($view) : lgrp_init()) or
171	  croak("lgrp_init: $!\n"), return;
172	bless($self, $class) if defined($class);
173	bless($self) unless defined($class);
174	return ($self);
175}
176
177#
178# DESTROY: the object destructor.
179#
180sub DESTROY
181{
182	lgrp_fini(cookie(shift));
183}
184
185############################################################
186# Wrapper methods.
187#
188sub stale
189{
190	scalar @_ == 1 or _usage("stale(class)");
191	return (lgrp_cookie_stale(cookie(shift)));
192}
193
194sub view
195{
196	scalar @_ == 1 or _usage("view(class)");
197	return (lgrp_view(cookie(shift)));
198}
199
200sub root
201{
202	scalar @_ == 1 or _usage("root(class)");
203	return (lgrp_root(cookie(shift)));
204}
205
206sub nlgrps
207{
208	scalar @_ == 1 or _usage("nlgrps(class)");
209	return (lgrp_nlgrps(cookie(shift)));
210}
211
212sub lgrps
213{
214	scalar @_ > 0 or _usage("lgrps(class, [lgrp])");
215	return (lgrp_lgrps(cookie(shift), shift));
216}
217
218sub leaves
219{
220	scalar @_ > 0 or _usage("leaves(class, [lgrp])");
221	return (lgrp_leaves(cookie(shift), shift));
222}
223
224sub version
225{
226	scalar @_ > 0 or _usage("leaves(class, [version])");
227	shift;
228	return (lgrp_version(shift || 0));
229}
230
231sub children
232{
233	scalar @_ == 2 or _usage("children(class, lgrp)");
234	return (lgrp_children(cookie(shift), shift));
235}
236
237sub parents
238{
239	scalar @_ == 2 or _usage("parents(class, lgrp)");
240	return (lgrp_parents(cookie(shift), shift));
241}
242
243sub mem_size
244{
245	scalar @_ == 4 or _usage("mem_size(class, lgrp, type, content)");
246	return (lgrp_mem_size(cookie(shift), shift, shift, shift));
247}
248
249sub cpus
250{
251	scalar @_ == 3 or _usage("cpus(class, lgrp, content)");
252	return (lgrp_cpus(cookie(shift), shift, shift));
253}
254
255sub isleaf
256{
257	scalar @_ == 2 or _usage("isleaf(class, lgrp)");
258	lgrp_isleaf(cookie(shift), shift);
259}
260
261sub resources
262{
263	scalar @_ == 3 or _usage("resources(class, lgrp, resource)");
264	return (lgrp_resources(cookie(shift), shift, shift));
265}
266
267sub latency
268{
269	scalar @_ == 3 or _usage("latency(class, from, to)");
270	return (lgrp_latency_cookie(cookie(shift), shift, shift));
271}
272
273# Methods that do not require cookie
274sub home
275{
276	scalar @_ == 3 or _usage("home(class, idtype, id)");
277	shift;
278	return (lgrp_home(shift, shift));
279}
280
281sub affinity_get
282{
283	scalar @_ == 4 or _usage("affinity_get(class, idtype, id, lgrp)");
284	shift;
285	return (lgrp_affinity_get(shift, shift, shift));
286}
287
288sub affinity_set
289{
290	scalar @_ == 5 or
291	  _usage("affinity_set(class, idtype, id, lgrp, affinity)");
292	shift;
293	return (lgrp_affinity_set(shift, shift, shift, shift));
294}
295
2961;
297
298__END__
299