usr/src/cmd/perl/contrib/Sun/Solaris/Lgrp/Lgrp.pm

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