package AIX::ODM;

require 5.005;
use strict;
use warnings;

our $VERSION = "0.1";

#======================================================================

$^O =~ /aix/i || die "This module only runs on AIX systems.\n";

sub odm_classes {
  my ${corp} = ${_[0]}?${_[0]}:'C';
  my @classes;
  my @devlist;
  my $class;
  my $devname;
  my %dev;
# Retrieve the list of classes from the ODM
  @classes = `lsdev -${corp} -r class`;
  foreach ${class} (@classes) {
    chomp(${class});
# Retrieve the list of devices associated with each class from the ODM
    @devlist = `lsdev -Cc ${class} -F name`;
    foreach ${devname} (@devlist) {
      chomp(${devname});
      ${dev{${devname}}} = ${class};
    }
  }
  return %dev;
};
################################################################
sub odm_class {
  my ${corp} = ${_[0]}?${_[0]}:'C';
  return -1 if ( ${corp} ne 'C' );
  return -1 if (!${_[1]});
# Retrieve the class of a device from the ODM
  my ${devclass} = `lsdev -${corp} -r class -l ${_[1]}`;
  chomp(${devclass});
  return ${devclass};
};
################################################################
sub odm_subclass {
  my ${corp} = ${_[0]}?${_[0]}:'C';
  return -1 if ( ${corp} ne 'C' );
  return -1 if (!${_[1]});
# Retrieve the subclass of a device from the ODM
  my ${devsub} = `lsdev -${corp} -r subclass -l ${_[1]}`;
  chomp(${devsub});
  return ${devsub};
};
################################################################
sub odm_attributes {
  my @{line};
  my ${ndx};
  my ${aname};
  my %attrib;
# Retrieve the attributes associated with the device from the ODM
# Two lines are returned, the attribute names are returned on the 
# first line, the attribute values returned on the second.
  my @lines = `lsattr -EOl ${_[0]}`;

  chomp(${lines[0]});
  ${lines[0]} =~ s/^#//g;
  my (@attr_name) = split(/:/,${lines[0]});

  chomp(${lines[1]});
  ${lines[1]} =~ s/^#//g;
  my (@attr_valu) = split(/:/,${lines[1]});

  ${ndx} = 0;
  foreach ${aname} (@attr_name) {
    ${attrib{${aname}}} = ${attr_valu[${ndx}]};
    ${ndx} = ${ndx} + 1;
  }
  return %{attrib};
};
################################################################
sub odm_dump {
# Create a hash of devices by their associated class
  my ${corp} = ${_[0]}?${_[0]}:'C';
  my %devlist = &odm_classes(${corp});
  my %attrout;
  my %devices;
  my $ndx;
  my $subndx;
  foreach $ndx (keys %devlist) {
# create a hash of attributes associated with each device
    %{attrout} = &odm_attributes(${ndx});
# Add a hash value for 'class' and 'devname'
    ${devices{${ndx}}{'class'}} = ${devlist{${ndx}}};
    ${devices{${ndx}}{'subclass'}} = odm_subclass(${corp},${ndx});
    chomp(${devices{${ndx}}{'subclass'}});
    ${devices{${ndx}}{'devname'}} = $ndx;
    foreach ${subndx} (keys %attrout) {
      ${devices{${ndx}}{${subndx}}} = ${attrout{${subndx}}};
    }
  }
  return %devices;
}

1;

__END__

=pod
=head1 NAME

AIX::ODM -  A Perl module for retrieving ODM information about an AIX (RS/6000/pSeries) system

=head1 SYNOPSIS

  use AIX::ODM;
  
  my %odm = odm_dump('C|P');
  while ( ($ndx1, $lev2) = each %odm ) {
    while ( ($ndx2, $val) = each %$lev2 ) {
        print "odm{${ndx1}}{${ndx2}} = ${odm{${ndx1}}{${ndx2}}}\n";
    }
  }

  my %dev = odm_classes('C|P');
  foreach ${devname} ( keys %dev ) {
    print "dev{${devname}} = ${dev{${devname}}}\n";
  }

  my %attribs = odm_attributes(${dev{'devname'}};
  foreach ${attrname} ( keys %attribs ) {
    print "attribs{${attrname}} = ${attribs{${attrname}}}\n";
  }

  my ${devclass} = odm_class('C|P',${dev{'devname'});
  my ${devsubcl} = odm_subclass('C|P',${dev{'devname'});

=head1 DESCRIPTION

This module provides a Perl interface for accessing ODM information about an RS/6000 / pSeries machine running the AIX operating system.  It makes available several functions, which return hashes of values containing device information and their attributes:

=head1 VERSION

0.1 (released 2004-06-22)

=head1 BUGS

No bugs are known at this time.

=head1 TO-DO

=head1 AUTHOR

  Dana French
  <mailto:dfrench@mtxia.com>
  <http://www.mtxia.com>
  
=head1 COPYRIGHT/LICENSE

Copyright (c) 2004, Dana French.  This module is free software.  It may be used, redistributed, and/or modified under the terms of the Perl Artistic License.

=cut