File Coverage

blib/lib/IBM/StorageSystem.pm

Criterion	Covered	Total	%
statement	120	233	51.5
branch	0	42	0.0
condition	0	2	0.0
subroutine	40	54	74.0
pod	2	2	100.0
total	162	333	48.6

package IBM::StorageSystem;

use strict;
use warnings;

use IBM::StorageSystem::Array;
use IBM::StorageSystem::Disk;
use IBM::StorageSystem::Drive;
use IBM::StorageSystem::Enclosure;
use IBM::StorageSystem::Export;
use IBM::StorageSystem::Fabric;
use IBM::StorageSystem::FileSystem;
use IBM::StorageSystem::Health;
use IBM::StorageSystem::Host;
use IBM::StorageSystem::Interface;
use IBM::StorageSystem::IOGroup;
use IBM::StorageSystem::Mount;
use IBM::StorageSystem::Node;
use IBM::StorageSystem::Pool;
use IBM::StorageSystem::Replication;
use IBM::StorageSystem::Service;
use IBM::StorageSystem::Task;
use IBM::StorageSystem::Quota;
use IBM::StorageSystem::VDisk;
use IBM::StorageSystem::Statistic;
use IBM::StorageSystem::StatisticsSet;
use IBM::StorageSystem::Statistic::ClusterThroughput;
use IBM::StorageSystem::Statistic::ClusterClientThroughput;
use IBM::StorageSystem::Statistic::ClusterCreateDeleteLatency;
use IBM::StorageSystem::Statistic::ClusterCreateDeleteOperations;
use IBM::StorageSystem::Statistic::ClusterOpenCloseLatency;
use IBM::StorageSystem::Statistic::ClusterOpenCloseOperations;
use IBM::StorageSystem::Statistic::ClusterReadWriteLatency;
use IBM::StorageSystem::Statistic::ClusterReadWriteOperations;
use IBM::StorageSystem::Statistic::Node::Memory;
use IBM::StorageSystem::Statistic::Node::CPU;
use IBM::StorageSystem::Statistic::Pool::Throughput;
use Net::OpenSSH;
use Carp qw(croak);

our $VERSION = '0.045';

our @ATTR = qw(auth_service_cert_set auth_service_configured auth_service_enabled
auth_service_pwd_set auth_service_type auth_service_url auth_service_user_name
bandwidth cluster_isns_IP_address cluster_locale cluster_ntp_IP_address code_level
console_IP email_contact email_contact2 email_contact2_alternate email_contact2_primary
email_contact_alternate email_contact_location email_contact_primary email_reply
email_state gm_inter_cluster_delay_simulation gm_intra_cluster_delay_simulation
gm_link_tolerance gm_max_host_delay has_nas_key id id_alias inventory_mail_interval
iscsi_auth_method iscsi_chap_secret layer location name partnership rc_buffer_size
relationship_bandwidth_limit space_allocated_to_vdisks space_in_mdisk_grps
statistics_frequency statistics_status stats_threshold tier tier_capacity tier_free_capacity
time_zone total_allocated_extent_capacity total_free_space total_mdisk_capacity
total_overallocation total_used_capacity total_vdisk_capacity total_vdiskcopy_capacity);

our @STAT = qw(compression_cpu_pc cpu_pc drive_r_io drive_r_mb drive_r_ms drive_w_io
drive_w_mb drive_w_ms fc_io fc_mb iscsi_io iscsi_mb mdisk_r_io mdisk_r_mb mdisk_r_ms
mdisk_w_io mdisk_w_mb mdisk_w_ms sas_io sas_mb total_cache_pc vdisk_r_io vdisk_r_mb
vdisk_r_ms vdisk_w_io vdisk_w_mb vdisk_w_ms write_cache_pc);

$|++;

foreach my $attr ( @ATTR ) {
        {
	no strict 'refs';
	*{ __PACKAGE__ .'::'. $attr } = sub {
		my( $self, $val ) = @_;
		$val =~ s/\#/no/ if $val;
		$self->{$attr} = $val if $val;

		return $self->{$attr}
	}
        }
}

foreach my $stat ( @STAT ) {
	{
	no strict 'refs';
	*{ __PACKAGE__ .'::'. $stat } = sub {
		my $self = shift;
		$self->stats_threshold or return $self->{$stat};

		return ( ( time - $self->{$stat}->{ts} ) > $self->stats_threshold
			? $self->{$stat}->refresh
			: $self->{$stat} )
	}
	}
}

our $STATS = {
                cluster_throughput => {
                        cmd     => '-g cluster_throughput',
                        class   => 'IBM::StorageSystem::Statistic::ClusterThroughput'
		},
                cluster_client_throughput => {
                        cmd     => '-g client_throughput',
                        class   => 'IBM::StorageSystem::Statistic::ClusterClientThroughput'
		},
		cluster_create_delete_latency => {
			cmd	=> '-g cluster_create_delete_latency',
			class	=> 'IBM::StorageSystem::Statistic::ClusterCreateDeleteLatency'
		},
		cluster_create_delete_operations => {
			cmd	=> '-g cluster_create_delete_operations',
			class	=> 'IBM::StorageSystem::Statistic::ClusterCreateDeleteOperations'
		},
		cluster_open_close_latency => {
			cmd	=> '-g cluster_open_close_latency',
			class	=> 'IBM::StorageSystem::Statistic::ClusterOpenCloseLatency'
		},
		cluster_open_close_operations => {
			cmd	=> '-g cluster_open_close_operations',
			class	=> 'IBM::StorageSystem::Statistic::ClusterOpenCloseOperations'
		},
		cluster_read_write_operations => {
			cmd	=> '-g cluster_read_write_operations',
			class	=> 'IBM::StorageSystem::Statistic::ClusterReadWriteOperations'
		},
		cluster_read_write_latency => {
			cmd	=> '-g cluster_read_write_latency',
			class	=> 'IBM::StorageSystem::Statistic::ClusterReadWriteLatency'
		}
};

foreach my $stat ( keys %{ $STATS } ) {
        {
        no strict 'refs';
        *{ __PACKAGE__ .'::'. $stat } =
        sub {
                my( $self, $t ) = @_;
                $t ||= 'minute';
                my $stats = $self->__lsperfdata( cmd   => "$STATS->{$stat}->{cmd} -t $t",
                                                 class => $STATS->{$stat}->{class}
					       );
                return $stats
        }
        }
}


# Our object hash for programmatic generation of methods.
#
# Each hash represents an object type that we will generate methods for - for example, given the below;
#
# 	drive =>
#		bcmd	=> 'lsdrive -nohdr -delim :',
#		cmd	=> 'lsdrive',
#		id	=> 'id',
#		class	=> 'IBM::StorageSystem::Drive',
#		type	=> 'drive'
#	},
#
# drive	- 	is the object type - in this case a drive in Storwize nomenclature representing a physical
# 		hard drive.
#
# bcmd	-	is the base cmd to be executed in the Storwize CLI to retrieve a list of drive objects.  This
#		parameter is only required for object types where object enumeration is required as a prequisite
#		to execution of object specific commands.
#
#		Using the example above for 'lsdrive -nohdr -delim :', the base cmd is necessary to first enumerate
#		all drives to obtain a summary listing of all drives and their ID's.  The ID's can then be used in
#		the 'cmd' command (e.g. lsdrive 1) to obtain detailed information on each drive.
#
#		As there is no way in which to obtain detailed information of some objects without specifying the
#		object ID, the bcmd is necessary to first produce a list of these ID's.  Contrast the operation of
#		the lsdrive command and the need for an ID parameter to obtain detailed information with the operation
#		of the lsnode command, which provides detailed information on all nodes without any parameters.
#
#		*NOTE* that the bcmd is	not necessary for all objects - only those which there is no single command
#		to produce a detailed listing without specifying an ID type parameter.  Note also, that you probably
#		want to specify additional options to the bcmd command (like -nohdr and -delim :) to prevent header
#		information from being parsed.
#
# cmd	-	is the CLI command that will be used to retrieve information about the object.  *NOTE* the above information
#		on the use of the bcmd value and how this command works in conjunction with it.
#
# id	-	is a single field in the CLI command output (or multiple fields concatenated by colon) that is
#		able to uniquely identify each object in a global context for this object type.  For example;
#		in a systems with more than one enclosure it is necessary to identify an enclosure PSU by specifying
#		both the enclosure id and the PSU id - e.g. Enclosure 2, PSU 1 - which when separated by a colon
#		would become 2:1 which is sufficient to uniquely identify a enclsoure PSU in a system of any number
#		of enclosures.
#
# class	-	the Perl package namespace into which this object will be blessed as a class.
#
# type	-	the 'type' of object - this is usually the same as the root key type, however it must also be
#		globally unique within this class.  This value is used internally to implement object caching
#		and is not used in method naming so need not necessarily intuitive to a user.
#
# sl	-	this optional parameter is used to designate the CLI command output type as 'single-line' - this
#		is in contrast to 'multi-line' output.  In general, CLI command output falls into two categories;
#		'single-line' output contains output on multiple objects with each line representative of a unique
#		object - this may also be referred to as 'row-based' data.  An example of such output is the 'lsnode'
#		command.
#
#		'multi-line' output contains output about a single object as key-value pairs over multiple lines,
#		may also be referred to as 'columnar' data.  An output of such output is the 'lsdrive' command when
#		executed with a valid drive id parameter (e.g. lsdrive 1).
#
#		By default, CLI commands are assumed to use columnar output, so it is necessary for any commands
#		using row-based output to also specify a true value for the 'sl' key to ensure that the output is
#		parsed correctly.  CLI commands that output columnar data should not specify this command.

our $OBJ = {	drive => {
			bcmd	=> 'lsdrive -nohdr -delim :',
			cmd	=> 'lsdrive -bytes',
			id	=> 'id',
			class	=> 'IBM::StorageSystem::Drive',
			type	=> 'drive'
		},
		vdisk => {
			bcmd	=> 'lsvdisk -nohdr -delim :',
			cmd	=> 'lsvdisk -bytes',
			id	=> 'id',
			class	=> 'IBM::StorageSystem::VDisk',
			type	=> 'vdisk'
		},
		disk => {
			cmd	=> 'lsdisk -Y -v',
			id	=> 'Name',
			class	=> 'IBM::StorageSystem::Disk',
			type	=> 'disk',
			sl	=> 1
		},
		enclosure => {
			bcmd	=> 'lsenclosure -nohdr -delim :',
			cmd	=> 'lsenclosure',
			id	=> 'id',
			class	=> 'IBM::StorageSystem::Enclosure',
			type	=> 'enclosure'
		},
		host => {
			bcmd    => 'lshost -nohdr -delim :',
			cmd     => 'lshost',
			id      => 'id',
			class   => 'IBM::StorageSystem::Host',
			# so we don't clobber IBM::StorageSystem::host variable
			type    => 'IBM::StorageSystem::Host::host'
		},
		enclosurebattery => {
			cmd     => 'lsenclosurebattery -delim :',
			id      => 'enclosure_id:battery_id',
			class   => 'IBM::StorageSystem::EnclosureBattery',
			type    => 'enclosurebattery',
			sl      => 1
		},
		fabric => {
			cmd     => 'lsfabric -delim :',
			id      => 'local_wwpn:remote_wwpn',
			class   => 'IBM::StorageSystem::Fabric',
			type    => 'fabric',
			sl      => 1
		},
		array => {
			bcmd	=> 'lsarray -nohdr -delim :',
			cmd	=> 'lsarray -bytes',
			id	=> 'mdisk_id',
			class	=> 'IBM::StorageSystem::Array',
			type 	=> 'array'
		},
		export => {
			cmd	=> 'lsexport -Y -v',
			id	=> 'Name:Path',
			class	=> 'IBM::StorageSystem::Export',
			type	=> 'export',
			sl	=> 1
		},
		mount => {
			cmd	=> 'lsmount -Y -v',
			id	=> 'File_system',
			class	=> 'IBM::StorageSystem::Mount',
			type	=> 'mount',
			sl	=> 1
		},
		node => {
			cmd	=> 'lsnode -Y -v',
			id	=> 'Hostname',
			class	=> 'IBM::StorageSystem::Node',
			type	=> 'node',
			sl	=> 1
		},
		health => {
			cmd	=> 'lshealth -Y',
			id	=> 'Host:Sensor',
			class	=> 'IBM::StorageSystem::Health',
			type	=> 'health',
			sl	=> 1
		},
		iogroup => {
			bcmd	=> 'lsiogrp -nohdr -delim :',
			cmd	=> 'lsiogrp -bytes',
			id	=> 'id',
			type	=> 'iogroup',
			class	=> 'IBM::StorageSystem::IOGroup'
		},
		filesystem => {
			cmd	=> 'lsfs -Y -v',
			id	=> 'Device_name',
			class	=> 'IBM::StorageSystem::FileSystem',
			type	=> 'fs',
			sl	=> 1
		},
		service => {
			cmd	=> 'lsservice -Y',
			id	=> 'Name',
			class	=> 'IBM::StorageSystem::Service',
			type	=> 'service',
			sl	=> 1
		},
		task => {
			cmd	=> 'lstask -Y -v',
			id	=> 'Name',
			class	=> 'IBM::StorageSystem::Task',
			type	=> 'task',
			sl	=> 1
		},
		replication => {
			cmd	=> 'lsrepl -Y',
			id	=> 'log_Id',
			class	=> 'IBM::StorageSystem::Replication',
			type	=> 'replication',
			sl	=> 1
		},
		quota => {
			cmd	=> 'lsquota -Y',
			id	=> 'Cluster:Device:Type:ID',
			class	=> 'IBM::StorageSystem::Quota',
			type	=> 'quota',
			sl	=> 1
		},
		interface => {
			cmd	=> 'lsnwinterface -x -Y',
			id	=> 'Node:Interface',
			class	=> 'IBM::StorageSystem::Interface',
			type	=> 'interface',
			sl	=> 1
		},
		pool => {
			cmd	=> 'lspool -Y',
			id	=> 'Filesystem:Name',
			class	=> 'IBM::StorageSystem::Pool',
			type	=> 'pool',
			sl	=> 1
		}
	};

foreach my $obj ( keys %{ $OBJ } ) {
	{
	no strict 'refs';
	my $m = 'get_'.$obj.'s';

	*{ __PACKAGE__ ."::$obj" } = sub {
		my ( $self, $id ) = @_;

		return ( $self->{$obj}->{$id}	? $self->{$obj}->{$id}
						: $self->$m( $id ) )
	};

	*{ __PACKAGE__ .'::get_'. $obj } = sub {
		return $_[0]->$m( $_[1] )
	};

	if ( $OBJ->{$obj}->{sl} ) {
		*{ __PACKAGE__ . "::$m" } = sub {
			my ( $self, $id ) = @_;
			my %args = (	cmd	=> $OBJ->{$obj}->{cmd},
					class	=> $OBJ->{$obj}->{class},
					type	=> $OBJ->{$obj}->{type},
					id	=> $OBJ->{$obj}->{id}
			);
			my @res = $self->__get_sl_objects( %args );

			return ( defined $id ? $self->{ $OBJ->{$obj}->{type} }->{$id} : @res )
		}
	}
	else {
		*{ __PACKAGE__ . "::$m" } = sub {
			my ( $self, $id ) = @_;
			my @objs = map { ( split /:/, $_ )[0] }
				   split /\n/, $self->__cmd( $OBJ->{$obj}->{bcmd} );

			my %args = (	cmd	=> $OBJ->{$obj}->{cmd},
					objects => [@objs],
					id	=> $OBJ->{$obj}->{id},
					class	=> $OBJ->{$obj}->{class},
					type	=> $OBJ->{$obj}->{type}
			);
			my @res = $self->__get_ml_objects( %args );

			return ( defined $id ? $self->{ $OBJ->{$obj}->{type} }->{$id} : @res )
		}
	}
	}
}

sub new {
	my ($class, %args) = @_;
	my $self = bless {} , $class;
	$args{user}	? $self->{user}	= $args{user}		: croak 'Mandatory parameter "user" not given';
	$args{host}	? $self->{host}	= $args{host}		: croak 'Mandatory parameter "host" not given';
	$args{key_path}	? $self->{key_path} = $args{key_path}	: croak 'Mandatory parameter "key_path" not given';
	my %opts = ( user => $self->{user}, key_path => $self->{key_path}, batch_mode => 1, master_opts => '-q' );
	$self->{ssh} = Net::OpenSSH->new( $args{host}, %opts );
	$self->{ssh}->error and croak 'Could not create Net::OpenSSH object: ' . $self->{ssh}->error . "\n";

	unless ( $args{no_stats} ) {
		$self->__lssystem;
		$self->refresh_system_stats;
		$self->{stats_threshold} = ( $args{stats_threshold} ? $args{stats_threshold} : 0 );
	}

	return $self
}

sub refresh_system_stats {
	my $self = shift;

	foreach my $stat ( splice @{ [ split /\n/, $self->__cmd( 'lssystemstats -gui -delim :' ) ] }, 1 ) {
		my ( $name, $epoch, $current, $peak, $peak_time, $peak_epoch ) = split /:/, $stat;
		$self->{$name} = IBM::StorageSystem::Statistic->new(	$self,
									name	=> $name,
									epoch	=> $epoch,
									current => $current,
									peak	=> $peak,
									peak_time => $peak_time,
									peak_epoch => $peak_epoch
								);
	}
}

sub __lssystem {
	my $self = shift;
	my ( %a, %dkeys );
	my @output = split /\n/, ( split /\n\n/, $self->__cmd( 'lssystem' ) )[0];
	%dkeys = map { $_ => $dkeys{ $_ }++ }
		 map { ( split /\s/, $_ )[0] } @output;

	for ( @output ) {
		last if /^\s*$/;
		s/$/ -/;
		my ( $var, $val ) = ( split /\s/ )[0,1];

		if ( $dkeys{ $var } >= 1 ) {
			push @{ $self->{$var} }, $val
		}
		else {
			$self->{$var} = $val
		}
	}

	return $self
}

sub __lsperfdata {
	my ( $self, %args ) = @_;
	my $stats = IBM::StorageSystem::StatisticsSet->new;
	my @output = split /\n/, $self->__cmd( "lsperfdata $args{cmd}" );
	shift @output;
	pop @output;

	foreach my $line ( @output ) {
		my @values = split /,/, $line;
		$stats->__push( $args{class}->new( @values ) )
	}

	return $stats;
}

sub __cmd {
	return $_[0]->{ssh}->capture( $_[1] )
}

# __get_sl_objects - Get Single Line Objects
# This method is used to parse CLI output where information is returned
# in a row-based format - e.g.
#
#	Column_1, Column_2, Column_3, ... Column_N
#	Value_1 , Value_2,  Value_3,  ... Value_N
#	Value_1 , Value_2,  Value_3,  ... Value_N
#	Value_1 , Value_2,  Value_3,  ... Value_N
#
# To parse this data into an array of objects, we treat each row as a single object.
# We split the column headers on a delimeter (usually :) and use each header as a hash
# key for the corresponding value in each row - i.e.
#
#	Column_1 => Value_1,
#	Column_2 => Value_2 ...etc.
#
# Each hash is then passed to the constructor for this object type (given as the 'class'
# argument in our %args hash), and the resultant object conditionally cached within our
# IBM::StorageSystem object and pushed onto our returned array.
#
# Note that this method includes a slight hack to cater for the lack of non-unique per-object
# keys in CLI output for some object types.  In this scenario it is necessary to create
# a unique key via composite fields concatenated with a colon.

sub __get_sl_objects {
	my( $self, %args ) = @_;
	my @objs = split /\n/, $self->__cmd( $args{ cmd } );
	my @headers = map { s/ /_/g; s/\.//g; $_ }
		      split /:/, shift @objs;
	my @res;

	foreach my $object ( @objs ) {
		my (%a, $c);

		foreach my $val ( split /:/, $object ) {
			$c++;
			next if $headers[ $c - 1 ] =~ /^(lsnode|lsexport|lshealth|lsfs|SensorSummary|Share|CtdbHost|HEADER|reserved)$/;
			$a{ $headers[ $c - 1 ] } = $val
		}

		if ( $args{ id } =~ /:/ ) {
			my ($nid, $nval);

			foreach my $id ( split /:/, $args{ id } ) {
				$nid .= ":$id"; $nval .= ":$a{ $id }"
			}

			$nid =~ s/^://; $nval =~ s/^://;
			$a{ $nid } = $nval
		}

		my $obj = $args{ class }->new( $self, %a );
		$self->{ $args{ type } }->{ $a{ $args{ id } } } = $obj unless $args{ nocache };
		push @res, $obj
	}

	return @res
}

# __get_ml_objects - Get Multi-Line Objects
# This method is used to parse CLI command where detailed information on
# single object is returned in a columnar format - e.g.
#
#	Column_1	Value_1
#	Column_2	Value_2
#	...		...
#	Column_N	Value_N
#
# To parse this data we split the output on a delimiter (usually whitespace)
# and treat each row as a name,value hash pair for an attribute of a single object.
# For example, the above example output would become:
#
#	Column_1 => Value_1,
#	Column_2 => Value_2,
#	...
#	Column_N => Value_N,
#
# The resultant hash is passed as the argument to the constructor of the type
# specified by the $args{ class } value and the resultant object is optionally cached
# in our and pushed onto the return array.
#
# Things to note in this sub include the hack required to handle non-unique column names.
# For example; an 'lsfabric' output may include multiple 'WWPN' columns, so it is
# neccesary to identify duplicate column names and treat the corresponding hash values
# as anonymous arrays rather than scalars.

sub __get_ml_objects {
	my ( $self, %args ) = @_;
	my @res;

	foreach my $object ( @{ $args{ objects } } ) {
		my ( %a, %dkeys );
		my @output = split /\n/, ( split /\n\n/, $self->__cmd( "$args{ cmd } $object" ) )[0];
		%dkeys = map { $_ => $dkeys{ $_ }++ }
			 map { ( split /\s/, $_ )[0] } @output;

		for ( @output ) {
			last if /^\s*$/;
			s/$/ -/;
			my ( $var, $val ) = ( split /\s/ )[0,1];

			if ( $dkeys{ $var } >= 1 ) {
				push @{ $a{ $var } }, $val
			}
			else {
				$a{ $var } = $val
			}
		}

		my $obj = $args{ class }->new( $self, %a );
		$self->{ $args{ type } }->{ $a{ $args{ id } } } = $args{ class }->new( $self, %a ) unless ( $args{ nocache } );
		push @res, $obj
	}

	return @res
}

1;

__END__