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