transfer from Sourceforge

.cvsignore

+tmp
+typescript
+.git

.gitignore

+.git
+.project
+CVSROOT
+CVS
+tmp
+typescript

README.textile

+h1. README
+
+h2. Location
+
+This project migrated on 2017-10-23 from Sourceforge (CVS) to Github
+(Git).  Please use the Github repository from now on.
+
+* https://sourceforge.net/projects/aix-pm/ *OBSOLETE REPOSITORY*
+* https://github.com/gonter/aix-pm
+
+h2. License
+
+Unless otherwise stated, the code in this repository can be used under
+terms of the BSD 2-clause license
+
+* https://en.wikipedia.org/wiki/BSD_licenses#2-clause_license_.28.22Simplified_BSD_License.22_or_.22FreeBSD_License.22.29

hacks/README

+$Id: README,v 1.1 2008/12/09 16:47:21 gonter Exp $
+
+=head1 Quick'n'dirty hacks
+
+Small scripts to solve small problems
+
+=head1 nim/
+
+=head2 lsnim.pl
+
+Script to sort output of "lsnim -t lpp_source" which is useful when
+it's called by a NIM client.
+
+=head1 linux/lvm/
+
+=head2 chfs.pl
+
+Script to simulate "chfs -a size=..." for a Linux LVM

hacks/linux/aptitude/.cvsignore

+packages.csv

hacks/linux/aptitude/.gitignore

+packages.csv

hacks/linux/aptitude/lib/Debian/Aptitude.pm

+#!/usr/bin/perl
+
+=head1 NAME
+
+  Debian::Aptitude;
+
+=cut
+
+package Debian::Aptitude;
+
+use strict;
+
+sub new
+{
+  my $class= shift;
+  my $obj= {};
+  bless $obj, $class;
+  $obj;
+}
+
+sub parse
+{
+  my $p= shift;
+  my $fnm= shift;
+
+  open (FI, $fnm) or die;
+
+  my @packages= ();
+  my %packages= ();
+  my $pkg= undef;
+
+  while (<FI>)
+  {
+    chop;
+
+    if (m#^([\w\-]+):\s+(.+)$#)
+    {
+      my ($an, $av)= ($1, $2);
+      # print "an=[$an] av=[$av]\n";
+      if ($an eq 'Package')
+      {
+        $pkg= {};
+        push (@packages, $pkg);
+      }
+
+      if (defined ($pkg))
+      {
+        $pkg->{$an}= $av;
+      }
+      else
+      {
+        print "ATTN: no package defined [$_]\n";
+      }
+    }
+    elsif (m#^$#)
+    {
+      $pkg= undef;
+    }
+    else
+    {
+      print "ATTN: unknown line format: [$_]\n";
+    }
+  }
+  close (FI);
+
+  # print "packages: ", main::Dumper (\@packages);
+
+  \@packages;
+}
+
+1;
+
+__END__
+
+=head1 AUTHOR
+
+  Gerhard Gonter <ggonter@cpan.org>
+
+=cut
+

hacks/linux/aptitude/x1.pl

+#!/usr/bin/perl 
+
+=head1 PURPOSE
+
+Test script for the package Debian::Aptitude .
+
+Reads /var/lib/aptitude/pkgstates and saves it in CSV format.
+
+=cut
+
+use strict;
+
+use Util::Simple_CSV;
+
+use Data::Dumper;
+$Data::Dumper::Indent= 1;
+
+use lib 'lib';
+use Debian::Aptitude;
+
+my $pkg_states= '/var/lib/aptitude/pkgstates';
+
+my $p= new Debian::Aptitude;
+my $pkgs= $p->parse ($pkg_states);
+# print "p: ", Dumper ($p);
+
+my @columns= (qw(Package Architecture Unseen State Dselect-State Remove-Reason));
+
+my $csv= new Util::Simple_CSV('no_array' => 1);
+
+$csv->define_columns(@columns);
+print "csv: ", Dumper ($csv);
+
+$csv->{'data'}= $pkgs;
+sub check
+{
+  my ($array_ref, $hash_ref)= @_;
+  # print "hr: ", Dumper($hash_ref);
+  return ($hash_ref->{'State'} == 2) ? 1 : 0;
+}
+
+# $csv->filter(\&check);
+# print "csv: ", Dumper ($csv);
+$csv->sort('Package');
+
+$csv->save_csv_file('filename' => 'packages.csv');
+
+exit (0);
+

hacks/linux/lvm/cfgmgr.pl

+#!/usr/bin/perl
+# $Id: cfgmgr.pl,v 1.2 2016/05/25 12:37:14 gonter Exp $
+
+use strict;
+
+use Data::Dumper;
+$Data::Dumper::Indent= 1;
+
+open (MSG, '/var/log/messages')    # RHEL, CentOS
+  or open (MSG, '/var/log/syslog') # Ubuntu
+  or die "cant read messages";     # TODO: or try something else?
+
+seek (MSG, 0, 2);
+
+my $config= new Linux::cfgmgr ('messages' => *MSG);
+
+$config->get_scsi_host ();
+print "config: ", Dumper ($config);
+$config->scan_scsi_host ();
+
+package Linux::cfgmgr;
+
+sub new
+{
+  my $class= shift;
+  my %par= @_;
+
+  my $obj= {};
+  bless $obj, $class;
+
+  foreach my $par (keys %par)
+  {
+    $obj->{$par}= $par{$par};
+  }
+
+  $obj;
+}
+
+sub show_messages
+{
+  my $cfg= shift;
+
+  local *M= $cfg->{'messages'};
+  while (<M>)
+  {
+    print $_;
+  }
+}
+
+sub scan_scsi_host
+{
+  my $cfg= shift;
+
+  my $c_scsi_host= $cfg->{'scsi_host'};
+  foreach my $scsi_host (sort keys %$c_scsi_host)
+  {
+    my $dev= $c_scsi_host->{$scsi_host};
+# print "dev: ", main::Dumper ($dev);
+
+    my $cmd= 'echo - - - >' . $dev->{'path'} . '/scan';
+    system ($cmd);
+
+    print ">>> [$cmd]\n";
+    sleep (3);
+    print "--- 8< ---\n";
+    $cfg->show_messages ();
+    print "--- >8 ---\n";
+  }
+}
+
+sub get_scsi_host
+{
+  my $cfg= shift;
+
+  my $sys_path= '/sys/class/scsi_host';
+
+  opendir (D, $sys_path) or die;
+  while (my $e= readdir (D))
+  {
+    next if ($e eq '.' || $e eq '..');
+    if ($e =~ /^host\d+/)
+    {
+      $cfg->{'scsi_host'}->{$e}= { 'dev' => $e, 'path' => join ('/', $sys_path, $e) };
+    }
+  }
+  closedir (D);
+}
+

hacks/linux/lvm/chfs.pl

+#!/usr/bin/perl
+# $Id: chfs.pl,v 1.6 2017/01/05 15:48:06 gonter Exp $
+
+=pod
+
+=head1 NAME
+
+chfs.pl  --  change filesystem properties
+
+=head1 USAGE
+
+chfs.pl -a size=+I<n>I<S> F<path>
+
+Write the commands necessary to expand the filesystem F<path> by adding
+I<n> units of I<S> (K, M, G, T) bytes (1K= 1024 bytes).
+
+=cut
+
+use strict;
+
+use Data::Dumper;
+$Data::Dumper::Indent= 1;
+
+my @paths= qw(/usr/sbin /sbin);
+
+my @PARS;
+my $attr= ();
+while (defined (my $arg= shift (@ARGV)))
+{
+  if ($arg =~ /^-/)
+  {
+    if ($arg eq '-a')
+    {
+      my ($an, $av)= split ('=', shift (@ARGV), '2');
+      $attr->{$an}= $av;
+    }
+  }
+  else
+  {
+    push (@PARS, $arg);
+  }
+}
+
+my $fs= &get_mount ();
+## print 'fs=', Dumper ($fs), "\n";
+## print 'attr=', Dumper ($attr), "\n";
+
+my $fs_name= shift (@PARS) or &usage ('no fs name');
+
+my $fs_p= $fs->{$fs_name};
+
+&chfs ($fs_p, $attr);
+
+exit (0);
+
+sub usage
+{
+  my $msg= shift;
+  print $msg, "\n";
+  print <<EOX;
+usage: $0 -a attr==value filesystem
+
+attribs:
+size=+3G
+
+Examples:
+  chfs.pl -a size=+5g /bla
+EOX
+  exit;
+}
+
+sub chfs
+{
+  my $fs_p= shift or &usage ('unknown fs');;
+  my $attr= shift;
+
+  if (exists ($attr->{'size'}))
+  {
+    my $sz= $attr->{'size'};
+    if ($sz =~ /^\+?(\d+)[GM]$/)
+    {
+      my $dv= $fs_p->{'dev'};
+      my $ty= $fs_p->{'type'};
+      # hmm: /dev/mapper/uservg-user3lv
+      my $lv_name;
+
+      print "# dv=[$dv]\n";
+      $dv=~ s/--/=/g;
+      if ($dv =~ m#/dev/mapper/([\w=]+)-([\w=]+)$#)
+      {
+        my ($vg, $lv)= ($1, $2);
+        $vg=~ s/=/-/g;
+        $lv=~ s/=/-/g;
+        print "# vg=[$vg] lv=[$lv]\n";
+        $lv_name= join ('/', '/dev', $vg, $lv);
+      }
+      elsif ($dv =~ m#/dev/mapper/(base--os)-([\w]+)$#)
+      {
+        my ($vg, $lv)= ('base-os', $2); # Ubuntu :-/
+        $lv_name= join ('/', '/dev', $vg, $lv);
+        # TODO: is there a general rule about this name scheme?
+      }
+      else
+      {
+        print "device name '$dv' not recognized!\n";
+        exit (1);
+      }
+
+      my $c1= &locate_binary ('lvextend') . " -L '$sz' '$lv_name'";
+      my $c2;
+      if ($ty eq 'ext3' || $ty eq 'ext4')
+      {
+        $c2= &locate_binary ('resize2fs') . " -p '$lv_name'";
+      }
+      elsif ($ty eq 'xfs')
+      {
+        $c2= &locate_binary ('xfs_growfs') . " '$lv_name'";
+      }
+      else
+      {
+        print "unknown filesystem type '$ty' for '$dv'\n";
+        exit (3);
+      }
+
+      print "# perform these commands:\n";
+      print $c1, "\n";
+      print $c2, "\n";
+    }
+    else
+    {
+      &usage ("size not known '$sz'");
+    }
+
+  }
+}
+
+sub get_mount
+{
+  my @mount= split (/\n/, `/bin/mount`);
+  my %fs= ();
+  foreach my $l (@mount)
+  {
+    ## print "# >>> l='$l'\n";
+
+# /dev/mapper/uservg-user0lv on /u/user0 type ext3 (rw,_netdev,acl,usrquota,grpquota)
+    if ($l =~ /^(\S+)\s+on\s+(.+)\s+type\s+(\S+)\s+\(([^)]+)\)$/)
+    {
+      my ($dev, $fs, $ty, $opts)= ($1, $2, $3, $4);
+      my @opts= split (/,/, $opts);
+      $fs{$fs}=
+      {
+        'dev'  => $dev,
+        'fs'   => $fs,
+        'type' => $ty,
+        'opts' => \@opts,
+      };
+    }
+
+  }
+
+  \%fs;
+}
+
+sub locate_binary
+{
+  my $cmd= shift;
+
+  foreach my $path (@paths)
+  {
+    my $bin= join ('/', $path, $cmd);
+    return $bin if (-x $bin);
+  }
+
+  print "$cmd not found\n";
+  exit (1);
+  # return undef;
+}
+
+__END__
+
+=pod
+
+=head1 TODO
+
+=head2 VG names
+
+Ubuntu uses a VG named "F<base-os>" for the volume group where it's root
+filesystem resides.  In the F</dev/mappper/> directory, this becomes
+"F<base--os>".  Is this generally handled this way?  If so, the matching
+pattern needs to be modified.
+
+=head2 doit
+
+The script should possibly really perform the steps in a controlled
+manner.
+
+=cut
+

hacks/misc/fillup.pl

+#!/usr/bin/perl
+# $Id: fillup.pl,v 1.5 2015/10/20 09:26:45 gonter Exp $
+
+=head1 NAME
+
+  fillup.pl
+
+=head1 DESCRIPTION
+
+Simple script to fill up target directory with copies of some input
+file.  This can be used to overwrite a disk with (random) data.
+
+=head1 USAGE
+
+  -i <input-file>
+  -o <target-directory>
+  -c <count> ... only copy that many times
+  --mb <count> ... generate random file; number of MiB; (1048576 * $count bytes)
+  --dryrun ... only show what would be done
+  --doit   ... perform the copy
+
+=head1 NOTES
+
+A suitable input file may be generated with a command like that:
+
+  dd if=/dev/urandom of=urxn bs=1048576 count=1
+
+=head1 BUGS
+
+presumably.
+
+=head1 AUTHOR
+
+  g.gonter@ieee.org
+
+=cut
+
+use strict;
+
+my $input= 'urxn';
+my $output= 'D';
+my $dryrun= 1;
+my $cnt= -1;
+my $block_size= 1048576;
+my $mb_count= 4;
+my $in_mem= 0;
+
+my @PAR= ();
+while (my $arg= shift (@ARGV))
+{
+     if ($arg eq '--') { push (@PAR, @ARGV); }
+  elsif ($arg =~ /^--(.+)/)
+  {
+    my ($opt, $val)= split ('=', $1, 2);
+
+       if ($opt eq 'count') { $cnt= $val; }
+    elsif ($opt eq 'doit')  { $dryrun= 0; }
+    elsif ($opt eq 'dryrun' || $opt eq 'dry-run') { $dryrun= 1; }
+    elsif ($opt eq 'output') { $output= $val || shift (@ARGV); }
+    elsif ($opt eq 'bs') { $block_size= $val || shift (@ARGV); }
+    elsif ($opt eq 'mb') { $mb_count= $val || shift (@ARGV); }
+    elsif ($opt eq 'mem') { $in_mem= 1; }
+    else { usage(); }
+  }
+  elsif ($arg =~ /^-(.+)/)
+  {
+    my @opts= split ('', $1);
+    foreach my $opt (@opts)
+    {
+         if ($opt eq 'c') { $cnt=    shift (@ARGV); }
+      elsif ($opt eq 'i') { $input=  shift (@ARGV); }
+      elsif ($opt eq 'o') { $output= shift (@ARGV); }
+      elsif ($opt eq 'n') { $dryrun= 1; }
+      else { usage(); }
+    }
+  }
+  else { &usage; }
+}
+
+sub usage
+{
+  system ("perldoc $0");
+  exit (0);
+}
+
+my $file_size= $block_size*$mb_count;
+print "file_size=[$file_size]\n";
+if (!-f $input || (stat(_))[7] < $file_size)
+{ # create input file if it does not exist or is too small
+  my @cmd= ('dd', 'if=/dev/urandom', "of=$input", "bs=$block_size", "count=$mb_count");
+  print ">>> ", join (' ', @cmd), "\n";
+  system (@cmd);
+}
+
+unless (-d $output)
+{
+  system ("mkdir $output");
+}
+
+my $buffer;
+if ($in_mem)
+{
+  unless (open (FI, '<:raw', $input))
+  {
+    die "can not read input file '$input'";
+  }
+  sysread (FI, $buffer, $file_size);
+}
+
+my $start= time();
+my $i= 0;
+while (1)
+{
+  if ($cnt > 0 && $i >= $cnt)
+  {
+    print "count exceeded\n";
+    last;
+  }
+
+  $i++;
+
+  my $dest= sprintf ("%s/%08d.fillup", $output, $i);
+  my @st;
+
+  if (@st= stat ($dest))
+  {
+    print "destination [$dest] exists, skipping!\n";
+    next;
+  }
+
+  my @c= ('cp', $input, $dest);
+
+  if ($dryrun)
+  {
+    print join (' ', @c), "\n";
+    if ($i >= 20)
+    {
+      print "enough for a dryrun!\n";
+      last;
+    }
+  }
+  else
+  {
+    if ($in_mem)
+    {
+      if (open (FO, '>:raw', $dest))
+      {
+        my $wr_size= syswrite (FO, $buffer, $file_size);
+        if ($wr_size != $file_size)
+        {
+          print "write_size ($wr_size) does not match file_size ($file_size)\n";
+          last;
+        }
+      }
+      else
+      {
+        print "can not open to $dest; exiting\n";
+        last;
+      }
+    }
+    else
+    {
+      my $rc= system (@c);
+      print join (' ', @c), ", rc='$rc'\n";
+      if ($rc)
+      {
+        print "copy return code=[$rc]; stopping\n";
+        last;
+      }
+    }
+  }
+}
+
+my $finish= time();
+print "start:  ", scalar localtime ($start), "\n";
+print "finish: ", scalar localtime ($finish), "\n";
+printf ("duration: %d seconds\n", $finish-$start);

hacks/nim/lsnim.pl

+#!/usr/bin/perl
+# $Id: lsnim.pl,v 1.1 2008/12/09 16:47:21 gonter Exp $
+
+=pod
+
+=head1 lsnim.pl
+
+This script modifies the behaviour of the lsnim command.
+
+Output of "lsnim -t lpp_source" is sorted which makes it easier to
+navigate on NIM clients when performing software maintenance.
+
+=head1 installation
+
+This script should be found as /usr/sbin/lsnim.pl
+
+mv -i /usr/sbin/lsnim /usr/sbin/lsnim.bin
+ln -s /usr/sbin/lsnim.pl /usr/sbin/lsnim
+
+=cut
+
+use strict;
+
+my $bin= '/usr/sbin/lsnim.bin';
+
+if ($ARGV[0] eq '-t' && $ARGV[1] eq 'lpp_source')
+{
+  system ("$bin -t lpp_source | sort");
+}
+else
+{
+  exec $bin, @ARGV;
+}

modules/README

+$Id: README,v 1.7 2010/10/21 11:18:39 gonter Exp $
+
+These are a couple of AIX specific Perl modules that might be
+useful for others.  This should be usable using AIX 4.2 and
+later versions.
+
++gg 2000-02-27
+
+Furthermore, /modules/san/ contains various modules and script which
+are intended for storage systems using EMC, IBM, and Brocade devices.
+
+/modules/hp/ contains modules for HP machines running Linux.
+
++gg 2010-10-21
+
+
+There are also Modules on CPAN, which are not part of
+this repository:
+
+AIX::ODM
+  see: http://search.cpan.org/~dfrench/AIX-ODM-1.0.2/ODM.pm
+
+The following Perl packages are defined here:
+
+AIX::odm
+  simple ODM command interface
+
+AIX::NIM::Config
+AIX::NIM::Object
+  ./nim/
+  mostly NIM configuration parsing
+  The stanza format that is generated by commands like "lsnim -l" is
+  quite generic, so I'm using this format as a configuration file format
+  for several purposes, even when the environment is not AIX.
+
+AIX::Software::Maintenance
+  ./sw-maint/
+  Software Maintenance, e.g. things that involve lslpp and it's relatives
+  
+AIX::System::Stanza::Entry
+AIX::System::Stanza::Comment
+AIX::System::Stanza
+  ./sys-stanza/
+
+AIX::dev::atm::stats
+AIX::dev::atm::attr
+AIX::dev::atm
+  ./dev-atm/
+
+
+AUTHOR
+
+Gerhard Gonter E<ggonter@cpan.orgE>
+
+See http://aix-pm.sourceforge.net/ for more information.
+
+COPYRIGHT AND LICENSE
+
+Copyright (C) 2006..2008 by Gerhard Gonter
+
+This is free software; you can redistribute and/or modify it
+under the same terms as Perl itself.
+

modules/dev-atm/atm.pm

+#
+# FILE AIX/dev/atm.pm
+#
+# encapsulation for AIX ATM device information
+# packages:
+# + AIX::dev::atm::stats    run time statistics
+# + AIX::dev::atm::attr     boot time attributes
+# + AIX::dev::atm           container class
+#
+# written:       2000-01-15
+# latest update: 2000-03-08 15:29:00
+# $Id: atm.pm,v 1.2 2000/03/08 21:11:19 gonter Exp $
+#
+
+use strict;
+
+# ----------------------------------------------------------------------------
+package AIX::dev::atm::stats;
+
+# translation for device statistics into object attributes
+my %Turboways_Stats=
+(
+ 'Packets Dropped - No small DMA buffer' => '',
+ 'Packets Dropped - No medium DMA buffer' => '',
+ 'Packets Dropped - No large DMA buffer' => '',
+ 'Receive Attempted - No Adapter Receive Buffer' => '',
+ 'Transmit Attempted - No small DMA buffer' => '',
+ 'Transmit Attempted - No medium DMA buffer' => '',
+ 'Transmit Attempted - No large DMA buffer' => '',
+ 'Transmit Attempted - No MTB DMA buffer' => '',
+ 'Transmit Aborted - No Adapter Transmit Buffer' => '',
+ 'Max Hardware transmit queue length' => '',
+ 'Small Mbuf in Use'      => 'used_sml_bufs',
+ 'Medium Mbuf in Use'     => 'used_med_bufs',
+ 'Large Mbuf in Use'      => 'used_lrg_bufs',
+ 'Huge Mbuf in Use'       => 'used_hug_bufs',
+ 'MTB Mbuf in Use'        => 'used_spec_bufs',
+ 'Max Small Mbuf in Use'  => 'max_sml_bufs',
+ 'Max Medium Mbuf in Use' => 'max_med_bufs',
+ 'Max Large Mbuf in Use'  => 'max_lrg_bufs',
+ 'Max Huge Mbuf in Use'   => 'max_hug_bufs',
+ 'Max MTB Mbuf in Use'    => 'max_spec_bufs',
+ 'Small Mbuf overflow'    => 'err_sml_bufs',
+ 'Medium Mbuf overflow'   => 'err_med_bufs',
+ 'Large Mbuf overflow'    => 'err_lrg_bufs',
+ 'Huge Mbuf overflow'     => 'err_hug_bufs',
+ 'MTB Mbuf overflow'      => 'err_spec_bufs'
+);
+
+sub new
+{
+  my $class= shift;
+  my $dev= shift;
+  my %par= @_;
+
+  # print ">> new stats $dev\n";
+  my $stat_driver= {};
+  my $res=
+  {
+    'device' => $dev,
+    'time' => time,
+    'general' => {},   # general statistics
+    'xmit' => {},      # transfer statistics
+    'recv' => {},      # receive statistics
+    'driver' => $stat_driver,    # driver dependant statistics
+  };
+
+  my $section= '?';
+  my $in;
+
+  if ($par{'is_file'})
+  {
+    $in= $dev;
+  }
+  else
+  {
+    $in= "/usr/ucb/netstat -v $dev|";
+  }
+
+  open (NETSTAT, $in) || die;
+
+  while (<NETSTAT>)
+  {
+    chop;
+    if (/^[\- ]+$/) { next; }
+    elsif (/Turboways ATM Adapter Specific Statistics:/)
+    {
+      $section= 'Turboways';
+      next;
+    }
+
+    if ($section eq 'Turboways')
+    {
+      my ($desc, $value)= split (/: */);
+      # print "desc='$desc' value='$value'\n";
+      # print " '$desc' => '',\n";
+      my $tlt= $Turboways_Stats{$desc};
+      $stat_driver->{$tlt}= $value if ($tlt);
+    }
+  }
+  close (NETSTAT);
+
+  bless $res;
+}
+
+# ----------------------------------------------------------------------------
+package AIX::dev::atm::attr;
+### sub get_acceptable_range
+### {
+###   my $av= shift;
+###   my $a;
+### 
+###   foreach $a (@$av)
+###   {
+###     $a->{range}= `lsattr -R -l atm0 -R -a $a->{attribute}`;
+###   }
+### }
+
+sub log_watch
+{
+  my $obj= shift;
+  my @keys= @_;
+  my $attr= $obj->{LOG_WATCH};
+
+  my $a;
+  foreach $a (@keys)
+  {
+    $attr->{$a}= 1;
+  }
+}
+
+sub print_attr
+{
+  my $obj= shift;
+  my @keys= @_;
+
+  my $attr= $obj->{AV_hash};
+  @keys= sort keys %$attr if ($#keys == -1);
+
+  my $a;
+  foreach $a (@keys)
+  {
+    my $av= $attr->{$a};
+    printf ("%-16s %-10s %5s %s\n",
+            map { $av->{$_} } qw(attribute value settable description));
+  }
+}
+
+sub new
+{
+  my $class= shift;
+  my $dev= shift;
+
+  # print ">> new attr $dev\n";
+  my @AV;    # attribute values
+  my %AV;
+
+  open (LSATTR, "/usr/sbin/lsattr -El $dev|") || die;
+
+  while (<LSATTR>)
+  {
+    chop;
+    # attribute  value  description user_settable
+    my ($attribute, $value, @rest)= split;
+
+    my $attr=
+    {
+      'attribute' => $attribute,
+      'value' => $value,
+      'settable' => pop (@rest),
+      'description' => join (' ', @rest),
+    };
+
+    push (@AV, $attr);
+    $AV{$attribute}= $attr;
+  }
+
+  close (LSATTR);
+
+  my $res=
+  {
+    'adapter' => $dev,
+    'AV_list' => \@AV,
+    'AV_hash' => \%AV,
+  };
+
+  bless $res;
+}
+
+# ----------------------------------------------------------------------------
+package AIX::dev::atm;
+
+my @mbufs= qw(hug_bufs lrg_bufs med_bufs sml_bufs spec_bufs);
+
+sub new
+{
+  my $class= shift;
+  my $adapter= shift;
+  my $nw_device= shift;
+  my $obj=
+  {
+    'adapter' => $adapter,
+    'nw_device' => $nw_device,
+  };
+  bless $obj;
+}
+
+sub attributes
+{
+  my $obj= shift;
+  unless (defined ($obj->{attributes}))
+  {
+    $obj->{attributes}= new AIX::dev::atm::attr ($obj->{adapter});
+  }
+
+  $obj->{attributes};
+}
+
+sub statistics
+{
+  my $obj= shift;
+  $obj->{statistics}= new AIX::dev::atm::stats ($obj->{nw_device});
+}
+
+sub print_attr
+{
+  my $obj= shift;
+  $obj->{attributes}->print_attr (@_);
+}
+
+sub diag_mbuf
+{
+  my $obj= shift;
+  my %arg= @_;
+  my $verbose= $arg{'verbose'};
+
+  my $attr= $obj->attributes;
+  my $av= $attr->{AV_hash};
+  my $stat= $obj->statistics;
+  my $sd= $stat->{'driver'};    # driver dependant statistics
+
+  my $idx;
+
+  printf ("%-16s %10s %10s %10s | %10s %5s\n",
+          qw(name used alloc max errors diag));
+  my $a;
+  my @res;       # result set
+  my $res= 'ok'; # total results
+  foreach $a (@mbufs)
+  {
+    my $used=      $sd->{"used_$a"};
+    my $allocated= $sd->{"max_$a"};
+    my $errors=    $sd->{"err_$a"};
+    my $max=       $av->{"max_$a"}->{value};
+
+    my $diag= 'ok';
+    if ($allocated >= $max)
+    {
+      $diag= 'full';
+      $diag= 'danger' if ($used > ($max * 9/10));
+      $diag= 'crash'  if ($used >= $max);
+    }
+
+    if ($diag eq 'ok') {} # NOP
+    elsif ($diag eq 'crash') { $res= 'crash'; }
+    elsif ($diag eq 'danger' && ($res eq 'ok' || $res eq 'full'))
+                { $res= 'danger'; }
+    elsif ($diag eq 'full' && $res eq 'ok') { $res= 'full'; }
+
+    push (@res, "$a=$diag");
+
+    if ($verbose)
+    {
+      printf ("%-16s %10ld %10ld %10ld | %10ld %5s\n",
+              $a, $used, $allocated, $max, $errors, $diag);
+    }
+  }
+
+  ($res, @res);
+}
+
+1;
+

modules/fs/SSA_disks.pm

+#!/usr/local/bin/perl
+# $Id: SSA_disks.pm,v 1.1 2006/05/05 10:26:38 gonter Exp $
+
+use strict;
+use AIX::fs::vg;
+use MIME::Media_Types;
+
+package AIX::fs::SSA_disks;
+
+my %LV_TYPE_not_listed= map { $_ => 1 } qw(boot paging jfslog);
+
+sub new
+{
+  my $class= shift;
+  my $obj=
+  {
+    'pdisk2hdisk' => {},
+    'hdisk2pdisk' => {},
+    'hdisk2vg' => {},
+
+    'pdisks' => {},  # information about pdisks
+    'vgs' => {},     # information about VGs
+  };
+  bless $obj;
+}
+
+sub print_vg_html
+{
+  my $obj= shift;
+
+  my $vgs= $obj->{'vgs'};
+  my $pdisks= $obj->{'pdisks'};
+
+  my %pdisk_printed= (); # names of pdisks printed
+
+  print <<EOX;
+<table border=1>
+<tr>
+  <th>VG</th>
+  <th>hdisk</th>
+  <th>pdisk</th>
+  <th>location</th>
+  <th>remarks</th>
+</tr>
+EOX
+
+  my $vg_name;
+  foreach $vg_name (sort keys %$vgs)
+  {
+    my $vg= $vgs->{$vg_name};
+    my $d= $obj->get_vg_disk_data ($vg);
+    my $t_num_pdisks= $d->{num_pdisks};
+
+    ## &MIME::Media_Types::print_refs (*STDOUT, $vg_name, $d);
+
+    my $vg_printed= 0;
+    my $vg_printed_comment= 0;
+
+    my $hd_info= $d->{hd};
+    my ($hdi, $pd_name);
+    foreach $hdi (@$hd_info)
+    {
+      my $hd_name= $hdi->{'name'};
+      my $pd_info= $hdi->{'pdisks'};
+
+      my $hd_printed= 0;
+      my $num_pdisks= @$pd_info;
+      unless ($num_pdisks)
+      {
+	$pd_info= [ 'non-ssa' ];
+        $num_pdisks= 1;
+      }
+
+# print __LINE__, "  num_pdisks=$num_pdisks pd_info=$pd_info\n";
+      foreach $pd_name (@$pd_info)
+      {
+        print "<tr>\n";
+	unless ($vg_printed)
+	{
+          print "  <td rowspan=$t_num_pdisks><a href=\"#vg:$vg_name\">$vg_name</a></td>\n";
+	  $vg_printed= 1;
+        }
+
+	unless ($hd_printed)
+	{
+          print "  <td rowspan=$num_pdisks>$hd_name</td>\n";
+	  $hd_printed= 1;
+	}
+
+        if ($pd_name eq 'non-ssa')
+	{
+          print "  <td colspan=2>&nbsp;</td>\n";
+	}
+	else
+	{
+	  my $loc= $pdisks->{$pd_name}->{'location'};
+          print "  <td>$pd_name</td>\n";
+          print "  <td>$loc</td>\n";
+	  $pdisk_printed{$pd_name}++;
+	}
+
+	unless ($vg_printed_comment)
+	{
+	  my $vg_comment= $vg->{'vg_remark'} || '&nbsp;';
+          print "  <td rowspan=$t_num_pdisks>$vg_comment</td>\n";
+	  $vg_printed_comment= 1;
+        }
+
+        print "</tr>\n";
+      }
+    }
+  }
+
+  my $pd;
+  foreach $pd (sort keys %$pdisks)
+  {
+    my $pdi= $pdisks->{$pd};
+    my $pd_name= $pdi->{'name'};
+    next if ($pdisk_printed{$pd_name});
+
+    my $pd_loc=  $pdi->{'location'};
+
+    print "<tr><td colspan=2>&nbsp;</td>\n";
+          print "  <td>$pd_name</td>\n";
+          print "  <td>$pd_loc</td>\n";
+        print "</tr>\n";
+  }
+
+  print <<EOX;
+</table>
+<h1>Volume Groups</h1>
+EOX
+
+  foreach $vg_name (sort keys %$vgs)
+  {
+    my $vg= $vgs->{$vg_name};
+    my $lsvg= $vg->{'lsvg HTML'};
+    next unless ($lsvg);
+
+    print <<EOX;
+<hr>
+<h2><a name="vg:$vg_name">$vg_name</a></h2>
+EOX
+    print "<pre>\n", $lsvg, "</pre>\n";
+  }
+}
+
+sub get_vg_disk_data
+{
+  my $obj= shift;
+  my $vg= shift;
+
+  my $num_t_pdisks= 0;
+
+  my $h2p= $obj->{'hdisk2pdisk'};
+  my @hdisks= sort @{$vg->{'hdisks'}};
+
+  my $hd_info= [];
+  my $res=
+  {
+    'hd' => $hd_info,
+  };
+
+  my ($hdisk, $pdisk);
+  foreach $hdisk (@hdisks)
+  {
+    my @pdisks= &get_pdisk_list ($h2p, $hdisk);
+    my $hdx= { 'name' => $hdisk, 'pdisks' => \@pdisks };
+    push (@$hd_info, $hdx);
+    $num_t_pdisks += @pdisks || 1 ;
+  }
+
+  $res->{num_pdisks}= $num_t_pdisks;
+  $res;
+}
+
+sub get_pdisk_list
+{
+  my $h2p= shift;
+  my $hd= shift;
+  my $pdisks= $h2p->{$hd};
+  ## print "hd: $h2p $hd -> $pdisks\n";
+  return () unless ($pdisks);
+  return @{$pdisks};
+}
+
+sub map_hdisk_vg
+{
+  my $obj= shift;
+
+  my $cmd= "/usr/sbin/lspv";
+  my @res= split (/\n/, `$cmd`);
+  my $h2vg= $obj->{hdisk2vg};
+  my $vgs= $obj->{vgs};
+  my $l;
+  foreach $l (@res)
+  {
+    ## print "[$l]\n";
+    my ($hdisk, $hd_id, $vg_name)= split (' ', $l);
+
+    # next if ($vg_name eq 'None');
+
+    $h2vg->{$hdisk}= $vg_name;
+    my $vg= $vgs->{$vg_name};
+    unless (defined ($vg))
+    {
+      $vg= new AIX::fs::vg ($vg_name);
+      $vgs->{$vg_name}= $vg;
+    }
+    push (@{$vg->{hdisks}}, $hdisk);
+  }
+}
+
+sub add_vg_remarks
+{
+  my $obj= shift;
+  my $vg_name= shift;
+
+  my $vgs= $obj->{vgs};
+  my $vgc= \$vgs->{$vg_name}->{'vg_remark'};
+  $$vgc .= join ("\n", @_) if (defined ($vgc));
+}
+
+sub lsvg_get_lvfs
+{
+  my $obj= shift;
+  my $vg_name= shift;
+
+  my $vgp= $obj->{vgs}->{$vg_name};
+  my $cmd= "lsvg -l '$vg_name'";
+  ## print ">>> $cmd\n";
+  my $res= `$cmd`;
+  $vgp->{'lsvg -l'}= $res;
+
+  my @res= split ("\n", $res);
+  my @res2= ();
+  my @ptrs= ();
+  my $l;
+  while ($l= shift (@res))
+  {
+    ## print ">>>> $l\n";
+    if ($l =~ /^(\w+):/) {} # { $l= "<a name=\"vg:$1\">$1</a>"; } # VG name
+    elsif ($l =~ /^LV NAME/) {}
+    else
+    {
+      my ($lv_name, $type, $lps, $pps, $pvs, $lv_state, $mp)= split (' ', $l, 7);
+      ## print "lv_name='$lv_name' mp='$mp'\n";
+      $l=~ s|$lv_name|<a name=\"lv:$lv_name\">$lv_name</a>|;
+
+      next if (exists ($LV_TYPE_not_listed{$type}));
+      my $ptr= "<a href=\"#lv:$lv_name\">$mp</a>";
+      push (@ptrs, $ptr);
+    }
+
+    push (@res2, $l);
+  }
+
+  $vgp->{'lsvg HTML'}= `lsvg '$vg_name'` . "<br>" . join ("\n", @res2) . "\n";
+
+  ($vgp, \@ptrs);
+}
+
+sub upd_vg_fs
+{
+  my $obj= shift;
+
+  my $vgs= $obj->{vgs};
+  my @vg_names= keys %$vgs;
+  ## print "VG Names: ", join (',', @vg_names), "\n";
+  my $vg_name;
+  foreach $vg_name (@vg_names)
+  {
+    next if ($vg_name eq 'None');
+
+    my ($vgp, $ptrs)= $obj->lsvg_get_lvfs ($vg_name);
+    if (@$ptrs)
+    {
+      my $vgc= \$vgp->{'vg_remark'};
+      $$vgc .= "<ul>\n<li>" . join ("\n<li>", @$ptrs) . "\n</ul>\n";
+    }
+  }
+}
+
+sub read_vg_remarks
+{
+  my $obj= shift;
+  my $fnm= shift;
+
+  return undef unless open (FI, $fnm);
+
+  # print "reading $fnm\n";
+  my $vgs= $obj->{vgs};
+  my $vg_name;
+  my $vgc= undef;
+  while (<FI>)
+  {
+    chop;
+    next if (/^#/|| /^\s*$/);
+
+    if (/^\[(.+)\]/)
+    {
+      $vg_name= $1;
+      $vgc= \$vgs->{$vg_name}->{'vg_remark'};
+      next;
+    }
+    $$vgc .= $_ if (defined ($vgc));
+  }
+  close (FI);
+}
+
+sub map_pdisk_hdisk
+{
+  my $obj= shift;
+  my @pdisks= @_;
+
+  my $p2h= $obj->{pdisk2hdisk};
+  my $h2p= $obj->{hdisk2pdisk};
+  my $pdisk;
+  foreach $pdisk (@pdisks)
+  {
+    my $cmd= "/usr/sbin/ssaxlate -l '$pdisk'";
+    ### print ">>> $cmd\n";
+    my $r= `$cmd`;
+    chop ($r);
+    $r=~ s/\s*//g;  # sometimes printed with space at the end!
+    ### print ">>> pdisk zu hdisk: [$pdisk] [$r]\n";
+    $p2h->{$pdisk}= $r;
+    push (@{$h2p->{$r}}, $pdisk);
+  }
+}
+
+sub ssa_pdisk_list
+{
+  my $obj= shift;
+
+  my $cmd= "/usr/sbin/lsdev -CS1 -cpdisk -sssar -F name";
+  my @res= split (' ', `$cmd`);
+  my %r2= map { $_ => { 'name' => $_ } } @res;
+  $obj->{pdisks}= \%r2;
+
+  $cmd= "/usr/sbin/lscfg";
+  my @res2= split ("\n", `$cmd`);
+  my $l;
+  foreach $l (@res2)
+  {
+    ## print "[$l]\n";
+    if ($l =~ /^\+ (pdisk\d+)\s+(\S+)\s+(.+)/)
+    {
+      my ($pdisk, $location, $comment)= ($1, $2, $3);
+      $r2{$pdisk}->{'location'}= $location;
+      $r2{$pdisk}->{'comment'}= $comment;
+    }
+  }
+
+  @res;
+}
+
+1;

modules/fs/vg.pm

+#!/usr/local/bin/perl
+
+package AIX::fs::vg;
+
+sub new
+{
+  my $class= shift;
+
+  my $vg_name= shift;
+  my $vg_id= shift;
+
+  my $obj= { 'vg_name' => $vg_name };
+  $obj->{'vg_id'}= $vg_id if ($vg_id);
+
+  bless $obj;
+}
+
+1;

modules/hp/HP/ACU.pm

+#!/usr/bin/perl
+# $Id: ACU.pm,v 1.1 2010/10/21 11:02:16 gonter Exp $
+
+use strict;
+use Data::Dumper;
+use HP::ACU::array;
+
+package HP::ACU;
+
+my $hpacucli= '/usr/sbin/hpacucli';
+
+my %ignore= map { $_ => 1 } (
+  q[FIRMWARE UPGRADE REQUIRED: A firmware update is recommended for this controller],
+  q[                           to prevent rare potential data write errors on a],
+  q[                           RAID 1 or RAID 1+0 volume in a scenario of],
+  q[                           concurrent background surface analysis and I/O write],
+  q[                           operations.  Please refer to Customer Advisory],
+  q[                           c01587778 which can be found at hp.com.],
+  q[Warning: Deleting an array can cause other array letters to become renamed.],
+  q[         E.g. Deleting array A from arrays A,B,C will result in two remaining],
+  q[         arrays A,B ... not B,C],
+);
+
+# print "ignore: ", Dumper (\%ignore), "\n";
+
+sub new
+{
+  my $class= shift;
+  my %par= @_;
+
+  my $obj= { 'ctrl_slot' => 0 };
+  bless $obj, $class;
+  $obj->reset ();
+
+  foreach my $par (keys %par)
+  {
+    if ($par eq 'pd_watch')
+    { # list of physical drives to watch
+      my $v= $par{$par};
+      my $p= $obj->{'pd_watch'};
+      $p= $obj->{'pd_watch'}= {} unless (defined($p));
+
+         if (ref($v) eq 'HASH')  { map { $obj->watch ($_, $v->{$_}); } keys %$v; }
+      elsif (ref($v) eq 'ARRAY') { map { $obj->watch ($_); } @$v; }
+    }
+    else
+    {
+      $obj->{$par}= $par{$par};
+    }
+  }
+  
+  $obj;
+}
+
+sub reset
+{
+  my $obj= shift;
+
+  map { $obj->{$_}= {}; } qw(array pd_id ld_id);
+}
+
+=pod
+
+=head2 $acu->watch (name, [an => av]*);
+
+
+=cut
+
+sub watch
+{
+  my $obj= shift;
+  my $pd_id= shift;
+  my %par= @_;
+
+  my $p= $obj->{'pd_watch'}->{$pd_id};
+  unless (defined ($p))
+  {
+    $p= $obj->{'pd_watch'}->{$pd_id}= {};
+  }
+
+  $p->{'watched'}= 1;
+  $p->{'pd_id'}= $pd_id;
+
+  foreach my $par (keys %par)
+  {
+    $p->{$par}= $par{$par};
+  }
+
+  $p;
+}
+
+=pod
+
+=head2 $acu->watched ([name]);
+
+if name is specified, return watched disks data,
+otherwise return sorted list of watched disks names.
+
+=cut
+
+sub watched
+{
+  my $obj= shift;
+  my $name= shift;
+
+  my $w= $obj->{'pd_watch'};
+
+  unless (defined ($w))
+  {
+    $w= $obj->{'pd_watch'}= {};
+  }
+
+  if (defined ($name))
+  {
+    my $x= $w->{$name};
+    unless (defined ($x))
+    {
+      $x= $w->{$name}= {};
+    }
+    return $x;
+  }
+
+  return sort keys %$w;
+}
+
+sub array
+{
+  my $obj= shift;
+  my $name= shift;
+  
+  unless (exists ($obj->{'array'}->{$name}))
+  {
+    $obj->{'array'}->{$name}= new HP::ACU::array;
+  }
+
+  $obj->{'array'}->{$name};
+}
+
+sub ld_create
+{
+  my $obj= shift;
+  my $drives= shift;
+
+  my $ctrl= $obj->{'ctrl_slot'};
+
+  $obj->get_cmd ("$hpacucli ctrl slot=$ctrl create type=ld drives=$drives");
+}
+
+sub ld_delete
+{
+  my $obj= shift;
+  my $ld_id= shift;
+
+  my $ctrl= $obj->{'ctrl_slot'};
+  my $cmd= "$hpacucli ctrl slot=$ctrl ld $ld_id delete forced";
+
+  $obj->get_cmd ($cmd);
+}
+
+sub get_config
+{
+  my $obj= shift;
+
+  my $ctrl= $obj->{'ctrl_slot'};
+
+  $obj->get_cmd ("$hpacucli ctrl slot=$ctrl pd all show");
+  $obj->get_cmd ("$hpacucli ctrl slot=$ctrl ld all show");
+  # $obj->get_cmd ("$hpacucli ctrl slot=$ctrl array all show");
+
+  my @arrays= sort keys %{$obj->{'array'}};
+  my $pd_watch= $obj->{'pd_watch'};
+
+  foreach my $array (@arrays)
+  {
+    # XXX next if ($array eq 'A'); # system disks!
+
+    # $obj->get_cmd ("$hpacucli ctrl slot=$ctrl array all show");
+    print "array=[$array]\n";
+    my $ua= $obj->{'array'}->{$array};
+    my $uap= $ua->{'pd_id'};
+
+    my $watched= 0;
+    foreach my $ua_disk (keys %$uap)
+    {
+      next unless (exists ($pd_watch->{$ua_disk}));
+      $obj->get_cmd ("$hpacucli ctrl slot=$ctrl pd $ua_disk show");
+      $watched++;
+    }
+
+    if ($watched)
+    {
+      my $ldp= $ua->{'ld_id'};
+      foreach my $ld_id (keys %$ldp)
+      {
+        $obj->get_cmd ("$hpacucli ctrl slot=$ctrl ld $ld_id show");
+      }
+    }
+  }
+}
+
+sub get_cmd
+{
+  my $obj= shift;
+  my $cmd= shift;
+
+  print ">>> $cmd\n";
+
+  open (CMD, $cmd . '|') or die;
+
+  my $state= undef;
+  my $array= undef;
+  my $array_name= 'unknown';
+  my $physicaldrive= undef;
+  my $logicaldrive= undef;
+
+  my $show_lines= ($obj->{'verbose'} >= 1) ? 1 : 0;
+
+  while (<CMD>)
+  {
+    chop;
+
+    next if ($_ eq '' || exists ($ignore{$_}));
+
+    print "[$_]\n" if ($show_lines);
+
+    if ($_ =~ q[Smart Array 6i in Slot (\d+) ])
+    {
+    }
+    elsif ($_ eq q[   unassigned])
+    {
+      $state= 'array';
+      $array= $obj->array ($array_name= 'unassigned');
+    }
+    elsif ($_ =~ m[^   array (\S+)])
+    {
+      $array_name= $1;
+      $array= $obj->array ($array_name);
+
+      $state= 'array';
+    }
+    elsif ($_ =~ m[^      physicaldrive ((\d+):(\d+))])
+    {
+      my ($pd_id, $port, $id)= ($1, $2, $3);
+      $physicaldrive= $array->physicaldrive ($pd_id); 
+
+      $state= 'physicaldrive';
+      $obj->{'pd_id'}->{$pd_id}= $array_name;
+    }
+    elsif ($_ =~ m[^      logicaldrive (\d+) ])
+    { # just a listing of logical drives
+      my $ld_id= $1;
+      $logicaldrive= $array->logicaldrive ($ld_id); 
+      $state= undef;
+      $obj->{'ld_id'}->{$ld_id}= $array_name;
+    }
+    elsif ($_ =~ m[^      Logical Drive: (\d+)])
+    { # more details about a logical drive
+      my $ld_id= $1;
+      $logicaldrive= $array->logicaldrive ($ld_id); 
+      $state= 'logicaldrive';
+      $obj->{'ld_id'}->{$ld_id}= $array_name;
+    }
+    elsif ($_ =~ m[^         (.+):\s+(.+)])
+    {
+      my ($an, $av)= ($1, $2);
+
+      if ($state eq 'physicaldrive')
+      {
+        $physicaldrive->{$an}= $av;
+        # push (@{$physicaldrive->{'_'}}, $_);
+      }
+      elsif ($state eq 'logicaldrive')
+      {
+        $logicaldrive->{$an}= $av;
+      }
+      else
+      {
+        goto UNKNOWN;
+      }
+    }
+    else
+    {
+UNKNOWN:
+      print __LINE__, " >>> [$_]\n";
+    }
+
+  }
+  close (CMD);
+}
+
+1;
+__END__

modules/hp/HP/ACU/array.pm

+#!/usr/bin/perl
+# $Id: array.pm,v 1.1 2010/10/21 11:02:16 gonter Exp $
+
+use strict;
+use Data::Dumper;
+
+use HP::ACU::item;
+
+package HP::ACU::array;
+
+sub new
+{
+  my $class= shift;
+  my $obj= {};
+  bless $obj, $class;
+  $obj;
+}
+
+sub physicaldrive
+{
+  my $obj= shift;
+  my $pd_id= shift;
+
+  unless (exists ($obj->{'pd_id'}->{$pd_id}))
+  {
+    $obj->{'pd_id'}->{$pd_id}= new HP::ACU::item;
+  }
+
+  $obj->{'pd_id'}->{$pd_id};
+}
+
+sub logicaldrive
+{
+  my $obj= shift;
+  my $ld_id= shift;
+
+  unless (exists ($obj->{'ld_id'}->{$ld_id}))
+  {
+    $obj->{'ld_id'}->{$ld_id}= new HP::ACU::item;
+  }
+
+  $obj->{'ld_id'}->{$ld_id};
+}
+
+1;

modules/hp/HP/ACU/item.pm

+#!/usr/bin/perl
+# $Id: item.pm,v 1.1 2010/10/21 11:02:16 gonter Exp $
+
+use strict;
+use Data::Dumper;
+
+package HP::ACU::item;
+
+sub new
+{
+  my $class= shift;
+  my $obj= {};
+  bless $obj, $class;
+  $obj;
+}
+
+1;

modules/hp/HP/ACU/physicaldrive.pm

+#!/usr/bin/perl
+# $Id: physicaldrive.pm,v 1.1 2010/10/21 11:02:16 gonter Exp $
+
+use strict;
+use Data::Dumper;
+
+package HP::ACU::physicaldrive;
+
+sub new
+{
+  my $class= shift;
+  my $obj= {};
+  bless $obj, $class;
+  $obj;
+}
+
+sub physicaldrive
+{
+  my $obj= shift;
+  my $port= shift;
+  my $id= shift;
+
+  unless (exists ($obj->{'port'}->{$port}->{$id}))
+  {
+    $obj->{'port'}->{$port}->{$id}= new HP::ACU::physicaldrive;
+  }
+
+  $obj->{'port'}->{$port}->{$id};
+}
+
+1;