Solaris::DeviceTree::Libdevinfo - Perl interface to the Solaris devinfo library

  use Solaris::DeviceTree::Libdevinfo;
  $tree = Solaris::DeviceTree::Libdevinfo->new;

  $path = $node->devfs_path;
  $nodename = $node->node_name;
  $bindingname = $node->binding_name;
  $busaddr = $node->bus_addr;
  @cnames = $devtree->compatible_names;
  $drivername = $devtree->driver_name;
  %ops = $devtree->driver_ops;
  $inst = $node->instance;
  %state = $node->state;
  $id = $node->nodeid;
  if( $node->is_pseudo_node ) { ... }
  if( $node->is_sid_node ) { ... }
  if( $node->is_prom_node ) { ... }
  $props = $node->props;
  $promprops = $node->prom_props;
  @minor = $node->minor_nodes;

     di_binding_name               di_bus_addr
     di_child_node                 di_compatible_names
     di_devfs_path                 di_devfs_path_free
     di_devid                      di_driver_name
     di_driver_ops                 di_drv_first_node
     di_drv_next_node              di_fini
     di_init                       di_instance
     di_minor_class                di_minor_devt
     di_minor_name                 di_minor_next
     di_minor_nodetype             di_minor_spectype
     di_minor_type                 di_node_name
     di_nodeid                     di_parent_node
     di_prom_fini                  di_prom_init
     di_prom_prop_data             di_prom_prop_lookup_bytes
     di_prom_prop_lookup_ints      di_prom_prop_lookup_strings
     di_prom_prop_name             di_prom_prop_next
     di_prop_bytes                 di_prop_devt
     di_prop_ints                  di_prop_lookup_bytes
     di_prop_lookup_ints           di_prop_lookup_strings
     di_prop_name                  di_prop_next
     di_prop_strings               di_prop_type
     di_sibling_node               di_state
     di_walk_minor                 di_walk_node

  BUS
  CB
  STREAM

  DRIVER_DETACHED
  DEVICE_OFFLINE
  DEVICE_DOWN
  BUS_QUIESCED
  BUS_DOWN

  PSEUDO
  SID
  PROM

#
# $Header: /cvsroot/devicetool/Solaris-DeviceTree/lib/Solaris/DeviceTree/Libdevinfo.pm,v 1.9 2003/12/12 11:11:55 honkbude Exp $
#

package Solaris::DeviceTree::Libdevinfo;

use 5.006;
use strict;
use warnings;
use Carp;
use English;

our @ISA = qw( Solaris::DeviceTree::Node );
our $VERSION = do { my @r = (q$Revision: 1.9 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; # must be all one line, for MakeMaker

use Solaris::DeviceTree::Libdevinfo::Impl;
use Solaris::DeviceTree::Libdevinfo::MinorNode;
use Solaris::DeviceTree::Libdevinfo::Property;
use Solaris::DeviceTree::Libdevinfo::PromProperty;

# Package global containing a reference to the Libdevinfo tree (singleton)
our $_ROOT_NODE;

# Package global containing a reference to the system PROM handle (singleton)
our $_PROM_HANDLE;

sub new {
  my ($pkg, %params) = @_;

  # We always want to access all information from the complete tree.
  # If only a subset of information is needed we handle it on the
  # perl end. This might be a performance issue when lots of trees
  # are generated, but as the methods are all read-only a singleton
  # tree should be sufficient.

  if( !defined $_ROOT_NODE ) {
    $_ROOT_NODE = bless {
      _data => di_init( "/", $DINFOCPYALL ),
      _parent => undef,
    }, $pkg;
  }
  return $_ROOT_NODE;
}

# Special constructor for internal nodes
sub _new_internal {
  my ($pkg, %params) = @_;

  # The parameter 'data' has the SWIG-type di_node_t and points to
  # the C data structure needed to access the node from the C library.
  # The parameter 'parent' points to the parent Perl object of this
  # node in the device tree. This is done in favor of using di_parent_node
  # from the library for two reasons: first it's a lot easier, second
  # it is good to have at most one object per node from the devicetree.
  # Checking the identity of a node can than be done by comparing the
  # references.
  # Both parameters should only be used when nodes inside the tree
  # are created from within methods of this class.

  die "No data specified." if( !defined $params{data} );
  die "No parent specified." if( !defined $params{parent} );

  my $this = bless {
    _data => $params{data},
    _parent => $params{parent},
  }, $pkg;

  return $this;
}

# This helper function generates a persistent prom handle on demand
# and returns it.
sub _prom_handle {
  if( !defined $_PROM_HANDLE ) {
    $_PROM_HANDLE = di_prom_init();
    if( isDI_PROM_HANDLE_NIL( $_PROM_HANDLE ) ) {
       # Maybe an exception should be thrown here.
#      warn "Cannot access PROM device: $ERRNO";
      $_PROM_HANDLE = undef;
    }
  }
  return $_PROM_HANDLE;
}

#=pod
#
#=head3 $tree->DESTROY;
#
#This is the destructor method. It should not be necessary to
#call this method directly.
#
#This is the equivalent of calling C<di_fini> from the C API.
#
#=cut

sub DESTROY {
  my $this = shift;

  # We need weak references for singletons. Fix this some time...
  if( !defined $this->{_parent} ) {
    di_prom_fini( $this->{_prom_handle} ) if( defined $this->{_prom_handle} );
    $this->{_prom_handle} = undef;
    di_fini( $this->{_data} ) if( defined $this->{_data} );
    $this->{_data} = undef;
  }
}

# tree traversal documented in Solaris::DeviceTree::Node
sub child_nodes {
  my ($this, %options) = @_;

  # The children of each node are cached
  if( !exists $this->{_children} ) {
    # Cache is empty, fill it.
    my @result = ();
    my $child = di_child_node( $this->{_data} );

    # Iterate over all children and generate objects accordlingly
    while( !isDI_NODE_NIL( $child ) ) {
      push @result, Solaris::DeviceTree::Libdevinfo->_new_internal(
        data => $child, parent => $this );
      $child = di_sibling_node( $child );
    }

    # Store result in cache
    $this->{_children} = \@result;
  }

  # Always return contents of cache
  return @{$this->{_children}};
}

# tree traversal documented in Solaris::DeviceTree::Node
sub parent_node {
  my $this = shift;

  # We directly return the parent node. Especially we don't use
  # di_parent_node from the C library. See the description of
  # the constructor for the reason.
  return $this->{_parent};
}

# tree traversal documented in Solaris::DeviceTree::Node
sub root_node {
  my $this = shift;

  # Since we have a singleton the same reference to the object is
  # always returned.
  return $_ROOT_NODE;
}

# tree traversal documented in Solaris::DeviceTree::Node
sub sibling_nodes {
  my $this = shift;

  my $parent = $this->parent_node;

  # Read all siblings including $this
  my @siblings = defined $parent ? $parent->child_nodes : ();

  # Strip out current node
  my @sib = grep { $_ ne $this } @siblings;

  return @sib;
}

sub devfs_path {
  my $this = shift;
  return di_devfs_path( $this->{_data} );
}

sub node_name {
  my $this = shift;
  return di_node_name( $this->{_data} );
}

sub binding_name {
  my $this = shift;
  return di_binding_name( $this->{_data} );
}

sub bus_addr {
  my $this = shift;
  my $busaddr = di_bus_addr( $this->{_data} );
  return $busaddr;
}

sub compatible_names {
  my $this = shift;
  my $node = $this->{_data};

  my $namehandle = newStringHandle();
  my $lastIndex = di_compatible_names( $node, $namehandle ) - 1;
  my @compatibleNames =
    map { getIndexedString( $namehandle, $_ ) } 0..$lastIndex;
  freeStringHandle( $namehandle );

  @compatibleNames;
}

#sub devid {
#  my $this = shift;
#  my $devid = di_devid( $this->{_data} );
#  return (isDevidNull( $devid ) == 0 ? $devid : 0);
#}

sub driver_name {
  my $this = shift;
  return di_driver_name( $this->{_data} );
}

sub driver_ops {
  my $this = shift;

  my $ops = di_driver_ops( $this->{_data} );
  my %ops;

  $ops{BUS}    = 1 if( $ops & $DI_BUS_OPS );
  $ops{CB}     = 1 if( $ops & $DI_CB_OPS );
  $ops{STREAM} = 1 if( $ops & $DI_STREAM_OPS );
  return %ops;
}

sub instance {
  my $this = shift;
  my $instance = di_instance( $this->{_data} );
  # if instance number is -1 then no instance was bound
  $instance = undef if( $instance == -1 );
  return $instance;
}

sub state {
  my $this = shift;

  my $state = di_state( $this->{_data} );
  my %state;

  $state{DRIVER_DETACHED} = 1 if( $state & $DI_DRIVER_DETACHED );
  $state{DEVICE_OFFLINE}  = 1 if( $state & $DI_DEVICE_OFFLINE );
  $state{DEVICE_DOWN}     = 1 if( $state & $DI_DEVICE_DOWN );
  $state{BUS_QUISCED}     = 1 if( $state & $DI_BUS_QUIESCED );
  $state{BUS_DOWN}        = 1 if( $state & $DI_BUS_DOWN );

  return %state;
}

sub nodeid {
  my $this = shift;
  my %_nodeid = (
    $DI_PSEUDO_NODEID => 'PSEUDO',
    $DI_SID_NODEID => 'SID',
    $DI_PROM_NODEID => 'PROM',
  );

  my $nodeid = di_nodeid( $this->{_data} );
  my $result = ( exists $_nodeid{ $nodeid } ? $_nodeid{ $nodeid } : undef );
  return $result;
}

sub is_pseudo_node {
  my $this = shift;
  return di_nodeid( $this->{_data} ) == $DI_PSEUDO_NODEID ? 'PSEUDO' : undef;
}

sub is_sid_node {
  my $this = shift;
  return di_nodeid( $this->{_data} ) == $DI_SID_NODEID ? 'SID' : undef;
}


sub is_prom_node {
  my $this = shift;

  return di_nodeid( $this->{_data} ) == $DI_PROM_NODEID ? 'PROM' : undef;
}

sub props {
  my $this = shift;
  my $node = $this->{_data};

  if( !exists $this->{_props} ) {
    my %props;
    my $prop = di_prop_next( $node, makeDI_PROP_NIL() );
    while( !isDI_PROP_NIL( $prop ) ) {
      my $propObj = new Solaris::DeviceTree::Libdevinfo::Property( $prop );
      $props{ $propObj->name } = $propObj;
      $prop = di_prop_next( $node, $prop );
    }
    $this->{_props} = \%props;
  }
  return $this->{_props};
}

sub prom_props {
  my $this = shift;
  my $node = $this->{_data};

  if( !exists $this->{_prom_props} ) {
    my %props;
    my $ph = $this->_prom_handle;
    if( defined $ph ) {
      my $handle = newUCharTHandle();
      my $prop = di_prom_prop_next( $ph, $node, makeDI_PROM_PROP_NIL() );
      while( !isDI_PROM_PROP_NIL( $prop ) ) {
        my $name = di_prom_prop_name( $prop );
        my $count = di_prom_prop_data( $prop, $handle );
        my $data = pack "C" x $count, map { getIndexedByte( $handle, $_ ) } 0 .. $count-1;
        $props{ $name } = Solaris::DeviceTree::Libdevinfo::PromProperty->new( $data );
  
        $prop = di_prom_prop_next( $ph, $node, $prop );
      }
      freeUCharTHandle( $handle );
      $this->{_prom_props} = \%props;
    } else {
      $this->{_prom_props} = undef;
    }
  }

  return $this->{_prom_props};
}

sub minor_nodes {
  my $this = shift;
  my $node = $this->{_data};

  if( !exists $this->{_minorNodes} ) {
    my @minorNodes;
    my $minor = di_minor_next( $node, makeDI_MINOR_NIL() );
    while( !isDI_MINOR_NIL( $minor ) ) {
      push @minorNodes, new Solaris::DeviceTree::Libdevinfo::MinorNode( $minor, $this );
      $minor = di_minor_next( $node, $minor );
    }
    $this->{_minorNodes} = \@minorNodes;
  }
  return $this->{_minorNodes};
}

1;