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 #
26
27 #
28 # Lgrp.pm provides procedural and object-oriented interface to the Solaris
29 # liblgrp(3LIB) library.
30 #
31
32
33 require 5.0010;
34 use strict;
35 use warnings;
36 use Carp;
37
38 package Sun::Solaris::Lgrp;
39
40 our $VERSION = '1.1';
41 use XSLoader;
42 XSLoader::load(__PACKAGE__, $VERSION);
43
44 require Exporter;
45
46 our @ISA = qw(Exporter);
47
48 our (@EXPORT_OK, %EXPORT_TAGS);
49
50 # Things to export
51 my @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
60 my @proc_constants = qw(P_PID P_LWPID P_MYID);
61
62 my @constants = (@lgrp_constants, @proc_constants);
63
64 my @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
71 my @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 #
86 sub _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 #
96 sub 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.
107 sub 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 #
134 sub 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 #
156 sub cookie
157 {
158 my $self = shift;
159 return ((ref $self) ? $self->{COOKIE} : $self);
160 }
161
162 #
163 # new: The object constructor
164 #
165 sub 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 #
180 sub DESTROY
181 {
182 lgrp_fini(cookie(shift));
183 }
184
185 ############################################################
186 # Wrapper methods.
187 #
188 sub stale
189 {
190 scalar @_ == 1 or _usage("stale(class)");
191 return (lgrp_cookie_stale(cookie(shift)));
192 }
193
194 sub view
195 {
196 scalar @_ == 1 or _usage("view(class)");
197 return (lgrp_view(cookie(shift)));
198 }
199
200 sub root
201 {
202 scalar @_ == 1 or _usage("root(class)");
203 return (lgrp_root(cookie(shift)));
204 }
205
206 sub nlgrps
207 {
208 scalar @_ == 1 or _usage("nlgrps(class)");
209 return (lgrp_nlgrps(cookie(shift)));
210 }
211
212 sub lgrps
213 {
214 scalar @_ > 0 or _usage("lgrps(class, [lgrp])");
215 return (lgrp_lgrps(cookie(shift), shift));
216 }
217
218 sub leaves
219 {
220 scalar @_ > 0 or _usage("leaves(class, [lgrp])");
221 return (lgrp_leaves(cookie(shift), shift));
222 }
223
224 sub version
225 {
226 scalar @_ > 0 or _usage("leaves(class, [version])");
227 shift;
228 return (lgrp_version(shift || 0));
229 }
230
231 sub children
232 {
233 scalar @_ == 2 or _usage("children(class, lgrp)");
234 return (lgrp_children(cookie(shift), shift));
235 }
236
237 sub parents
238 {
239 scalar @_ == 2 or _usage("parents(class, lgrp)");
240 return (lgrp_parents(cookie(shift), shift));
241 }
242
243 sub 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
249 sub cpus
250 {
251 scalar @_ == 3 or _usage("cpus(class, lgrp, content)");
252 return (lgrp_cpus(cookie(shift), shift, shift));
253 }
254
255 sub isleaf
256 {
257 scalar @_ == 2 or _usage("isleaf(class, lgrp)");
258 lgrp_isleaf(cookie(shift), shift);
259 }
260
261 sub resources
262 {
263 scalar @_ == 3 or _usage("resources(class, lgrp, resource)");
264 return (lgrp_resources(cookie(shift), shift, shift));
265 }
266
267 sub 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
274 sub home
275 {
276 scalar @_ == 3 or _usage("home(class, idtype, id)");
277 shift;
278 return (lgrp_home(shift, shift));
279 }
280
281 sub 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
288 sub 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
296 1;
297
298 __END__