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