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.8.4;
  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__