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