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 33require 5.8.4; 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